Multivariate/paths.ml

   1 (* ========================================================================= *)
   2 (* Paths, connectedness, homotopy, simple connectedness & contractibility.   *)
   3 (*                                                                           *)
   4 (*              (c) Copyright, John Harrison 1998-2008                       *)
   5 (*              (c) Copyright, Valentina Bruno 2010                          *)
   6 (* ========================================================================= *)
   7
   8 needs "Multivariate/convex.ml";;
   9
  10 (* ------------------------------------------------------------------------- *)
  11 (* Paths and arcs.                                                           *)
  12 (* ------------------------------------------------------------------------- *)
  13
  14 let path = new_definition
  15  `!g:real^1->real^N. path g <=> g continuous_on interval[vec 0,vec 1]`;;
  16
  17 let pathstart = new_definition
  18  `pathstart (g:real^1->real^N) = g(vec 0)`;;
  19
  20 let pathfinish = new_definition
  21  `pathfinish (g:real^1->real^N) = g(vec 1)`;;
  22
  23 let path_image = new_definition
  24  `path_image (g:real^1->real^N) = IMAGE g (interval[vec 0,vec 1])`;;
  25
  26 let reversepath = new_definition
  27  `reversepath (g:real^1->real^N) = \x. g(vec 1 - x)`;;
  28
  29 let joinpaths = new_definition
  30  `(g1 ++ g2) = \x. if drop x <= &1 / &2 then g1(&2 % x)
  31                    else g2(&2 % x - vec 1)`;;
  32
  33 let simple_path = new_definition
  34  `simple_path (g:real^1->real^N) <=>
  35         path g /\
  36         !x y. x IN interval[vec 0,vec 1] /\
  37               y IN interval[vec 0,vec 1] /\
  38               g x = g y
  39               ==> x = y \/ x = vec 0 /\ y = vec 1 \/ x = vec 1 /\ y = vec 0`;;
  40
  41 let arc = new_definition
  42  `arc (g:real^1->real^N) <=>
  43         path g /\
  44         !x y. x IN interval [vec 0,vec 1] /\
  45               y IN interval [vec 0,vec 1] /\
  46               g x = g y
  47               ==> x = y`;;
  48
  49 (* ------------------------------------------------------------------------- *)
  50 (* Invariance theorems.                                                      *)
  51 (* ------------------------------------------------------------------------- *)
  52
  53 let PATH_EQ = prove
  54  (`!p q. (!t. t IN interval[vec 0,vec 1] ==> p t = q t) /\ path p
  55          ==> path q`,
  56   REWRITE_TAC[path; CONTINUOUS_ON_EQ]);;
  57
  58 let PATH_CONTINUOUS_IMAGE = prove
  59  (`!f:real^M->real^N g.
  60      path g /\ f continuous_on path_image g ==> path(f o g)`,
  61   REWRITE_TAC[path; path_image; CONTINUOUS_ON_COMPOSE]);;
  62
  63 let PATH_TRANSLATION_EQ = prove
  64  (`!a g:real^1->real^N. path((\x. a + x) o g) <=> path g`,
  65   REPEAT GEN_TAC THEN REWRITE_TAC[path] THEN EQ_TAC THEN DISCH_TAC THENL
  66    [SUBGOAL_THEN `(g:real^1->real^N) = (\x. --a + x) o (\x. a + x) o g`
  67     SUBST1_TAC THENL
  68      [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN VECTOR_ARITH_TAC; ALL_TAC];
  69     ALL_TAC] THEN
  70   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
  71   ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]);;
  72
  73 add_translation_invariants [PATH_TRANSLATION_EQ];;
  74
  75 let PATH_LINEAR_IMAGE_EQ = prove
  76  (`!f:real^M->real^N g.
  77         linear f /\ (!x y. f x = f y ==> x = y)
  78         ==> (path(f o g) <=> path g)`,
  79   REPEAT GEN_TAC THEN DISCH_TAC THEN
  80   FIRST_ASSUM(X_CHOOSE_THEN `h:real^N->real^M` STRIP_ASSUME_TAC o
  81         MATCH_MP LINEAR_INJECTIVE_LEFT_INVERSE) THEN
  82   REWRITE_TAC[path] THEN EQ_TAC THEN DISCH_TAC THENL
  83    [SUBGOAL_THEN `g:real^1->real^M = h o (f:real^M->real^N) o g`
  84     SUBST1_TAC THENL [ASM_REWRITE_TAC[o_ASSOC; I_O_ID]; ALL_TAC];
  85     ALL_TAC] THEN
  86   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
  87   ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON]);;
  88
  89 add_linear_invariants [PATH_LINEAR_IMAGE_EQ];;
  90
  91 let PATHSTART_TRANSLATION = prove
  92  (`!a g. pathstart((\x. a + x) o g) = a + pathstart g`,
  93   REWRITE_TAC[pathstart; o_THM]);;
  94
  95 add_translation_invariants [PATHSTART_TRANSLATION];;
  96
  97 let PATHSTART_LINEAR_IMAGE_EQ = prove
  98  (`!f g. linear f ==> pathstart(f o g) = f(pathstart g)`,
  99   REWRITE_TAC[pathstart; o_THM]);;
 100
 101 add_linear_invariants [PATHSTART_LINEAR_IMAGE_EQ];;
 102
 103 let PATHFINISH_TRANSLATION = prove
 104  (`!a g. pathfinish((\x. a + x) o g) = a + pathfinish g`,
 105   REWRITE_TAC[pathfinish; o_THM]);;
 106
 107 add_translation_invariants [PATHFINISH_TRANSLATION];;
 108
 109 let PATHFINISH_LINEAR_IMAGE = prove
 110  (`!f g. linear f ==> pathfinish(f o g) = f(pathfinish g)`,
 111   REWRITE_TAC[pathfinish; o_THM]);;
 112
 113 add_linear_invariants [PATHFINISH_LINEAR_IMAGE];;
 114
 115 let PATH_IMAGE_TRANSLATION = prove
 116  (`!a g. path_image((\x. a + x) o g) = IMAGE (\x. a + x) (path_image g)`,
 117   REWRITE_TAC[path_image; IMAGE_o]);;
 118
 119 add_translation_invariants [PATH_IMAGE_TRANSLATION];;
 120
 121 let PATH_IMAGE_LINEAR_IMAGE = prove
 122  (`!f g. linear f ==> path_image(f o g) = IMAGE f (path_image g)`,
 123   REWRITE_TAC[path_image; IMAGE_o]);;
 124
 125 add_linear_invariants [PATH_IMAGE_LINEAR_IMAGE];;
 126
 127 let REVERSEPATH_TRANSLATION = prove
 128  (`!a g. reversepath((\x. a + x) o g) = (\x. a + x) o reversepath g`,
 129   REWRITE_TAC[FUN_EQ_THM; reversepath; o_THM]);;
 130
 131 add_translation_invariants [REVERSEPATH_TRANSLATION];;
 132
 133 let REVERSEPATH_LINEAR_IMAGE = prove
 134  (`!f g. linear f ==> reversepath(f o g) = f o reversepath g`,
 135   REWRITE_TAC[FUN_EQ_THM; reversepath; o_THM]);;
 136
 137 add_linear_invariants [REVERSEPATH_LINEAR_IMAGE];;
 138
 139 let JOINPATHS_TRANSLATION = prove
 140  (`!a:real^N g1 g2. ((\x. a + x) o g1) ++ ((\x. a + x) o g2) =
 141                     (\x. a + x) o (g1 ++ g2)`,
 142   REWRITE_TAC[joinpaths; FUN_EQ_THM] THEN REPEAT GEN_TAC THEN
 143   COND_CASES_TAC THEN ASM_REWRITE_TAC[o_THM]);;
 144
 145 add_translation_invariants [JOINPATHS_TRANSLATION];;
 146
 147 let JOINPATHS_LINEAR_IMAGE = prove
 148  (`!f g1 g2. linear f ==> (f o g1) ++ (f o g2) = f o (g1 ++ g2)`,
 149   REWRITE_TAC[joinpaths; FUN_EQ_THM] THEN REPEAT STRIP_TAC THEN
 150   COND_CASES_TAC THEN ASM_REWRITE_TAC[o_THM]);;
 151
 152 add_linear_invariants [JOINPATHS_LINEAR_IMAGE];;
 153
 154 let SIMPLE_PATH_TRANSLATION_EQ = prove
 155  (`!a g:real^1->real^N. simple_path((\x. a + x) o g) <=> simple_path g`,
 156   REPEAT GEN_TAC THEN REWRITE_TAC[simple_path; PATH_TRANSLATION_EQ] THEN
 157   REWRITE_TAC[o_THM; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]);;
 158
 159 add_translation_invariants [SIMPLE_PATH_TRANSLATION_EQ];;
 160
 161 let SIMPLE_PATH_LINEAR_IMAGE_EQ = prove
 162  (`!f:real^M->real^N g.
 163         linear f /\ (!x y. f x = f y ==> x = y)
 164         ==> (simple_path(f o g) <=> simple_path g)`,
 165   REPEAT STRIP_TAC THEN REWRITE_TAC[simple_path; PATH_TRANSLATION_EQ] THEN
 166   BINOP_TAC THENL [ASM_MESON_TAC[PATH_LINEAR_IMAGE_EQ]; ALL_TAC] THEN
 167   REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]);;
 168
 169 add_linear_invariants [SIMPLE_PATH_LINEAR_IMAGE_EQ];;
 170
 171 let ARC_TRANSLATION_EQ = prove
 172  (`!a g:real^1->real^N. arc((\x. a + x) o g) <=> arc g`,
 173   REPEAT GEN_TAC THEN REWRITE_TAC[arc; PATH_TRANSLATION_EQ] THEN
 174   REWRITE_TAC[o_THM; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]);;
 175
 176 add_translation_invariants [ARC_TRANSLATION_EQ];;
 177
 178 let ARC_LINEAR_IMAGE_EQ = prove
 179  (`!f:real^M->real^N g.
 180         linear f /\ (!x y. f x = f y ==> x = y)
 181         ==> (arc(f o g) <=> arc g)`,
 182   REPEAT STRIP_TAC THEN REWRITE_TAC[arc; PATH_TRANSLATION_EQ] THEN
 183   BINOP_TAC THENL [ASM_MESON_TAC[PATH_LINEAR_IMAGE_EQ]; ALL_TAC] THEN
 184   REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]);;
 185
 186 add_linear_invariants [ARC_LINEAR_IMAGE_EQ];;
 187
 188 (* ------------------------------------------------------------------------- *)
 189 (* Basic lemmas about paths.                                                 *)
 190 (* ------------------------------------------------------------------------- *)
 191
 192 let ARC_IMP_SIMPLE_PATH = prove
 193  (`!g. arc g ==> simple_path g`,
 194   REWRITE_TAC[arc; simple_path] THEN MESON_TAC[]);;
 195
 196 let ARC_IMP_PATH = prove
 197  (`!g. arc g ==> path g`,
 198   REWRITE_TAC[arc] THEN MESON_TAC[]);;
 199
 200 let SIMPLE_PATH_IMP_PATH = prove
 201  (`!g. simple_path g ==> path g`,
 202   REWRITE_TAC[simple_path] THEN MESON_TAC[]);;
 203
 204 let SIMPLE_PATH_CASES = prove
 205  (`!g:real^1->real^N. simple_path g ==> arc g \/ pathfinish g = pathstart g`,
 206   REWRITE_TAC[simple_path; arc; pathfinish; pathstart] THEN
 207   REPEAT STRIP_TAC THEN
 208   ASM_CASES_TAC `(g:real^1->real^N) (vec 0) = g(vec 1)` THEN
 209   ASM_REWRITE_TAC[] THEN
 210   MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN STRIP_TAC THEN
 211   FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^1`; `v:real^1`]) THEN
 212   ASM_MESON_TAC[]);;
 213
 214 let SIMPLE_PATH_IMP_ARC = prove
 215  (`!g:real^1->real^N.
 216         simple_path g /\ ~(pathfinish g = pathstart g) ==> arc g`,
 217   MESON_TAC[SIMPLE_PATH_CASES]);;
 218
 219 let ARC_DISTINCT_ENDS = prove
 220  (`!g:real^1->real^N. arc g ==> ~(pathfinish g = pathstart g)`,
 221   GEN_TAC THEN REWRITE_TAC[arc; pathfinish; pathstart] THEN
 222   ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> a /\ b /\ ~d ==> ~c`] THEN
 223   DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN
 224   REWRITE_TAC[GSYM DROP_EQ; IN_INTERVAL_1; DROP_VEC] THEN
 225   CONV_TAC REAL_RAT_REDUCE_CONV);;
 226
 227 let ARC_SIMPLE_PATH = prove
 228  (`!g:real^1->real^N.
 229         arc g <=> simple_path g /\ ~(pathfinish g = pathstart g)`,
 230   MESON_TAC[SIMPLE_PATH_CASES; ARC_IMP_SIMPLE_PATH; ARC_DISTINCT_ENDS]);;
 231
 232 let SIMPLE_PATH_EQ_ARC = prove
 233  (`!g. ~(pathstart g = pathfinish g) ==> (simple_path g <=> arc g)`,
 234   SIMP_TAC[ARC_SIMPLE_PATH]);;
 235
 236 let PATH_IMAGE_NONEMPTY = prove
 237  (`!g. ~(path_image g = {})`,
 238   REWRITE_TAC[path_image; IMAGE_EQ_EMPTY; INTERVAL_EQ_EMPTY] THEN
 239   SIMP_TAC[DIMINDEX_1; CONJ_ASSOC; LE_ANTISYM; UNWIND_THM1; VEC_COMPONENT;
 240            ARITH; REAL_OF_NUM_LT]);;
 241
 242 let PATHSTART_IN_PATH_IMAGE = prove
 243  (`!g. (pathstart g) IN path_image g`,
 244   GEN_TAC THEN REWRITE_TAC[pathstart; path_image] THEN
 245   MATCH_MP_TAC FUN_IN_IMAGE THEN
 246   REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS]);;
 247
 248 let PATHFINISH_IN_PATH_IMAGE = prove
 249  (`!g. (pathfinish g) IN path_image g`,
 250   GEN_TAC THEN REWRITE_TAC[pathfinish; path_image] THEN
 251   MATCH_MP_TAC FUN_IN_IMAGE THEN
 252   REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN REAL_ARITH_TAC);;
 253
 254 let CONNECTED_PATH_IMAGE = prove
 255  (`!g. path g ==> connected(path_image g)`,
 256   REWRITE_TAC[path; path_image] THEN REPEAT STRIP_TAC THEN
 257   MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
 258   ASM_SIMP_TAC[CONVEX_CONNECTED; CONVEX_INTERVAL]);;
 259
 260 let COMPACT_PATH_IMAGE = prove
 261  (`!g. path g ==> compact(path_image g)`,
 262   REWRITE_TAC[path; path_image] THEN REPEAT STRIP_TAC THEN
 263   MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
 264   ASM_REWRITE_TAC[COMPACT_INTERVAL]);;
 265
 266 let BOUNDED_PATH_IMAGE = prove
 267  (`!g. path g ==> bounded(path_image g)`,
 268   MESON_TAC[COMPACT_PATH_IMAGE; COMPACT_IMP_BOUNDED]);;
 269
 270 let CLOSED_PATH_IMAGE = prove
 271  (`!g. path g ==> closed(path_image g)`,
 272   MESON_TAC[COMPACT_PATH_IMAGE; COMPACT_IMP_CLOSED]);;
 273
 274 let CONNECTED_SIMPLE_PATH_IMAGE = prove
 275  (`!g. simple_path g ==> connected(path_image g)`,
 276   MESON_TAC[CONNECTED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]);;
 277
 278 let COMPACT_SIMPLE_PATH_IMAGE = prove
 279  (`!g. simple_path g ==> compact(path_image g)`,
 280   MESON_TAC[COMPACT_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]);;
 281
 282 let BOUNDED_SIMPLE_PATH_IMAGE = prove
 283  (`!g. simple_path g ==> bounded(path_image g)`,
 284   MESON_TAC[BOUNDED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]);;
 285
 286 let CLOSED_SIMPLE_PATH_IMAGE = prove
 287  (`!g. simple_path g ==> closed(path_image g)`,
 288   MESON_TAC[CLOSED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]);;
 289
 290 let CONNECTED_ARC_IMAGE = prove
 291  (`!g. arc g ==> connected(path_image g)`,
 292   MESON_TAC[CONNECTED_PATH_IMAGE; ARC_IMP_PATH]);;
 293
 294 let COMPACT_ARC_IMAGE = prove
 295  (`!g. arc g ==> compact(path_image g)`,
 296   MESON_TAC[COMPACT_PATH_IMAGE; ARC_IMP_PATH]);;
 297
 298 let BOUNDED_ARC_IMAGE = prove
 299  (`!g. arc g ==> bounded(path_image g)`,
 300   MESON_TAC[BOUNDED_PATH_IMAGE; ARC_IMP_PATH]);;
 301
 302 let CLOSED_ARC_IMAGE = prove
 303  (`!g. arc g ==> closed(path_image g)`,
 304   MESON_TAC[CLOSED_PATH_IMAGE; ARC_IMP_PATH]);;
 305
 306 let PATHSTART_COMPOSE = prove
 307  (`!f p. pathstart(f o p) = f(pathstart p)`,
 308   REWRITE_TAC[pathstart; o_THM]);;
 309
 310 let PATHFINISH_COMPOSE = prove
 311  (`!f p. pathfinish(f o p) = f(pathfinish p)`,
 312   REWRITE_TAC[pathfinish; o_THM]);;
 313
 314 let PATH_IMAGE_COMPOSE = prove
 315  (`!f p. path_image (f o p) = IMAGE f (path_image p)`,
 316   REWRITE_TAC[path_image; IMAGE_o]);;
 317
 318 let PATH_COMPOSE_JOIN = prove
 319  (`!f p q. f o (p ++ q) = (f o p) ++ (f o q)`,
 320   REWRITE_TAC[joinpaths; o_DEF; FUN_EQ_THM] THEN MESON_TAC[]);;
 321
 322 let PATH_COMPOSE_REVERSEPATH = prove
 323  (`!f p. f o reversepath p = reversepath(f o p)`,
 324   REWRITE_TAC[reversepath; o_DEF; FUN_EQ_THM] THEN MESON_TAC[]);;
 325
 326 let JOIN_PATHS_EQ = prove
 327  (`!p q:real^1->real^N.
 328    (!t. t IN interval[vec 0,vec 1] ==> p t = p' t) /\
 329    (!t. t IN interval[vec 0,vec 1] ==> q t = q' t)
 330    ==> !t. t IN interval[vec 0,vec 1] ==> (p ++ q) t = (p' ++ q') t`,
 331   REWRITE_TAC[joinpaths; IN_INTERVAL_1; DROP_VEC] THEN REPEAT STRIP_TAC THEN
 332   COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
 333   REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_SUB; DROP_VEC] THEN
 334   ASM_REAL_ARITH_TAC);;
 335
 336 let CARD_EQ_SIMPLE_PATH_IMAGE = prove
 337  (`!g. simple_path g ==> path_image g =_c (:real)`,
 338   SIMP_TAC[CONNECTED_CARD_EQ_IFF_NONTRIVIAL; CONNECTED_SIMPLE_PATH_IMAGE] THEN
 339   GEN_TAC THEN REWRITE_TAC[simple_path; path_image] THEN MATCH_MP_TAC(SET_RULE
 340    `(?u v. u IN s /\ v IN s /\ ~(u = a) /\ ~(v = a) /\ ~(u = v))
 341     ==> P /\ (!x y. x IN s /\ y IN s /\ f x = f y
 342                     ==> x = y \/ x = a /\ y = b \/ x = b /\ y = a)
 343         ==> ~(?c. IMAGE f s SUBSET {c})`) THEN
 344   MAP_EVERY EXISTS_TAC [`lift(&1 / &3)`; `lift(&1 / &2)`] THEN
 345   REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; GSYM LIFT_NUM; LIFT_EQ] THEN
 346   CONV_TAC REAL_RAT_REDUCE_CONV);;
 347
 348 let INFINITE_SIMPLE_PATH_IMAGE = prove
 349  (`!g. simple_path g ==> INFINITE(path_image g)`,
 350   MESON_TAC[CARD_EQ_SIMPLE_PATH_IMAGE; INFINITE; FINITE_IMP_COUNTABLE;
 351             UNCOUNTABLE_REAL; CARD_COUNTABLE_CONG]);;
 352
 353 let CARD_EQ_ARC_IMAGE = prove
 354  (`!g. arc g ==> path_image g =_c (:real)`,
 355   MESON_TAC[ARC_IMP_SIMPLE_PATH; CARD_EQ_SIMPLE_PATH_IMAGE]);;
 356
 357 let INFINITE_ARC_IMAGE = prove
 358  (`!g. arc g ==> INFINITE(path_image g)`,
 359   MESON_TAC[ARC_IMP_SIMPLE_PATH; INFINITE_SIMPLE_PATH_IMAGE]);;
 360
 361 (* ------------------------------------------------------------------------- *)
 362 (* Simple paths with the endpoints removed.                                  *)
 363 (* ------------------------------------------------------------------------- *)
 364
 365 let SIMPLE_PATH_ENDLESS = prove
 366  (`!c:real^1->real^N.
 367         simple_path c
 368         ==> path_image c DIFF {pathstart c,pathfinish c} =
 369             IMAGE c (interval(vec 0,vec 1))`,
 370   REWRITE_TAC[simple_path; path_image; pathstart; pathfinish] THEN
 371   REWRITE_TAC[OPEN_CLOSED_INTERVAL_1; path] THEN
 372   REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE
 373    `(!x y. x IN s /\ y IN s /\ c x = c y
 374            ==> x = y \/ x = a /\ y = b \/ x = b /\ y = a) /\
 375     a IN s /\ b IN s
 376     ==>  IMAGE c s DIFF {c a,c b} = IMAGE c (s DIFF {a,b})`) THEN
 377   ASM_REWRITE_TAC[] THEN
 378   REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL]);;
 379
 380 let CONNECTED_SIMPLE_PATH_ENDLESS = prove
 381  (`!c:real^1->real^N.
 382         simple_path c
 383         ==> connected(path_image c DIFF {pathstart c,pathfinish c})`,
 384   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SIMPLE_PATH_ENDLESS] THEN
 385   MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
 386   SIMP_TAC[CONVEX_INTERVAL; CONVEX_CONNECTED] THEN
 387   MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
 388   EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
 389   RULE_ASSUM_TAC(REWRITE_RULE[simple_path; path]) THEN
 390   ASM_REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED]);;
 391
 392 let NONEMPTY_SIMPLE_PATH_ENDLESS = prove
 393  (`!c:real^1->real^N.
 394       simple_path c ==> ~(path_image c DIFF {pathstart c,pathfinish c} = {})`,
 395   SIMP_TAC[SIMPLE_PATH_ENDLESS; IMAGE_EQ_EMPTY; INTERVAL_EQ_EMPTY_1] THEN
 396   REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC);;
 397
 398 (* ------------------------------------------------------------------------- *)
 399 (* The operations on paths.                                                  *)
 400 (* ------------------------------------------------------------------------- *)
 401
 402 let JOINPATHS = prove
 403  (`!g1 g2. pathfinish g1 = pathstart g2
 404            ==> g1 ++ g2 = \x. if drop x < &1 / &2 then g1(&2 % x)
 405                               else g2 (&2 % x - vec 1)`,
 406   REWRITE_TAC[pathstart; pathfinish] THEN REPEAT STRIP_TAC THEN
 407   REWRITE_TAC[joinpaths; FUN_EQ_THM] THEN
 408   X_GEN_TAC `x:real^1` THEN ASM_CASES_TAC `drop x = &1 / &2` THENL
 409    [FIRST_X_ASSUM(MP_TAC o AP_TERM `lift`) THEN
 410     REWRITE_TAC[LIFT_DROP] THEN DISCH_THEN SUBST1_TAC THEN
 411     REWRITE_TAC[LIFT_DROP; REAL_LE_REFL; GSYM LIFT_CMUL; REAL_LT_REFL] THEN
 412     CONV_TAC REAL_RAT_REDUCE_CONV THEN
 413     ASM_REWRITE_TAC[LIFT_NUM; VECTOR_SUB_REFL];
 414     REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_REAL_ARITH_TAC]);;
 415
 416 let REVERSEPATH_REVERSEPATH = prove
 417  (`!g:real^1->real^N. reversepath(reversepath g) = g`,
 418   REWRITE_TAC[reversepath; ETA_AX;
 419               VECTOR_ARITH `vec 1 - (vec 1 - x):real^1 = x`]);;
 420
 421 let PATHSTART_REVERSEPATH = prove
 422  (`pathstart(reversepath g) = pathfinish g`,
 423   REWRITE_TAC[pathstart; reversepath; pathfinish; VECTOR_SUB_RZERO]);;
 424
 425 let PATHFINISH_REVERSEPATH = prove
 426  (`pathfinish(reversepath g) = pathstart g`,
 427   REWRITE_TAC[pathstart; reversepath; pathfinish; VECTOR_SUB_REFL]);;
 428
 429 let PATHSTART_JOIN = prove
 430  (`!g1 g2. pathstart(g1 ++ g2) = pathstart g1`,
 431   REWRITE_TAC[joinpaths; pathstart; pathstart; DROP_VEC; VECTOR_MUL_RZERO] THEN
 432   CONV_TAC REAL_RAT_REDUCE_CONV);;
 433
 434 let PATHFINISH_JOIN = prove
 435  (`!g1 g2. pathfinish(g1 ++ g2) = pathfinish g2`,
 436   REPEAT GEN_TAC THEN REWRITE_TAC[joinpaths; pathfinish; DROP_VEC] THEN
 437   CONV_TAC REAL_RAT_REDUCE_CONV THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC);;
 438
 439 let PATH_IMAGE_REVERSEPATH = prove
 440  (`!g:real^1->real^N. path_image(reversepath g) = path_image g`,
 441   SUBGOAL_THEN `!g:real^1->real^N.
 442       path_image(reversepath g) SUBSET path_image g`
 443    (fun th -> MESON_TAC[th; REVERSEPATH_REVERSEPATH; SUBSET_ANTISYM]) THEN
 444   REWRITE_TAC[SUBSET; path_image; FORALL_IN_IMAGE] THEN
 445   MAP_EVERY X_GEN_TAC [`g:real^1->real^N`; `x:real^1`] THEN
 446   DISCH_TAC THEN REWRITE_TAC[reversepath; IN_IMAGE] THEN
 447   EXISTS_TAC `vec 1 - x:real^1` THEN POP_ASSUM MP_TAC THEN
 448   REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC);;
 449
 450 let PATH_REVERSEPATH = prove
 451  (`!g:real^1->real^N. path(reversepath g) <=> path g`,
 452   SUBGOAL_THEN `!g:real^1->real^N. path g ==> path(reversepath g)`
 453    (fun th -> MESON_TAC[th; REVERSEPATH_REVERSEPATH]) THEN
 454   GEN_TAC THEN REWRITE_TAC[path; reversepath] THEN STRIP_TAC THEN
 455   GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
 456   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
 457   SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
 458   MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
 459   EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
 460   ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN
 461   REWRITE_TAC[DROP_VEC; DROP_SUB] THEN REAL_ARITH_TAC);;
 462
 463 let PATH_JOIN = prove
 464  (`!g1 g2:real^1->real^N.
 465         pathfinish g1 = pathstart g2
 466         ==> (path(g1 ++ g2) <=> path g1 /\ path g2)`,
 467   REWRITE_TAC[path; pathfinish; pathstart] THEN
 468   REPEAT STRIP_TAC THEN EQ_TAC THENL
 469    [STRIP_TAC THEN CONJ_TAC THENL
 470      [SUBGOAL_THEN
 471        `(g1:real^1->real^N) = (\x. g1 (&2 % x)) o (\x. &1 / &2 % x)`
 472       SUBST1_TAC THENL
 473        [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN
 474         VECTOR_ARITH_TAC;
 475         ALL_TAC] THEN
 476       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
 477       SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN
 478       MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
 479       EXISTS_TAC `(g1 ++ g2):real^1->real^N` THEN CONJ_TAC THENL
 480        [REWRITE_TAC[FORALL_IN_IMAGE; joinpaths; IN_INTERVAL_1; DROP_CMUL] THEN
 481         SIMP_TAC[DROP_VEC; REAL_ARITH `&1 / &2 * x <= &1 / &2 <=> x <= &1`];
 482         ALL_TAC] THEN
 483       MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
 484       EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[] THEN
 485       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_CMUL] THEN
 486       REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC;
 487       SUBGOAL_THEN
 488        `(g2:real^1->real^N) =
 489         (\x. g2 (&2 % x - vec 1)) o (\x. &1 / &2 % (x + vec 1))`
 490       SUBST1_TAC THENL
 491        [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN
 492         VECTOR_ARITH_TAC;
 493         ALL_TAC] THEN
 494       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
 495       SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST;
 496                CONTINUOUS_ON_ADD] THEN
 497       MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
 498       EXISTS_TAC `(g1 ++ g2):real^1->real^N` THEN CONJ_TAC THENL
 499        [REWRITE_TAC[FORALL_IN_IMAGE; joinpaths; IN_INTERVAL_1; DROP_CMUL] THEN
 500         REWRITE_TAC[DROP_VEC; DROP_ADD; REAL_ARITH
 501          `&1 / &2 * (x + &1) <= &1 / &2 <=> x <= &0`] THEN
 502         SIMP_TAC[REAL_ARITH `&0 <= x ==> (x <= &0 <=> x = &0)`; LIFT_NUM;
 503           VECTOR_MUL_ASSOC; GSYM LIFT_EQ; LIFT_DROP; GSYM LIFT_CMUL] THEN
 504         CONV_TAC REAL_RAT_REDUCE_CONV THEN
 505         ASM_REWRITE_TAC[VECTOR_ADD_LID; VECTOR_MUL_LID] THEN
 506         REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
 507         REWRITE_TAC[VECTOR_ARITH `(x + vec 1) - vec 1 = x`];
 508         ALL_TAC] THEN
 509       MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
 510       EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[] THEN
 511       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_CMUL] THEN
 512       REWRITE_TAC[DROP_VEC; DROP_ADD] THEN REAL_ARITH_TAC];
 513     STRIP_TAC THEN
 514     SUBGOAL_THEN `interval[vec 0,vec 1] =
 515                   interval[vec 0,lift(&1 / &2)] UNION
 516                   interval[lift(&1 / &2),vec 1]`
 517     SUBST1_TAC THENL
 518      [SIMP_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
 519       REAL_ARITH_TAC;
 520       ALL_TAC] THEN
 521     MATCH_MP_TAC CONTINUOUS_ON_UNION THEN REWRITE_TAC[CLOSED_INTERVAL] THEN
 522     CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL
 523      [EXISTS_TAC `\x. (g1:real^1->real^N) (&2 % x)`;
 524       EXISTS_TAC `\x. (g2:real^1->real^N) (&2 % x - vec 1)`] THEN
 525     REWRITE_TAC[joinpaths] THEN SIMP_TAC[IN_INTERVAL_1; LIFT_DROP] THENL
 526      [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
 527       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
 528       SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN
 529       ONCE_REWRITE_TAC[VECTOR_ARITH `&2 % (x:real^1) = &2 % x + vec 0`] THEN
 530       REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN
 531       REWRITE_TAC[REAL_POS; INTERVAL_EQ_EMPTY_1; LIFT_DROP; DROP_VEC] THEN
 532       REWRITE_TAC[GSYM LIFT_CMUL; VECTOR_ADD_RID; VECTOR_MUL_RZERO] THEN
 533       CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[LIFT_NUM];
 534       ALL_TAC] THEN
 535     CONJ_TAC THENL
 536      [SIMP_TAC[REAL_ARITH `&1 / &2 <= x ==> (x <= &1 / &2 <=> x = &1 / &2)`;
 537                GSYM LIFT_EQ; LIFT_DROP; GSYM LIFT_CMUL] THEN
 538       CONV_TAC REAL_RAT_REDUCE_CONV THEN
 539       RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
 540       ASM_REWRITE_TAC[LIFT_NUM] THEN
 541       REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
 542       REWRITE_TAC[GSYM LIFT_CMUL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
 543       REWRITE_TAC[LIFT_NUM; VECTOR_SUB_REFL];
 544       ALL_TAC] THEN
 545     GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
 546     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
 547     SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST;
 548              CONTINUOUS_ON_ID] THEN
 549     ONCE_REWRITE_TAC[VECTOR_ARITH `&2 % x - vec 1 = &2 % x + --vec 1`] THEN
 550     REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN
 551     REWRITE_TAC[REAL_POS; INTERVAL_EQ_EMPTY_1; LIFT_DROP; DROP_VEC] THEN
 552     REWRITE_TAC[GSYM LIFT_CMUL; VECTOR_ADD_RID; VECTOR_MUL_RZERO] THEN
 553     CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[LIFT_NUM] THEN
 554     ASM_REWRITE_TAC[VECTOR_ARITH `&2 % x + --x = x /\ x + --x = vec 0`]]);;
 555
 556 let PATH_JOIN_IMP = prove
 557  (`!g1 g2:real^1->real^N.
 558         path g1 /\ path g2 /\ pathfinish g1 = pathstart g2
 559         ==> path(g1 ++ g2)`,
 560   MESON_TAC[PATH_JOIN]);;
 561
 562 let PATH_IMAGE_JOIN_SUBSET = prove
 563  (`!g1 g2:real^1->real^N.
 564         path_image(g1 ++ g2) SUBSET (path_image g1 UNION path_image g2)`,
 565   REWRITE_TAC[path_image; FORALL_IN_IMAGE; SUBSET] THEN
 566   GEN_TAC THEN GEN_TAC THEN X_GEN_TAC `x:real^1` THEN
 567   REWRITE_TAC[IN_INTERVAL_1; IN_UNION; IN_IMAGE; DROP_VEC; joinpaths] THEN
 568   STRIP_TAC THEN ASM_CASES_TAC `drop x <= &1 / &2` THEN ASM_REWRITE_TAC[] THENL
 569    [DISJ1_TAC THEN EXISTS_TAC `&2 % x:real^1` THEN REWRITE_TAC[DROP_CMUL];
 570     DISJ2_TAC THEN EXISTS_TAC `&2 % x - vec 1:real^1` THEN
 571     REWRITE_TAC[DROP_CMUL; DROP_SUB; DROP_VEC]] THEN
 572   ASM_REAL_ARITH_TAC);;
 573
 574 let SUBSET_PATH_IMAGE_JOIN = prove
 575  (`!g1 g2:real^1->real^N s.
 576         path_image g1 SUBSET s /\ path_image g2 SUBSET s
 577         ==> path_image(g1 ++ g2) SUBSET s`,
 578   MP_TAC PATH_IMAGE_JOIN_SUBSET THEN
 579   REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
 580   SET_TAC[]);;
 581
 582 let PATH_IMAGE_JOIN = prove
 583  (`!g1 g2. pathfinish g1 = pathstart g2
 584            ==> path_image(g1 ++ g2) = path_image g1 UNION path_image g2`,
 585   REWRITE_TAC[pathfinish; pathstart] THEN REPEAT STRIP_TAC THEN
 586   MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[PATH_IMAGE_JOIN_SUBSET] THEN
 587   REWRITE_TAC[path_image; SUBSET; FORALL_AND_THM; IN_UNION; TAUT
 588                 `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN
 589   REWRITE_TAC[FORALL_IN_IMAGE; joinpaths] THEN
 590   REWRITE_TAC[IN_INTERVAL_1; IN_IMAGE; DROP_VEC] THEN
 591   CONJ_TAC THEN X_GEN_TAC `x:real^1` THEN REPEAT STRIP_TAC THENL
 592    [EXISTS_TAC `(&1 / &2) % x:real^1` THEN
 593     ASM_REWRITE_TAC[DROP_CMUL; REAL_ARITH
 594      `&1 / &2 * x <= &1 / &2 <=> x <= &1`] THEN
 595     REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
 596     ASM_REWRITE_TAC[VECTOR_MUL_LID];
 597     EXISTS_TAC `(&1 / &2) % (x + vec 1):real^1` THEN
 598     ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; DROP_VEC] THEN
 599     REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
 600     REWRITE_TAC[VECTOR_MUL_LID; VECTOR_ARITH `(x + vec 1) - vec 1 = x`] THEN
 601     ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> (&1 / &2 * (x + &1) <= &1 / &2 <=>
 602                                           x = &0)`] THEN
 603     REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM] THEN
 604     COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_LID; DROP_VEC]] THEN
 605   ASM_REAL_ARITH_TAC);;
 606
 607 let NOT_IN_PATH_IMAGE_JOIN = prove
 608  (`!g1 g2 x. ~(x IN path_image g1) /\ ~(x IN path_image g2)
 609              ==> ~(x IN path_image(g1 ++ g2))`,
 610   MESON_TAC[PATH_IMAGE_JOIN_SUBSET; SUBSET; IN_UNION]);;
 611
 612 let ARC_REVERSEPATH = prove
 613  (`!g. arc g ==> arc(reversepath g)`,
 614   GEN_TAC THEN SIMP_TAC[arc; PATH_REVERSEPATH] THEN
 615   REWRITE_TAC[arc; reversepath] THEN STRIP_TAC THEN
 616   MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN
 617   FIRST_X_ASSUM(MP_TAC o SPECL [`vec 1 - x:real^1`; `vec 1 - y:real^1`]) THEN
 618   ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN
 619   REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ; DROP_SUB; DROP_VEC] THEN
 620   REAL_ARITH_TAC);;
 621
 622 let SIMPLE_PATH_REVERSEPATH = prove
 623  (`!g. simple_path g ==> simple_path (reversepath g)`,
 624   GEN_TAC THEN SIMP_TAC[simple_path; PATH_REVERSEPATH] THEN
 625   REWRITE_TAC[simple_path; reversepath] THEN STRIP_TAC THEN
 626   MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN
 627   FIRST_X_ASSUM(MP_TAC o SPECL [`vec 1 - x:real^1`; `vec 1 - y:real^1`]) THEN
 628   ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN
 629   REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ; DROP_SUB; DROP_VEC] THEN
 630   REAL_ARITH_TAC);;
 631
 632 let SIMPLE_PATH_JOIN_LOOP = prove
 633  (`!g1 g2:real^1->real^N.
 634         arc g1 /\ arc g2 /\
 635         pathfinish g1 = pathstart g2 /\
 636         pathfinish g2 = pathstart g1 /\
 637         (path_image g1 INTER path_image g2) SUBSET
 638             {pathstart g1,pathstart g2}
 639         ==> simple_path(g1 ++ g2)`,
 640   REPEAT GEN_TAC THEN REWRITE_TAC[arc; simple_path] THEN
 641   MATCH_MP_TAC(TAUT
 642    `(a /\ b /\ c /\ d ==> f) /\
 643     (a' /\ b' /\ c /\ d /\ e ==> g)
 644     ==> (a /\ a') /\ (b /\ b') /\ c /\ d /\ e ==> f /\ g`) THEN
 645   CONJ_TAC THENL [MESON_TAC[PATH_JOIN]; ALL_TAC] THEN
 646   REWRITE_TAC[arc; simple_path; SUBSET; IN_INTER; pathstart;
 647     pathfinish; IN_INTERVAL_1; DROP_VEC; IN_INSERT; NOT_IN_EMPTY] THEN
 648   DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G1") MP_TAC) THEN
 649   DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G2") MP_TAC) THEN
 650   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
 651   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "G0")) THEN
 652   MATCH_MP_TAC DROP_WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
 653   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[joinpaths] THEN
 654   MAP_EVERY ASM_CASES_TAC [`drop x <= &1 / &2`; `drop y <= &1 / &2`] THEN
 655   ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL
 656    [REMOVE_THEN "G1" (MP_TAC o SPECL [`&2 % x:real^1`; `&2 % y:real^1`]) THEN
 657     ASM_REWRITE_TAC[DROP_CMUL; DROP_VEC; DROP_SUB] THEN
 658     ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
 659     DISCH_THEN(fun th -> DISJ1_TAC THEN MP_TAC th) THEN VECTOR_ARITH_TAC;
 660     ALL_TAC;
 661     ASM_REAL_ARITH_TAC;
 662     REMOVE_THEN "G2" (MP_TAC o SPECL
 663      [`&2 % x:real^1 - vec 1`; `&2 % y:real^1 - vec 1`]) THEN
 664     ASM_REWRITE_TAC[DROP_CMUL; DROP_VEC; DROP_SUB] THEN
 665     ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
 666     DISCH_THEN(fun th -> DISJ1_TAC THEN MP_TAC th) THEN VECTOR_ARITH_TAC] THEN
 667   REMOVE_THEN "G0" (MP_TAC o SPEC `(g1:real^1->real^N) (&2 % x)`) THEN
 668   ANTS_TAC THENL
 669    [CONJ_TAC THENL
 670      [REWRITE_TAC[path_image; IN_IMAGE] THEN EXISTS_TAC `&2 % x:real^1` THEN
 671       REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL] THEN
 672       ASM_REAL_ARITH_TAC;
 673       ASM_REWRITE_TAC[path_image; IN_IMAGE] THEN
 674       EXISTS_TAC `&2 % y:real^1 - vec 1` THEN
 675       REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN
 676       ASM_REAL_ARITH_TAC];
 677     ALL_TAC] THEN
 678   STRIP_TAC THENL
 679    [DISJ2_TAC THEN DISJ1_TAC;
 680     DISJ1_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
 681     EXISTS_TAC `&1 / &2 % vec 1:real^1`] THEN
 682   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
 683    [SUBGOAL_THEN `&2 % x:real^1 = vec 0` MP_TAC THENL
 684      [ALL_TAC; VECTOR_ARITH_TAC] THEN
 685     REMOVE_THEN "G1" MATCH_MP_TAC;
 686     DISCH_THEN SUBST_ALL_TAC THEN
 687     RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_MUL_RZERO]) THEN
 688     UNDISCH_TAC `T` THEN REWRITE_TAC[] THEN
 689     SUBGOAL_THEN `&2 % y:real^1 - vec 1 = vec 1` MP_TAC THENL
 690      [ALL_TAC; VECTOR_ARITH_TAC] THEN
 691     REMOVE_THEN "G2" MATCH_MP_TAC;
 692     SUBGOAL_THEN `&2 % x:real^1 = vec 1` MP_TAC THENL
 693      [ALL_TAC; VECTOR_ARITH_TAC] THEN
 694     REMOVE_THEN "G1" MATCH_MP_TAC;
 695     DISCH_THEN SUBST_ALL_TAC THEN
 696     SUBGOAL_THEN `&2 % y:real^1 - vec 1 = vec 0` MP_TAC THENL
 697      [ALL_TAC; VECTOR_ARITH_TAC] THEN
 698     REMOVE_THEN "G2" MATCH_MP_TAC] THEN
 699   (REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
 700     [ALL_TAC; ASM_MESON_TAC[]] THEN
 701    ASM_REWRITE_TAC[DROP_CMUL; DROP_SUB; DROP_VEC] THEN
 702    ASM_REAL_ARITH_TAC));;
 703
 704 let ARC_JOIN = prove
 705  (`!g1 g2:real^1->real^N.
 706         arc g1 /\ arc g2 /\
 707         pathfinish g1 = pathstart g2 /\
 708         (path_image g1 INTER path_image g2) SUBSET {pathstart g2}
 709         ==> arc(g1 ++ g2)`,
 710   REPEAT GEN_TAC THEN REWRITE_TAC[arc; simple_path] THEN
 711   MATCH_MP_TAC(TAUT
 712    `(a /\ b /\ c /\ d ==> f) /\
 713     (a' /\ b' /\ c /\ d ==> g)
 714     ==> (a /\ a') /\ (b /\ b') /\ c /\ d ==> f /\ g`) THEN
 715   CONJ_TAC THENL [MESON_TAC[PATH_JOIN]; ALL_TAC] THEN
 716   REWRITE_TAC[arc; simple_path; SUBSET; IN_INTER; pathstart;
 717     pathfinish; IN_INTERVAL_1; DROP_VEC; IN_INSERT; NOT_IN_EMPTY] THEN
 718   DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G1") MP_TAC) THEN
 719   DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G2") MP_TAC) THEN
 720   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "G0")) THEN
 721   MATCH_MP_TAC DROP_WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
 722   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[joinpaths] THEN
 723   MAP_EVERY ASM_CASES_TAC [`drop x <= &1 / &2`; `drop y <= &1 / &2`] THEN
 724   ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL
 725    [REMOVE_THEN "G1" (MP_TAC o SPECL [`&2 % x:real^1`; `&2 % y:real^1`]) THEN
 726     ASM_REWRITE_TAC[DROP_CMUL; DROP_VEC; DROP_SUB] THEN
 727     ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
 728     VECTOR_ARITH_TAC;
 729     ALL_TAC;
 730     ASM_REAL_ARITH_TAC;
 731     REMOVE_THEN "G2" (MP_TAC o SPECL
 732      [`&2 % x:real^1 - vec 1`; `&2 % y:real^1 - vec 1`]) THEN
 733     ASM_REWRITE_TAC[DROP_CMUL; DROP_VEC; DROP_SUB] THEN
 734     ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
 735     VECTOR_ARITH_TAC] THEN
 736   REMOVE_THEN "G0" (MP_TAC o SPEC `(g1:real^1->real^N) (&2 % x)`) THEN
 737   ANTS_TAC THENL
 738    [CONJ_TAC THENL
 739      [REWRITE_TAC[path_image; IN_IMAGE] THEN EXISTS_TAC `&2 % x:real^1` THEN
 740       REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL] THEN
 741       ASM_REAL_ARITH_TAC;
 742       ASM_REWRITE_TAC[path_image; IN_IMAGE] THEN
 743       EXISTS_TAC `&2 % y:real^1 - vec 1` THEN
 744       REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN
 745       ASM_REAL_ARITH_TAC];
 746     ALL_TAC] THEN
 747   STRIP_TAC THEN
 748   SUBGOAL_THEN `x:real^1 = &1 / &2 % vec 1` SUBST_ALL_TAC THENL
 749    [SUBGOAL_THEN `&2 % x:real^1 = vec 1` MP_TAC THENL
 750      [ALL_TAC; VECTOR_ARITH_TAC] THEN
 751     REMOVE_THEN "G1" MATCH_MP_TAC;
 752     SUBGOAL_THEN `&2 % y:real^1 - vec 1 = vec 0` MP_TAC THENL
 753      [ALL_TAC; VECTOR_ARITH_TAC] THEN
 754     REMOVE_THEN "G2" MATCH_MP_TAC] THEN
 755   (REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
 756     [ALL_TAC; ASM_MESON_TAC[]] THEN
 757    ASM_REWRITE_TAC[DROP_CMUL; DROP_SUB; DROP_VEC] THEN
 758    ASM_REAL_ARITH_TAC));;
 759
 760 let REVERSEPATH_JOINPATHS = prove
 761  (`!g1 g2. pathfinish g1 = pathstart g2
 762            ==> reversepath(g1 ++ g2) = reversepath g2 ++ reversepath g1`,
 763   REPEAT GEN_TAC THEN
 764   REWRITE_TAC[reversepath; joinpaths; pathfinish; pathstart; FUN_EQ_THM] THEN
 765   DISCH_TAC THEN X_GEN_TAC `t:real^1` THEN
 766   REWRITE_TAC[DROP_VEC; DROP_SUB; REAL_ARITH
 767    `&1 - x <= &1 / &2 <=> &1 / &2 <= x`] THEN
 768   ASM_CASES_TAC `t = lift(&1 / &2)` THENL
 769    [ASM_REWRITE_TAC[LIFT_DROP; REAL_LE_REFL; GSYM LIFT_NUM; GSYM LIFT_SUB;
 770                     GSYM LIFT_CMUL] THEN
 771     CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[LIFT_NUM];
 772     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM DROP_EQ]) THEN
 773     REWRITE_TAC[LIFT_DROP] THEN DISCH_TAC THEN
 774     ASM_SIMP_TAC[REAL_ARITH
 775      `~(x = &1 / &2) ==> (&1 / &2 <= x <=> ~(x <= &1 / &2))`] THEN
 776     ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_REWRITE_TAC[] THEN
 777     AP_TERM_TAC THEN REWRITE_TAC[VECTOR_SUB_LDISTRIB] THEN VECTOR_ARITH_TAC]);;
 778
 779 (* ------------------------------------------------------------------------- *)
 780 (* Some reversed and "if and only if" versions of joining theorems.          *)
 781 (* ------------------------------------------------------------------------- *)
 782
 783 let PATH_JOIN_PATH_ENDS = prove
 784  (`!g1 g2:real^1->real^N.
 785         path g2 /\ path(g1 ++ g2) ==> pathfinish g1 = pathstart g2`,
 786   REPEAT GEN_TAC THEN DISJ_CASES_TAC(NORM_ARITH
 787    `pathfinish g1:real^N = pathstart g2 \/
 788     &0 < dist(pathfinish g1,pathstart g2)`) THEN
 789   ASM_REWRITE_TAC[path; continuous_on; joinpaths] THEN
 790   RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
 791   REWRITE_TAC[pathstart; pathfinish] THEN
 792   ABBREV_TAC `e = dist((g1:real^1->real^N)(vec 1),g2(vec 0:real^1))` THEN
 793   DISCH_THEN(CONJUNCTS_THEN2
 794    (MP_TAC o SPEC `vec 0:real^1`) (MP_TAC o SPEC `lift(&1 / &2)`)) THEN
 795   REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; LIFT_DROP; REAL_LE_REFL] THEN
 796   REWRITE_TAC[GSYM LIFT_CMUL; IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
 797   CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM] THEN
 798   DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
 799   DISCH_THEN(X_CHOOSE_THEN `d1:real`
 800    (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1"))) THEN
 801   DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
 802   DISCH_THEN(X_CHOOSE_THEN `d2:real`
 803    (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2"))) THEN
 804   REMOVE_THEN "2" (MP_TAC o SPEC `lift(min (&1 / &2) (min d1 d2) / &2)`) THEN
 805   REWRITE_TAC[LIFT_DROP; DIST_LIFT; DIST_0; NORM_REAL; GSYM drop] THEN
 806   ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
 807   REMOVE_THEN "1" (MP_TAC o SPEC
 808    `lift(&1 / &2 + min (&1 / &2) (min d1 d2) / &4)`) THEN
 809   REWRITE_TAC[LIFT_DROP; DIST_LIFT] THEN
 810   ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
 811   COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
 812   REWRITE_TAC[GSYM LIFT_CMUL; LIFT_ADD; REAL_ADD_LDISTRIB] THEN
 813   CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM] THEN
 814   REWRITE_TAC[VECTOR_ADD_SUB; REAL_ARITH `&2 * x / &4 = x / &2`] THEN
 815   REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);;
 816
 817 let PATH_JOIN_EQ = prove
 818  (`!g1 g2:real^1->real^N.
 819         path g1 /\ path g2
 820         ==> (path(g1 ++ g2) <=> pathfinish g1 = pathstart g2)`,
 821   MESON_TAC[PATH_JOIN_PATH_ENDS; PATH_JOIN_IMP]);;
 822
 823 let SIMPLE_PATH_JOIN_IMP = prove
 824  (`!g1 g2:real^1->real^N.
 825         simple_path(g1 ++ g2) /\ pathfinish g1 = pathstart g2
 826         ==> arc g1 /\ arc g2 /\
 827             path_image g1 INTER path_image g2 SUBSET
 828             {pathstart g1, pathstart g2}`,
 829   REPEAT GEN_TAC THEN
 830   ASM_CASES_TAC `path(g1:real^1->real^N) /\ path(g2:real^1->real^N)` THENL
 831    [ALL_TAC; ASM_MESON_TAC[PATH_JOIN; SIMPLE_PATH_IMP_PATH]] THEN
 832   REWRITE_TAC[simple_path; pathstart; pathfinish; arc] THEN
 833   STRIP_TAC THEN REPEAT CONJ_TAC THEN ASM_REWRITE_TAC[] THENL
 834    [MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
 835     REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN
 836     FIRST_X_ASSUM(MP_TAC o SPECL
 837      [`&1 / &2 % x:real^1`; `&1 / &2 % y:real^1`]) THEN
 838     REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; joinpaths; DROP_CMUL] THEN
 839     REPEAT(COND_CASES_TAC THEN TRY ASM_REAL_ARITH_TAC) THEN
 840     REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
 841     ASM_REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; VECTOR_MUL_LID; DROP_VEC] THEN
 842     ASM_REAL_ARITH_TAC;
 843     MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
 844     REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN
 845     FIRST_X_ASSUM(MP_TAC o SPECL
 846      [`&1 / &2 % (x + vec 1):real^1`; `&1 / &2 % (y + vec 1):real^1`]) THEN
 847     ASM_SIMP_TAC[JOINPATHS; pathstart; pathfinish] THEN
 848     REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_ADD; DROP_CMUL] THEN
 849     REPEAT(COND_CASES_TAC THEN TRY ASM_REAL_ARITH_TAC) THEN
 850     REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
 851     ASM_REWRITE_TAC[VECTOR_MUL_LID; VECTOR_ARITH `(a + b) - b:real^N = a`] THEN
 852     ASM_REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; VECTOR_MUL_LID; DROP_VEC;
 853                     DROP_ADD] THEN
 854     ASM_REAL_ARITH_TAC;
 855     REWRITE_TAC[SET_RULE
 856      `s INTER t SUBSET u <=> !x. x IN s ==> x IN t ==> x IN u`] THEN
 857     REWRITE_TAC[path_image; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^1` THEN
 858     REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN
 859     REWRITE_TAC[IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:real^1` THEN
 860     REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN
 861     SUBST1_TAC(SYM(ASSUME
 862      `(g1:real^1->real^N)(vec 1) = g2(vec 0:real^1)`)) THEN
 863     MATCH_MP_TAC(SET_RULE `x = a \/ x = b ==> f x IN {f a,f b}`) THEN
 864     FIRST_X_ASSUM(MP_TAC o SPECL
 865      [`&1 / &2 % x:real^1`; `&1 / &2 % (y + vec 1):real^1`]) THEN
 866     ANTS_TAC THENL
 867      [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_ADD] THEN
 868       REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
 869       GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [joinpaths] THEN
 870       ASM_SIMP_TAC[JOINPATHS; pathstart; pathfinish] THEN
 871       REWRITE_TAC[DROP_ADD; DROP_CMUL; DROP_VEC] THEN
 872       REPEAT(COND_CASES_TAC THEN TRY ASM_REAL_ARITH_TAC) THEN
 873       REWRITE_TAC[VECTOR_ARITH `&2 % &1 / &2 % x:real^N = x`] THEN
 874       ASM_REWRITE_TAC[VECTOR_ARITH `(a + b) - b:real^N = a`];
 875       REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_ADD; DROP_VEC] THEN
 876       ASM_REAL_ARITH_TAC]]);;
 877
 878 let SIMPLE_PATH_JOIN_LOOP_EQ = prove
 879  (`!g1 g2:real^1->real^N.
 880         pathfinish g2 = pathstart g1 /\
 881         pathfinish g1 = pathstart g2
 882         ==> (simple_path(g1 ++ g2) <=>
 883              arc g1 /\ arc g2 /\
 884              path_image g1 INTER path_image g2 SUBSET
 885              {pathstart g1, pathstart g2})`,
 886   MESON_TAC[SIMPLE_PATH_JOIN_IMP; SIMPLE_PATH_JOIN_LOOP]);;
 887
 888 let ARC_JOIN_EQ = prove
 889  (`!g1 g2:real^1->real^N.
 890         pathfinish g1 = pathstart g2
 891         ==> (arc(g1 ++ g2) <=>
 892              arc g1 /\ arc g2 /\
 893              path_image g1 INTER path_image g2 SUBSET {pathstart g2})`,
 894   REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[ARC_JOIN] THEN
 895   GEN_REWRITE_TAC LAND_CONV [ARC_SIMPLE_PATH] THEN
 896   REWRITE_TAC[PATHFINISH_JOIN; PATHSTART_JOIN] THEN STRIP_TAC THEN
 897   MP_TAC(ISPECL [`g1:real^1->real^N`; `g2:real^1->real^N`]
 898         SIMPLE_PATH_JOIN_IMP) THEN
 899   ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
 900   SUBGOAL_THEN `~((pathstart g1:real^N) IN path_image g2)`
 901    (fun th -> MP_TAC th THEN ASM SET_TAC[]) THEN
 902   REWRITE_TAC[path_image; IN_IMAGE; IN_INTERVAL_1; DROP_VEC] THEN
 903   DISCH_THEN(X_CHOOSE_THEN `u:real^1` STRIP_ASSUME_TAC) THEN
 904   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [simple_path]) THEN
 905   DISCH_THEN(MP_TAC o SPECL [`vec 0:real^1`; `lift(&1 / &2) + inv(&2) % u`] o
 906     CONJUNCT2) THEN
 907   REWRITE_TAC[GSYM DROP_EQ; IN_INTERVAL_1; DROP_ADD; DROP_VEC;
 908               DROP_CMUL; LIFT_DROP; joinpaths] THEN
 909   CONV_TAC REAL_RAT_REDUCE_CONV THEN
 910   ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_IMP_NZ;
 911                REAL_ARITH `&0 <= x ==> &0 < &1 / &2 + &1 / &2 * x`] THEN
 912   REWRITE_TAC[REAL_ARITH `&1 / &2 + &1 / &2 * u = &1 <=> u = &1`] THEN
 913   ASM_SIMP_TAC[REAL_ARITH
 914    `&0 <= u ==> (&1 / &2 + &1 / &2 * u <= &1 / &2 <=> u = &0)`] THEN
 915   RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
 916   ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN
 917   ASM_SIMP_TAC[REAL_ARITH `u <= &1 ==> &1 / &2 + &1 / &2 * u <= &1`] THEN
 918   REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN COND_CASES_TAC THENL
 919    [ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_RID; GSYM LIFT_CMUL] THEN
 920     CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM] THEN
 921     ASM_REWRITE_TAC[VEC_EQ] THEN ARITH_TAC;
 922     REWRITE_TAC[VECTOR_ADD_LDISTRIB; GSYM LIFT_CMUL] THEN
 923     REWRITE_TAC[VECTOR_MUL_ASSOC] THEN
 924     CONV_TAC REAL_RAT_REDUCE_CONV THEN
 925     REWRITE_TAC[LIFT_NUM; VECTOR_MUL_LID; VECTOR_ADD_SUB] THEN
 926     ASM_MESON_TAC[]]);;
 927
 928 let ARC_JOIN_EQ_ALT = prove
 929  (`!g1 g2:real^1->real^N.
 930         pathfinish g1 = pathstart g2
 931         ==> (arc(g1 ++ g2) <=>
 932              arc g1 /\ arc g2 /\
 933              path_image g1 INTER path_image g2 = {pathstart g2})`,
 934   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[ARC_JOIN_EQ] THEN
 935   MP_TAC(ISPEC `g1:real^1->real^N` PATHFINISH_IN_PATH_IMAGE) THEN
 936   MP_TAC(ISPEC `g2:real^1->real^N` PATHSTART_IN_PATH_IMAGE) THEN
 937   ASM SET_TAC[]);;
 938
 939 (* ------------------------------------------------------------------------- *)
 940 (* Reassociating a joined path doesn't matter for various properties.        *)
 941 (* ------------------------------------------------------------------------- *)
 942
 943 let PATH_ASSOC = prove
 944  (`!p q r:real^1->real^N.
 945         pathfinish p = pathstart q /\ pathfinish q = pathstart r
 946         ==> (path(p ++ (q ++ r)) <=> path((p ++ q) ++ r))`,
 947   SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN] THEN CONV_TAC TAUT);;
 948
 949 let SIMPLE_PATH_ASSOC = prove
 950  (`!p q r:real^1->real^N.
 951         pathfinish p = pathstart q /\ pathfinish q = pathstart r
 952         ==> (simple_path(p ++ (q ++ r)) <=> simple_path((p ++ q) ++ r))`,
 953   REPEAT STRIP_TAC THEN
 954   ASM_CASES_TAC `pathstart(p:real^1->real^N) = pathfinish r` THENL
 955    [ALL_TAC;
 956     ASM_SIMP_TAC[SIMPLE_PATH_EQ_ARC; PATHSTART_JOIN; PATHFINISH_JOIN]] THEN
 957   ASM_SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; PATHSTART_JOIN; PATHFINISH_JOIN;
 958                ARC_JOIN_EQ; PATH_IMAGE_JOIN] THEN
 959   MAP_EVERY ASM_CASES_TAC
 960    [`arc(p:real^1->real^N)`; `arc(q:real^1->real^N)`;
 961     `arc(r:real^1->real^N)`] THEN
 962   ASM_REWRITE_TAC[UNION_OVER_INTER; UNION_SUBSET;
 963                   ONCE_REWRITE_RULE[INTER_COMM] UNION_OVER_INTER] THEN
 964   REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP ARC_DISTINCT_ENDS)) THEN
 965   MAP_EVERY (fun t -> MP_TAC(ISPEC t PATHSTART_IN_PATH_IMAGE) THEN
 966                       MP_TAC(ISPEC t PATHFINISH_IN_PATH_IMAGE))
 967    [`p:real^1->real^N`; `q:real^1->real^N`; `r:real^1->real^N`] THEN
 968   ASM SET_TAC[]);;
 969
 970 let ARC_ASSOC = prove
 971  (`!p q r:real^1->real^N.
 972         pathfinish p = pathstart q /\ pathfinish q = pathstart r
 973         ==> (arc(p ++ (q ++ r)) <=> arc((p ++ q) ++ r))`,
 974   SIMP_TAC[ARC_SIMPLE_PATH; SIMPLE_PATH_ASSOC] THEN
 975   SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN]);;
 976
 977 (* ------------------------------------------------------------------------- *)
 978 (* In the case of a loop, neither does symmetry.                             *)
 979 (* ------------------------------------------------------------------------- *)
 980
 981 let PATH_SYM = prove
 982  (`!p q. pathfinish p = pathstart q /\ pathfinish q = pathstart p
 983          ==> (path(p ++ q) <=> path(q ++ p))`,
 984   SIMP_TAC[PATH_JOIN; CONJ_ACI]);;
 985
 986 let SIMPLE_PATH_SYM = prove
 987  (`!p q. pathfinish p = pathstart q /\ pathfinish q = pathstart p
 988          ==> (simple_path(p ++ q) <=> simple_path(q ++ p))`,
 989   SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; INTER_ACI; CONJ_ACI; INSERT_AC]);;
 990
 991 let PATH_IMAGE_SYM = prove
 992  (`!p q. pathfinish p = pathstart q /\ pathfinish q = pathstart p
 993          ==> path_image(p ++ q) = path_image(q ++ p)`,
 994   SIMP_TAC[PATH_IMAGE_JOIN; UNION_ACI]);;
 995
 996 (* ------------------------------------------------------------------------- *)
 997 (* Reparametrizing a closed curve to start at some chosen point.             *)
 998 (* ------------------------------------------------------------------------- *)
 999
1000 let shiftpath = new_definition
1001   `shiftpath a (f:real^1->real^N) =
1002         \x. if drop(a + x) <= &1 then f(a + x)
1003             else f(a + x - vec 1)`;;
1004
1005 let SHIFTPATH_TRANSLATION = prove
1006  (`!a t g. shiftpath t ((\x. a + x) o g) = (\x. a + x) o shiftpath t g`,
1007   REWRITE_TAC[FUN_EQ_THM; shiftpath; o_THM] THEN MESON_TAC[]);;
1008
1009 add_translation_invariants [SHIFTPATH_TRANSLATION];;
1010
1011 let SHIFTPATH_LINEAR_IMAGE = prove
1012  (`!f t g. linear f ==> shiftpath t (f o g) = f o shiftpath t g`,
1013   REWRITE_TAC[FUN_EQ_THM; shiftpath; o_THM] THEN MESON_TAC[]);;
1014
1015 add_linear_invariants [SHIFTPATH_LINEAR_IMAGE];;
1016
1017 let PATHSTART_SHIFTPATH = prove
1018  (`!a g. drop a <= &1 ==> pathstart(shiftpath a g) = g(a)`,
1019   SIMP_TAC[pathstart; shiftpath; VECTOR_ADD_RID]);;
1020
1021 let PATHFINISH_SHIFTPATH = prove
1022  (`!a g. &0 <= drop a /\ pathfinish g = pathstart g
1023          ==> pathfinish(shiftpath a g) = g(a)`,
1024   SIMP_TAC[pathfinish; shiftpath; pathstart; DROP_ADD; DROP_VEC] THEN
1025   REWRITE_TAC[VECTOR_ARITH `a + vec 1 - vec 1 = a`] THEN
1026   ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> (x + &1 <= &1 <=> x = &0)`] THEN
1027   SIMP_TAC[DROP_EQ_0; VECTOR_ADD_LID] THEN MESON_TAC[]);;
1028
1029 let ENDPOINTS_SHIFTPATH = prove
1030  (`!a g. pathfinish g = pathstart g /\ a IN interval[vec 0,vec 1]
1031          ==> pathfinish(shiftpath a g) = g a /\
1032              pathstart(shiftpath a g) = g a`,
1033   SIMP_TAC[IN_INTERVAL_1; DROP_VEC;
1034            PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH]);;
1035
1036 let CLOSED_SHIFTPATH = prove
1037  (`!a g. pathfinish g = pathstart g /\ a IN interval[vec 0,vec 1]
1038          ==> pathfinish(shiftpath a g) = pathstart(shiftpath a g)`,
1039   SIMP_TAC[IN_INTERVAL_1; PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH;
1040            DROP_VEC]);;
1041
1042 let PATH_SHIFTPATH = prove
1043  (`!g a. path g /\ pathfinish g:real^N = pathstart g /\
1044          a IN interval[vec 0,vec 1]
1045          ==> path(shiftpath a g)`,
1046   REWRITE_TAC[shiftpath; path] THEN REPEAT STRIP_TAC THEN
1047   SUBGOAL_THEN
1048    `interval[vec 0,vec 1] = interval[vec 0,vec 1 - a:real^1] UNION
1049                             interval[vec 1 - a,vec 1]`
1050   SUBST1_TAC THENL
1051    [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN
1052     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
1053     REWRITE_TAC[DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC;
1054     ALL_TAC] THEN
1055   MATCH_MP_TAC CONTINUOUS_ON_UNION THEN REWRITE_TAC[CLOSED_INTERVAL] THEN
1056   CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL
1057    [EXISTS_TAC `(\x. g(a + x)):real^1->real^N` THEN
1058     REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; DROP_VEC; DROP_SUB] THEN
1059     SIMP_TAC[REAL_ARITH `a + x <= &1 <=> x <= &1 - a`];
1060     EXISTS_TAC `(\x. g(a + x - vec 1)):real^1->real^N` THEN
1061     REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; DROP_VEC; DROP_SUB] THEN
1062     SIMP_TAC[REAL_ARITH `&1 - a <= x ==> (a + x <= &1 <=> a + x = &1)`] THEN
1063     ONCE_REWRITE_TAC[COND_RAND] THEN
1064     REWRITE_TAC[VECTOR_ARITH `a + x - vec 1 = (a + x) - vec 1`] THEN
1065     RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
1066     ASM_SIMP_TAC[GSYM LIFT_EQ; LIFT_ADD; LIFT_NUM; LIFT_DROP] THEN
1067     REWRITE_TAC[VECTOR_SUB_REFL; COND_ID]] THEN
1068   MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN
1069   SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID;
1070            CONTINUOUS_ON_SUB] THEN
1071   MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
1072   EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
1073   ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
1074   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
1075   REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; DROP_ADD] THEN
1076   REAL_ARITH_TAC);;
1077
1078 let SHIFTPATH_SHIFTPATH = prove
1079  (`!g a x. a IN interval[vec 0,vec 1] /\ pathfinish g = pathstart g /\
1080            x IN interval[vec 0,vec 1]
1081            ==> shiftpath (vec 1 - a) (shiftpath a g) x = g x`,
1082   REWRITE_TAC[shiftpath; pathfinish; pathstart] THEN
1083   REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC] THEN
1084   REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
1085   REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN
1086   REWRITE_TAC[DROP_VEC] THEN REPEAT STRIP_TAC THENL
1087    [ALL_TAC;
1088     AP_TERM_TAC THEN VECTOR_ARITH_TAC;
1089     AP_TERM_TAC THEN VECTOR_ARITH_TAC;
1090     ASM_REAL_ARITH_TAC] THEN
1091   SUBGOAL_THEN `x:real^1 = vec 0` SUBST1_TAC THENL
1092    [REWRITE_TAC[GSYM DROP_EQ; DROP_VEC] THEN
1093     ASM_REAL_ARITH_TAC;
1094     ASM_REWRITE_TAC[VECTOR_ARITH `a + vec 1 - a + vec 0:real^1 = vec 1`]]);;
1095
1096 let PATH_IMAGE_SHIFTPATH = prove
1097  (`!a g:real^1->real^N.
1098         a IN interval[vec 0,vec 1] /\ pathfinish g = pathstart g
1099         ==> path_image(shiftpath a g) = path_image g`,
1100   REWRITE_TAC[IN_INTERVAL_1; pathfinish; pathstart] THEN REPEAT STRIP_TAC THEN
1101   MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN
1102   REWRITE_TAC[path_image; shiftpath; FORALL_IN_IMAGE; SUBSET] THEN
1103   REWRITE_TAC[IN_IMAGE] THEN REPEAT STRIP_TAC THEN
1104   REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_IMAGE] THENL
1105    [EXISTS_TAC `a + x:real^1`;
1106     EXISTS_TAC `a + x - vec 1:real^1`;
1107     ALL_TAC] THEN
1108   REPEAT(POP_ASSUM MP_TAC) THEN
1109   REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_SUB; DROP_ADD] THEN
1110   TRY REAL_ARITH_TAC THEN REPEAT STRIP_TAC THEN
1111   ASM_CASES_TAC `drop a <= drop x` THENL
1112    [EXISTS_TAC `x - a:real^1` THEN
1113     REWRITE_TAC[VECTOR_ARITH `a + x - a:real^1 = x`; DROP_SUB] THEN
1114     COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
1115     ASM_REAL_ARITH_TAC;
1116     EXISTS_TAC `vec 1 + x - a:real^1` THEN
1117     REWRITE_TAC[VECTOR_ARITH `a + (v + x - a) - v:real^1 = x`] THEN
1118     REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC] THEN
1119     ASM_CASES_TAC `x:real^1 = vec 0` THEN
1120     ASM_REWRITE_TAC[VECTOR_ARITH `a + v + x - a:real^1 = v + x`] THEN
1121     ASM_REWRITE_TAC[VECTOR_ADD_RID; DROP_VEC; COND_ID] THEN
1122     ASM_REWRITE_TAC[REAL_ARITH `a + &1 + x - a <= &1 <=> x <= &0`] THEN
1123     REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[GSYM DROP_EQ; DROP_VEC] THEN
1124     TRY(COND_CASES_TAC THEN POP_ASSUM MP_TAC) THEN REWRITE_TAC[] THEN
1125     REAL_ARITH_TAC]);;
1126
1127 let SIMPLE_PATH_SHIFTPATH = prove
1128  (`!g a. simple_path g /\ pathfinish g = pathstart g /\
1129          a IN interval[vec 0,vec 1]
1130          ==> simple_path(shiftpath a g)`,
1131   REPEAT GEN_TAC THEN REWRITE_TAC[simple_path] THEN
1132   MATCH_MP_TAC(TAUT
1133    `(a /\ c /\ d ==> e) /\ (b /\ c /\ d ==> f)
1134     ==>  (a /\ b) /\ c /\ d ==> e /\ f`) THEN
1135   CONJ_TAC THENL [MESON_TAC[PATH_SHIFTPATH]; ALL_TAC] THEN
1136   REWRITE_TAC[simple_path; shiftpath; IN_INTERVAL_1; DROP_VEC;
1137               DROP_ADD; DROP_SUB] THEN
1138   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
1139   ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN
1140   STRIP_TAC THEN REPEAT GEN_TAC THEN
1141   REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
1142   DISCH_THEN(fun th -> FIRST_X_ASSUM(MP_TAC o C MATCH_MP th)) THEN
1143   REPEAT(POP_ASSUM MP_TAC) THEN
1144   REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC; GSYM DROP_EQ] THEN
1145   REAL_ARITH_TAC);;
1146
1147 (* ------------------------------------------------------------------------- *)
1148 (* Choosing a sub-path of an existing path.                                  *)
1149 (* ------------------------------------------------------------------------- *)
1150
1151 let subpath = new_definition
1152  `subpath u v g = \x. g(u + drop(v - u) % x)`;;
1153
1154 let SUBPATH_SCALING_LEMMA = prove
1155  (`!u v.
1156     IMAGE (\x. u + drop(v - u) % x) (interval[vec 0,vec 1]) = segment[u,v]`,
1157   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN
1158   REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; SEGMENT_1] THEN
1159   REWRITE_TAC[DROP_SUB; REAL_SUB_LE; INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN
1160   CONV_TAC REAL_RAT_REDUCE_CONV THEN COND_CASES_TAC THEN
1161   ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
1162   BINOP_TAC THEN REWRITE_TAC[GSYM LIFT_EQ_CMUL; VECTOR_MUL_RZERO] THEN
1163   REWRITE_TAC[LIFT_DROP; LIFT_SUB] THEN VECTOR_ARITH_TAC);;
1164
1165 let PATH_IMAGE_SUBPATH_GEN = prove
1166  (`!u v g:real^1->real^N. path_image(subpath u v g) = IMAGE g (segment[u,v])`,
1167   REPEAT GEN_TAC THEN REWRITE_TAC[path_image; subpath] THEN
1168   ONCE_REWRITE_TAC[GSYM o_DEF] THEN
1169   REWRITE_TAC[IMAGE_o; SUBPATH_SCALING_LEMMA]);;
1170
1171 let PATH_IMAGE_SUBPATH = prove
1172  (`!u v g:real^1->real^N.
1173         drop u <= drop v
1174         ==> path_image(subpath u v g) = IMAGE g (interval[u,v])`,
1175   SIMP_TAC[PATH_IMAGE_SUBPATH_GEN; SEGMENT_1]);;
1176
1177 let PATH_SUBPATH = prove
1178  (`!u v g:real^1->real^N.
1179         path g /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1]
1180         ==> path(subpath u v g)`,
1181   REWRITE_TAC[path; subpath] THEN REPEAT STRIP_TAC THEN
1182   MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN
1183   SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID;
1184            CONTINUOUS_ON_CONST] THEN
1185   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1186     CONTINUOUS_ON_SUBSET)) THEN
1187   REWRITE_TAC[SUBPATH_SCALING_LEMMA; SEGMENT_1] THEN
1188   COND_CASES_TAC THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN
1189   REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
1190   REAL_ARITH_TAC);;
1191
1192 let PATHSTART_SUBPATH = prove
1193  (`!u v g:real^1->real^N. pathstart(subpath u v g) = g(u)`,
1194   REWRITE_TAC[pathstart; subpath; VECTOR_MUL_RZERO; VECTOR_ADD_RID]);;
1195
1196 let PATHFINISH_SUBPATH = prove
1197  (`!u v g:real^1->real^N. pathfinish(subpath u v g) = g(v)`,
1198   REWRITE_TAC[pathfinish; subpath; GSYM LIFT_EQ_CMUL] THEN
1199   REWRITE_TAC[LIFT_DROP; VECTOR_ARITH `u + v - u:real^N = v`]);;
1200
1201 let SUBPATH_TRIVIAL = prove
1202  (`!g. subpath (vec 0) (vec 1) g = g`,
1203   REWRITE_TAC[subpath; VECTOR_SUB_RZERO; DROP_VEC; VECTOR_MUL_LID;
1204               VECTOR_ADD_LID; ETA_AX]);;
1205
1206 let SUBPATH_REVERSEPATH = prove
1207  (`!g. subpath (vec 1) (vec 0) g = reversepath g`,
1208   REWRITE_TAC[subpath; reversepath; VECTOR_SUB_LZERO; DROP_NEG; DROP_VEC] THEN
1209   REWRITE_TAC[VECTOR_ARITH `a + -- &1 % b:real^N = a - b`]);;
1210
1211 let REVERSEPATH_SUBPATH = prove
1212  (`!g u v. reversepath(subpath u v g) = subpath v u g`,
1213   REWRITE_TAC[reversepath; subpath; FUN_EQ_THM] THEN REPEAT GEN_TAC THEN
1214   AP_TERM_TAC THEN REWRITE_TAC[DROP_SUB; VECTOR_SUB_LDISTRIB] THEN
1215   REWRITE_TAC[GSYM LIFT_EQ_CMUL; LIFT_SUB; LIFT_DROP] THEN
1216   VECTOR_ARITH_TAC);;
1217
1218 let SUBPATH_TRANSLATION = prove
1219  (`!a g u v. subpath u v ((\x. a + x) o g) = (\x. a + x) o subpath u v g`,
1220   REWRITE_TAC[FUN_EQ_THM; subpath; o_THM]);;
1221
1222 add_translation_invariants [SUBPATH_TRANSLATION];;
1223
1224 let SUBPATH_LINEAR_IMAGE = prove
1225  (`!f g u v. linear f ==> subpath u v (f o g) = f o subpath u v g`,
1226   REWRITE_TAC[FUN_EQ_THM; subpath; o_THM]);;
1227
1228 add_linear_invariants [SUBPATH_LINEAR_IMAGE];;
1229
1230 let SIMPLE_PATH_SUBPATH_EQ = prove
1231  (`!g u v. simple_path(subpath u v g) <=>
1232            path(subpath u v g) /\ ~(u = v) /\
1233            (!x y. x IN segment[u,v] /\ y IN segment[u,v] /\ g x = g y
1234                   ==> x = y \/ x = u /\ y = v \/ x = v /\ y = u)`,
1235   REPEAT GEN_TAC THEN REWRITE_TAC[simple_path; subpath] THEN AP_TERM_TAC THEN
1236   REWRITE_TAC[GSYM SUBPATH_SCALING_LEMMA] THEN
1237   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
1238   REWRITE_TAC[VECTOR_ARITH `u + a % x = u <=> a % x = vec 0`;
1239               VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN
1240   REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_MUL_LCANCEL] THEN
1241   REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_ADD; DROP_SUB;
1242               REAL_RING `u + (v - u) * y = v <=> v = u \/ y = &1`] THEN
1243   REWRITE_TAC[REAL_SUB_0; DROP_EQ; GSYM DROP_VEC] THEN
1244   ASM_CASES_TAC `v:real^1 = u` THEN ASM_REWRITE_TAC[] THEN
1245   REWRITE_TAC[REAL_SUB_REFL; DROP_VEC; VECTOR_MUL_LZERO] THEN
1246   REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
1247   DISCH_THEN(MP_TAC o SPECL [`lift(&1 / &2)`; `lift(&3 / &4)`]) THEN
1248   REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ; LIFT_DROP] THEN
1249   CONV_TAC REAL_RAT_REDUCE_CONV);;
1250
1251 let ARC_SUBPATH_EQ = prove
1252  (`!g u v. arc(subpath u v g) <=>
1253            path(subpath u v g) /\ ~(u = v) /\
1254            (!x y. x IN segment[u,v] /\ y IN segment[u,v] /\ g x = g y
1255                   ==> x = y)`,
1256   REPEAT GEN_TAC THEN REWRITE_TAC[arc; subpath] THEN AP_TERM_TAC THEN
1257   REWRITE_TAC[GSYM SUBPATH_SCALING_LEMMA] THEN
1258   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
1259   REWRITE_TAC[VECTOR_ARITH `u + a % x = u + a % y <=> a % (x - y) = vec 0`;
1260               VECTOR_MUL_EQ_0; DROP_EQ_0; VECTOR_SUB_EQ] THEN
1261   ASM_CASES_TAC `v:real^1 = u` THEN ASM_REWRITE_TAC[] THEN
1262   REWRITE_TAC[VECTOR_SUB_REFL; DROP_VEC; VECTOR_MUL_LZERO] THEN
1263   REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
1264   DISCH_THEN(MP_TAC o SPECL [`lift(&1 / &2)`; `lift(&3 / &4)`]) THEN
1265   REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ; LIFT_DROP] THEN
1266   CONV_TAC REAL_RAT_REDUCE_CONV);;
1267
1268 let SIMPLE_PATH_SUBPATH = prove
1269  (`!g u v. simple_path g /\
1270            u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\
1271            ~(u = v)
1272            ==> simple_path(subpath u v g)`,
1273   SIMP_TAC[SIMPLE_PATH_SUBPATH_EQ; PATH_SUBPATH; SIMPLE_PATH_IMP_PATH] THEN
1274   REWRITE_TAC[simple_path] THEN GEN_TAC THEN
1275   REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN
1276   REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN
1277   CONJ_TAC THENL [MESON_TAC[SEGMENT_SYM]; ALL_TAC] THEN
1278   SIMP_TAC[SEGMENT_1; REAL_LT_IMP_LE] THEN
1279   MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN DISCH_TAC THEN
1280   STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
1281   STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^1`; `y:real^1`]) THEN
1282   SUBGOAL_THEN
1283    `!x:real^1. x IN interval[u,v] ==> x IN interval[vec 0,vec 1]`
1284   ASSUME_TAC THENL
1285    [REWRITE_TAC[GSYM SUBSET; SUBSET_INTERVAL_1] THEN
1286     ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC; REAL_LE_TRANS];
1287     ASM_SIMP_TAC[]] THEN
1288   REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN
1289   REWRITE_TAC[DROP_VEC; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC);;
1290
1291 let ARC_SIMPLE_PATH_SUBPATH = prove
1292  (`!g u v. simple_path g /\
1293            u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\
1294            ~(g u = g v)
1295            ==> arc(subpath u v g)`,
1296   REPEAT STRIP_TAC THEN MATCH_MP_TAC SIMPLE_PATH_IMP_ARC THEN
1297   ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
1298   ASM_MESON_TAC[SIMPLE_PATH_SUBPATH]);;
1299
1300 let ARC_SUBPATH_ARC = prove
1301  (`!u v g. arc g /\
1302            u IN interval [vec 0,vec 1] /\ v IN interval [vec 0,vec 1] /\
1303            ~(u = v)
1304            ==> arc(subpath u v g)`,
1305   REPEAT STRIP_TAC THEN MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN
1306   ASM_MESON_TAC[ARC_IMP_SIMPLE_PATH; arc]);;
1307
1308 let ARC_SIMPLE_PATH_SUBPATH_INTERIOR = prove
1309  (`!g u v. simple_path g /\
1310            u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\
1311            ~(u = v) /\ abs(drop u - drop v) < &1
1312            ==> arc(subpath u v g)`,
1313   REPEAT STRIP_TAC THEN MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN
1314   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
1315   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [simple_path]) THEN
1316   DISCH_THEN(MP_TAC o SPECL [`u:real^1`; `v:real^1`] o CONJUNCT2) THEN
1317   ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
1318   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN
1319   STRIP_TAC THEN ASM_REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC);;
1320
1321 let PATH_IMAGE_SUBPATH_SUBSET = prove
1322  (`!u v g:real^1->real^N.
1323         path g /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1]
1324         ==> path_image(subpath u v g) SUBSET path_image g`,
1325   SIMP_TAC[PATH_IMAGE_SUBPATH_GEN] THEN REPEAT STRIP_TAC THEN
1326   REWRITE_TAC[path_image] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
1327   SIMP_TAC[SEGMENT_CONVEX_HULL; SUBSET_HULL; CONVEX_INTERVAL] THEN
1328   ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET]);;
1329
1330 let JOIN_SUBPATHS_MIDDLE = prove
1331  (`!p:real^1->real^N.
1332    subpath (vec 0) (lift(&1 / &2)) p ++ subpath (lift(&1 / &2)) (vec 1) p = p`,
1333   REWRITE_TAC[FUN_EQ_THM] THEN REPEAT GEN_TAC THEN
1334   REWRITE_TAC[joinpaths; subpath] THEN COND_CASES_TAC THEN AP_TERM_TAC THEN
1335   REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_SUB; DROP_CMUL; LIFT_DROP;
1336               DROP_VEC] THEN
1337   REAL_ARITH_TAC);;
1338
1339 (* ------------------------------------------------------------------------- *)
1340 (* Some additional lemmas about choosing sub-paths.                          *)
1341 (* ------------------------------------------------------------------------- *)
1342
1343 let EXISTS_SUBPATH_OF_PATH = prove
1344  (`!g a b:real^N.
1345         path g /\ a IN path_image g /\ b IN path_image g
1346         ==> ?h. path h /\ pathstart h = a /\ pathfinish h = b /\
1347                 path_image h SUBSET path_image g`,
1348   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; path_image; FORALL_IN_IMAGE] THEN
1349   GEN_TAC THEN DISCH_TAC THEN
1350   X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN
1351   X_GEN_TAC `v:real^1` THEN DISCH_TAC THEN
1352   EXISTS_TAC `subpath u v (g:real^1->real^N)` THEN
1353   ASM_REWRITE_TAC[GSYM path_image; PATH_IMAGE_SUBPATH_GEN] THEN
1354   ASM_SIMP_TAC[PATH_SUBPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
1355   REWRITE_TAC[path_image] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
1356   SIMP_TAC[SEGMENT_CONVEX_HULL; SUBSET_HULL; CONVEX_INTERVAL] THEN
1357   ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET]);;
1358
1359 let EXISTS_SUBPATH_OF_ARC_NOENDS = prove
1360  (`!g a b:real^N.
1361         arc g /\ a IN path_image g /\ b IN path_image g /\
1362         {a,b} INTER {pathstart g,pathfinish g} = {}
1363         ==> ?h. path h /\ pathstart h = a /\ pathfinish h = b /\
1364                 path_image h SUBSET
1365                 (path_image g) DIFF {pathstart g,pathfinish g}`,
1366   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; path_image; FORALL_IN_IMAGE] THEN
1367   GEN_TAC THEN DISCH_TAC THEN
1368   X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN
1369   X_GEN_TAC `v:real^1` THEN DISCH_TAC THEN DISCH_TAC THEN
1370   EXISTS_TAC `subpath u v (g:real^1->real^N)` THEN
1371   ASM_SIMP_TAC[PATH_SUBPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH;
1372                ARC_IMP_PATH; GSYM path_image; PATH_IMAGE_SUBPATH_GEN] THEN
1373   REWRITE_TAC[path_image; pathstart; pathfinish] THEN
1374   REWRITE_TAC[SET_RULE
1375    `s SUBSET t DIFF {a,b} <=> s SUBSET t /\ ~(a IN s) /\ ~(b IN s)`] THEN
1376   REWRITE_TAC[IN_IMAGE] THEN
1377   SUBGOAL_THEN `~(vec 0 IN segment[u:real^1,v]) /\ ~(vec 1 IN segment[u,v])`
1378   STRIP_ASSUME_TAC THENL
1379    [REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN
1380     REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THEN
1381     ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
1382     SIMP_TAC[REAL_ARITH `a <= b ==> (b <= a <=> a = b)`] THEN
1383     REWRITE_TAC[GSYM DROP_VEC; DROP_EQ] THEN
1384     RULE_ASSUM_TAC(REWRITE_RULE[arc; pathstart; pathfinish]) THEN
1385     ASM SET_TAC[];
1386     ALL_TAC] THEN
1387   SUBGOAL_THEN `segment[u:real^1,v] SUBSET interval[vec 0,vec 1]` MP_TAC THENL
1388    [SIMP_TAC[SEGMENT_CONVEX_HULL; SUBSET_HULL; CONVEX_INTERVAL] THEN
1389     ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET];
1390     ALL_TAC] THEN
1391   RULE_ASSUM_TAC(REWRITE_RULE[arc; pathstart; pathfinish]) THEN
1392   SUBGOAL_THEN `(vec 0:real^1) IN interval[vec 0,vec 1] /\
1393                 (vec 1:real^1) IN interval[vec 0,vec 1]`
1394   MP_TAC THENL
1395    [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL];
1396     ASM SET_TAC[]]);;
1397
1398 let EXISTS_SUBARC_OF_ARC_NOENDS = prove
1399  (`!g a b:real^N.
1400         arc g /\ a IN path_image g /\ b IN path_image g /\ ~(a = b) /\
1401         {a,b} INTER {pathstart g,pathfinish g} = {}
1402         ==> ?h. arc h /\ pathstart h = a /\ pathfinish h = b /\
1403                 path_image h SUBSET
1404                 (path_image g) DIFF {pathstart g,pathfinish g}`,
1405   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; path_image; FORALL_IN_IMAGE] THEN
1406   GEN_TAC THEN DISCH_TAC THEN
1407   X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN
1408   X_GEN_TAC `v:real^1` THEN REPEAT DISCH_TAC THEN
1409   EXISTS_TAC `subpath u v (g:real^1->real^N)` THEN
1410   ASM_SIMP_TAC[PATH_SUBPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH;
1411                ARC_IMP_PATH; GSYM path_image; PATH_IMAGE_SUBPATH_GEN] THEN
1412   CONJ_TAC THENL
1413    [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN
1414     ASM_SIMP_TAC[ARC_IMP_SIMPLE_PATH];
1415     ALL_TAC] THEN
1416   REWRITE_TAC[path_image; pathstart; pathfinish] THEN
1417   REWRITE_TAC[SET_RULE
1418    `s SUBSET t DIFF {a,b} <=> s SUBSET t /\ ~(a IN s) /\ ~(b IN s)`] THEN
1419   REWRITE_TAC[IN_IMAGE] THEN
1420   SUBGOAL_THEN `~(vec 0 IN segment[u:real^1,v]) /\ ~(vec 1 IN segment[u,v])`
1421   STRIP_ASSUME_TAC THENL
1422    [REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN
1423     REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THEN
1424     ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
1425     SIMP_TAC[REAL_ARITH `a <= b ==> (b <= a <=> a = b)`] THEN
1426     REWRITE_TAC[GSYM DROP_VEC; DROP_EQ] THEN
1427     RULE_ASSUM_TAC(REWRITE_RULE[arc; pathstart; pathfinish]) THEN
1428     ASM SET_TAC[];
1429     ALL_TAC] THEN
1430   SUBGOAL_THEN `segment[u:real^1,v] SUBSET interval[vec 0,vec 1]` MP_TAC THENL
1431    [SIMP_TAC[SEGMENT_CONVEX_HULL; SUBSET_HULL; CONVEX_INTERVAL] THEN
1432     ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET];
1433     ALL_TAC] THEN
1434   RULE_ASSUM_TAC(REWRITE_RULE[arc; pathstart; pathfinish]) THEN
1435   SUBGOAL_THEN `(vec 0:real^1) IN interval[vec 0,vec 1] /\
1436                 (vec 1:real^1) IN interval[vec 0,vec 1]`
1437   MP_TAC THENL
1438    [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL];
1439     ASM SET_TAC[]]);;
1440
1441 let EXISTS_ARC_PSUBSET_SIMPLE_PATH = prove
1442  (`!g:real^1->real^N.
1443         simple_path g /\ closed s /\ s PSUBSET path_image g
1444         ==> ?h. arc h /\
1445                 s SUBSET path_image h /\
1446                 path_image h SUBSET path_image g`,
1447   REPEAT STRIP_TAC THEN
1448   FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP SIMPLE_PATH_CASES) THENL
1449    [EXISTS_TAC `g:real^1->real^N` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
1450     ALL_TAC] THEN
1451   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [PSUBSET_ALT]) THEN
1452   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1453   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [path_image] THEN
1454   REWRITE_TAC[EXISTS_IN_IMAGE] THEN
1455   DISCH_THEN(X_CHOOSE_THEN `u:real^1` STRIP_ASSUME_TAC) THEN
1456   ABBREV_TAC `(h:real^1->real^N) = shiftpath u g` THEN
1457   SUBGOAL_THEN
1458    `simple_path(h:real^1->real^N) /\
1459     pathstart h = (g:real^1->real^N) u /\
1460     pathfinish h = (g:real^1->real^N) u /\
1461     path_image h = path_image g`
1462   MP_TAC THENL
1463    [EXPAND_TAC "h" THEN
1464     ASM_MESON_TAC[SIMPLE_PATH_SHIFTPATH; PATH_IMAGE_SHIFTPATH;
1465                   PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH;
1466                   IN_INTERVAL_1; DROP_VEC];
1467     REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
1468     DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
1469     UNDISCH_THEN `pathstart(h:real^1->real^N) = (g:real^1->real^N) u`
1470         (SUBST_ALL_TAC o SYM)] THEN
1471   SUBGOAL_THEN
1472    `open_in (subtopology euclidean (interval[vec 0,vec 1]))
1473             {x:real^1 | x IN interval[vec 0,vec 1] /\
1474                         (h x) IN ((:real^N) DIFF s)}`
1475   MP_TAC THENL
1476    [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN
1477     ASM_SIMP_TAC[GSYM path; GSYM closed; SIMPLE_PATH_IMP_PATH];
1478     REWRITE_TAC[open_in] THEN DISCH_THEN(MP_TAC o CONJUNCT2)] THEN
1479   REWRITE_TAC[IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN
1480   DISCH_THEN(fun th ->
1481     MP_TAC(SPEC `vec 0:real^1` th) THEN MP_TAC(SPEC `vec 1:real^1` th)) THEN
1482   REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN
1483   REWRITE_TAC[DIST_REAL; VEC_COMPONENT; REAL_SUB_RZERO] THEN
1484   SIMP_TAC[GSYM drop] THEN
1485   ANTS_TAC THENL [ASM_MESON_TAC[pathfinish]; ALL_TAC] THEN
1486   DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN
1487   ANTS_TAC THENL [ASM_MESON_TAC[pathstart]; ALL_TAC] THEN
1488   DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN
1489   EXISTS_TAC
1490    `subpath (lift(min d1 (&1 / &4))) (lift(&1 - min d2 (&1 / &4)))
1491             (h:real^1->real^N)` THEN
1492   REPEAT CONJ_TAC THENL
1493    [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH_INTERIOR THEN
1494     ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP; LIFT_EQ] THEN
1495     ASM_REAL_ARITH_TAC;
1496     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
1497      `s SUBSET t ==> t INTER s SUBSET u ==> s SUBSET u`)) THEN
1498     REWRITE_TAC[SUBSET; IN_INTER; IMP_CONJ] THEN
1499     SIMP_TAC[PATH_IMAGE_SUBPATH; LIFT_DROP;
1500              REAL_ARITH `min d1 (&1 / &4) <= &1 - min d2 (&1 / &4)`] THEN
1501     REWRITE_TAC[FORALL_IN_IMAGE; path_image; IN_INTERVAL_1; DROP_VEC] THEN
1502     X_GEN_TAC `x:real^1` THEN REPEAT STRIP_TAC THEN
1503     REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `x:real^1` THEN
1504     ASM_REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN
1505     REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`)) THEN
1506     ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
1507     MATCH_MP_TAC PATH_IMAGE_SUBPATH_SUBSET THEN
1508     ASM_SIMP_TAC[SIMPLE_PATH_IMP_PATH; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
1509     ASM_REAL_ARITH_TAC]);;
1510
1511 let EXISTS_DOUBLE_ARC = prove
1512  (`!g:real^1->real^N a b.
1513         simple_path g /\ pathfinish g = pathstart g /\
1514         a IN path_image g /\ b IN path_image g /\ ~(a = b)
1515         ==> ?u d. arc u /\ arc d /\
1516                   pathstart u = a /\ pathfinish u = b /\
1517                   pathstart d = b /\ pathfinish d = a /\
1518                   (path_image u) INTER (path_image d) = {a,b} /\
1519                   (path_image u) UNION (path_image d) = path_image g`,
1520   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; path_image] THEN
1521   ONCE_REWRITE_TAC[FORALL_IN_IMAGE] THEN GEN_TAC THEN REPEAT DISCH_TAC THEN
1522   X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN REWRITE_TAC[GSYM path_image] THEN
1523   X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN DISCH_TAC THEN
1524   ABBREV_TAC `h = shiftpath u (g:real^1->real^N)` THEN
1525   SUBGOAL_THEN
1526    `simple_path(h:real^1->real^N) /\
1527     pathstart h = g u /\
1528     pathfinish h = g u /\
1529     path_image h = path_image g`
1530   STRIP_ASSUME_TAC THENL
1531    [EXPAND_TAC "h" THEN
1532     ASM_SIMP_TAC[SIMPLE_PATH_SHIFTPATH; PATH_IMAGE_SHIFTPATH] THEN
1533     RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
1534     EXPAND_TAC "h" THEN
1535     ASM_SIMP_TAC[PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH];
1536     UNDISCH_THEN `path_image h :real^N->bool = path_image g`
1537      (SUBST_ALL_TAC o SYM)] THEN
1538   UNDISCH_TAC `(b:real^N) IN path_image h` THEN
1539   REWRITE_TAC[IN_IMAGE; path_image; LEFT_IMP_EXISTS_THM] THEN
1540   X_GEN_TAC `v:real^1` THEN STRIP_TAC THEN REWRITE_TAC[GSYM path_image] THEN
1541   MAP_EVERY EXISTS_TAC
1542    [`subpath (vec 0) v (h:real^1->real^N)`;
1543     `subpath v (vec 1) (h:real^1->real^N)`] THEN
1544   RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
1545   ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
1546   UNDISCH_THEN `b = (h:real^1->real^N) v` SUBST_ALL_TAC THEN
1547   STRIP_ASSUME_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]
1548    (ASSUME `(v:real^1) IN interval[vec 0,vec 1]`)) THEN
1549   ASM_SIMP_TAC[ARC_SIMPLE_PATH_SUBPATH; IN_INTERVAL_1; DROP_VEC;
1550                REAL_LE_REFL; REAL_POS; PATH_IMAGE_SUBPATH] THEN
1551   REWRITE_TAC[GSYM IMAGE_UNION; path_image] THEN
1552   UNDISCH_THEN `(h:real^1->real^N)(vec 0) = (g:real^1->real^N) u`
1553    (SUBST_ALL_TAC o SYM) THEN
1554   SUBGOAL_THEN
1555    `interval[vec 0,v] UNION interval[v,vec 1] = interval[vec 0:real^1,vec 1]`
1556   ASSUME_TAC THENL
1557    [ALL_TAC;
1558     ASM_SIMP_TAC[IMAGE_SUBSET] THEN
1559     MATCH_MP_TAC(SET_RULE
1560      `(!x y. x IN (s UNION t) /\ y IN (s UNION t) /\ f x = f y
1561              ==> x = y \/ x = vec 0 /\ y = vec 1 \/ x = vec 1 /\ y = vec 0) /\
1562       (f(vec 0) = f(vec 1)) /\ (vec 0) IN s /\ (vec 1) IN t /\
1563       s INTER t = {c}
1564       ==> IMAGE f s INTER IMAGE f t = {f (vec 0), f c}`) THEN
1565     RULE_ASSUM_TAC(REWRITE_RULE[simple_path]) THEN ASM_REWRITE_TAC[]] THEN
1566   REWRITE_TAC[EXTENSION; IN_INSERT; NOT_IN_EMPTY; IN_INTER; IN_UNION] THEN
1567   REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN
1568   REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ; DROP_VEC] THEN ASM_REAL_ARITH_TAC);;
1569
1570 let SUBPATH_TO_FRONTIER_EXPLICIT = prove
1571  (`!g:real^1->real^N s.
1572         path g /\ pathstart g IN s /\ ~(pathfinish g IN s)
1573         ==> ?u. u IN interval[vec 0,vec 1] /\
1574                 (!x. &0 <= drop x /\ drop x < drop u ==> g x IN interior s) /\
1575                 ~(g u IN interior s) /\
1576                 (u = vec 0 \/ g u IN closure s)`,
1577   REPEAT STRIP_TAC THEN
1578   MP_TAC(ISPEC `{u | lift u IN interval[vec 0,vec 1] /\
1579                      g(lift u) IN closure((:real^N) DIFF s)}`
1580          COMPACT_ATTAINS_INF) THEN
1581   SIMP_TAC[LIFT_DROP; SET_RULE
1582    `(!x. lift(drop x) = x) ==> IMAGE lift {x | P(lift x)} = {x | P x}`] THEN
1583   ANTS_TAC THENL
1584    [RULE_ASSUM_TAC(REWRITE_RULE[path; pathstart; pathfinish; SUBSET;
1585                                 path_image; FORALL_IN_IMAGE]) THEN
1586     CONJ_TAC THENL
1587      [REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL
1588        [MATCH_MP_TAC BOUNDED_SUBSET THEN
1589         EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
1590         REWRITE_TAC[BOUNDED_INTERVAL] THEN SET_TAC[];
1591         MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
1592         ASM_REWRITE_TAC[CLOSED_CLOSURE; CLOSED_INTERVAL]];
1593       REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN
1594       EXISTS_TAC `&1` THEN REWRITE_TAC[LIFT_NUM] THEN
1595       REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN
1596       MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN
1597       ASM_REWRITE_TAC[IN_DIFF; IN_UNIV]];
1598     ALL_TAC] THEN
1599   REWRITE_TAC[EXISTS_DROP; FORALL_DROP; IN_ELIM_THM; LIFT_DROP] THEN
1600   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN
1601   REWRITE_TAC[CLOSURE_COMPLEMENT; IN_DIFF; IN_UNIV] THEN STRIP_TAC THEN
1602   ASM_REWRITE_TAC[subpath; VECTOR_SUB_RZERO; VECTOR_ADD_LID] THEN
1603   ASM_REWRITE_TAC[GSYM LIFT_EQ_CMUL; LIFT_DROP] THEN
1604   RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
1605   REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ] THEN
1606   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
1607    [REPEAT STRIP_TAC THEN
1608     FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE BINDER_CONV
1609      [TAUT `a /\ ~b ==> c <=> a /\ ~c ==> b`]) THEN
1610     ASM_REAL_ARITH_TAC;
1611     FIRST_X_ASSUM(K ALL_TAC o SPEC `x:real^1`) THEN DISCH_TAC] THEN
1612   ASM_CASES_TAC `drop u = &0` THEN
1613   ASM_REWRITE_TAC[frontier; IN_DIFF; CLOSURE_APPROACHABLE] THEN
1614   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
1615   RULE_ASSUM_TAC(REWRITE_RULE[path; pathstart; pathfinish]) THEN
1616   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_on]) THEN
1617   DISCH_THEN(MP_TAC o SPEC `u:real^1`) THEN
1618   ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
1619   DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
1620   DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
1621   DISCH_THEN(MP_TAC o SPEC `lift(max (&0) (drop u - d / &2))`) THEN
1622   REWRITE_TAC[LIFT_DROP; DIST_REAL; GSYM drop] THEN
1623   ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC
1624    (MESON[] `P a ==> dist(a,y) < e ==> ?x. P x /\ dist(x,y) < e`) THEN
1625   MATCH_MP_TAC(REWRITE_RULE[SUBSET] INTERIOR_SUBSET) THEN
1626   FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[LIFT_DROP] THEN ASM_ARITH_TAC);;
1627
1628 let SUBPATH_TO_FRONTIER_STRONG = prove
1629  (`!g:real^1->real^N s.
1630         path g /\ pathstart g IN s /\ ~(pathfinish g IN s)
1631         ==> ?u. u IN interval[vec 0,vec 1] /\
1632                  ~(pathfinish(subpath (vec 0) u g) IN interior s) /\
1633                 (u = vec 0 \/
1634                  (!x. x IN interval[vec 0,vec 1] /\ ~(x = vec 1)
1635                       ==> (subpath (vec 0) u g x) IN interior s) /\
1636                  pathfinish(subpath (vec 0) u g) IN closure s)`,
1637   REPEAT GEN_TAC THEN DISCH_TAC THEN
1638   FIRST_ASSUM(MP_TAC o MATCH_MP SUBPATH_TO_FRONTIER_EXPLICIT) THEN
1639   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN
1640   REWRITE_TAC[subpath; pathfinish; VECTOR_SUB_RZERO; VECTOR_ADD_LID] THEN
1641   ASM_CASES_TAC `u:real^1 = vec 0` THEN ASM_REWRITE_TAC[] THEN
1642   STRIP_TAC THEN ASM_REWRITE_TAC[DROP_VEC; VECTOR_MUL_LZERO] THEN
1643   ASM_REWRITE_TAC[GSYM LIFT_EQ_CMUL; LIFT_DROP] THEN
1644   X_GEN_TAC `x:real^1` THEN
1645   REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ; DROP_VEC] THEN STRIP_TAC THEN
1646   FIRST_X_ASSUM MATCH_MP_TAC THEN
1647   RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
1648   ASM_SIMP_TAC[DROP_CMUL; REAL_LE_MUL] THEN
1649   REWRITE_TAC[REAL_ARITH `u * x < u <=> &0 < u * (&1 - x)`] THEN
1650   MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[REAL_SUB_LT] THEN
1651   ASM_REWRITE_TAC[REAL_LT_LE] THEN
1652   ASM_REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM]);;
1653
1654 let SUBPATH_TO_FRONTIER = prove
1655  (`!g:real^1->real^N s.
1656         path g /\ pathstart g IN s /\ ~(pathfinish g IN s)
1657         ==> ?u. u IN interval[vec 0,vec 1] /\
1658                 pathfinish(subpath (vec 0) u g) IN frontier s /\
1659                 (path_image(subpath (vec 0) u g) DELETE
1660                  pathfinish(subpath (vec 0) u g))
1661                 SUBSET interior s`,
1662   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[frontier; IN_DIFF] THEN
1663   FIRST_ASSUM(MP_TAC o MATCH_MP SUBPATH_TO_FRONTIER_STRONG) THEN
1664   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN
1665   ASM_CASES_TAC `u:real^1 = vec 0` THEN ASM_REWRITE_TAC[] THENL
1666    [REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
1667     RULE_ASSUM_TAC(REWRITE_RULE[pathstart]) THEN STRIP_TAC THEN
1668     ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN
1669     REWRITE_TAC[subpath; path_image; VECTOR_SUB_REFL; DROP_VEC;
1670                 VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN
1671     SET_TAC[];
1672     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
1673     REWRITE_TAC[SUBSET; path_image; FORALL_IN_IMAGE; IN_DELETE; IMP_CONJ] THEN
1674     REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; pathfinish] THEN
1675     REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
1676     ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_MESON_TAC[]]);;
1677
1678 let EXISTS_PATH_SUBPATH_TO_FRONTIER = prove
1679  (`!g:real^1->real^N s.
1680         path g /\ pathstart g IN s /\ ~(pathfinish g IN s)
1681         ==> ?h. path h /\ pathstart h = pathstart g /\
1682                 (path_image h) SUBSET (path_image g) /\
1683                 (path_image h DELETE (pathfinish h)) SUBSET interior s /\
1684                 pathfinish h IN frontier s`,
1685   REPEAT GEN_TAC THEN DISCH_TAC THEN
1686   FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP SUBPATH_TO_FRONTIER) THEN
1687   EXISTS_TAC `subpath (vec 0) u (g:real^1->real^N)` THEN
1688   ASM_SIMP_TAC[PATH_SUBPATH; IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL;
1689                PATHSTART_SUBPATH; PATH_IMAGE_SUBPATH_SUBSET] THEN
1690   REWRITE_TAC[pathstart]);;
1691
1692 let EXISTS_PATH_SUBPATH_TO_FRONTIER_CLOSED = prove
1693  (`!g:real^1->real^N s.
1694         closed s /\ path g /\ pathstart g IN s /\ ~(pathfinish g IN s)
1695         ==> ?h. path h /\ pathstart h = pathstart g /\
1696                 (path_image h) SUBSET (path_image g) INTER s /\
1697                 pathfinish h IN frontier s`,
1698   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN
1699   FIRST_ASSUM(MP_TAC o MATCH_MP EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN
1700   MATCH_MP_TAC MONO_EXISTS THEN
1701   REWRITE_TAC[SUBSET_INTER] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
1702   MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC
1703    `(pathfinish h:real^N) INSERT (path_image h DELETE pathfinish h)` THEN
1704   CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[INSERT_SUBSET]] THEN CONJ_TAC THENL
1705    [ASM_MESON_TAC[frontier; CLOSURE_EQ; IN_DIFF];
1706     ASM_MESON_TAC[SUBSET_TRANS; INTERIOR_SUBSET]]);;
1707
1708 (* ------------------------------------------------------------------------- *)
1709 (* Special case of straight-line paths.                                      *)
1710 (* ------------------------------------------------------------------------- *)
1711
1712 let linepath = new_definition
1713  `linepath(a,b) = \x. (&1 - drop x) % a + drop x % b`;;
1714
1715 let LINEPATH_TRANSLATION = prove
1716  (`!a b c. linepath(a + b,a + c) = (\x. a + x) o linepath(b,c)`,
1717   REWRITE_TAC[linepath; o_THM; FUN_EQ_THM] THEN VECTOR_ARITH_TAC);;
1718
1719 add_translation_invariants [LINEPATH_TRANSLATION];;
1720
1721 let LINEPATH_LINEAR_IMAGE = prove
1722  (`!f. linear f ==> !b c. linepath(f b,f c) = f o linepath(b,c)`,
1723   REWRITE_TAC[linepath; o_THM; FUN_EQ_THM] THEN REPEAT STRIP_TAC THEN
1724   FIRST_ASSUM(ASSUME_TAC o MATCH_MP LINEAR_ADD) THEN
1725   FIRST_ASSUM(ASSUME_TAC o MATCH_MP LINEAR_CMUL) THEN
1726   ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);;
1727
1728 add_linear_invariants [LINEPATH_LINEAR_IMAGE];;
1729
1730 let PATHSTART_LINEPATH = prove
1731  (`!a b. pathstart(linepath(a,b)) = a`,
1732   REWRITE_TAC[linepath; pathstart; DROP_VEC] THEN VECTOR_ARITH_TAC);;
1733
1734 let PATHFINISH_LINEPATH = prove
1735  (`!a b. pathfinish(linepath(a,b)) = b`,
1736   REWRITE_TAC[linepath; pathfinish; DROP_VEC] THEN VECTOR_ARITH_TAC);;
1737
1738 let CONTINUOUS_LINEPATH_AT = prove
1739  (`!a b x. linepath(a,b) continuous (at x)`,
1740   REPEAT GEN_TAC THEN REWRITE_TAC[linepath] THEN
1741   REWRITE_TAC[VECTOR_ARITH `(&1 - u) % x + y = x + u % --x + y`] THEN
1742   MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN
1743   MATCH_MP_TAC CONTINUOUS_ADD THEN CONJ_TAC THEN
1744   MATCH_MP_TAC CONTINUOUS_VMUL THEN
1745   REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_AT_ID]);;
1746
1747 let CONTINUOUS_ON_LINEPATH = prove
1748  (`!a b s. linepath(a,b) continuous_on s`,
1749   MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_LINEPATH_AT]);;
1750
1751 let PATH_LINEPATH = prove
1752  (`!a b. path(linepath(a,b))`,
1753   REWRITE_TAC[path; CONTINUOUS_ON_LINEPATH]);;
1754
1755 let PATH_IMAGE_LINEPATH = prove
1756  (`!a b. path_image(linepath (a,b)) = segment[a,b]`,
1757   REWRITE_TAC[segment; path_image; linepath] THEN
1758   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; IN_INTERVAL] THEN
1759   SIMP_TAC[DIMINDEX_1; FORALL_1; VEC_COMPONENT; ARITH] THEN
1760   REWRITE_TAC[EXISTS_LIFT; GSYM drop; LIFT_DROP] THEN MESON_TAC[]);;
1761
1762 let REVERSEPATH_LINEPATH = prove
1763  (`!a b. reversepath(linepath(a,b)) = linepath(b,a)`,
1764   REWRITE_TAC[reversepath; linepath; DROP_SUB; DROP_VEC; FUN_EQ_THM] THEN
1765   VECTOR_ARITH_TAC);;
1766
1767 let ARC_LINEPATH = prove
1768  (`!a b. ~(a = b) ==> arc(linepath(a,b))`,
1769   REWRITE_TAC[arc; PATH_LINEPATH] THEN REWRITE_TAC[linepath] THEN
1770   REWRITE_TAC[VECTOR_ARITH
1771    `(&1 - x) % a + x % b:real^N = (&1 - y) % a + y % b <=>
1772     (x - y) % (a - b) = vec 0`] THEN
1773   SIMP_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; DROP_EQ; REAL_SUB_0]);;
1774
1775 let SIMPLE_PATH_LINEPATH = prove
1776  (`!a b. ~(a = b) ==> simple_path(linepath(a,b))`,
1777   MESON_TAC[ARC_IMP_SIMPLE_PATH; ARC_LINEPATH]);;
1778
1779 let SIMPLE_PATH_LINEPATH_EQ = prove
1780  (`!a b:real^N. simple_path(linepath(a,b)) <=> ~(a = b)`,
1781   REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[SIMPLE_PATH_LINEPATH] THEN
1782   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[simple_path] THEN
1783   DISCH_THEN SUBST1_TAC THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN
1784   REWRITE_TAC[linepath; GSYM VECTOR_ADD_RDISTRIB] THEN
1785   DISCH_THEN(MP_TAC o SPECL [`lift(&0)`; `lift(&1 / &2)`]) THEN
1786   REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; GSYM DROP_EQ; DROP_VEC] THEN
1787   CONV_TAC REAL_RAT_REDUCE_CONV);;
1788
1789 let ARC_LINEPATH_EQ = prove
1790  (`!a b. arc(linepath(a,b)) <=> ~(a = b)`,
1791   REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[ARC_LINEPATH] THEN
1792   MESON_TAC[SIMPLE_PATH_LINEPATH_EQ; ARC_IMP_SIMPLE_PATH]);;
1793
1794 let LINEPATH_REFL = prove
1795  (`!a. linepath(a,a) = \x. a`,
1796   REWRITE_TAC[linepath; VECTOR_ARITH `(&1 - u) % x + u % x:real^N = x`]);;
1797
1798 let SHIFTPATH_TRIVIAL = prove
1799  (`!t a. shiftpath t (linepath(a,a)) = linepath(a,a)`,
1800   REWRITE_TAC[shiftpath; LINEPATH_REFL; COND_ID]);;
1801
1802 let SUBPATH_REFL = prove
1803  (`!g a. subpath a a g = linepath(g a,g a)`,
1804   REWRITE_TAC[subpath; linepath; VECTOR_SUB_REFL; DROP_VEC; VECTOR_MUL_LZERO;
1805               FUN_EQ_THM; VECTOR_ADD_RID] THEN
1806   VECTOR_ARITH_TAC);;
1807
1808 (* ------------------------------------------------------------------------- *)
1809 (* Bounding a point away from a path.                                        *)
1810 (* ------------------------------------------------------------------------- *)
1811
1812 let NOT_ON_PATH_BALL = prove
1813  (`!g z:real^N.
1814         path g /\ ~(z IN path_image g)
1815         ==> ?e. &0 < e /\ ball(z,e) INTER (path_image g) = {}`,
1816   REPEAT STRIP_TAC THEN
1817   MP_TAC(ISPECL [`path_image g:real^N->bool`; `z:real^N`]
1818      DISTANCE_ATTAINS_INF) THEN
1819   REWRITE_TAC[PATH_IMAGE_NONEMPTY] THEN
1820   ASM_SIMP_TAC[COMPACT_PATH_IMAGE; COMPACT_IMP_CLOSED] THEN
1821   DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
1822   EXISTS_TAC `dist(z:real^N,a)` THEN
1823   CONJ_TAC THENL [ASM_MESON_TAC[DIST_POS_LT]; ALL_TAC] THEN
1824   REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_BALL; IN_INTER] THEN
1825   ASM_MESON_TAC[REAL_NOT_LE]);;
1826
1827 let NOT_ON_PATH_CBALL = prove
1828  (`!g z:real^N.
1829         path g /\ ~(z IN path_image g)
1830         ==> ?e. &0 < e /\ cball(z,e) INTER (path_image g) = {}`,
1831   REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP NOT_ON_PATH_BALL) THEN
1832   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
1833   EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN
1834   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
1835    `s INTER u = {} ==> t SUBSET s ==> t INTER u = {}`)) THEN
1836   REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN
1837   UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC);;
1838
1839 (* ------------------------------------------------------------------------- *)
1840 (* Homeomorphisms of arc images.                                             *)
1841 (* ------------------------------------------------------------------------- *)
1842
1843 let HOMEOMORPHISM_ARC = prove
1844  (`!g:real^1->real^N.
1845      arc g ==> ?h. homeomorphism (interval[vec 0,vec 1],path_image g) (g,h)`,
1846   REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN
1847   ASM_REWRITE_TAC[path_image; COMPACT_INTERVAL; GSYM path; GSYM arc]);;
1848
1849 let HOMEOMORPHIC_ARC_IMAGE_INTERVAL = prove
1850  (`!g:real^1->real^N a b:real^1.
1851       arc g /\ drop a < drop b ==> (path_image g) homeomorphic interval[a,b]`,
1852   REPEAT STRIP_TAC THEN
1853   TRANS_TAC HOMEOMORPHIC_TRANS `interval[vec 0:real^1,vec 1]` THEN
1854   CONJ_TAC THENL
1855    [ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN
1856     EXISTS_TAC `g:real^1->real^N` THEN ASM_SIMP_TAC[HOMEOMORPHISM_ARC];
1857     MATCH_MP_TAC HOMEOMORPHIC_CLOSED_INTERVALS THEN
1858     ASM_REWRITE_TAC[INTERVAL_NE_EMPTY_1; DROP_VEC; REAL_LT_01]]);;
1859
1860 let HOMEOMORPHIC_ARC_IMAGES = prove
1861  (`!g:real^1->real^M h:real^1->real^N.
1862         arc g /\ arc h ==> (path_image g) homeomorphic (path_image h)`,
1863   REPEAT STRIP_TAC THEN
1864   TRANS_TAC HOMEOMORPHIC_TRANS `interval[vec 0:real^1,vec 1]` THEN
1865   CONJ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM]] THEN
1866   MATCH_MP_TAC HOMEOMORPHIC_ARC_IMAGE_INTERVAL THEN
1867   ASM_REWRITE_TAC[DROP_VEC; REAL_LT_01]);;
1868
1869 let HOMEOMORPHIC_ARC_IMAGE_SEGMENT = prove
1870  (`!g:real^1->real^N a b:real^M.
1871         arc g /\ ~(a = b) ==> (path_image g) homeomorphic segment[a,b]`,
1872   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM PATH_IMAGE_LINEPATH] THEN
1873   MATCH_MP_TAC HOMEOMORPHIC_ARC_IMAGES THEN
1874   ASM_REWRITE_TAC[ARC_LINEPATH_EQ]);;
1875
1876 (* ------------------------------------------------------------------------- *)
1877 (* Path component, considered as a "joinability" relation (from Tom Hales).  *)
1878 (* ------------------------------------------------------------------------- *)
1879
1880 let path_component = new_definition
1881  `path_component s x y <=>
1882         ?g. path g /\ path_image g SUBSET s /\
1883             pathstart g = x /\ pathfinish g = y`;;
1884
1885 let PATH_COMPONENT_IN = prove
1886  (`!s x y. path_component s x y ==> x IN s /\ y IN s`,
1887   REWRITE_TAC[path_component; path_image; pathstart; pathfinish] THEN
1888   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN
1889   REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM)) THEN
1890   FIRST_X_ASSUM MATCH_MP_TAC THEN
1891   REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_LE_REFL; REAL_POS]);;
1892
1893 let PATH_COMPONENT_REFL = prove
1894  (`!s x:real^N. x IN s ==> path_component s x x`,
1895   REPEAT STRIP_TAC THEN REWRITE_TAC[path_component] THEN
1896   EXISTS_TAC `(\u. x):real^1->real^N` THEN
1897   REWRITE_TAC[pathstart; pathfinish; path_image; path;
1898               CONTINUOUS_ON_CONST; IMAGE; FORALL_IN_IMAGE] THEN
1899   REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[]);;
1900
1901 let PATH_COMPONENT_REFL_EQ = prove
1902  (`!s x:real^N. path_component s x x <=> x IN s`,
1903   MESON_TAC[PATH_COMPONENT_IN; PATH_COMPONENT_REFL]);;
1904
1905 let PATH_COMPONENT_SYM = prove
1906  (`!s x y:real^N. path_component s x y ==> path_component s y x`,
1907   REPEAT GEN_TAC THEN REWRITE_TAC[path_component] THEN
1908   MESON_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH;
1909             PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH]);;
1910
1911 let PATH_COMPONENT_SYM_EQ = prove
1912  (`!s x y. path_component s x y <=> path_component s y x`,
1913   MESON_TAC[PATH_COMPONENT_SYM]);;
1914
1915 let PATH_COMPONENT_TRANS = prove
1916  (`!s x y:real^N.
1917     path_component s x y /\ path_component s y z ==> path_component s x z`,
1918   REPEAT GEN_TAC THEN REWRITE_TAC[path_component] THEN
1919   DISCH_THEN(CONJUNCTS_THEN2
1920    (X_CHOOSE_TAC `g1:real^1->real^N`) (X_CHOOSE_TAC `g2:real^1->real^N`)) THEN
1921   EXISTS_TAC `g1 ++ g2 :real^1->real^N` THEN
1922   ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET;
1923                PATHSTART_JOIN; PATHFINISH_JOIN]);;
1924
1925 let PATH_COMPONENT_OF_SUBSET = prove
1926  (`!s t x. s SUBSET t /\ path_component s x y ==> path_component t x y`,
1927   REWRITE_TAC[path_component] THEN SET_TAC[]);;
1928
1929 (* ------------------------------------------------------------------------- *)
1930 (* Can also consider it as a set, as the name suggests.                      *)
1931 (* ------------------------------------------------------------------------- *)
1932
1933 let PATH_COMPONENT_SET = prove
1934  (`!s x. path_component s x =
1935             { y | ?g. path g /\ path_image g SUBSET s /\
1936                       pathstart g = x /\ pathfinish g = y }`,
1937   REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REWRITE_TAC[IN; path_component]);;
1938
1939 let PATH_COMPONENT_SUBSET = prove
1940  (`!s x. (path_component s x) SUBSET s`,
1941   REWRITE_TAC[SUBSET; IN] THEN MESON_TAC[PATH_COMPONENT_IN; IN]);;
1942
1943 let PATH_COMPONENT_EQ_EMPTY = prove
1944  (`!s x. path_component s x = {} <=> ~(x IN s)`,
1945   REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN
1946   MESON_TAC[IN; PATH_COMPONENT_REFL; PATH_COMPONENT_IN]);;
1947
1948 let PATH_COMPONENT_EMPTY = prove
1949  (`!x. path_component {} x = {}`,
1950   REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY; NOT_IN_EMPTY]);;
1951
1952 let UNIONS_PATH_COMPONENT = prove
1953  (`!s:real^N->bool. UNIONS {path_component s x |x| x IN s} = s`,
1954   GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
1955   REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC; PATH_COMPONENT_SUBSET] THEN
1956   REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM] THEN
1957   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `x:real^N` THEN
1958   ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN] THEN
1959   ASM_REWRITE_TAC[PATH_COMPONENT_REFL_EQ]);;
1960
1961 let PATH_COMPONENT_TRANSLATION = prove
1962  (`!a s x. path_component (IMAGE (\x. a + x) s) (a + x) =
1963                 IMAGE (\x. a + x) (path_component s x)`,
1964   REWRITE_TAC[PATH_COMPONENT_SET] THEN GEOM_TRANSLATE_TAC[]);;
1965
1966 add_translation_invariants [PATH_COMPONENT_TRANSLATION];;
1967
1968 let PATH_COMPONENT_LINEAR_IMAGE = prove
1969  (`!f s x. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
1970            ==> path_component (IMAGE f s) (f x) =
1971                IMAGE f (path_component s x)`,
1972   REWRITE_TAC[PATH_COMPONENT_SET] THEN
1973   GEOM_TRANSFORM_TAC[]);;
1974
1975 add_linear_invariants [PATH_COMPONENT_LINEAR_IMAGE];;
1976
1977 (* ------------------------------------------------------------------------- *)
1978 (* Path connectedness of a space.                                            *)
1979 (* ------------------------------------------------------------------------- *)
1980
1981 let path_connected = new_definition
1982  `path_connected s <=>
1983         !x y. x IN s /\ y IN s
1984               ==> ?g. path g /\ (path_image g) SUBSET s /\
1985                       pathstart g = x /\ pathfinish g = y`;;
1986
1987 let PATH_CONNECTED_IFF_PATH_COMPONENT = prove
1988  (`!s. path_connected s <=> !x y. x IN s /\ y IN s ==> path_component s x y`,
1989   REWRITE_TAC[path_connected; path_component]);;
1990
1991 let PATH_CONNECTED_COMPONENT_SET = prove
1992  (`!s. path_connected s <=> !x. x IN s ==> path_component s x = s`,
1993   REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT; GSYM SUBSET_ANTISYM_EQ] THEN
1994   REWRITE_TAC[PATH_COMPONENT_SUBSET] THEN SET_TAC[]);;
1995
1996 let PATH_COMPONENT_MONO = prove
1997  (`!s t x. s SUBSET t ==> (path_component s x) SUBSET (path_component t x)`,
1998   REWRITE_TAC[PATH_COMPONENT_SET] THEN SET_TAC[]);;
1999
2000 let PATH_COMPONENT_MAXIMAL = prove
2001  (`!s t x. x IN t /\ path_connected t /\ t SUBSET s
2002            ==> t SUBSET (path_component s x)`,
2003   REWRITE_TAC[path_connected; PATH_COMPONENT_SET; SUBSET; IN_ELIM_THM] THEN
2004   MESON_TAC[]);;
2005
2006 let PATH_COMPONENT_EQ = prove
2007  (`!s x y. y IN path_component s x
2008            ==> path_component s y = path_component s x`,
2009   REWRITE_TAC[EXTENSION; IN] THEN
2010   MESON_TAC[PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS]);;
2011
2012 let PATH_COMPONENT_PATH_IMAGE_PATHSTART = prove
2013  (`!p x:real^N.
2014         path p /\ x IN path_image p
2015         ==> path_component (path_image p) (pathstart p) x`,
2016   REWRITE_TAC[path_image; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
2017   REPEAT STRIP_TAC THEN ASM_CASES_TAC `x:real^1 = vec 0` THENL
2018    [ASM_REWRITE_TAC[pathstart] THEN MATCH_MP_TAC PATH_COMPONENT_REFL THEN
2019     MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1] THEN
2020     REWRITE_TAC[DROP_VEC; REAL_POS];
2021     ALL_TAC] THEN
2022   REWRITE_TAC[path_component] THEN
2023   EXISTS_TAC `\y. (p:real^1->real^N)(drop x % y)` THEN
2024   ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish] THEN
2025   REWRITE_TAC[VECTOR_MUL_RZERO] THEN REPEAT CONJ_TAC THENL
2026    [MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN
2027     ASM_SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN
2028     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path]) THEN
2029     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET);
2030     ONCE_REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[IMAGE_o] THEN
2031     MATCH_MP_TAC IMAGE_SUBSET;
2032     AP_TERM_TAC THEN REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_VEC] THEN
2033     REWRITE_TAC[REAL_MUL_RID]] THEN
2034   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
2035   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
2036   SIMP_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC; REAL_LE_MUL] THEN
2037   REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
2038   MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[]);;
2039
2040 let PATH_CONNECTED_PATH_IMAGE = prove
2041  (`!p:real^1->real^N. path p ==> path_connected(path_image p)`,
2042   REPEAT STRIP_TAC THEN REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
2043   MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
2044   MATCH_MP_TAC PATH_COMPONENT_TRANS THEN
2045   EXISTS_TAC `pathstart p :real^N` THEN
2046   ASM_MESON_TAC[PATH_COMPONENT_PATH_IMAGE_PATHSTART; PATH_COMPONENT_SYM]);;
2047
2048 let PATH_CONNECTED_PATH_COMPONENT = prove
2049  (`!s x:real^N. path_connected(path_component s x)`,
2050   REPEAT GEN_TAC THEN REWRITE_TAC[path_connected; IN] THEN
2051   MAP_EVERY X_GEN_TAC [`y:real^N`; `z:real^N`] THEN STRIP_TAC THEN
2052   SUBGOAL_THEN `path_component s y (z:real^N)` MP_TAC THENL
2053    [ASM_MESON_TAC[PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS]; ALL_TAC] THEN
2054   REWRITE_TAC[path_component] THEN
2055   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:real^1->real^N` THEN
2056   STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET] THEN
2057   X_GEN_TAC `w:real^N` THEN DISCH_TAC THEN
2058   SUBGOAL_THEN `path_component s (x:real^N) = path_component s y`
2059   SUBST1_TAC THENL [ASM_MESON_TAC[PATH_COMPONENT_EQ; IN]; ALL_TAC] THEN
2060   MP_TAC(ISPECL [`p:real^1->real^N`; `w:real^N`]
2061      PATH_COMPONENT_PATH_IMAGE_PATHSTART) THEN
2062   ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN] THEN
2063   FIRST_ASSUM(MP_TAC o MATCH_MP PATH_COMPONENT_MONO) THEN
2064   REWRITE_TAC[SUBSET; IN] THEN MESON_TAC[]);;
2065
2066 let PATH_COMPONENT = prove
2067  (`!s x y:real^N.
2068         path_component s x y <=>
2069         ?t. path_connected t /\ t SUBSET s /\ x IN t /\ y IN t`,
2070   REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL
2071    [EXISTS_TAC `path_component s (x:real^N)` THEN
2072     REWRITE_TAC[PATH_CONNECTED_PATH_COMPONENT; PATH_COMPONENT_SUBSET] THEN
2073     FIRST_ASSUM(MP_TAC o MATCH_MP PATH_COMPONENT_IN) THEN
2074     ASM_SIMP_TAC[IN; PATH_COMPONENT_REFL_EQ];
2075     REWRITE_TAC[path_component] THEN ASM_MESON_TAC[path_connected; SUBSET]]);;
2076
2077 let PATH_COMPONENT_PATH_COMPONENT = prove
2078  (`!s x:real^N.
2079         path_component (path_component s x) x = path_component s x`,
2080   REPEAT GEN_TAC THEN
2081   ASM_CASES_TAC `(x:real^N) IN s` THENL
2082    [MATCH_MP_TAC SUBSET_ANTISYM THEN
2083     SIMP_TAC[PATH_COMPONENT_MONO; PATH_COMPONENT_SUBSET] THEN
2084     MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN
2085     REWRITE_TAC[SUBSET_REFL; PATH_CONNECTED_PATH_COMPONENT] THEN
2086     ASM_REWRITE_TAC[IN; PATH_COMPONENT_REFL_EQ];
2087     MATCH_MP_TAC(SET_RULE `s = {} /\ t = {} ==> s = t`) THEN
2088     ASM_REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY] THEN
2089     ASM_MESON_TAC[SUBSET; PATH_COMPONENT_SUBSET]]);;
2090
2091 let PATH_CONNECTED_LINEPATH = prove
2092  (`!s a b:real^N. segment[a,b] SUBSET s ==> path_component s a b`,
2093   REPEAT STRIP_TAC THEN REWRITE_TAC[path_component] THEN
2094   EXISTS_TAC `linepath(a:real^N,b)` THEN
2095   ASM_REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_LINEPATH] THEN
2096   ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH]);;
2097
2098 let PATH_COMPONENT_DISJOINT = prove
2099  (`!s a b. DISJOINT (path_component s a) (path_component s b) <=>
2100              ~(a IN path_component s b)`,
2101   REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN
2102   REWRITE_TAC[IN] THEN MESON_TAC[PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS]);;
2103
2104 let PATH_COMPONENT_EQ_EQ = prove
2105  (`!s x y:real^N.
2106         path_component s x = path_component s y <=>
2107         ~(x IN s) /\ ~(y IN s) \/
2108         x IN s /\ y IN s /\ path_component s x y`,
2109   REPEAT GEN_TAC THEN ASM_CASES_TAC `(y:real^N) IN s` THENL
2110    [ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THENL
2111      [REWRITE_TAC[FUN_EQ_THM] THEN
2112       ASM_MESON_TAC[PATH_COMPONENT_TRANS; PATH_COMPONENT_REFL;
2113                     PATH_COMPONENT_SYM];
2114       ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY]];
2115     RULE_ASSUM_TAC(REWRITE_RULE[GSYM PATH_COMPONENT_EQ_EMPTY]) THEN
2116     ASM_REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY] THEN
2117     ONCE_REWRITE_TAC[PATH_COMPONENT_SYM_EQ] THEN
2118     ASM_REWRITE_TAC[EMPTY] THEN ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY]]);;
2119
2120 let PATH_COMPONENT_UNIQUE = prove
2121  (`!s c x:real^N.
2122         x IN c /\ c SUBSET s /\ path_connected c /\
2123         (!c'. x IN c' /\ c' SUBSET s /\ path_connected c'
2124               ==> c' SUBSET c)
2125         ==> path_component s x = c`,
2126   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
2127    [FIRST_X_ASSUM MATCH_MP_TAC THEN
2128     REWRITE_TAC[PATH_COMPONENT_SUBSET; PATH_CONNECTED_PATH_COMPONENT] THEN
2129     REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[PATH_COMPONENT_REFL_EQ] THEN
2130     ASM SET_TAC[];
2131     MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[]]);;
2132
2133 let PATH_COMPONENT_INTERMEDIATE_SUBSET = prove
2134  (`!t u a:real^N.
2135         path_component u a SUBSET t /\ t SUBSET u
2136         ==> path_component t a = path_component u a`,
2137   REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN u` THENL
2138    [REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_COMPONENT_UNIQUE THEN
2139     ASM_REWRITE_TAC[PATH_CONNECTED_PATH_COMPONENT] THEN
2140     CONJ_TAC THENL [ASM_MESON_TAC[PATH_COMPONENT_REFL; IN]; ALL_TAC] THEN
2141     REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN
2142     ASM SET_TAC[];
2143     ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY; SUBSET]]);;
2144
2145 let COMPLEMENT_PATH_COMPONENT_UNIONS = prove
2146  (`!s x:real^N.
2147      s DIFF path_component s x =
2148      UNIONS({path_component s y | y | y IN s} DELETE (path_component s x))`,
2149   REPEAT GEN_TAC THEN
2150   GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM UNIONS_PATH_COMPONENT] THEN
2151   MATCH_MP_TAC(SET_RULE
2152    `(!x. x IN s DELETE a ==> DISJOINT a x)
2153      ==> UNIONS s DIFF a = UNIONS (s DELETE a)`) THEN
2154   REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC; IN_DELETE] THEN
2155   SIMP_TAC[PATH_COMPONENT_DISJOINT; PATH_COMPONENT_EQ_EQ] THEN
2156   MESON_TAC[IN; SUBSET; PATH_COMPONENT_SUBSET]);;
2157
2158 (* ------------------------------------------------------------------------- *)
2159 (* General "locally connected implies connected" type results.               *)
2160 (* ------------------------------------------------------------------------- *)
2161
2162 let OPEN_GENERAL_COMPONENT = prove
2163  (`!c. (!s x y. c s x y ==> x IN s /\ y IN s) /\
2164        (!s x y. c s x y ==> c s y x) /\
2165        (!s x y z. c s x y /\ c s y z ==> c s x z) /\
2166        (!s t x y. s SUBSET t /\ c s x y ==> c t x y) /\
2167        (!s x y e. y IN ball(x,e) /\ ball(x,e) SUBSET s
2168                   ==> c (ball(x,e)) x y)
2169        ==> !s x:real^N. open s ==> open(c s x)`,
2170   GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "IN") MP_TAC) THEN
2171   DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SYM") MP_TAC) THEN
2172   DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "TRANS") MP_TAC) THEN
2173   DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SUBSET") (LABEL_TAC "BALL")) THEN
2174   REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL; SUBSET; IN_BALL] THEN
2175   DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN
2176   REWRITE_TAC[SUBSET; IN] THEN STRIP_TAC THEN
2177   SUBGOAL_THEN `(x:real^N) IN s /\ y IN s` STRIP_ASSUME_TAC THENL
2178    [ASM_MESON_TAC[]; ALL_TAC] THEN
2179   FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(y:real^N) IN s`)) THEN
2180   MATCH_MP_TAC MONO_EXISTS THEN
2181   X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
2182   X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN
2183   REMOVE_THEN "TRANS" MATCH_MP_TAC THEN EXISTS_TAC `y:real^N` THEN
2184   ASM_REWRITE_TAC[] THEN REMOVE_THEN "SUBSET" MATCH_MP_TAC THEN
2185   EXISTS_TAC `ball(y:real^N,e)` THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN
2186   REMOVE_THEN "BALL" MATCH_MP_TAC THEN
2187   REWRITE_TAC[SUBSET; IN_BALL] THEN ASM_MESON_TAC[]);;
2188
2189 let OPEN_NON_GENERAL_COMPONENT = prove
2190  (`!c. (!s x y. c s x y ==> x IN s /\ y IN s) /\
2191        (!s x y. c s x y ==> c s y x) /\
2192        (!s x y z. c s x y /\ c s y z ==> c s x z) /\
2193        (!s t x y. s SUBSET t /\ c s x y ==> c t x y) /\
2194        (!s x y e. y IN ball(x,e) /\ ball(x,e) SUBSET s
2195                   ==> c (ball(x,e)) x y)
2196        ==> !s x:real^N. open s ==> open(s DIFF c s x)`,
2197   GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "IN") MP_TAC) THEN
2198   DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SYM") MP_TAC) THEN
2199   DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "TRANS") MP_TAC) THEN
2200   DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SUBSET") (LABEL_TAC "BALL")) THEN
2201   REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL; SUBSET; IN_BALL] THEN
2202   DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_DIFF] THEN
2203   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o REWRITE_RULE[IN])) THEN
2204   FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(y:real^N) IN s`)) THEN
2205   MATCH_MP_TAC MONO_EXISTS THEN
2206   X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
2207   X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN ASM_SIMP_TAC[] THEN
2208   REWRITE_TAC[IN] THEN DISCH_TAC THEN
2209   FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN REWRITE_TAC[] THEN
2210   REMOVE_THEN "TRANS" MATCH_MP_TAC THEN EXISTS_TAC `z:real^N` THEN
2211   ASM_REWRITE_TAC[] THEN REMOVE_THEN "SUBSET" MATCH_MP_TAC THEN
2212   EXISTS_TAC `ball(y:real^N,e)` THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN
2213   REMOVE_THEN "SYM" MATCH_MP_TAC THEN
2214   REMOVE_THEN "BALL" MATCH_MP_TAC THEN
2215   REWRITE_TAC[SUBSET; IN_BALL] THEN ASM_MESON_TAC[]);;
2216
2217 let GENERAL_CONNECTED_OPEN = prove
2218  (`!c. (!s x y. c s x y ==> x IN s /\ y IN s) /\
2219        (!s x y. c s x y ==> c s y x) /\
2220        (!s x y z. c s x y /\ c s y z ==> c s x z) /\
2221        (!s t x y. s SUBSET t /\ c s x y ==> c t x y) /\
2222        (!s x y e. y IN ball(x,e) /\ ball(x,e) SUBSET s
2223                   ==> c (ball(x,e)) x y)
2224        ==> !s x y:real^N. open s /\ connected s /\ x IN s /\ y IN s
2225                           ==> c s x y`,
2226   REPEAT STRIP_TAC THEN
2227   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [connected]) THEN
2228   REWRITE_TAC[IN] THEN REWRITE_TAC[NOT_EXISTS_THM; LEFT_IMP_FORALL_THM] THEN
2229   MAP_EVERY EXISTS_TAC
2230    [`c (s:real^N->bool) (x:real^N):real^N->bool`;
2231     `s DIFF (c (s:real^N->bool) (x:real^N))`] THEN
2232   MATCH_MP_TAC(TAUT `a /\ b /\ c /\ d /\ e /\ (f ==> g)
2233                      ==> ~(a /\ b /\ c /\ d /\ e /\ ~f) ==> g`) THEN
2234   REPEAT CONJ_TAC THENL
2235    [MP_TAC(SPEC `c:(real^N->bool)->real^N->real^N->bool`
2236         OPEN_GENERAL_COMPONENT) THEN ASM_MESON_TAC[];
2237     MP_TAC(SPEC `c:(real^N->bool)->real^N->real^N->bool`
2238         OPEN_NON_GENERAL_COMPONENT) THEN ASM_MESON_TAC[];
2239     SET_TAC[];
2240     SET_TAC[];
2241     ALL_TAC;
2242     ASM SET_TAC[]] THEN
2243   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN
2244   DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
2245   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
2246   REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^N` THEN
2247   ASM_REWRITE_TAC[IN_INTER] THEN REWRITE_TAC[IN] THEN
2248   FIRST_ASSUM(MATCH_MP_TAC o
2249     SPECL [`ball(x:real^N,e)`; `s:real^N->bool`]) THEN
2250   ASM_MESON_TAC[CENTRE_IN_BALL]);;
2251
2252 (* ------------------------------------------------------------------------- *)
2253 (* Some useful lemmas about path-connectedness.                              *)
2254 (* ------------------------------------------------------------------------- *)
2255
2256 let CONVEX_IMP_PATH_CONNECTED = prove
2257  (`!s:real^N->bool. convex s ==> path_connected s`,
2258   REWRITE_TAC[CONVEX_ALT; path_connected] THEN REPEAT GEN_TAC THEN
2259   DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
2260   STRIP_TAC THEN EXISTS_TAC `\u. (&1 - drop u) % x + drop u % y:real^N` THEN
2261   ASM_SIMP_TAC[pathstart; pathfinish; DROP_VEC; path; path_image;
2262                SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; GSYM FORALL_DROP] THEN
2263   CONJ_TAC THENL [ALL_TAC; CONJ_TAC THEN VECTOR_ARITH_TAC] THEN
2264   MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
2265   MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN
2266   REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP; LIFT_NUM] THEN
2267   SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);;
2268
2269 let PATH_CONNECTED_UNIV = prove
2270  (`path_connected(:real^N)`,
2271   SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; CONVEX_UNIV]);;
2272
2273 let IS_INTERVAL_PATH_CONNECTED = prove
2274  (`!s. is_interval s ==> path_connected s`,
2275   SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; IS_INTERVAL_CONVEX]);;
2276
2277 let PATH_CONNECTED_INTERVAL = prove
2278  (`(!a b:real^N. path_connected(interval[a,b])) /\
2279    (!a b:real^N. path_connected(interval(a,b)))`,
2280   SIMP_TAC[IS_INTERVAL_PATH_CONNECTED; IS_INTERVAL_INTERVAL]);;
2281
2282 let PATH_COMPONENT_UNIV = prove
2283  (`!x. path_component(:real^N) x = (:real^N)`,
2284   MESON_TAC[PATH_CONNECTED_COMPONENT_SET; PATH_CONNECTED_UNIV; IN_UNIV]);;
2285
2286 let PATH_CONNECTED_IMP_CONNECTED = prove
2287  (`!s:real^N->bool. path_connected s ==> connected s`,
2288   GEN_TAC THEN
2289   REWRITE_TAC[path_connected; CONNECTED_IFF_CONNECTED_COMPONENT] THEN
2290   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN
2291   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^N` THEN
2292   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
2293   DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
2294   REWRITE_TAC[connected_component] THEN
2295   EXISTS_TAC `path_image(g:real^1->real^N)` THEN
2296   ASM_MESON_TAC[CONNECTED_PATH_IMAGE; PATHSTART_IN_PATH_IMAGE;
2297                 PATHFINISH_IN_PATH_IMAGE]);;
2298
2299 let OPEN_PATH_COMPONENT = prove
2300  (`!s x:real^N. open s ==> open(path_component s x)`,
2301   MATCH_MP_TAC OPEN_GENERAL_COMPONENT THEN
2302   REWRITE_TAC[PATH_COMPONENT_IN; PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS;
2303               PATH_COMPONENT_OF_SUBSET] THEN REPEAT STRIP_TAC THEN
2304   MATCH_MP_TAC(REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]
2305    (MATCH_MP CONVEX_IMP_PATH_CONNECTED (SPEC_ALL CONVEX_BALL))) THEN
2306   ASM_MESON_TAC[CENTRE_IN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE; NOT_IN_EMPTY]);;
2307
2308 let OPEN_NON_PATH_COMPONENT = prove
2309  (`!s x:real^N. open s ==> open(s DIFF path_component s x)`,
2310   MATCH_MP_TAC OPEN_NON_GENERAL_COMPONENT THEN
2311   REWRITE_TAC[PATH_COMPONENT_IN; PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS;
2312               PATH_COMPONENT_OF_SUBSET] THEN REPEAT STRIP_TAC THEN
2313   MATCH_MP_TAC(REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]
2314    (MATCH_MP CONVEX_IMP_PATH_CONNECTED (SPEC_ALL CONVEX_BALL))) THEN
2315   ASM_MESON_TAC[CENTRE_IN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE; NOT_IN_EMPTY]);;
2316
2317 let PATH_CONNECTED_CONTINUOUS_IMAGE = prove
2318  (`!f:real^M->real^N s.
2319         f continuous_on s /\ path_connected s ==> path_connected (IMAGE f s)`,
2320   REPEAT GEN_TAC THEN REWRITE_TAC[path_connected] THEN STRIP_TAC THEN
2321   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
2322   X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
2323   X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN
2324   FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `y:real^M`]) THEN
2325   ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish] THEN
2326   DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC) THEN
2327   EXISTS_TAC `(f:real^M->real^N) o (g:real^1->real^M)` THEN CONJ_TAC THENL
2328    [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
2329     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
2330     ASM_REWRITE_TAC[o_DEF] THEN ASM SET_TAC[]]);;
2331
2332 let HOMEOMORPHIC_PATH_CONNECTEDNESS = prove
2333  (`!s t. s homeomorphic t ==> (path_connected s <=> path_connected t)`,
2334   REWRITE_TAC[homeomorphic; homeomorphism] THEN
2335   MESON_TAC[PATH_CONNECTED_CONTINUOUS_IMAGE]);;
2336
2337 let PATH_CONNECTED_LINEAR_IMAGE = prove
2338  (`!f:real^M->real^N s.
2339      path_connected s /\ linear f ==> path_connected(IMAGE f s)`,
2340   SIMP_TAC[LINEAR_CONTINUOUS_ON; PATH_CONNECTED_CONTINUOUS_IMAGE]);;
2341
2342 let PATH_CONNECTED_LINEAR_IMAGE_EQ = prove
2343  (`!f s. linear f /\ (!x y. f x = f y ==> x = y)
2344          ==> (path_connected (IMAGE f s) <=> path_connected s)`,
2345   MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE PATH_CONNECTED_LINEAR_IMAGE));;
2346
2347 add_linear_invariants [PATH_CONNECTED_LINEAR_IMAGE_EQ];;
2348
2349 let PATH_CONNECTED_EMPTY = prove
2350  (`path_connected {}`,
2351   REWRITE_TAC[path_connected; NOT_IN_EMPTY]);;
2352
2353 let PATH_CONNECTED_SING = prove
2354  (`!a:real^N. path_connected {a}`,
2355   GEN_TAC THEN REWRITE_TAC[path_connected; IN_SING] THEN
2356   REPEAT STRIP_TAC THEN EXISTS_TAC `linepath(a:real^N,a)` THEN
2357   ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
2358   REWRITE_TAC[SEGMENT_REFL; PATH_IMAGE_LINEPATH; SUBSET_REFL]);;
2359
2360 let PATH_CONNECTED_UNION = prove
2361  (`!s t. path_connected s /\ path_connected t /\ ~(s INTER t = {})
2362          ==> path_connected (s UNION t)`,
2363   REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
2364   REWRITE_TAC[IN_INTER; IN_UNION] THEN
2365   MESON_TAC[PATH_COMPONENT_OF_SUBSET; SUBSET_UNION; PATH_COMPONENT_TRANS]);;
2366
2367 let PATH_CONNECTED_TRANSLATION = prove
2368  (`!a s. path_connected s ==> path_connected (IMAGE (\x:real^N. a + x) s)`,
2369   REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN
2370   ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]);;
2371
2372 let PATH_CONNECTED_TRANSLATION_EQ = prove
2373  (`!a s. path_connected (IMAGE (\x:real^N. a + x) s) <=> path_connected s`,
2374   REWRITE_TAC[path_connected] THEN GEOM_TRANSLATE_TAC[]);;
2375
2376 add_translation_invariants [PATH_CONNECTED_TRANSLATION_EQ];;
2377
2378 let PATH_CONNECTED_PCROSS = prove
2379  (`!s:real^M->bool t:real^N->bool.
2380         path_connected s /\ path_connected t
2381         ==> path_connected (s PCROSS t)`,
2382   REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS; path_connected] THEN DISCH_TAC THEN
2383   REWRITE_TAC[FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN
2384   MAP_EVERY X_GEN_TAC [`x1:real^M`; `y1:real^N`; `x2:real^M`; `y2:real^N`] THEN
2385   STRIP_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN2
2386    (MP_TAC o SPECL [`x1:real^M`; `x2:real^M`])
2387    (MP_TAC o SPECL [`y1:real^N`; `y2:real^N`])) THEN
2388   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
2389   X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THEN
2390   X_GEN_TAC `g:real^1->real^M` THEN STRIP_TAC THEN
2391   EXISTS_TAC `(\t. pastecart (x1:real^M) ((h:real^1->real^N) t)) ++
2392               (\t. pastecart ((g:real^1->real^M) t) (y2:real^N))` THEN
2393   RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish; path]) THEN
2394   RULE_ASSUM_TAC(REWRITE_RULE[path_image; FORALL_IN_IMAGE; SUBSET]) THEN
2395   REPEAT CONJ_TAC THENL
2396    [MATCH_MP_TAC PATH_JOIN_IMP THEN REPEAT CONJ_TAC THENL
2397      [REWRITE_TAC[path] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
2398       ASM_REWRITE_TAC[CONTINUOUS_ON_CONST];
2399       REWRITE_TAC[path] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
2400       ASM_REWRITE_TAC[CONTINUOUS_ON_CONST];
2401       ASM_REWRITE_TAC[pathstart; pathfinish]];
2402     MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN
2403     ASM_SIMP_TAC[path_image; FORALL_IN_IMAGE; SUBSET; IN_ELIM_PASTECART_THM];
2404     REWRITE_TAC[PATHSTART_JOIN] THEN ASM_REWRITE_TAC[pathstart];
2405     REWRITE_TAC[PATHFINISH_JOIN] THEN ASM_REWRITE_TAC[pathfinish]]);;
2406
2407 let PATH_CONNECTED_PCROSS_EQ = prove
2408  (`!s:real^M->bool t:real^N->bool.
2409         path_connected(s PCROSS t) <=>
2410         s = {} \/ t = {} \/ path_connected s /\ path_connected t`,
2411   REPEAT GEN_TAC THEN
2412   ASM_CASES_TAC `s:real^M->bool = {}` THEN
2413   ASM_REWRITE_TAC[PCROSS_EMPTY; PATH_CONNECTED_EMPTY] THEN
2414   ASM_CASES_TAC `t:real^N->bool = {}` THEN
2415   ASM_REWRITE_TAC[PCROSS_EMPTY; PATH_CONNECTED_EMPTY] THEN
2416   EQ_TAC THEN REWRITE_TAC[PATH_CONNECTED_PCROSS] THEN REPEAT STRIP_TAC THENL
2417    [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`;
2418                     `(s:real^M->bool) PCROSS (t:real^N->bool)`]
2419        PATH_CONNECTED_LINEAR_IMAGE) THEN
2420     ASM_REWRITE_TAC[LINEAR_FSTCART];
2421     MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`;
2422                    `(s:real^M->bool) PCROSS (t:real^N->bool)`]
2423        PATH_CONNECTED_LINEAR_IMAGE) THEN
2424     ASM_REWRITE_TAC[LINEAR_SNDCART]] THEN
2425   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
2426   REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS;
2427               FSTCART_PASTECART; SNDCART_PASTECART] THEN
2428   ASM SET_TAC[]);;
2429
2430 let PATH_CONNECTED_SCALING = prove
2431  (`!s:real^N->bool c.
2432         path_connected s ==> path_connected (IMAGE (\x. c % x) s)`,
2433   REPEAT STRIP_TAC THEN
2434   MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
2435   MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
2436   REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
2437   REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);;
2438
2439 let PATH_CONNECTED_NEGATIONS = prove
2440  (`!s:real^N->bool.
2441         path_connected s ==> path_connected (IMAGE (--) s)`,
2442   REPEAT STRIP_TAC THEN
2443   MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
2444   MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
2445   REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
2446   REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);;
2447
2448 let PATH_CONNECTED_SUMS = prove
2449  (`!s t:real^N->bool.
2450         path_connected s /\ path_connected t
2451         ==> path_connected {x + y | x IN s /\ y IN t}`,
2452   REPEAT GEN_TAC THEN
2453   DISCH_THEN(MP_TAC o MATCH_MP PATH_CONNECTED_PCROSS) THEN
2454   DISCH_THEN(MP_TAC o ISPEC
2455    `\z. (fstcart z + sndcart z:real^N)` o
2456     MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
2457       PATH_CONNECTED_CONTINUOUS_IMAGE)) THEN
2458   SIMP_TAC[CONTINUOUS_ON_ADD; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART;
2459            LINEAR_SNDCART; PCROSS] THEN
2460   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
2461   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; EXISTS_PASTECART] THEN
2462   REWRITE_TAC[PASTECART_INJ; FSTCART_PASTECART; SNDCART_PASTECART] THEN
2463   MESON_TAC[]);;
2464
2465 let IS_INTERVAL_PATH_CONNECTED_1 = prove
2466  (`!s:real^1->bool. is_interval s <=> path_connected s`,
2467   MESON_TAC[CONVEX_IMP_PATH_CONNECTED; PATH_CONNECTED_IMP_CONNECTED;
2468             IS_INTERVAL_CONNECTED_1; IS_INTERVAL_CONVEX_1]);;
2469
2470 (* ------------------------------------------------------------------------- *)
2471 (* Bounds on components of a continuous image.                               *)
2472 (* ------------------------------------------------------------------------- *)
2473
2474 let CARD_LE_PATH_COMPONENTS = prove
2475  (`!f:real^M->real^N s.
2476         f continuous_on s
2477         ==> {path_component (IMAGE f s) y | y | y IN IMAGE f s}
2478             <=_c {path_component s x | x | x IN s}`,
2479   REPEAT STRIP_TAC THEN REWRITE_TAC[LE_C] THEN
2480   SIMP_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC; FORALL_IN_IMAGE] THEN EXISTS_TAC
2481    `\c. path_component (IMAGE (f:real^M->real^N) s) (f(@x. x IN c))` THEN
2482   X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN EXISTS_TAC `x:real^M` THEN
2483   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC PATH_COMPONENT_EQ THEN
2484   REWRITE_TAC[IN] THEN ONCE_REWRITE_TAC[PATH_COMPONENT] THEN
2485   EXISTS_TAC `IMAGE (f:real^M->real^N) (path_component s x)` THEN
2486   REPEAT CONJ_TAC THENL
2487    [MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN
2488     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; PATH_COMPONENT_SUBSET;
2489                   PATH_CONNECTED_PATH_COMPONENT];
2490     MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[PATH_COMPONENT_SUBSET];
2491     ALL_TAC; ALL_TAC] THEN
2492   MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN] THEN
2493   ASM_MESON_TAC[PATH_COMPONENT_REFL_EQ]);;
2494
2495 let CARD_LE_CONNECTED_COMPONENTS = prove
2496  (`!f:real^M->real^N s.
2497         f continuous_on s
2498         ==> {connected_component (IMAGE f s) y | y | y IN IMAGE f s}
2499             <=_c {connected_component s x | x | x IN s}`,
2500   REPEAT STRIP_TAC THEN REWRITE_TAC[LE_C] THEN
2501   SIMP_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC; FORALL_IN_IMAGE] THEN EXISTS_TAC
2502    `\c. connected_component (IMAGE (f:real^M->real^N) s) (f(@x. x IN c))` THEN
2503   X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN EXISTS_TAC `x:real^M` THEN
2504   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN
2505   REWRITE_TAC[IN] THEN ONCE_REWRITE_TAC[connected_component] THEN
2506   EXISTS_TAC `IMAGE (f:real^M->real^N) (connected_component s x)` THEN
2507   REPEAT CONJ_TAC THENL
2508    [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
2509     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; CONNECTED_COMPONENT_SUBSET;
2510                   CONNECTED_CONNECTED_COMPONENT];
2511     MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET];
2512     ALL_TAC; ALL_TAC] THEN
2513   MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN] THEN
2514   ASM_MESON_TAC[CONNECTED_COMPONENT_REFL_EQ]);;
2515
2516 let CARD_LE_COMPONENTS = prove
2517  (`!f:real^M->real^N s.
2518         f continuous_on s ==> components(IMAGE f s) <=_c components s`,
2519   REWRITE_TAC[components; CARD_LE_CONNECTED_COMPONENTS]);;
2520
2521 (* ------------------------------------------------------------------------- *)
2522 (* More stuff about segments.                                                *)
2523 (* ------------------------------------------------------------------------- *)
2524
2525 let SEGMENT_OPEN_SUBSET_CLOSED = prove
2526  (`!a b. segment(a,b) SUBSET segment[a,b]`,
2527   REWRITE_TAC[CONJUNCT2(SPEC_ALL segment)] THEN SET_TAC[]);;
2528
2529 let BOUNDED_SEGMENT = prove
2530  (`(!a b:real^N. bounded(segment[a,b])) /\
2531    (!a b:real^N. bounded(segment(a,b)))`,
2532   REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
2533   MATCH_MP_TAC(MESON[BOUNDED_SUBSET]
2534    `bounded s /\ t SUBSET s ==> bounded s /\ bounded t`) THEN
2535   REWRITE_TAC[SEGMENT_OPEN_SUBSET_CLOSED] THEN
2536   MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN
2537   MATCH_MP_TAC COMPACT_CONVEX_HULL THEN
2538   SIMP_TAC[COMPACT_INSERT; COMPACT_EMPTY]);;
2539
2540 let SEGMENT_IMAGE_INTERVAL = prove
2541  (`(!a b. segment[a,b] =
2542           IMAGE (\u. (&1 - drop u) % a + drop u % b)
2543                 (interval[vec 0,vec 1])) /\
2544    (!a b. ~(a = b)
2545           ==> segment(a,b) =
2546                 IMAGE (\u. (&1 - drop u) % a + drop u % b)
2547                 (interval(vec 0,vec 1)))`,
2548   REPEAT STRIP_TAC THEN
2549   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_INTERVAL_1; IN_SEGMENT] THEN
2550   ASM_REWRITE_TAC[GSYM EXISTS_DROP; DROP_VEC] THEN MESON_TAC[]);;
2551
2552 let CLOSURE_SEGMENT = prove
2553  (`(!a b:real^N. closure(segment[a,b]) = segment[a,b]) /\
2554    (!a b:real^N. closure(segment(a,b)) = if a = b then {} else segment[a,b])`,
2555   REPEAT STRIP_TAC THENL
2556    [ASM_MESON_TAC[CLOSURE_EQ; COMPACT_IMP_CLOSED; SEGMENT_CONVEX_HULL;
2557                   COMPACT_CONVEX_HULL; COMPACT_INSERT; COMPACT_EMPTY];
2558     ALL_TAC] THEN
2559   REPEAT GEN_TAC THEN COND_CASES_TAC THEN
2560   ASM_REWRITE_TAC[SEGMENT_REFL; CLOSURE_EMPTY] THEN
2561   ASM_SIMP_TAC[SEGMENT_IMAGE_INTERVAL] THEN
2562   ASM_SIMP_TAC[CONV_RULE(RAND_CONV SYM_CONV) (SPEC_ALL CLOSURE_OPEN_INTERVAL);
2563                INTERVAL_EQ_EMPTY_1; DROP_VEC; REAL_ARITH `~(&1 <= &0)`] THEN
2564   SUBGOAL_THEN
2565    `(\u. (&1 - drop u) % a + drop u % (b:real^N)) =
2566     (\x. a + x) o (\u. drop u % (b - a))`
2567   SUBST1_TAC THENL
2568    [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN
2569   REWRITE_TAC[IMAGE_o; CLOSURE_TRANSLATION] THEN AP_TERM_TAC THEN
2570   MATCH_MP_TAC CLOSURE_INJECTIVE_LINEAR_IMAGE THEN
2571   ASM_REWRITE_TAC[VECTOR_MUL_RCANCEL; VECTOR_SUB_EQ; DROP_EQ] THEN
2572   REWRITE_TAC[linear; DROP_ADD; DROP_CMUL] THEN VECTOR_ARITH_TAC);;
2573
2574 let CLOSED_SEGMENT = prove
2575  (`(!a b:real^N. closed(segment[a,b])) /\
2576    (!a b:real^N. closed(segment(a,b)) <=> a = b)`,
2577   REWRITE_TAC[GSYM CLOSURE_EQ; CLOSURE_SEGMENT] THEN
2578   REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[SEGMENT_REFL] THEN
2579   MESON_TAC[ENDS_NOT_IN_SEGMENT; ENDS_IN_SEGMENT]);;
2580
2581 let COMPACT_SEGMENT = prove
2582  (`(!a b:real^N. compact(segment[a,b])) /\
2583    (!a b:real^N. compact(segment(a,b)) <=> a = b)`,
2584   REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_SEGMENT; BOUNDED_SEGMENT]);;
2585
2586 let AFFINE_HULL_SEGMENT = prove
2587  (`(!a b:real^N. affine hull (segment [a,b]) = affine hull {a,b}) /\
2588    (!a b:real^N. affine hull (segment(a,b)) =
2589                  if a = b then {} else affine hull {a,b})`,
2590   REWRITE_TAC[SEGMENT_CONVEX_HULL; AFFINE_HULL_CONVEX_HULL] THEN
2591   REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM AFFINE_HULL_CLOSURE] THEN
2592   REWRITE_TAC[CLOSURE_SEGMENT] THEN
2593   COND_CASES_TAC THEN ASM_REWRITE_TAC[AFFINE_HULL_EMPTY] THEN
2594   REWRITE_TAC[SEGMENT_CONVEX_HULL; AFFINE_HULL_CONVEX_HULL]);;
2595
2596 let SEGMENT_AS_BALL = prove
2597  (`(!a b. segment[a:real^N,b] =
2598          affine hull {a,b} INTER cball(inv(&2) % (a + b),norm(b - a) / &2)) /\
2599    (!a b. segment(a:real^N,b) =
2600          affine hull {a,b} INTER ball(inv(&2) % (a + b),norm(b - a) / &2))`,
2601   REPEAT STRIP_TAC THEN
2602   (ASM_CASES_TAC `b:real^N = a` THEN
2603    ASM_REWRITE_TAC[SEGMENT_REFL; VECTOR_SUB_REFL; NORM_0] THEN
2604    CONV_TAC REAL_RAT_REDUCE_CONV THEN
2605    REWRITE_TAC[BALL_TRIVIAL; CBALL_TRIVIAL] THENL
2606     [REWRITE_TAC[INTER_EMPTY; INSERT_AC] THEN
2607      REWRITE_TAC[VECTOR_ARITH `&1 / &2 % (a + a) = a`] THEN
2608      REWRITE_TAC[SET_RULE `a = b INTER a <=> a SUBSET b`; HULL_SUBSET];
2609      ASM_REWRITE_TAC[EXTENSION; IN_SEGMENT; IN_INTER; AFFINE_HULL_2] THEN
2610      X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN
2611      ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
2612      REWRITE_TAC[REAL_ARITH `u + v:real = &1 <=> u = &1 - v`] THEN
2613      REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
2614      AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN
2615      X_GEN_TAC `u:real` THEN REWRITE_TAC[] THEN
2616      ASM_CASES_TAC `y:real^N = (&1 - u) % a + u % b` THEN
2617      ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_BALL; IN_CBALL; dist; VECTOR_ARITH
2618       `&1 / &2 % (a + b) - ((&1 - u) % a + u % b):real^N =
2619        (&1 / &2 - u) % (b - a)`] THEN
2620     ASM_SIMP_TAC[NORM_MUL; REAL_LT_MUL_EQ; REAL_LE_MUL_EQ; NORM_POS_LT;
2621      VECTOR_SUB_EQ; REAL_ARITH `a * n < n / &2 <=> &0 < n * (inv(&2) - a)`;
2622               REAL_ARITH `a * n <= n / &2 <=> &0 <= n * (inv(&2) - a)`] THEN
2623     REAL_ARITH_TAC]));;
2624
2625 let CONVEX_SEGMENT = prove
2626  (`(!a b. convex(segment[a,b])) /\ (!a b. convex(segment(a,b)))`,
2627   REWRITE_TAC[SEGMENT_AS_BALL] THEN
2628   SIMP_TAC[CONVEX_INTER; CONVEX_BALL; CONVEX_CBALL;
2629            AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL]);;
2630
2631 let RELATIVE_INTERIOR_SEGMENT = prove
2632  (`(!a b:real^N.
2633       relative_interior(segment[a,b]) = if a = b then {a} else segment(a,b)) /\
2634    (!a b:real^N. relative_interior(segment(a,b)) = segment(a,b))`,
2635   MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL
2636    [REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN
2637     ASM_REWRITE_TAC[SEGMENT_REFL; RELATIVE_INTERIOR_EMPTY] THEN
2638     REWRITE_TAC[RELATIVE_INTERIOR_EQ; OPEN_IN_OPEN] THEN
2639     ASM_REWRITE_TAC[AFFINE_HULL_SEGMENT] THEN
2640     EXISTS_TAC `ball(inv(&2) % (a + b):real^N,norm(b - a) / &2)` THEN
2641     REWRITE_TAC[OPEN_BALL; SEGMENT_AS_BALL];
2642     REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
2643     ASM_REWRITE_TAC[SEGMENT_REFL; RELATIVE_INTERIOR_SING] THEN
2644     MP_TAC(ISPECL [`a:real^N`; `b:real^N`] (CONJUNCT2 CLOSURE_SEGMENT)) THEN
2645     ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
2646     FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN
2647     MATCH_MP_TAC CONVEX_RELATIVE_INTERIOR_CLOSURE THEN
2648     REWRITE_TAC[CONVEX_SEGMENT]]);;
2649
2650 let PATH_CONNECTED_SEGMENT = prove
2651  (`(!a b. path_connected(segment[a,b])) /\
2652    (!a b. path_connected(segment(a,b)))`,
2653   SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; CONVEX_SEGMENT]);;
2654
2655 let CONNECTED_SEGMENT = prove
2656  (`(!a b. connected(segment[a,b])) /\ (!a b. connected(segment(a,b)))`,
2657   SIMP_TAC[CONVEX_CONNECTED; CONVEX_SEGMENT]);;
2658
2659 let CONVEX_SEMIOPEN_SEGMENT = prove
2660  (`(!a b:real^N. convex(segment[a,b] DELETE a)) /\
2661    (!a b:real^N. convex(segment[a,b] DELETE b))`,
2662   MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN
2663   CONJ_TAC THENL [MESON_TAC[SEGMENT_SYM]; ALL_TAC] THEN
2664   REPEAT GEN_TAC THEN ASM_CASES_TAC `b:real^N = a` THEN
2665   ASM_SIMP_TAC[SEGMENT_REFL; SET_RULE `{a} DELETE a = {}`; CONVEX_EMPTY] THEN
2666   REWRITE_TAC[CONVEX_ALT; IN_DELETE] THEN
2667   SIMP_TAC[REWRITE_RULE[CONVEX_ALT] CONVEX_SEGMENT] THEN
2668   REWRITE_TAC[IN_SEGMENT] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
2669   ASM_REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC;
2670                   GSYM VECTOR_ADD_ASSOC] THEN
2671   ASM_REWRITE_TAC[VECTOR_ARITH
2672    `x % a + y % b + z % a + w % b:real^N = a <=>
2673     (&1 - x - z) % a = (w + y) % b`] THEN
2674   ASM_REWRITE_TAC[VECTOR_MUL_LCANCEL; REAL_ARITH
2675    `&1 - (&1 - u) * (&1 - v) - u * (&1 - w) =
2676     u * w + (&1 - u) * v`] THEN
2677   ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_ARITH
2678    `&0 <= x /\ &0 <= y ==> (x + y = &0 <=> x = &0 /\ y = &0)`] THEN
2679   REWRITE_TAC[REAL_ENTIRE; REAL_ARITH `&1 - x = &0 <=> x = &1`] THEN
2680   DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
2681    `(u = &0 \/ w = &0) /\ (u = &1 \/ v = &0)
2682     ==> u = &0 /\ v = &0 \/ u = &1 /\ w = &0 \/ v = &0 /\ w = &0`)) THEN
2683   DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN (CONJUNCTS_THEN SUBST_ALL_TAC)) THEN
2684   ASM_MESON_TAC[VECTOR_ARITH `(&1 - &0) % a + &0 % b:real^N = a`]);;
2685
2686 let PATH_CONNECTED_SEMIOPEN_SEGMENT = prove
2687  (`(!a b:real^N. path_connected(segment[a,b] DELETE a)) /\
2688    (!a b:real^N. path_connected(segment[a,b] DELETE b))`,
2689   SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; CONVEX_SEMIOPEN_SEGMENT]);;
2690
2691 let CONNECTED_SEMIOPEN_SEGMENT = prove
2692  (`(!a b:real^N. connected(segment[a,b] DELETE a)) /\
2693    (!a b:real^N. connected(segment[a,b] DELETE b))`,
2694   SIMP_TAC[CONVEX_CONNECTED; CONVEX_SEMIOPEN_SEGMENT]);;
2695
2696 let SEGMENT_EQ_EMPTY = prove
2697  (`(!a b:real^N. ~(segment[a,b] = {})) /\
2698    (!a b:real^N. segment(a,b) = {} <=> a = b)`,
2699   REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_EQ_EMPTY; NOT_INSERT_EMPTY] THEN
2700   REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN
2701   ASM_REWRITE_TAC[SEGMENT_REFL] THEN
2702   ASM_MESON_TAC[NOT_IN_EMPTY; MIDPOINT_IN_SEGMENT]);;
2703
2704 let FINITE_SEGMENT = prove
2705  (`(!a b:real^N. FINITE(segment[a,b]) <=> a = b) /\
2706    (!a b:real^N. FINITE(segment(a,b)) <=> a = b)`,
2707   REWRITE_TAC[open_segment; SET_RULE `s DIFF {a,b} = s DELETE a DELETE b`] THEN
2708   REWRITE_TAC[FINITE_DELETE] THEN REPEAT GEN_TAC THEN
2709   ASM_CASES_TAC `a:real^N = b` THEN
2710   ASM_REWRITE_TAC[SEGMENT_REFL; FINITE_SING] THEN
2711   REWRITE_TAC[SEGMENT_IMAGE_INTERVAL] THEN
2712   W(MP_TAC o PART_MATCH (lhs o rand) FINITE_IMAGE_INJ_EQ o rand o snd) THEN
2713   ANTS_TAC THENL
2714    [REWRITE_TAC[VECTOR_ARITH
2715      `(&1 - u) % a + u % b:real^N = (&1 - v) % a + v % b <=>
2716       (u - v) % (b - a) = vec 0`] THEN
2717     ASM_SIMP_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; REAL_SUB_0; DROP_EQ];
2718     DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[FINITE_INTERVAL_1] THEN
2719     REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC]);;
2720
2721 let SEGMENT_EQ_SING = prove
2722  (`(!a b c:real^N. segment[a,b] = {c} <=> a = c /\ b = c) /\
2723    (!a b c:real^N. ~(segment(a,b) = {c}))`,
2724   REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_EQ_SING] THEN
2725   CONJ_TAC THENL [SET_TAC[]; REPEAT GEN_TAC] THEN
2726   ASM_CASES_TAC `a:real^N = b` THEN
2727   ASM_REWRITE_TAC[SEGMENT_REFL; NOT_INSERT_EMPTY] THEN
2728   DISCH_TAC THEN
2729   MP_TAC(ISPECL [`a:real^N`; `b:real^N`] (CONJUNCT2 FINITE_SEGMENT)) THEN
2730   ASM_REWRITE_TAC[FINITE_SING]);;
2731
2732 let SUBSET_SEGMENT_OPEN_CLOSED = prove
2733  (`!a b c d:real^N.
2734         segment(a,b) SUBSET segment(c,d) <=>
2735         a = b \/ segment[a,b] SUBSET segment[c,d]`,
2736   REPEAT GEN_TAC THEN EQ_TAC THENL
2737    [ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[] THEN
2738     DISCH_THEN(MP_TAC o MATCH_MP SUBSET_CLOSURE) THEN
2739     ASM_REWRITE_TAC[CLOSURE_SEGMENT] THEN
2740     COND_CASES_TAC THEN REWRITE_TAC[SUBSET_EMPTY; SEGMENT_EQ_EMPTY];
2741     ALL_TAC] THEN
2742   DISCH_THEN(DISJ_CASES_THEN2 SUBST1_TAC MP_TAC) THEN
2743   REWRITE_TAC[SEGMENT_REFL; EMPTY_SUBSET] THEN
2744   ABBREV_TAC `m:real^N = d - c` THEN POP_ASSUM MP_TAC THEN
2745   GEOM_NORMALIZE_TAC `m:real^N` THEN
2746   SIMP_TAC[VECTOR_SUB_EQ; SEGMENT_REFL; SEGMENT_EQ_SING; SEGMENT_EQ_EMPTY;
2747            SET_RULE `s SUBSET {a} <=> s = {a} \/ s = {}`; SUBSET_REFL] THEN
2748   X_GEN_TAC `m:real^N` THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
2749   DISCH_THEN(SUBST_ALL_TAC o SYM) THEN POP_ASSUM MP_TAC THEN
2750   GEOM_ORIGIN_TAC `c:real^N` THEN GEOM_BASIS_MULTIPLE_TAC 1 `d:real^N` THEN
2751   X_GEN_TAC `d:real` THEN DISCH_TAC THEN
2752   MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
2753   SIMP_TAC[VECTOR_SUB_RZERO; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
2754   ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN DISCH_THEN SUBST_ALL_TAC THEN
2755   POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN
2756   SUBGOAL_THEN `collinear{vec 0:real^N,&1 % basis 1,x} /\
2757                 collinear{vec 0:real^N,&1 % basis 1,y}`
2758   MP_TAC THENL
2759    [ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {a,c,b}`] THEN
2760     CONJ_TAC THEN MATCH_MP_TAC BETWEEN_IMP_COLLINEAR THEN
2761     REWRITE_TAC[BETWEEN_IN_SEGMENT] THEN
2762     ASM_MESON_TAC[SUBSET; ENDS_IN_SEGMENT];
2763     ALL_TAC] THEN
2764   SIMP_TAC[COLLINEAR_LEMMA_ALT; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL;
2765            VECTOR_ARITH `&1 % x:real^N = vec 0 <=> x = vec 0`] THEN
2766   REWRITE_TAC[IMP_CONJ; VECTOR_MUL_ASSOC; LEFT_IMP_EXISTS_THM] THEN
2767   X_GEN_TAC `a:real` THEN REWRITE_TAC[REAL_MUL_RID] THEN
2768   DISCH_THEN SUBST_ALL_TAC THEN X_GEN_TAC `b:real` THEN
2769   DISCH_THEN SUBST_ALL_TAC THEN POP_ASSUM MP_TAC THEN
2770   SUBST1_TAC(VECTOR_ARITH `vec 0:real^N = &0 % basis 1`) THEN
2771   ASM_SIMP_TAC[SEGMENT_SCALAR_MULTIPLE; VECTOR_MUL_RCANCEL; BASIS_NONZERO;
2772                DIMINDEX_GE_1; LE_REFL; SET_RULE
2773                 `(!x y. x % v = y % v <=> x = y)
2774                  ==> ({x % v | P x} SUBSET {x % v | Q x} <=>
2775                       {x | P x} SUBSET {x | Q x})`] THEN
2776   REWRITE_TAC[REAL_ARITH `a <= x /\ x <= b \/ b <= x /\ x <= a <=>
2777                           min a b <= x /\ x <= max a b`;
2778               REAL_ARITH `a < x /\ x < b \/ b < x /\ x < a <=>
2779                           min a b < x /\ x < max a b`] THEN
2780   CONV_TAC REAL_RAT_REDUCE_CONV THEN
2781   REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_TAC THEN
2782   X_GEN_TAC `x:real` THEN
2783   FIRST_X_ASSUM(fun th -> MAP_EVERY (MP_TAC o C SPEC th)
2784         [`min (a:real) b`; `max (a:real) b`]) THEN
2785   REAL_ARITH_TAC);;
2786
2787 let SUBSET_SEGMENT = prove
2788  (`(!a b c d:real^N.
2789         segment[a,b] SUBSET segment[c,d] <=>
2790         a IN segment[c,d] /\ b IN segment[c,d]) /\
2791    (!a b c d:real^N.
2792         segment[a,b] SUBSET segment(c,d) <=>
2793         a IN segment(c,d) /\ b IN segment(c,d)) /\
2794    (!a b c d:real^N.
2795         segment(a,b) SUBSET segment[c,d] <=>
2796         a = b \/ a IN segment[c,d] /\ b IN segment[c,d]) /\
2797    (!a b c d:real^N.
2798         segment(a,b) SUBSET segment(c,d) <=>
2799         a = b \/ a IN segment[c,d] /\ b IN segment[c,d])`,
2800   MATCH_MP_TAC(TAUT `(a /\ b) /\ (a /\ b ==> c) ==> a /\ b /\ c`) THEN
2801   CONJ_TAC THENL
2802    [REPEAT STRIP_TAC THEN
2803     GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [SEGMENT_CONVEX_HULL] THEN
2804     SIMP_TAC[SUBSET_HULL; CONVEX_SEGMENT] THEN SET_TAC[];
2805     STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_SEGMENT_OPEN_CLOSED] THEN
2806     REPEAT GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
2807     EXISTS_TAC `closure(segment(a:real^N,b)) SUBSET segment[c,d]` THEN
2808     CONJ_TAC THENL [SIMP_TAC[CLOSURE_MINIMAL_EQ; CLOSED_SEGMENT]; ALL_TAC] THEN
2809     REWRITE_TAC[CLOSURE_SEGMENT] THEN
2810     COND_CASES_TAC THEN ASM_REWRITE_TAC[EMPTY_SUBSET]]);;
2811
2812 let INTERIOR_SEGMENT = prove
2813  (`(!a b:real^N. interior(segment[a,b]) =
2814                  if 2 <= dimindex(:N) then {} else segment(a,b)) /\
2815    (!a b:real^N. interior(segment(a,b)) =
2816                  if 2 <= dimindex(:N) then {} else segment(a,b))`,
2817   REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
2818   ASM_CASES_TAC `2 <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THENL
2819    [MATCH_MP_TAC(SET_RULE `t SUBSET s /\ s = {} ==> s = {} /\ t = {}`) THEN
2820     SIMP_TAC[SEGMENT_OPEN_SUBSET_CLOSED; SUBSET_INTERIOR] THEN
2821     REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN
2822     MATCH_MP_TAC EMPTY_INTERIOR_CONVEX_HULL THEN
2823     REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN FIRST_ASSUM
2824      (MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LE_TRANS)) THEN
2825     SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ARITH_TAC;
2826     ASM_CASES_TAC `a:real^N = b` THEN
2827     ASM_SIMP_TAC[SEGMENT_REFL; INTERIOR_EMPTY; EMPTY_INTERIOR_FINITE;
2828                  FINITE_SING] THEN
2829     SUBGOAL_THEN
2830      `affine hull (segment[a,b]) = (:real^N) /\
2831       affine hull (segment(a,b)) = (:real^N)`
2832      (fun th -> ASM_SIMP_TAC[th; GSYM RELATIVE_INTERIOR_INTERIOR;
2833                              RELATIVE_INTERIOR_SEGMENT]) THEN
2834     ASM_REWRITE_TAC[AFFINE_HULL_SEGMENT] THEN
2835     MATCH_MP_TAC AFFINE_INDEPENDENT_SPAN_GT THEN
2836     REWRITE_TAC[AFFINE_INDEPENDENT_2] THEN
2837     ASM_SIMP_TAC[CARD_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY] THEN
2838     ASM_ARITH_TAC]);;
2839
2840 let SEGMENT_EQ = prove
2841  (`(!a b c d:real^N.
2842         segment[a,b] = segment[c,d] <=> {a,b} = {c,d}) /\
2843    (!a b c d:real^N.
2844         ~(segment[a,b] = segment(c,d))) /\
2845    (!a b c d:real^N.
2846         ~(segment(a,b) = segment[c,d])) /\
2847    (!a b c d:real^N.
2848         segment(a,b) = segment(c,d) <=> a = b /\ c = d \/ {a,b} = {c,d})`,
2849   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
2850    [REPEAT GEN_TAC THEN EQ_TAC THENL
2851      [DISCH_THEN(fun th -> MP_TAC th THEN
2852        MP_TAC(AP_TERM `\s:real^N->bool. s DIFF relative_interior s` th)) THEN
2853       REWRITE_TAC[RELATIVE_INTERIOR_SEGMENT] THEN
2854       REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[SEGMENT_REFL]) THEN
2855       SIMP_TAC[ENDS_IN_SEGMENT; open_segment; SET_RULE
2856         `a IN s /\ b IN s ==> s DIFF (s DIFF {a,b}) = {a,b}`] THEN
2857       ASM SET_TAC[SEGMENT_EQ_SING];
2858       SIMP_TAC[SEGMENT_CONVEX_HULL]];
2859     DISCH_TAC] THEN
2860   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
2861    [REPEAT STRIP_TAC THEN
2862     FIRST_ASSUM(MP_TAC o AP_TERM `closed:(real^N->bool)->bool`) THEN
2863     REWRITE_TAC[CONJUNCT1 CLOSED_SEGMENT] THEN
2864     REWRITE_TAC[GSYM CLOSURE_EQ; CLOSURE_SEGMENT] THEN
2865     COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
2866      [ASM SET_TAC[SEGMENT_EQ_EMPTY];
2867       REWRITE_TAC[open_segment; ENDS_IN_SEGMENT; SET_RULE
2868        `s = s DIFF {a,b} <=> ~(a IN s) /\ ~(b IN s)`]];
2869     DISCH_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
2870       REPEAT GEN_TAC THEN ASM_CASES_TAC `c:real^N = d` THEN
2871     ASM_REWRITE_TAC[SEGMENT_EQ_EMPTY; SEGMENT_REFL] THENL
2872      [ASM SET_TAC[]; ALL_TAC] THEN
2873     CONV_TAC(BINOP_CONV SYM_CONV)THEN
2874     ASM_CASES_TAC `a:real^N = b` THEN
2875     ASM_REWRITE_TAC[SEGMENT_EQ_EMPTY; SEGMENT_REFL] THENL
2876      [ASM SET_TAC[]; ALL_TAC] THEN
2877     ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_SEGMENT_OPEN_CLOSED] THEN
2878     ASM_REWRITE_TAC[SUBSET_ANTISYM_EQ]]);;
2879
2880 let COLLINEAR_SEGMENT = prove
2881  (`(!a b:real^N. collinear(segment[a,b])) /\
2882    (!a b:real^N. collinear(segment(a,b)))`,
2883   REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
2884   MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
2885    [REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN
2886     MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN
2887     REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_SUBSET_AFFINE_HULL];
2888     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COLLINEAR_SUBSET) THEN
2889     REWRITE_TAC[SEGMENT_OPEN_SUBSET_CLOSED]]);;
2890
2891 let INTER_SEGMENT = prove
2892  (`!a b c:real^N.
2893         b IN segment[a,c] \/ ~collinear{a,b,c}
2894         ==> segment[a,b] INTER segment[b,c] = {b}`,
2895   REPEAT GEN_TAC THEN ASM_CASES_TAC `c:real^N = a` THENL
2896    [ASM_SIMP_TAC[SEGMENT_REFL; IN_SING; INTER_IDEMPOT; INSERT_AC; COLLINEAR_2];
2897     ALL_TAC] THEN
2898   DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL
2899    [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN DISCH_TAC THEN
2900     MP_TAC(ISPECL [`{a:real^N,c}`; `b:real^N`; `{a:real^N}`; `{c:real^N}`]
2901         CONVEX_HULL_EXCHANGE_INTER) THEN
2902     ASM_REWRITE_TAC[AFFINE_INDEPENDENT_2] THEN
2903     ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[INSERT_AC]] THEN
2904     DISCH_THEN SUBST1_TAC THEN
2905     ASM_SIMP_TAC[SET_RULE `~(a = c) ==> {a} INTER {c} = {}`] THEN
2906     REWRITE_TAC[CONVEX_HULL_SING];
2907     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN
2908     DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
2909      `~(s INTER t = {b})
2910       ==> b IN s /\ b IN t
2911           ==> ?a. ~(a = b) /\ a IN s /\ b IN s /\ a IN t /\ b IN t`)) THEN
2912     ANTS_TAC THENL [REWRITE_TAC[ENDS_IN_SEGMENT]; ALL_TAC] THEN
2913     REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; LEFT_IMP_EXISTS_THM] THEN
2914     X_GEN_TAC `d:real^N` THEN STRIP_TAC THEN
2915     REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR)) THEN
2916     MATCH_MP_TAC COLLINEAR_3_TRANS THEN EXISTS_TAC `d:real^N` THEN
2917     REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[INSERT_AC]]);;
2918
2919 let SUBSET_CONTINUOUS_IMAGE_SEGMENT_1 = prove
2920  (`!f:real^N->real^1 a b.
2921         f continuous_on segment[a,b]
2922         ==> segment[f a,f b] SUBSET IMAGE f (segment[a,b])`,
2923   REPEAT STRIP_TAC THEN
2924   FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2925         CONNECTED_CONTINUOUS_IMAGE)) THEN
2926   REWRITE_TAC[CONNECTED_SEGMENT] THEN
2927   REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_CONVEX_1] THEN
2928   REWRITE_TAC[CONVEX_CONTAINS_SEGMENT] THEN
2929   MESON_TAC[IN_IMAGE; ENDS_IN_SEGMENT]);;
2930
2931 let CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1 = prove
2932  (`!f:real^N->real^1 a b.
2933         f continuous_on segment[a,b] /\
2934         (!x y. x IN segment[a,b] /\ y IN segment[a,b] /\ f x = f y ==> x = y)
2935         ==> IMAGE f (segment[a,b]) = segment[f a,f b]`,
2936   let lemma = prove
2937    (`!a b c:real^1.
2938       ~(a = b) /\ ~(a IN segment(c,b)) /\ ~(b IN segment(a,c))
2939       ==> c IN segment[a,b]`,
2940     REWRITE_TAC[FORALL_LIFT; SEGMENT_1; LIFT_DROP] THEN
2941     REPEAT GEN_TAC THEN REWRITE_TAC[SEGMENT_1; LIFT_EQ] THEN
2942     REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP]) THEN
2943     ASM_REAL_ARITH_TAC) in
2944   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
2945   REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE; LEFT_IMP_EXISTS_THM] THEN
2946   X_GEN_TAC `g:real^1->real^N` THEN DISCH_TAC THEN
2947   MP_TAC(ISPECL [`f:real^N->real^1`; `g:real^1->real^N`;
2948                  `segment[a:real^N,b]`]
2949         CONTINUOUS_ON_INVERSE) THEN
2950   ASM_REWRITE_TAC[COMPACT_SEGMENT] THEN DISCH_TAC THEN
2951   REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
2952   MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL
2953    [ASM_SIMP_TAC[SUBSET_CONTINUOUS_IMAGE_SEGMENT_1]; DISCH_TAC] THEN
2954   ASM_CASES_TAC `a:real^N = b` THEN
2955   ASM_REWRITE_TAC[SEGMENT_REFL] THENL [SET_TAC[]; ALL_TAC] THEN
2956   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `c:real^N` THEN
2957   DISCH_TAC THEN MATCH_MP_TAC lemma THEN
2958   MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
2959    [ASM_MESON_TAC[ENDS_IN_SEGMENT]; DISCH_TAC] THEN
2960   ONCE_REWRITE_TAC[segment] THEN
2961   ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN
2962   REPEAT STRIP_TAC THENL
2963    [MP_TAC(ISPECL [`f:real^N->real^1`; `c:real^N`; `b:real^N`]
2964         SUBSET_CONTINUOUS_IMAGE_SEGMENT_1) THEN
2965     SUBGOAL_THEN `segment[c:real^N,b] SUBSET segment[a,b]` ASSUME_TAC THENL
2966      [ASM_REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT]; ALL_TAC] THEN
2967     REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
2968      [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[SUBSET]] THEN
2969     DISCH_THEN(MP_TAC o SPEC `(f:real^N->real^1) a`) THEN
2970     ASM_REWRITE_TAC[IN_IMAGE; NOT_EXISTS_THM] THEN
2971     X_GEN_TAC `d:real^N` THEN ASM_CASES_TAC `d:real^N = a` THENL
2972      [ASM_MESON_TAC[BETWEEN_ANTISYM; BETWEEN_IN_SEGMENT];
2973       ASM_MESON_TAC[ENDS_IN_SEGMENT; SUBSET]];
2974     MP_TAC(ISPECL [`f:real^N->real^1`; `a:real^N`; `c:real^N`]
2975         SUBSET_CONTINUOUS_IMAGE_SEGMENT_1) THEN
2976     SUBGOAL_THEN `segment[a:real^N,c] SUBSET segment[a,b]` ASSUME_TAC THENL
2977      [ASM_REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT]; ALL_TAC] THEN
2978     REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
2979      [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[SUBSET]] THEN
2980     DISCH_THEN(MP_TAC o SPEC `(f:real^N->real^1) b`) THEN
2981     ASM_REWRITE_TAC[IN_IMAGE; NOT_EXISTS_THM] THEN
2982     X_GEN_TAC `d:real^N` THEN ASM_CASES_TAC `d:real^N = b` THENL
2983      [ASM_MESON_TAC[BETWEEN_ANTISYM; BETWEEN_IN_SEGMENT; BETWEEN_SYM];
2984       ASM_MESON_TAC[ENDS_IN_SEGMENT; SUBSET]]]);;
2985
2986 let CONTINUOUS_INJECTIVE_IMAGE_OPEN_SEGMENT_1 = prove
2987  (`!f:real^N->real^1 a b.
2988         f continuous_on segment[a,b] /\
2989         (!x y. x IN segment[a,b] /\ y IN segment[a,b] /\ f x = f y ==> x = y)
2990         ==> IMAGE f (segment(a,b)) = segment(f a,f b)`,
2991   REPEAT GEN_TAC THEN DISCH_TAC THEN
2992   ONCE_REWRITE_TAC[segment] THEN
2993   FIRST_ASSUM(MP_TAC o MATCH_MP CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1) THEN
2994   MP_TAC(ISPECL [`a:real^N`; `b:real^N`] ENDS_IN_SEGMENT) THEN
2995   MP_TAC(ISPECL [`(f:real^N->real^1) a`; `(f:real^1->real^1) b`]
2996     ENDS_IN_SEGMENT) THEN
2997   ASM SET_TAC[]);;
2998
2999 let CONTINUOUS_IVT_LOCAL_EXTREMUM = prove
3000  (`!f:real^N->real^1 a b.
3001         f continuous_on segment[a,b] /\ ~(a = b) /\ f(a) = f(b)
3002          ==> ?z. z IN segment(a,b) /\
3003                  ((!w. w IN segment[a,b] ==> drop(f w) <= drop(f z)) \/
3004                   (!w. w IN segment[a,b] ==> drop(f z) <= drop(f w)))`,
3005   REPEAT STRIP_TAC THEN
3006   MAP_EVERY (MP_TAC o ISPECL
3007             [`drop o (f:real^N->real^1)`; `segment[a:real^N,b]`])
3008             [CONTINUOUS_ATTAINS_SUP; CONTINUOUS_ATTAINS_INF] THEN
3009   ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN
3010   REWRITE_TAC[COMPACT_SEGMENT; SEGMENT_EQ_EMPTY] THEN
3011   DISCH_THEN(X_CHOOSE_THEN `d:real^N` STRIP_ASSUME_TAC) THEN
3012   ASM_CASES_TAC `(d:real^N) IN segment(a,b)` THENL
3013    [ASM_MESON_TAC[]; ALL_TAC] THEN
3014   DISCH_THEN(X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC) THEN
3015   ASM_CASES_TAC `(c:real^N) IN segment(a,b)` THENL
3016    [ASM_MESON_TAC[]; ALL_TAC] THEN
3017   EXISTS_TAC `midpoint(a:real^N,b)` THEN
3018   MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
3019    [ASM_REWRITE_TAC[MIDPOINT_IN_SEGMENT]; DISCH_TAC] THEN
3020   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CONJUNCT2 segment]) THEN
3021   REPEAT(FIRST_X_ASSUM(MP_TAC o
3022     GEN_REWRITE_RULE (RAND_CONV o RAND_CONV) [segment])) THEN
3023   ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN
3024   REPEAT(DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC)) THEN
3025   FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_MESON_TAC[REAL_LE_ANTISYM; DROP_EQ]);;
3026
3027 let FRONTIER_UNIONS_SUBSET_CLOSURE = prove
3028  (`!f:(real^N->bool)->bool.
3029         frontier(UNIONS f) SUBSET closure(UNIONS {frontier t | t IN f})`,
3030   GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [frontier] THEN
3031   REWRITE_TAC[SUBSET; IN_DIFF; CLOSURE_APPROACHABLE] THEN
3032   X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
3033   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
3034   FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN
3035   ASM_REWRITE_TAC[EXISTS_IN_UNIONS; EXISTS_IN_GSPEC; RIGHT_EXISTS_AND_THM] THEN
3036   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
3037   ASM_CASES_TAC `(t:real^N->bool) IN f` THEN ASM_REWRITE_TAC[] THEN
3038   ASM_CASES_TAC `(x:real^N) IN t` THENL
3039    [DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `x:real^N` THEN
3040     ASM_REWRITE_TAC[frontier; DIST_REFL; IN_DIFF] THEN
3041     ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN
3042     FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN
3043     SPEC_TAC(`x:real^N`,`z:real^N`) THEN
3044     REWRITE_TAC[CONTRAPOS_THM; GSYM SUBSET] THEN
3045     MATCH_MP_TAC SUBSET_INTERIOR THEN ASM SET_TAC[];
3046     DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
3047     MP_TAC(ISPECL [`segment[x:real^N,y]`; `t:real^N->bool`]
3048         CONNECTED_INTER_FRONTIER) THEN
3049     SIMP_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_DIFF] THEN
3050     ANTS_TAC THENL [ASM_MESON_TAC[ENDS_IN_SEGMENT]; ALL_TAC] THEN
3051     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN
3052     ASM_MESON_TAC[DIST_IN_CLOSED_SEGMENT; DIST_SYM; REAL_LET_TRANS]]);;
3053
3054 let FRONTIER_UNIONS_SUBSET = prove
3055  (`!f:(real^N->bool)->bool.
3056         FINITE f ==> frontier(UNIONS f) SUBSET UNIONS {frontier t | t IN f}`,
3057   REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[]
3058    `s SUBSET closure t /\ closure t = t ==> s SUBSET t`) THEN
3059   REWRITE_TAC[FRONTIER_UNIONS_SUBSET_CLOSURE; CLOSURE_EQ] THEN
3060   MATCH_MP_TAC CLOSED_UNIONS THEN
3061   ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE; FRONTIER_CLOSED]);;
3062
3063 let CLOSURE_CONVEX_INTER_AFFINE = prove
3064  (`!s t:real^N->bool.
3065       convex s /\ affine t /\ ~(relative_interior s INTER t = {})
3066       ==> closure(s INTER t) = closure(s) INTER t`,
3067   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
3068   REWRITE_TAC[SUBSET_INTER] THEN REPEAT CONJ_TAC THENL
3069    [MATCH_MP_TAC SUBSET_CLOSURE THEN SET_TAC[];
3070     TRANS_TAC SUBSET_TRANS `closure t:real^N->bool` THEN
3071     SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN
3072     ASM_SIMP_TAC[CLOSURE_CLOSED; CLOSED_AFFINE; SUBSET_REFL];
3073     ALL_TAC] THEN
3074   FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^N` MP_TAC o
3075         GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
3076   POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
3077   GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT GEN_TAC THEN
3078   REWRITE_TAC[IN_INTER] THEN
3079   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
3080   ASM_SIMP_TAC[AFFINE_EQ_SUBSPACE] THEN STRIP_TAC THEN
3081   FIRST_ASSUM(ASSUME_TAC o MATCH_MP(REWRITE_RULE[SUBSET]
3082     RELATIVE_INTERIOR_SUBSET)) THEN
3083   REWRITE_TAC[SUBSET; IN_INTER] THEN X_GEN_TAC `x:real^N` THEN
3084   STRIP_TAC THEN ASM_CASES_TAC `x:real^N = vec 0` THENL
3085    [MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN
3086     ASM_REWRITE_TAC[IN_INTER];
3087     ALL_TAC] THEN
3088   SUBGOAL_THEN `x IN closure(segment(vec 0:real^N,x))` MP_TAC THENL
3089    [ASM_REWRITE_TAC[CLOSURE_SEGMENT; ENDS_IN_SEGMENT]; ALL_TAC] THEN
3090   MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN
3091   MATCH_MP_TAC SUBSET_CLOSURE THEN REWRITE_TAC[SUBSET_INTER] THEN
3092   CONJ_TAC THENL
3093    [TRANS_TAC SUBSET_TRANS `relative_interior s:real^N->bool` THEN
3094     REWRITE_TAC[RELATIVE_INTERIOR_SUBSET] THEN
3095     MATCH_MP_TAC IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT THEN
3096     ASM_REWRITE_TAC[];
3097     ASM_SIMP_TAC[SUBSET; IN_SEGMENT; VECTOR_MUL_RZERO; VECTOR_ADD_LID;
3098                  SUBSPACE_MUL; LEFT_IMP_EXISTS_THM]]);;
3099
3100 let RELATIVE_FRONTIER_CONVEX_INTER_AFFINE = prove
3101  (`!s t:real^N->bool.
3102         convex s /\ affine t /\ ~(interior s INTER t = {})
3103         ==> relative_frontier(s INTER t) = frontier s INTER t`,
3104   SIMP_TAC[relative_frontier; RELATIVE_INTERIOR_CONVEX_INTER_AFFINE;
3105            frontier] THEN
3106   REPEAT STRIP_TAC THEN
3107   SUBGOAL_THEN `~(relative_interior s INTER t:real^N->bool = {})`
3108   ASSUME_TAC THENL
3109    [MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET_RELATIVE_INTERIOR) THEN
3110     ASM SET_TAC[];
3111     ASM_SIMP_TAC[CLOSURE_CONVEX_INTER_AFFINE] THEN SET_TAC[]]);;
3112
3113 let CONNECTED_COMPONENT_1_GEN = prove
3114  (`!s a b:real^N.
3115         dimindex(:N) = 1
3116         ==> (connected_component s a b <=> segment[a,b] SUBSET s)`,
3117   SIMP_TAC[connected_component; GSYM CONNECTED_CONVEX_1_GEN] THEN
3118  MESON_TAC[CONVEX_CONTAINS_SEGMENT; SUBSET; CONVEX_SEGMENT;
3119             ENDS_IN_SEGMENT]);;
3120
3121 let CONNECTED_COMPONENT_1 = prove
3122  (`!s a b:real^1. connected_component s a b <=> segment[a,b] SUBSET s`,
3123   SIMP_TAC[CONNECTED_COMPONENT_1_GEN; DIMINDEX_1]);;
3124
3125 (* ------------------------------------------------------------------------- *)
3126 (* An injective function into R is a homeomorphism and so an open map.       *)
3127 (* ------------------------------------------------------------------------- *)
3128
3129 let INJECTIVE_INTO_1D_EQ_HOMEOMORPHISM = prove
3130  (`!f:real^N->real^1 s.
3131         f continuous_on s /\ path_connected s
3132         ==>  ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=>
3133               ?g. homeomorphism (s,IMAGE f s) (f,g))`,
3134   REPEAT STRIP_TAC THEN EQ_TAC THENL
3135    [REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE];
3136     REWRITE_TAC[homeomorphism] THEN MESON_TAC[]] THEN
3137   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^1->real^N` THEN
3138   STRIP_TAC THEN ASM_SIMP_TAC[homeomorphism; FORALL_IN_IMAGE] THEN
3139   CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
3140   SUBGOAL_THEN `is_interval (IMAGE (f:real^N->real^1) s)` ASSUME_TAC THENL
3141    [REWRITE_TAC[IS_INTERVAL_PATH_CONNECTED_1] THEN
3142     ASM_MESON_TAC[PATH_CONNECTED_CONTINUOUS_IMAGE];
3143     ALL_TAC] THEN
3144   REWRITE_TAC[continuous_on; IMP_CONJ; FORALL_IN_IMAGE] THEN
3145   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
3146   ABBREV_TAC `y = (f:real^N->real^1) x` THEN
3147   ABBREV_TAC `t = IMAGE (f:real^N->real^1) s` THEN
3148   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
3149   SUBGOAL_THEN
3150    `?a b d. a IN s /\ b IN s /\ &0 < d /\
3151             ball(y,d) INTER t SUBSET segment[(f:real^N->real^1) a,f b]`
3152   STRIP_ASSUME_TAC THENL
3153    [MP_TAC(ISPECL [`t:real^1->bool`; `y:real^1`]
3154         INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD) THEN
3155     ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
3156     ASM_SIMP_TAC[INTERVAL_SUBSET_IS_INTERVAL] THEN
3157     REWRITE_TAC[SET_RULE
3158      `P /\ y IN s /\ (s = {} \/ a IN t /\ b IN t) /\ R <=>
3159       a IN t /\ b IN t /\ P /\ y IN s /\ R`] THEN
3160     REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
3161     EXPAND_TAC "t" THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN
3162     REWRITE_TAC[SEGMENT_1; IN_INTERVAL_1] THEN
3163     MESON_TAC[REAL_LE_TRANS];
3164    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
3165    DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
3166    ASM_REWRITE_TAC[] THEN
3167    DISCH_THEN(X_CHOOSE_THEN `p:real^1->real^N` STRIP_ASSUME_TAC) THEN
3168    SUBGOAL_THEN
3169     `(g:real^1->real^N) continuous_on segment[(f:real^N->real^1) a,f b]`
3170    MP_TAC THENL
3171     [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
3172      EXISTS_TAC `IMAGE (f:real^N->real^1) (path_image p)` THEN CONJ_TAC THENL
3173       [MATCH_MP_TAC CONTINUOUS_ON_INVERSE THEN
3174        ASM_SIMP_TAC[COMPACT_PATH_IMAGE] THEN CONJ_TAC THENL
3175         [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]];
3176        SUBGOAL_THEN `convex(IMAGE (f:real^N->real^1) (path_image p))`
3177        MP_TAC THENL
3178         [REWRITE_TAC[GSYM IS_INTERVAL_CONVEX_1; IS_INTERVAL_CONNECTED_1] THEN
3179          MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
3180          ASM_SIMP_TAC[CONNECTED_PATH_IMAGE] THEN
3181          ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
3182          REWRITE_TAC[CONVEX_CONTAINS_SEGMENT] THEN DISCH_THEN MATCH_MP_TAC THEN
3183          CONJ_TAC THEN MATCH_MP_TAC FUN_IN_IMAGE THEN
3184          ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]]];
3185      REWRITE_TAC[continuous_on] THEN
3186      DISCH_THEN(MP_TAC o SPEC `y:real^1`) THEN ANTS_TAC THENL
3187       [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
3188        ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL] THEN ASM SET_TAC[];
3189        ALL_TAC] THEN
3190      DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
3191      DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN
3192      EXISTS_TAC `min d k` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
3193      X_GEN_TAC `x':real^N` THEN REPEAT STRIP_TAC THEN
3194      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
3195      FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
3196      ASM_REWRITE_TAC[IN_INTER; IN_BALL] THEN
3197      ONCE_REWRITE_TAC[DIST_SYM] THEN ASM SET_TAC[]]]);;
3198
3199 let INJECTIVE_INTO_1D_IMP_OPEN_MAP = prove
3200  (`!f:real^N->real^1 s t.
3201         f continuous_on s /\ path_connected s /\
3202         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
3203         open_in (subtopology euclidean s) t
3204         ==> open_in (subtopology euclidean (IMAGE f s)) (IMAGE f t)`,
3205   REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
3206   ASM_MESON_TAC[INJECTIVE_INTO_1D_EQ_HOMEOMORPHISM]);;
3207
3208 (* ------------------------------------------------------------------------- *)
3209 (* Injective function on an interval is strictly increasing or decreasing.   *)
3210 (* ------------------------------------------------------------------------- *)
3211
3212 let CONTINUOUS_INJECTIVE_IFF_MONOTONIC = prove
3213  (`!f:real^1->real^1 s.
3214         f continuous_on s /\ is_interval s
3215         ==> ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=>
3216              (!x y. x IN s /\ y IN s /\ drop x < drop y
3217                     ==> drop(f x) < drop(f y)) \/
3218              (!x y. x IN s /\ y IN s /\ drop x < drop y
3219                     ==> drop(f y) < drop(f x)))`,
3220   let lemma = prove
3221    (`!s f:real^1->real^1.
3222         f continuous_on s /\ is_interval s /\
3223         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
3224         ==> !u v w. u IN s /\ v IN s /\ w IN s /\
3225                     drop u < drop v /\ drop v < drop w /\
3226                     drop(f u) <= drop(f v) /\ drop(f w) <= drop(f v) ==> F`,
3227     REWRITE_TAC[IS_INTERVAL_CONVEX_1; CONVEX_CONTAINS_SEGMENT] THEN
3228     REPEAT STRIP_TAC THEN
3229     MP_TAC(ISPECL [`f:real^1->real^1`; `u:real^1`; `w:real^1`]
3230         CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1) THEN
3231     ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET]; ALL_TAC] THEN
3232     REWRITE_TAC[EXTENSION] THEN
3233     DISCH_THEN(MP_TAC o SPEC `(f:real^1->real^1) v`) THEN
3234     MATCH_MP_TAC(TAUT `p /\ ~q ==> (p <=> q) ==> F`) THEN CONJ_TAC THENL
3235      [MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_REWRITE_TAC[SEGMENT_1] THEN
3236       COND_CASES_TAC THENL
3237        [ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LT_IMP_LE]; ASM_REAL_ARITH_TAC];
3238       REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THEN
3239       ASM_REWRITE_TAC[IN_INTERVAL_1] THEN DISCH_TAC THENL
3240        [SUBGOAL_THEN `drop(f(w:real^1)) = drop(f v)` ASSUME_TAC THENL
3241          [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[DROP_EQ; REAL_LT_REFL]];
3242         SUBGOAL_THEN `drop(f(u:real^1)) = drop(f v)` ASSUME_TAC THENL
3243          [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[DROP_EQ; REAL_LT_REFL]]]])
3244   and tac s1 s2 =
3245    let [l1;l2] = map (map (fun x -> mk_var(x,`:real^1`)) o explode) [s1;s2] in
3246    REPEAT(FIRST_X_ASSUM(fun th ->
3247      MP_TAC(ISPECL l1 th) THEN MP_TAC(ISPECL l2 th))) THEN
3248    ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC in
3249   REPEAT STRIP_TAC THEN EQ_TAC THENL
3250    [ALL_TAC;
3251     REWRITE_TAC[GSYM DROP_EQ] THEN
3252     MESON_TAC[REAL_LT_TOTAL; REAL_LT_REFL]] THEN
3253   DISCH_TAC THEN MATCH_MP_TAC(MESON[]
3254    `(!a b c d. ~(~P a b /\ ~Q c d)) ==> (!x y. P x y) \/ (!x y. Q x y)`) THEN
3255   MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`; `c:real^1`; `d:real^1`] THEN
3256   REWRITE_TAC[NOT_IMP; REAL_NOT_LT] THEN STRIP_TAC THEN
3257   REPEAT
3258    (FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_LE_LT]) THEN
3259     REWRITE_TAC[DROP_EQ] THEN STRIP_TAC THENL
3260      [ALL_TAC; ASM_MESON_TAC[REAL_LT_REFL]]) THEN
3261   MP_TAC(ISPEC `s:real^1->bool` lemma) THEN ASM_REWRITE_TAC[] THEN
3262   DISCH_THEN(fun th ->
3263    MP_TAC(SPEC `(--) o (f:real^1->real^1)` th) THEN
3264    MP_TAC(SPEC `f:real^1->real^1` th)) THEN
3265   ASM_REWRITE_TAC[o_THM; VECTOR_ARITH `--x:real^N = --y <=> x = y`] THEN
3266   DISCH_TAC THEN REWRITE_TAC[NOT_IMP; DROP_NEG; REAL_LE_NEG2] THEN
3267   CONJ_TAC THENL
3268    [ASM_MESON_TAC[CONTINUOUS_ON_COMPOSE;LINEAR_CONTINUOUS_ON; LINEAR_NEGATION];
3269     DISCH_TAC] THEN
3270   ASM_CASES_TAC `drop d <= drop a` THENL [tac "cab" "cdb"; ALL_TAC] THEN
3271   ASM_CASES_TAC `drop b <= drop c` THENL [tac "abd" "acd"; ALL_TAC] THEN
3272   ASM_CASES_TAC `c:real^1 = a /\ d:real^1 = b` THENL
3273    [ASM_MESON_TAC[REAL_LT_ANTISYM]; ALL_TAC] THEN
3274   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
3275    `~(c = a /\ d = b)
3276     ==> (c = a ==> d = b) /\ (d = b ==> c = a) /\
3277         (~(c = a) /\ ~(d = b) ==> F) ==> F`)) THEN
3278   REPEAT CONJ_TAC THENL
3279    [DISCH_THEN SUBST_ALL_TAC THEN SIMP_TAC[GSYM DROP_EQ] THEN tac "adb" "abd";
3280     DISCH_THEN SUBST_ALL_TAC THEN SIMP_TAC[GSYM DROP_EQ] THEN tac "acb" "cab";
3281     REWRITE_TAC[GSYM DROP_EQ] THEN STRIP_TAC] THEN
3282   ASM_CASES_TAC `drop a <= drop c` THENL [tac "acb" "acd"; tac "cab" "cad"]);;
3283
3284 (* ------------------------------------------------------------------------- *)
3285 (* Some uncountability results for relevant sets.                            *)
3286 (* ------------------------------------------------------------------------- *)
3287
3288 let CARD_EQ_SEGMENT = prove
3289  (`(!a b:real^N. ~(a = b) ==> segment[a,b] =_c (:real)) /\
3290    (!a b:real^N. ~(a = b) ==> segment(a,b) =_c (:real))`,
3291   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SEGMENT_IMAGE_INTERVAL] THENL
3292    [TRANS_TAC CARD_EQ_TRANS `interval[vec 0:real^1,vec 1]`;
3293     TRANS_TAC CARD_EQ_TRANS `interval(vec 0:real^1,vec 1)`] THEN
3294   SIMP_TAC[CARD_EQ_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN
3295   MATCH_MP_TAC CARD_EQ_IMAGE THEN
3296   ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; VECTOR_ARITH
3297    `(&1 - x) % a + x % b:real^N = (&1 - y) % a + y % b <=>
3298     (x - y) % (a - b) = vec 0`] THEN
3299   SIMP_TAC[REAL_SUB_0; DROP_EQ]);;
3300
3301 let UNCOUNTABLE_SEGMENT = prove
3302  (`(!a b:real^N. ~(a = b) ==> ~COUNTABLE(segment[a,b])) /\
3303    (!a b:real^N. ~(a = b) ==> ~COUNTABLE(segment(a,b)))`,
3304   SIMP_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; CARD_EQ_SEGMENT]);;
3305
3306 let CARD_EQ_PATH_CONNECTED = prove
3307  (`!s a b:real^N.
3308         path_connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> s =_c (:real)`,
3309   MESON_TAC[CARD_EQ_CONNECTED; PATH_CONNECTED_IMP_CONNECTED]);;
3310
3311 let UNCOUNTABLE_PATH_CONNECTED = prove
3312  (`!s a b:real^N.
3313         path_connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> ~COUNTABLE s`,
3314   REPEAT GEN_TAC THEN STRIP_TAC THEN
3315   MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN
3316   MATCH_MP_TAC CARD_EQ_PATH_CONNECTED THEN
3317   ASM_MESON_TAC[]);;
3318
3319 let CARD_EQ_CONVEX = prove
3320  (`!s a b:real^N.
3321         convex s /\ a IN s /\ b IN s /\ ~(a = b) ==> s =_c (:real)`,
3322   MESON_TAC[CARD_EQ_PATH_CONNECTED; CONVEX_IMP_PATH_CONNECTED]);;
3323
3324 let UNCOUNTABLE_CONVEX = prove
3325  (`!s a b:real^N.
3326         convex s /\ a IN s /\ b IN s /\ ~(a = b) ==> ~COUNTABLE s`,
3327   REPEAT GEN_TAC THEN STRIP_TAC THEN
3328   MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN
3329   MATCH_MP_TAC CARD_EQ_CONVEX THEN
3330   ASM_MESON_TAC[]);;
3331
3332 let CARD_EQ_NONEMPTY_INTERIOR = prove
3333  (`!s:real^N->bool. ~(interior s = {}) ==> s =_c (:real)`,
3334   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
3335    [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
3336     SIMP_TAC[CARD_LE_UNIV; CARD_EQ_IMP_LE; CARD_EQ_EUCLIDEAN];
3337     TRANS_TAC CARD_LE_TRANS `interior(s:real^N->bool)` THEN
3338     SIMP_TAC[CARD_LE_SUBSET; INTERIOR_SUBSET] THEN
3339     MATCH_MP_TAC(ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE) THEN
3340     MATCH_MP_TAC CARD_EQ_OPEN THEN ASM_REWRITE_TAC[OPEN_INTERIOR]]);;
3341
3342 let UNCOUNTABLE_NONEMPTY_INTERIOR = prove
3343  (`!s:real^N->bool. ~(interior s = {}) ==> ~(COUNTABLE s)`,
3344   SIMP_TAC[CARD_EQ_NONEMPTY_INTERIOR; CARD_EQ_REAL_IMP_UNCOUNTABLE]);;
3345
3346 let COUNTABLE_EMPTY_INTERIOR = prove
3347  (`!s:real^N->bool. COUNTABLE s ==> interior s = {}`,
3348   MESON_TAC[UNCOUNTABLE_NONEMPTY_INTERIOR]);;
3349
3350 let FINITE_EMPTY_INTERIOR = prove
3351  (`!s:real^N->bool. FINITE s ==> interior s = {}`,
3352   SIMP_TAC[COUNTABLE_EMPTY_INTERIOR; FINITE_IMP_COUNTABLE]);;
3353
3354 let [CONNECTED_FINITE_IFF_SING;
3355      CONNECTED_FINITE_IFF_COUNTABLE;
3356      CONNECTED_INFINITE_IFF_CARD_EQ] = (CONJUNCTS o prove)
3357  (`(!s:real^N->bool. connected s ==> (FINITE s <=> s = {} \/ ?a. s = {a})) /\
3358    (!s:real^N->bool. connected s ==> (FINITE s <=> COUNTABLE s)) /\
3359    (!s:real^N->bool. connected s ==> (INFINITE s <=> s =_c (:real)))`,
3360   REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN
3361   ASM_CASES_TAC `connected(s:real^N->bool)` THEN
3362   ASM_REWRITE_TAC[INFINITE] THEN MATCH_MP_TAC(TAUT
3363    `(f ==> c) /\ (r ==> ~c) /\ (s ==> f) /\ (~s ==> r)
3364     ==> (f <=> s) /\ (f <=> c) /\ (~f <=> r)`) THEN
3365   REWRITE_TAC[FINITE_IMP_COUNTABLE] THEN
3366   REPEAT CONJ_TAC THEN STRIP_TAC THEN
3367   ASM_SIMP_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; FINITE_INSERT; FINITE_EMPTY] THEN
3368   MATCH_MP_TAC CARD_EQ_CONNECTED THEN ASM SET_TAC[]);;
3369
3370 let CLOSED_AS_FRONTIER_OF_SUBSET = prove
3371  (`!s:real^N->bool. closed s <=> ?t. t SUBSET s /\ s = frontier t`,
3372   GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[FRONTIER_CLOSED]] THEN
3373   DISCH_TAC THEN MP_TAC(ISPEC `s:real^N->bool` SEPARABLE) THEN
3374   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
3375   SIMP_TAC[frontier] THEN STRIP_TAC THEN MATCH_MP_TAC(SET_RULE
3376    `s SUBSET c /\ c SUBSET s /\ i = {} ==> s = c DIFF i`) THEN
3377   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
3378    [ASM_MESON_TAC[SUBSET_CLOSURE; CLOSURE_CLOSED];
3379     ASM_MESON_TAC[UNCOUNTABLE_NONEMPTY_INTERIOR]]);;
3380
3381 let CLOSED_AS_FRONTIER = prove
3382  (`!s:real^N->bool. closed s <=> ?t. s = frontier t`,
3383   GEN_TAC THEN EQ_TAC THENL
3384    [MESON_TAC[CLOSED_AS_FRONTIER_OF_SUBSET]; MESON_TAC[FRONTIER_CLOSED]]);;
3385
3386 let CARD_EQ_CLOSED = prove
3387  (`!s:real^N->bool. closed s ==> s <=_c (:num) \/ s =_c (:real)`,
3388   let slemma = prove
3389    (`!s:real^N->bool.
3390           ~COUNTABLE s
3391           ==> ?x y. ~(x = y) /\ x IN s /\ y IN s /\
3392                     x condensation_point_of s /\
3393                     y condensation_point_of s`,
3394     REPEAT STRIP_TAC THEN
3395     FIRST_ASSUM(MP_TAC o MATCH_MP CARD_EQ_CONDENSATION_POINTS_IN_SET) THEN
3396     DISCH_THEN(MP_TAC o MATCH_MP CARD_INFINITE_CONG) THEN
3397     REWRITE_TAC[INFINITE] THEN
3398     MATCH_MP_TAC(TAUT `q /\ (p ==> s) ==> (p <=> q) ==> s`) THEN
3399     CONJ_TAC THENL [ASM_MESON_TAC[FINITE_IMP_COUNTABLE]; ALL_TAC] THEN
3400     DISCH_TAC THEN
3401     MP_TAC(ISPECL [`2`; `{x:real^N | x IN s /\ x condensation_point_of s}`]
3402           CHOOSE_SUBSET_STRONG) THEN
3403     ASM_REWRITE_TAC[HAS_SIZE_CONV `s HAS_SIZE 2`; RIGHT_AND_EXISTS_THM] THEN
3404     DISCH_THEN(CHOOSE_THEN MP_TAC) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
3405     REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
3406     STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN
3407     RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_INSERT; NOT_IN_EMPTY]) THEN
3408     ASM_REWRITE_TAC[]) in
3409   GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM COUNTABLE_ALT] THEN
3410   ASM_CASES_TAC `COUNTABLE(s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN
3411   SUBGOAL_THEN
3412    `!n t:real^N->bool.
3413         closed t /\ ~COUNTABLE t
3414         ==> ?l r. (compact l /\ ~COUNTABLE l) /\ (compact r /\ ~COUNTABLE r) /\
3415                   l INTER r = {} /\ l SUBSET t /\ r SUBSET t /\
3416                   diameter l <= inv(&2 pow n) /\
3417                   diameter r <= inv(&2 pow n)`
3418   MP_TAC THENL
3419    [REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
3420      (MP_TAC o MATCH_MP slemma)) THEN
3421     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
3422     MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN
3423     MAP_EVERY EXISTS_TAC
3424      [`t INTER cball(a:real^N,min (inv(&2 pow (SUC n))) (dist(a,b) / &3))`;
3425      `t INTER cball(b:real^N,min (inv(&2 pow (SUC n))) (dist(a,b) / &3))`] THEN
3426     ASM_SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_CBALL] THEN
3427     REPEAT CONJ_TAC THENL
3428      [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I
3429        [CONDENSATION_POINT_INFINITE_CBALL]) THEN
3430       REWRITE_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; REAL_LT_POW2] THEN
3431       UNDISCH_TAC `~(a:real^N = b)` THEN CONV_TAC NORM_ARITH;
3432       FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I
3433        [CONDENSATION_POINT_INFINITE_CBALL]) THEN
3434       REWRITE_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; REAL_LT_POW2] THEN
3435       UNDISCH_TAC `~(a:real^N = b)` THEN CONV_TAC NORM_ARITH;
3436       MATCH_MP_TAC(SET_RULE
3437        `(!x. ~(x IN t /\ x IN u)) ==> (s INTER t) INTER (s INTER u) = {}`) THEN
3438       REWRITE_TAC[IN_CBALL; REAL_LE_MIN] THEN
3439       UNDISCH_TAC `~(a:real^N = b)` THEN CONV_TAC NORM_ARITH;
3440       SET_TAC[];
3441       SET_TAC[];
3442       MATCH_MP_TAC DIAMETER_LE THEN
3443       SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE; REAL_LT_POW2] THEN
3444       REWRITE_TAC[IN_INTER; IN_CBALL; REAL_LE_MIN; real_pow; REAL_INV_MUL] THEN
3445       CONV_TAC NORM_ARITH;
3446       MATCH_MP_TAC DIAMETER_LE THEN
3447       SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE; REAL_LT_POW2] THEN
3448       REWRITE_TAC[IN_INTER; IN_CBALL; REAL_LE_MIN; real_pow; REAL_INV_MUL] THEN
3449       CONV_TAC NORM_ARITH];
3450     REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
3451     MAP_EVERY X_GEN_TAC
3452      [`l:num->(real^N->bool)->(real^N->bool)`;
3453       `r:num->(real^N->bool)->(real^N->bool)`] THEN
3454     DISCH_TAC THEN
3455     SUBGOAL_THEN
3456      `!b. ?x:num->real^N->bool.
3457           (x 0 = s) /\ (!n. x(SUC n) = if b(n) then r n (x n) else l n (x n))`
3458     MP_TAC THENL
3459      [GEN_TAC THEN
3460       W(ACCEPT_TAC o prove_recursive_functions_exist num_RECURSION o
3461         snd o dest_exists o snd);
3462       REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM]] THEN
3463     X_GEN_TAC `x:(num->bool)->num->real^N->bool` THEN STRIP_TAC THEN
3464     REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
3465      [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
3466       SIMP_TAC[CARD_LE_UNIV; CARD_EQ_EUCLIDEAN; CARD_EQ_IMP_LE];
3467       TRANS_TAC CARD_LE_TRANS `(:num->bool)` THEN
3468       SIMP_TAC[CARD_EQ_REAL; CARD_EQ_IMP_LE]] THEN
3469     REWRITE_TAC[le_c; IN_UNIV] THEN
3470     SUBGOAL_THEN
3471      `!b n. closed((x:(num->bool)->num->real^N->bool) b n) /\
3472             ~COUNTABLE(x b n)`
3473     MP_TAC THENL
3474      [GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[] THEN
3475       COND_CASES_TAC THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED];
3476       REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN
3477     MP_TAC(GEN `b:num->bool` (ISPEC `(x:(num->bool)->num->real^N->bool) b`
3478           DECREASING_CLOSED_NEST_SING)) THEN
3479     DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN ANTS_TAC THENL
3480      [ASM_SIMP_TAC[FORALL_AND_THM] THEN REPEAT CONJ_TAC THENL
3481        [ASM_MESON_TAC[COUNTABLE_EMPTY];
3482         GEN_TAC THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
3483         REWRITE_TAC[SUBSET_REFL] THEN ASM SET_TAC[];
3484         MAP_EVERY X_GEN_TAC [`b:num->bool`; `e:real`] THEN DISCH_TAC THEN
3485         MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN
3486         ASM_REWRITE_TAC[REAL_POW_INV] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
3487         DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN
3488         EXISTS_TAC `SUC m` THEN ASM_SIMP_TAC[] THEN
3489         REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
3490         DISCH_THEN(MP_TAC o MATCH_MP
3491          (REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> q /\ r ==> p ==> s`]
3492           DIAMETER_BOUNDED_BOUND)) THEN
3493         ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN
3494         UNDISCH_TAC `inv(&2 pow m) < e` THEN MATCH_MP_TAC(NORM_ARITH
3495          `d <= i ==> i < e ==> norm(x - y) <= d ==> dist(x:real^N,y) < e`) THEN
3496         ASM_SIMP_TAC[]];
3497       ALL_TAC] THEN
3498     REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
3499     X_GEN_TAC `f:(num->bool)->real^N` THEN STRIP_TAC THEN CONJ_TAC THENL
3500      [X_GEN_TAC `b:num->bool` THEN
3501       REWRITE_TAC[SET_RULE `x IN s <=> {x} SUBSET s`] THEN
3502       FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN
3503       REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
3504       ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
3505       SIMP_TAC[FORALL_UNWIND_THM2] THEN GEN_TAC THEN ASM SET_TAC[];
3506       MAP_EVERY X_GEN_TAC [`b:num->bool`; `c:num->bool`] THEN
3507       ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
3508       GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [FUN_EQ_THM] THEN
3509       REWRITE_TAC[NOT_FORALL_THM] THEN ONCE_REWRITE_TAC[num_WOP] THEN
3510       SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN
3511       MATCH_MP_TAC(SET_RULE
3512        `!f g. INTERS f = {a} /\ INTERS g = {b} /\
3513               (?s t. s IN f /\ t IN g /\ s INTER t = {})
3514               ==> ~(a = b)`) THEN
3515       EXISTS_TAC `{t | ?n. t = (x:(num->bool)->num->real^N->bool) b n}` THEN
3516       EXISTS_TAC `{t | ?n. t = (x:(num->bool)->num->real^N->bool) c n}` THEN
3517       ASM_REWRITE_TAC[IN_ELIM_THM] THEN
3518       EXISTS_TAC `(x:(num->bool)->num->real^N->bool) b (SUC k)` THEN
3519       EXISTS_TAC `(x:(num->bool)->num->real^N->bool) c (SUC k)` THEN
3520       REPEAT(CONJ_TAC THENL [MESON_TAC[]; ALL_TAC]) THEN ASM_SIMP_TAC[] THEN
3521       SUBGOAL_THEN
3522        `!i. i <= k ==> (x:(num->bool)->num->real^N->bool) b i = x c i`
3523       MP_TAC THENL
3524        [INDUCT_TAC THEN ASM_SIMP_TAC[LE_SUC_LT; LT_IMP_LE];
3525         DISCH_THEN(MP_TAC o SPEC `k:num`)] THEN
3526       REWRITE_TAC[LE_REFL] THEN DISCH_THEN SUBST1_TAC THEN
3527       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
3528        [TAUT `~(p <=> q) <=> (q <=> ~p)`]) THEN
3529       REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
3530       ASM_MESON_TAC[INTER_COMM]]]);;
3531
3532 let CONDENSATION_POINTS_EQ_EMPTY,CARD_EQ_CONDENSATION_POINTS =
3533  (CONJ_PAIR o prove)
3534  (`(!s:real^N->bool.
3535         {x | x condensation_point_of s} = {} <=> COUNTABLE s) /\
3536    (!s:real^N->bool.
3537         {x | x condensation_point_of s} =_c (:real) <=> ~(COUNTABLE s))`,
3538   REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT
3539    `(r ==> p) /\ (~r ==> q) /\ (p ==> ~q)
3540     ==> (p <=> r) /\ (q <=> ~r)`) THEN
3541   REPEAT CONJ_TAC THENL
3542    [DISCH_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN
3543     REWRITE_TAC[condensation_point_of] THEN
3544     ASM_MESON_TAC[COUNTABLE_SUBSET; INTER_SUBSET; IN_UNIV; OPEN_UNIV];
3545     DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE
3546      [TAUT `p ==> q \/ r <=> p /\ ~q ==> r`] CARD_EQ_CLOSED) THEN
3547     REWRITE_TAC[CLOSED_CONDENSATION_POINTS; GSYM COUNTABLE_ALT] THEN
3548     FIRST_ASSUM(MP_TAC o MATCH_MP CARD_EQ_CONDENSATION_POINTS_IN_SET) THEN
3549     DISCH_THEN(MP_TAC o MATCH_MP CARD_COUNTABLE_CONG) THEN
3550     ASM_REWRITE_TAC[CONTRAPOS_THM] THEN
3551     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN SET_TAC[];
3552     DISCH_THEN SUBST1_TAC THEN
3553     DISCH_THEN(MP_TAC o MATCH_MP CARD_FINITE_CONG) THEN
3554     REWRITE_TAC[FINITE_EMPTY; GSYM INFINITE; real_INFINITE]]);;
3555
3556 let UNCOUNTABLE_HAS_CONDENSATION_POINT = prove
3557  (`!s:real^N->bool. ~COUNTABLE s ==> ?x. x condensation_point_of s`,
3558   REWRITE_TAC[GSYM CONDENSATION_POINTS_EQ_EMPTY] THEN SET_TAC[]);;
3559
3560 let CARD_EQ_PERFECT_SET = prove
3561  (`!s:real^N->bool.
3562         closed s /\ (!x. x IN s ==> x limit_point_of s) /\ ~(s = {})
3563         ==> s =_c (:real)`,
3564   REPEAT STRIP_TAC THEN
3565   FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP CARD_EQ_CLOSED) THEN
3566   ASM_REWRITE_TAC[] THEN
3567   RULE_ASSUM_TAC(REWRITE_RULE[GSYM COUNTABLE; GSYM ge_c]) THEN
3568   MP_TAC(ISPECL [`IMAGE (\x:real^N. s DELETE x) s`; `s:real^N->bool`]
3569     BAIRE) THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
3570   SIMP_TAC[OPEN_IN_DELETE; OPEN_IN_REFL] THEN
3571   MATCH_MP_TAC(TAUT `p /\ ~q ==> (p ==> q) ==> r`) THEN CONJ_TAC THENL
3572    [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
3573     GEN_REWRITE_TAC I [SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
3574     ASM_CASES_TAC `x:real^N = y` THEN
3575     ASM_SIMP_TAC[IN_CLOSURE_DELETE] THEN
3576     MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN
3577     ASM_REWRITE_TAC[IN_DELETE];
3578     REWRITE_TAC[INTERS_IMAGE; IN_DELETE] THEN
3579     SUBGOAL_THEN `{y:real^N | !x. x IN s ==> y IN s /\ ~(y = x)} = {}`
3580     SUBST1_TAC THENL
3581      [ASM SET_TAC[]; ASM_REWRITE_TAC[CLOSURE_EMPTY; SUBSET_EMPTY]]]);;
3582
3583 (* ------------------------------------------------------------------------- *)
3584 (* Density of sets with small complement, including irrationals.             *)
3585 (* ------------------------------------------------------------------------- *)
3586
3587 let COSMALL_APPROXIMATION = prove
3588  (`!s. ((:real) DIFF s) <_c (:real)
3589        ==> !x e. &0 < e ==> ?y. y IN s /\ abs(y - x) < e`,
3590   let lemma = prove
3591    (`!s. ((:real^1) DIFF s) <_c (:real)
3592          ==> !x e. &0 < e ==> ?y. y IN s /\ norm(y - x) < e`,
3593     REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE
3594       `~({x | P x} SUBSET UNIV DIFF s) ==> ?x. x IN s /\ P x`) THEN
3595     MP_TAC(ISPEC `ball(x:real^1,e)` CARD_EQ_OPEN) THEN
3596     ASM_REWRITE_TAC[OPEN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE] THEN DISCH_TAC THEN
3597     DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN
3598     REWRITE_TAC[CARD_NOT_LE] THEN
3599     REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] dist); GSYM ball] THEN
3600     TRANS_TAC CARD_LTE_TRANS `(:real)` THEN
3601     ASM_SIMP_TAC[ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE]) in
3602   REWRITE_TAC[FORALL_DROP_IMAGE; FORALL_DROP; EXISTS_DROP] THEN
3603   REWRITE_TAC[GSYM IMAGE_DROP_UNIV; GSYM DROP_SUB; GSYM ABS_DROP] THEN
3604   REWRITE_TAC[DROP_IN_IMAGE_DROP] THEN REWRITE_TAC[GSYM FORALL_DROP] THEN
3605   SIMP_TAC[GSYM IMAGE_DIFF_INJ; DROP_EQ] THEN GEN_TAC THEN
3606   DISCH_TAC THEN MATCH_MP_TAC lemma THEN POP_ASSUM MP_TAC THEN
3607   MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC CARD_LT_CONG THEN
3608   REWRITE_TAC[IMAGE_DROP_UNIV; CARD_EQ_REFL] THEN
3609   MATCH_MP_TAC CARD_EQ_IMAGE THEN SIMP_TAC[DROP_EQ]);;
3610
3611 let COCOUNTABLE_APPROXIMATION = prove
3612  (`!s. COUNTABLE((:real) DIFF s)
3613        ==> !x e. &0 < e ==> ?y. y IN s /\ abs(y - x) < e`,
3614   GEN_TAC THEN REWRITE_TAC[COUNTABLE; ge_c] THEN DISCH_TAC THEN
3615   MATCH_MP_TAC COSMALL_APPROXIMATION THEN
3616   TRANS_TAC CARD_LET_TRANS `(:num)` THEN ASM_REWRITE_TAC[] THEN
3617   TRANS_TAC CARD_LTE_TRANS `(:num->bool)` THEN SIMP_TAC[CANTOR_THM_UNIV] THEN
3618   MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
3619   REWRITE_TAC[CARD_EQ_REAL]);;
3620
3621 let IRRATIONAL_APPROXIMATION = prove
3622  (`!x e. &0 < e ==> ?y. ~(rational y) /\ abs(y - x) < e`,
3623   REWRITE_TAC[SET_RULE `~rational y <=> y IN UNIV DIFF rational`] THEN
3624   MATCH_MP_TAC COCOUNTABLE_APPROXIMATION THEN
3625   REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`; COUNTABLE_RATIONAL]);;
3626
3627 let OPEN_SET_COSMALL_COORDINATES = prove
3628  (`!P. (!i. 1 <= i /\ i <= dimindex(:N)
3629             ==> (:real) DIFF {x | P i x} <_c (:real))
3630        ==> !s:real^N->bool.
3631               open s /\ ~(s = {})
3632               ==> ?x. x IN s /\ !i. 1 <= i /\ i <= dimindex(:N) ==> P i (x$i)`,
3633   REPEAT STRIP_TAC THEN
3634   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
3635   DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
3636   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
3637   DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN
3638   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
3639   SUBGOAL_THEN
3640    `!i. 1 <= i /\ i <= dimindex(:N)
3641         ==> ?y:real. P i y /\ abs(y - (a:real^N)$i) < d / &(dimindex(:N))`
3642   MP_TAC THENL
3643    [X_GEN_TAC `i:num` THEN STRIP_TAC THEN
3644     FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN
3645     DISCH_THEN(MP_TAC o MATCH_MP COSMALL_APPROXIMATION) THEN
3646     REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN
3647     ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1];
3648     REWRITE_TAC[LAMBDA_SKOLEM] THEN MATCH_MP_TAC MONO_EXISTS THEN
3649     REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN
3650     FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
3651     REWRITE_TAC[IN_CBALL; dist] THEN
3652     W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN
3653     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
3654     MATCH_MP_TAC SUM_BOUND_GEN THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
3655     REWRITE_TAC[VECTOR_SUB_COMPONENT; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1] THEN
3656     ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN
3657     ASM_SIMP_TAC[REAL_LT_IMP_LE; CARD_NUMSEG_1]]);;
3658
3659 let OPEN_SET_COCOUNTABLE_COORDINATES = prove
3660  (`!P. (!i. 1 <= i /\ i <= dimindex(:N)
3661             ==> COUNTABLE((:real) DIFF {x | P i x}))
3662        ==> !s:real^N->bool.
3663               open s /\ ~(s = {})
3664               ==> ?x. x IN s /\ !i. 1 <= i /\ i <= dimindex(:N) ==> P i (x$i)`,
3665   GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC OPEN_SET_COSMALL_COORDINATES THEN
3666   REPEAT STRIP_TAC THEN
3667   TRANS_TAC CARD_LET_TRANS `(:num)` THEN ASM_SIMP_TAC[GSYM COUNTABLE_ALT] THEN
3668   TRANS_TAC CARD_LTE_TRANS `(:num->bool)` THEN SIMP_TAC[CANTOR_THM_UNIV] THEN
3669   MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
3670   REWRITE_TAC[CARD_EQ_REAL]);;
3671
3672 let OPEN_SET_IRRATIONAL_COORDINATES = prove
3673  (`!s:real^N->bool.
3674         open s /\ ~(s = {})
3675         ==> ?x. x IN s /\ !i. 1 <= i /\ i <= dimindex(:N) ==> ~rational(x$i)`,
3676   MATCH_MP_TAC OPEN_SET_COCOUNTABLE_COORDINATES THEN
3677   REWRITE_TAC[SET_RULE `UNIV DIFF {x | ~P x} = P`; COUNTABLE_RATIONAL]);;
3678
3679 let CLOSURE_COSMALL_COORDINATES = prove
3680  (`!P. (!i. 1 <= i /\ i <= dimindex(:N)
3681             ==> (:real) DIFF {x | P i x} <_c (:real))
3682        ==> closure {x | !i. 1 <= i /\ i <= dimindex (:N) ==> P i (x$i)} =
3683            (:real^N)`,
3684   GEN_TAC THEN DISCH_TAC THEN
3685   REWRITE_TAC[CLOSURE_APPROACHABLE; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN
3686   MAP_EVERY X_GEN_TAC [`x:real^N`; `e:real`] THEN DISCH_TAC THEN
3687   FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_SET_COSMALL_COORDINATES) THEN
3688   DISCH_THEN(MP_TAC o SPEC `ball(x:real^N,e)`) THEN
3689   ASM_REWRITE_TAC[OPEN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE; IN_BALL] THEN
3690   MESON_TAC[DIST_SYM]);;
3691
3692 let CLOSURE_COCOUNTABLE_COORDINATES = prove
3693  (`!P. (!i. 1 <= i /\ i <= dimindex(:N)
3694             ==> COUNTABLE((:real) DIFF {x | P i x}))
3695        ==> closure {x | !i. 1 <= i /\ i <= dimindex (:N) ==> P i (x$i)} =
3696            (:real^N)`,
3697   REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_COSMALL_COORDINATES THEN
3698   REPEAT STRIP_TAC THEN
3699   TRANS_TAC CARD_LET_TRANS `(:num)` THEN ASM_SIMP_TAC[GSYM COUNTABLE_ALT] THEN
3700   TRANS_TAC CARD_LTE_TRANS `(:num->bool)` THEN SIMP_TAC[CANTOR_THM_UNIV] THEN
3701   MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
3702   REWRITE_TAC[CARD_EQ_REAL]);;
3703
3704 let CLOSURE_IRRATIONAL_COORDINATES = prove
3705  (`closure {x | !i. 1 <= i /\ i <= dimindex (:N) ==> ~rational(x$i)} =
3706    (:real^N)`,
3707   MATCH_MP_TAC CLOSURE_COCOUNTABLE_COORDINATES THEN
3708   REWRITE_TAC[SET_RULE `UNIV DIFF {x | ~P x} = P`; COUNTABLE_RATIONAL]);;
3709
3710 (* ------------------------------------------------------------------------- *)
3711 (* Every path between distinct points contains an arc, and hence             *)
3712 (* that path connection is equivalent to arcwise connection, for distinct    *)
3713 (* points. The proof is based on Whyburn's "Topological Analysis".           *)
3714 (* ------------------------------------------------------------------------- *)
3715
3716 let HOMEOMORPHIC_MONOTONE_IMAGE_INTERVAL = prove
3717  (`!f:real^1->real^N.
3718        f continuous_on interval[vec 0,vec 1] /\
3719        (!y. connected {x | x IN interval[vec 0,vec 1] /\ f x = y}) /\
3720        ~(f(vec 1) = f(vec 0))
3721        ==> (IMAGE f (interval[vec 0,vec 1])) homeomorphic
3722            (interval[vec 0:real^1,vec 1])`,
3723   let closure_dyadic_rationals_in_convex_set_pos_1 = prove
3724    (`!s. convex s /\ ~(interior s = {}) /\ (!x. x IN s ==> &0 <= drop x)
3725          ==> closure(s INTER { lift(&m / &2 pow n) |
3726                                m IN (:num) /\ n IN (:num)}) =
3727              closure s`,
3728     REPEAT STRIP_TAC THEN
3729     MP_TAC(ISPEC `s:real^1->bool` CLOSURE_DYADIC_RATIONALS_IN_CONVEX_SET) THEN
3730     ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN
3731     MATCH_MP_TAC(SET_RULE
3732      `(!x. x IN t ==> x IN u) /\ (!x. x IN u ==> x IN s ==> x IN t)
3733       ==> s INTER t = s INTER u`) THEN
3734     REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; DIMINDEX_1; FORALL_1] THEN
3735     REWRITE_TAC[IN_ELIM_THM; EXISTS_LIFT; GSYM drop; LIFT_DROP] THEN
3736     REWRITE_TAC[REAL_ARITH `x / y:real = inv y * x`; LIFT_CMUL] THEN
3737     CONJ_TAC THENL [MESON_TAC[INTEGER_CLOSED]; ALL_TAC] THEN
3738     MAP_EVERY X_GEN_TAC [`n:num`; `x:real^1`] THEN REPEAT DISCH_TAC THEN
3739     FIRST_X_ASSUM(MP_TAC o SPEC `inv(&2 pow n) % x:real^1`) THEN
3740     ASM_SIMP_TAC[DROP_CMUL; REAL_LE_MUL_EQ; REAL_LT_POW2; REAL_LT_INV_EQ] THEN
3741     ASM_MESON_TAC[INTEGER_POS; LIFT_DROP]) in
3742   let function_on_dyadic_rationals = prove
3743    (`!f:num->num->A.
3744           (!m n. f (2 * m) (n + 1) = f m n)
3745           ==> ?g. !m n. g(&m / &2 pow n) = f m n`,
3746     REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN MP_TAC(ISPECL
3747      [`\(m,n). (f:num->num->A) m n`; `\(m,n). &m / &2 pow n`]
3748      FUNCTION_FACTORS_LEFT) THEN
3749     REWRITE_TAC[FORALL_PAIR_THM; FUN_EQ_THM; o_THM] THEN
3750     DISCH_THEN (SUBST1_TAC o SYM) THEN
3751     ONCE_REWRITE_TAC[MESON[]
3752       `(!a b c d. P a b c d) <=> (!b d a c. P a b c d)`] THEN
3753     MATCH_MP_TAC WLOG_LE THEN REPEAT CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
3754     SIMP_TAC[REAL_FIELD `~(y = &0) /\ ~(y' = &0)
3755                          ==> (x / y = x' / y' <=> y' / y * x = x')`;
3756        REAL_POW_EQ_0; REAL_OF_NUM_EQ; REAL_DIV_POW2; ARITH_EQ] THEN
3757     SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN
3758     SIMP_TAC[ADD_SUB2; REAL_OF_NUM_MUL; REAL_OF_NUM_EQ; REAL_OF_NUM_POW] THEN
3759     REWRITE_TAC[MESON[]
3760      `(!n n' d. n' = f d n ==> !m m'. g d m = m' ==> P m m' n d) <=>
3761       (!d m n. P m (g d m) n d)`] THEN
3762     INDUCT_TAC THEN SIMP_TAC[EXP; MULT_CLAUSES; ADD_CLAUSES] THEN
3763     REWRITE_TAC[GSYM MULT_ASSOC; ADD1] THEN ASM_MESON_TAC[]) in
3764   let recursion_on_dyadic_rationals = prove
3765    (`!b:num->A l r.
3766           ?f. (!m. f(&m) = b m) /\
3767               (!m n. f(&(4 * m + 1) / &2 pow (n + 1)) =
3768                      l(f(&(2 * m + 1) / &2 pow n))) /\
3769               (!m n. f(&(4 * m + 3) / &2 pow (n + 1)) =
3770                      r(f(&(2 * m + 1) / &2 pow n)))`,
3771     REPEAT GEN_TAC THEN
3772     SUBGOAL_THEN
3773      `?f:num->num->A.
3774           (!m n. f (2 * m) (n + 1) = f m n) /\
3775           (!m. f m 0 = b m) /\
3776           (!m n. f (4 * m + 1) (n + 1) = l(f (2 * m + 1) n)) /\
3777           (!m n. f (4 * m + 3) (n + 1) = r(f (2 * m + 1) n))`
3778     MP_TAC THENL
3779      [MP_TAC(prove_recursive_functions_exist num_RECURSION
3780        `(!m. f m 0 = (b:num->A) m) /\
3781         (!m n. f m (SUC n) =
3782                   if EVEN m then f (m DIV 2) n
3783                   else if EVEN(m DIV 2)
3784                        then l(f ((m + 1) DIV 2) n)
3785                        else r(f (m DIV 2) n))`) THEN
3786       MATCH_MP_TAC MONO_EXISTS THEN
3787       X_GEN_TAC `f:num->num->A` THEN STRIP_TAC THEN
3788       RULE_ASSUM_TAC(REWRITE_RULE[ADD1]) THEN ASM_REWRITE_TAC[] THEN
3789       REWRITE_TAC[EVEN_MULT; ARITH_EVEN; ARITH_RULE `(2 * m) DIV 2 = m`] THEN
3790       REWRITE_TAC[ARITH_RULE `(4 * m + 1) DIV 2 = 2 * m`;
3791                   ARITH_RULE `(4 * m + 3) DIV 2 = 2 * m + 1`;
3792                   ARITH_RULE `((4 * m + 1) + 1) DIV 2 = 2 * m + 1`;
3793                   ARITH_RULE `((4 * m + 3) + 1) DIV 2 = 2 * m + 2`] THEN
3794       REWRITE_TAC[EVEN_ADD; EVEN_MULT; EVEN; ARITH_EVEN; SND];
3795       DISCH_THEN(X_CHOOSE_THEN `f:num->num->A`
3796        (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN
3797       DISCH_THEN(MP_TAC o MATCH_MP function_on_dyadic_rationals) THEN
3798       MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
3799       DISCH_THEN(fun th -> RULE_ASSUM_TAC(REWRITE_RULE[GSYM th])) THEN
3800       RULE_ASSUM_TAC(REWRITE_RULE[REAL_ARITH `x / &2 pow 0 = x`]) THEN
3801       ASM_REWRITE_TAC[]]) in
3802   let recursion_on_dyadic_rationals_1 = prove
3803    (`!b:A l r.
3804           ?f. (!m. f(&m / &2) = b) /\
3805               (!m n. 0 < n ==> f(&(4 * m + 1) / &2 pow (n + 1)) =
3806                                l(f(&(2 * m + 1) / &2 pow n))) /\
3807               (!m n. 0 < n ==> f(&(4 * m + 3) / &2 pow (n + 1)) =
3808                                r(f(&(2 * m + 1) / &2 pow n)))`,
3809     REPEAT GEN_TAC THEN
3810     MP_TAC(ISPECL [`(\n. b):num->A`; `l:A->A`; `r:A->A`]
3811           recursion_on_dyadic_rationals) THEN
3812     REWRITE_TAC[] THEN
3813     DISCH_THEN(X_CHOOSE_THEN `f:real->A` STRIP_ASSUME_TAC) THEN
3814     EXISTS_TAC `\x. (f:real->A)(&2 * x)` THEN
3815     ASM_REWRITE_TAC[REAL_ARITH `&2 * x / &2 = x`] THEN
3816     CONJ_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[LT_REFL] THEN
3817     ASM_SIMP_TAC[ADD_CLAUSES; real_pow; REAL_POW_EQ_0; REAL_OF_NUM_EQ;
3818       ARITH_EQ; REAL_FIELD `~(y = &0) ==> &2 * x / (&2 * y) = x / y`]) in
3819   let exists_function_unpair = prove
3820    (`(?f:A->B#C. P f) <=> (?f1 f2. P(\x. (f1 x,f2 x)))`,
3821     EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN STRIP_TAC THEN
3822     EXISTS_TAC `\x. FST((f:A->B#C) x)` THEN
3823     EXISTS_TAC `\x. SND((f:A->B#C) x)` THEN
3824     ASM_REWRITE_TAC[PAIR; ETA_AX]) in
3825   let dyadics_in_open_unit_interval = prove
3826    (`interval(vec 0,vec 1) INTER
3827       {lift(&m / &2 pow n) | m IN (:num) /\ n IN (:num)} =
3828       {lift(&m / &2 pow n) | 0 < m /\ m < 2 EXP n}`,
3829     MATCH_MP_TAC(SET_RULE
3830      `(!m n. (f m n) IN s <=> P m n)
3831       ==> s INTER {f m n | m IN UNIV /\ n IN UNIV} =
3832           {f m n | P m n}`) THEN
3833     REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
3834     SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN
3835     SIMP_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_POW; REAL_OF_NUM_LT]) in
3836   REPEAT STRIP_TAC THEN
3837   SUBGOAL_THEN
3838    `!a b m. m IN interval[a,b] /\ interval[a,b] SUBSET interval[vec 0,vec 1]
3839             ==> ?c d. drop a <= drop c /\ drop c <= drop m /\
3840                       drop m <= drop d /\ drop d <= drop b /\
3841                       (!x. x IN interval[c,d] ==> f x = f m) /\
3842                       (!x. x IN interval[a,c] DELETE c ==> ~(f x = f m)) /\
3843                       (!x. x IN interval[d,b] DELETE d ==> ~(f x = f m)) /\
3844                       (!x y. x IN interval[a,c] DELETE c /\
3845                              y IN interval[d,b] DELETE d
3846                              ==> ~((f:real^1->real^N) x = f y))`
3847   MP_TAC THENL
3848    [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; SUBSET_INTERVAL_1] THEN
3849     REPEAT STRIP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
3850     SUBGOAL_THEN
3851      `?c d. {x | x IN interval[a,b] /\ (f:real^1->real^N) x = f m} =
3852             interval[c,d]`
3853     MP_TAC THENL
3854      [SUBGOAL_THEN
3855        `{x | x IN interval[a,b] /\ (f:real^1->real^N) x = f m} =
3856         interval[a,b] INTER
3857         {x | x IN interval[vec 0,vec 1] /\ (f:real^1->real^N) x = f m}`
3858       SUBST1_TAC THENL
3859        [REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL_1; IN_ELIM_THM;
3860                     DROP_VEC] THEN
3861         GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN ASM_REAL_ARITH_TAC;
3862         ALL_TAC] THEN
3863       SUBGOAL_THEN
3864        `?c d. {x | x IN interval[vec 0,vec 1] /\ (f:real^1->real^N) x = f m} =
3865               interval[c,d]`
3866       MP_TAC THENL
3867        [ASM_REWRITE_TAC[GSYM CONNECTED_COMPACT_INTERVAL_1] THEN
3868         ONCE_REWRITE_TAC[SET_RULE
3869          `{x | x IN s /\ P x} = s INTER {x | x IN s /\ P x}`] THEN
3870         MATCH_MP_TAC COMPACT_INTER_CLOSED THEN
3871         REWRITE_TAC[COMPACT_INTERVAL] THEN
3872         MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_CONSTANT THEN
3873         ASM_REWRITE_TAC[CLOSED_INTERVAL];
3874         STRIP_TAC THEN ASM_REWRITE_TAC[INTER_INTERVAL_1] THEN MESON_TAC[]];
3875       ALL_TAC] THEN
3876     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^1` THEN
3877     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^1` THEN DISCH_TAC THEN
3878     SUBGOAL_THEN `m IN interval[c:real^1,d]` MP_TAC THENL
3879      [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN
3880       REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
3881                   ASM_REAL_ARITH_TAC;
3882       REWRITE_TAC[IN_INTERVAL_1; IN_DELETE] THEN STRIP_TAC] THEN
3883     SUBGOAL_THEN `{c:real^1,d} SUBSET interval[c,d]` MP_TAC THENL
3884      [ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_INTERVAL_1] THEN
3885       ASM_REAL_ARITH_TAC;
3886       FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV)
3887        [GSYM th]) THEN
3888       REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM; IN_INTERVAL_1] THEN
3889       STRIP_TAC THEN ASM_REWRITE_TAC[]] THEN
3890     CONJ_TAC THENL
3891      [GEN_TAC THEN REWRITE_TAC[GSYM IN_INTERVAL_1] THEN
3892       FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC  (LAND_CONV o RAND_CONV)
3893        [GSYM th]) THEN SIMP_TAC[IN_ELIM_THM];
3894       ALL_TAC] THEN
3895     GEN_REWRITE_TAC I [CONJ_ASSOC] THEN CONJ_TAC THENL
3896      [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
3897       `{x | x IN s /\ f x = a} = t
3898        ==> (!x. P x ==> x IN s) /\ (!x. P x /\ Q x ==> ~(x IN t))
3899            ==> !x. P x /\ Q x ==> ~(f x = a)`)) THEN
3900       REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC;
3901       ALL_TAC] THEN
3902     MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
3903     REWRITE_TAC[GSYM DROP_EQ] THEN STRIP_TAC THEN
3904     SUBGOAL_THEN `{x:real^1,y} INTER interval[c,d] = {}` MP_TAC THENL
3905      [REWRITE_TAC[SET_RULE `{a,b} INTER s = {} <=> ~(a IN s) /\ ~(b IN s)`;
3906                   IN_INTERVAL_1] THEN
3907       ASM_REAL_ARITH_TAC;
3908       FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC
3909        (LAND_CONV o LAND_CONV o RAND_CONV) [GSYM th])] THEN
3910     REWRITE_TAC[SET_RULE `{a,b} INTER s = {} <=> ~(a IN s) /\ ~(b IN s)`] THEN
3911     REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL_1] THEN
3912     ASM_CASES_TAC `(f:real^1->real^N) x = f m` THENL
3913      [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN
3914     ASM_CASES_TAC `(f:real^1->real^N) y = f m` THENL
3915      [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN
3916     ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
3917     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM IS_INTERVAL_CONNECTED_1] o
3918                   SPEC `(f:real^1->real^N) y`) THEN
3919     ASM_REWRITE_TAC[IS_INTERVAL_1] THEN DISCH_THEN(MP_TAC o SPECL
3920      [`x:real^1`; `y:real^1`; `m:real^1`]) THEN
3921     ASM_REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
3922     ASM_REAL_ARITH_TAC;
3923     REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
3924     MAP_EVERY X_GEN_TAC
3925      [`leftcut:real^1->real^1->real^1->real^1`;
3926       `rightcut:real^1->real^1->real^1->real^1`] THEN
3927     STRIP_TAC] THEN
3928   FIRST_ASSUM(MP_TAC o SPECL
3929    [`vec 0:real^1`; `vec 1:real^1`; `vec 0:real^1`]) THEN
3930   REWRITE_TAC[SUBSET_REFL; ENDS_IN_UNIT_INTERVAL] THEN ABBREV_TAC
3931    `u = (rightcut:real^1->real^1->real^1->real^1) (vec 0) (vec 1) (vec 0)` THEN
3932   REWRITE_TAC[CONJ_ASSOC; REAL_LE_ANTISYM; DROP_EQ] THEN
3933   REWRITE_TAC[GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
3934   DISCH_THEN(SUBST1_TAC o SYM) THEN
3935   REWRITE_TAC[INTERVAL_SING; SET_RULE `~(x IN ({a} DELETE a))`] THEN
3936   STRIP_TAC THEN
3937   FIRST_ASSUM(MP_TAC o SPECL
3938    [`u:real^1`; `vec 1:real^1`; `vec 1:real^1`]) THEN
3939   REWRITE_TAC[ENDS_IN_INTERVAL; SUBSET_INTERVAL_1; INTERVAL_NE_EMPTY_1] THEN
3940   ASM_REWRITE_TAC[REAL_LE_REFL] THEN ABBREV_TAC
3941    `v = (leftcut:real^1->real^1->real^1->real^1) u (vec 1) (vec 1)` THEN
3942   ONCE_REWRITE_TAC[TAUT
3943     `a /\ b /\ c /\ d /\ e <=> (c /\ d) /\ a /\ b /\ e`] THEN
3944   REWRITE_TAC[REAL_LE_ANTISYM; DROP_EQ] THEN
3945   ONCE_REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
3946   REWRITE_TAC[INTERVAL_SING; SET_RULE `~(x IN ({a} DELETE a))`] THEN
3947   STRIP_TAC THEN
3948   SUBGOAL_THEN
3949    `!x. x IN interval[vec 0,v] DELETE v
3950         ==> ~((f:real^1->real^N) x = f(vec 1))`
3951   ASSUME_TAC THENL
3952    [X_GEN_TAC `t:real^1` THEN
3953     REWRITE_TAC[IN_DELETE; IN_INTERVAL_1; GSYM DROP_EQ] THEN STRIP_TAC THEN
3954     ASM_CASES_TAC `drop t < drop u` THENL
3955      [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
3956        `~(f1 = f0) ==> ft = f0 ==> ~(ft = f1)`));
3957       ALL_TAC] THEN
3958     FIRST_X_ASSUM MATCH_MP_TAC THEN
3959     ASM_REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN
3960     ASM_REAL_ARITH_TAC;
3961     UNDISCH_THEN
3962       `!x. x IN interval[u,v] DELETE v ==> ~((f:real^1->real^N) x = f (vec 1))`
3963       (K ALL_TAC)] THEN
3964   MP_TAC(ISPECL
3965    [`(u:real^1,v:real^1)`;
3966     `\(a,b). (a:real^1,leftcut a b (midpoint(a,b)):real^1)`;
3967     `\(a,b). (rightcut a b (midpoint(a,b)):real^1,b:real^1)`]
3968         recursion_on_dyadic_rationals_1) THEN
3969   REWRITE_TAC[exists_function_unpair; PAIR_EQ] THEN
3970   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
3971   MAP_EVERY X_GEN_TAC [`a:real->real^1`; `b:real->real^1`] THEN
3972   ABBREV_TAC `(c:real->real^1) x = midpoint(a x,b x)` THEN
3973   REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN
3974   REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN
3975   SUBGOAL_THEN
3976    `!m n. drop u <= drop(a(&m / &2 pow n)) /\
3977           drop(a(&m / &2 pow n)) <= drop(b(&m / &2 pow n)) /\
3978           drop(b(&m / &2 pow n)) <= drop v`
3979   MP_TAC THENL
3980    [GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN MATCH_MP_TAC num_INDUCTION THEN
3981     CONJ_TAC THENL
3982      [REWRITE_TAC[REAL_ARITH `x / &2 pow 0 = (&2 * x) / &2`] THEN
3983       ASM_REWRITE_TAC[REAL_OF_NUM_MUL; REAL_LE_REFL];
3984       X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "*")] THEN
3985     X_GEN_TAC `p:num` THEN DISJ_CASES_TAC(SPEC `p:num` EVEN_OR_ODD) THENL
3986      [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
3987       DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
3988       REWRITE_TAC[GSYM REAL_OF_NUM_MUL; real_pow] THEN
3989       ASM_SIMP_TAC[REAL_LT_POW2; REAL_FIELD
3990        `&0 < y ==> (&2 * x) / (&2 * y) = x / y`];
3991       ALL_TAC] THEN
3992     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
3993     DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
3994     DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL
3995      [ASM_REWRITE_TAC[real_pow; REAL_MUL_RID; REAL_LE_REFL];
3996       REWRITE_TAC[ADD1]] THEN
3997     DISJ_CASES_TAC(SPEC `m:num` EVEN_OR_ODD) THENL
3998      [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
3999       DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN
4000       ASM_SIMP_TAC[ARITH_RULE `2 * 2 * r = 4 * r`];
4001       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
4002       DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN
4003       ASM_SIMP_TAC[ARITH_RULE `2 * SUC(2 * r) + 1 = 4 * r + 3`]] THEN
4004     (FIRST_X_ASSUM(MP_TAC o SPECL
4005       [`a(&(2 * r + 1) / &2 pow n):real^1`;
4006        `b(&(2 * r + 1) / &2 pow n):real^1`;
4007        `c(&(2 * r + 1) / &2 pow n):real^1`]) THEN
4008      ANTS_TAC THENL
4009       [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
4010         [GSYM th]) THEN
4011        REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4012        REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
4013        UNDISCH_TAC `drop(vec 0) <= drop u` THEN
4014        UNDISCH_TAC `drop v <= drop (vec 1)`;
4015        ALL_TAC] THEN
4016      REMOVE_THEN "*" (MP_TAC o SPEC `2 * r + 1`) THEN REAL_ARITH_TAC);
4017     REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN
4018   SUBGOAL_THEN `!m n. drop(vec 0) <= drop(a(&m / &2 pow n))` ASSUME_TAC THENL
4019    [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN
4020   SUBGOAL_THEN `!m n. drop(b(&m / &2 pow n)) <= drop(vec 1)` ASSUME_TAC THENL
4021    [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN
4022   SUBGOAL_THEN
4023    `!m n. drop(a(&m / &2 pow n)) <= drop(c(&m / &2 pow n)) /\
4024           drop(c(&m / &2 pow n)) <= drop(b(&m / &2 pow n))`
4025   MP_TAC THENL
4026    [UNDISCH_THEN `!x:real. midpoint(a x:real^1,b x) = c x`
4027       (fun th -> REWRITE_TAC[GSYM th]) THEN
4028     REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4029     ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
4030      `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`];
4031     REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN
4032   SUBGOAL_THEN
4033    `!i m n j. ODD j /\
4034               abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n)
4035               ==> drop(a(&j / &2 pow n)) <= drop(c(&i / &2 pow m)) /\
4036                   drop(c(&i / &2 pow m)) <= drop(b(&j / &2 pow n))`
4037   ASSUME_TAC THENL
4038    [REPLICATE_TAC 3 GEN_TAC THEN WF_INDUCT_TAC `m - n:num` THEN
4039     DISJ_CASES_TAC(ARITH_RULE `m <= n \/ n:num < m`) THENL
4040      [GEN_TAC THEN STRIP_TAC THEN
4041       MP_TAC(SPEC `abs(&2 pow n) * abs(&i / &2 pow m - &j / &2 pow n)`
4042                 REAL_ABS_INTEGER_LEMMA) THEN
4043       MATCH_MP_TAC(TAUT
4044        `i /\ ~b /\ (n ==> p) ==> (i /\ ~n ==> b) ==> p`) THEN
4045       REPEAT CONJ_TAC THENL
4046        [REWRITE_TAC[GSYM REAL_ABS_MUL; INTEGER_ABS] THEN
4047         REWRITE_TAC[REAL_ARITH
4048          `n * (x / m - y / n):real = x * (n / m) - y * (n / n)`] THEN
4049         ASM_SIMP_TAC[GSYM REAL_POW_SUB; LE_REFL; REAL_OF_NUM_EQ; ARITH_EQ] THEN
4050         MESON_TAC[INTEGER_CLOSED];
4051         SIMP_TAC[REAL_ABS_MUL; REAL_ABS_ABS; REAL_ABS_POW; REAL_ABS_NUM] THEN
4052         REWRITE_TAC[REAL_ARITH `~(&1 <= x * y) <=> y * x < &1`] THEN
4053         SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
4054         ASM_REWRITE_TAC[REAL_ARITH `&1 / x = inv x`];
4055         ASM_SIMP_TAC[REAL_ABS_POW; REAL_ABS_NUM; REAL_ENTIRE; REAL_LT_IMP_NZ;
4056           REAL_LT_POW2; REAL_ARITH `abs(x - y) = &0 <=> x = y`]];
4057       ALL_TAC] THEN
4058     X_GEN_TAC `k:num` THEN REWRITE_TAC[IMP_CONJ; ODD_EXISTS] THEN
4059     DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
4060     DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL
4061      [ASM_REWRITE_TAC[REAL_ARITH `x / &2 pow 0 = (&2 * x) / &2`] THEN
4062       ASM_REWRITE_TAC[REAL_OF_NUM_MUL] THEN ASM_MESON_TAC[REAL_LE_TRANS];
4063       ALL_TAC] THEN
4064     UNDISCH_THEN `n:num < m`
4065       (fun th -> let th' = MATCH_MP
4066                    (ARITH_RULE `n < m ==> m - SUC n < m - n`) th in
4067                  FIRST_X_ASSUM(MP_TAC o C MATCH_MP th')) THEN
4068     REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH
4069      `&i / &2 pow m = &(2 * j + 1) / &2 pow n \/
4070       &i / &2 pow m < &(2 * j + 1) / &2 pow n \/
4071       &(2 * j + 1) / &2 pow n < &i / &2 pow m`)
4072     THENL
4073      [ASM_REWRITE_TAC[ADD1];
4074       DISCH_THEN(MP_TAC o SPEC `4 * j + 1`) THEN
4075       REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN ASM_SIMP_TAC[ADD1] THEN
4076       MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL
4077        [MATCH_MP_TAC(REAL_ARITH
4078          `x < i /\ &2 * n1 = n /\ j + n1 = i
4079           ==> abs(x - i) < n ==> abs(x - j) < n1`) THEN
4080         ASM_REWRITE_TAC[REAL_ARITH `a / b + inv b = (a + &1) / b`] THEN
4081         REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN
4082         REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
4083         REAL_ARITH_TAC;
4084         MATCH_MP_TAC(REAL_ARITH
4085          `b' <= b ==> a <= c /\ c <= b' ==> a <= c /\ c <= b`) THEN
4086         FIRST_X_ASSUM(MP_TAC o SPECL
4087          [`a(&(2 * j + 1) / &2 pow n):real^1`;
4088           `b(&(2 * j + 1) / &2 pow n):real^1`;
4089           `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
4090         ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN
4091         FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
4092           [GSYM th]) THEN
4093         REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4094         REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
4095         ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
4096          `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]];
4097       DISCH_THEN(MP_TAC o SPEC `4 * j + 3`) THEN
4098       REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN ASM_SIMP_TAC[ADD1] THEN
4099       MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL
4100        [MATCH_MP_TAC(REAL_ARITH
4101          `i < x /\ &2 * n1 = n /\ j - n1 = i
4102           ==> abs(x - i) < n ==> abs(x - j) < n1`) THEN
4103         ASM_REWRITE_TAC[REAL_ARITH `a / b - inv b = (a - &1) / b`] THEN
4104         REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN
4105         REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
4106         REAL_ARITH_TAC;
4107         MATCH_MP_TAC(REAL_ARITH
4108          `a <= a' ==> a' <= c /\ c <= b ==> a <= c /\ c <= b`) THEN
4109         FIRST_X_ASSUM(MP_TAC o SPECL
4110          [`a(&(2 * j + 1) / &2 pow n):real^1`;
4111           `b(&(2 * j + 1) / &2 pow n):real^1`;
4112           `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
4113         ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN
4114         FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
4115           [GSYM th]) THEN
4116         REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4117         REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
4118         ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
4119          `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]]];
4120     ALL_TAC] THEN
4121   SUBGOAL_THEN
4122    `!m n. ODD m ==> abs(drop(a(&m / &2 pow n)) - drop(b(&m / &2 pow n)))
4123                     <= &2 / &2 pow n`
4124   ASSUME_TAC THENL
4125    [ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN INDUCT_TAC THENL
4126      [ASM_REWRITE_TAC[REAL_ARITH `x / &2 pow 0 = (&2 * x) / &2`] THEN
4127       ASM_REWRITE_TAC[REAL_OF_NUM_MUL] THEN CONV_TAC NUM_REDUCE_CONV THEN
4128       RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC]) THEN ASM_REAL_ARITH_TAC;
4129       ALL_TAC] THEN
4130     X_GEN_TAC `m:num` THEN REWRITE_TAC[ODD_EXISTS] THEN
4131     DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
4132     DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL
4133      [ASM_REWRITE_TAC[ARITH; REAL_POW_1] THEN
4134       RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC]) THEN ASM_REAL_ARITH_TAC;
4135       ALL_TAC] THEN
4136     DISJ_CASES_TAC(SPEC `k:num` EVEN_OR_ODD) THENL
4137      [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
4138       DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
4139       REWRITE_TAC[ARITH_RULE `SUC(2 * 2 * j) = 4 * j + 1`] THEN
4140       ASM_SIMP_TAC[ADD1] THEN
4141       MATCH_MP_TAC(REAL_ARITH
4142        `drop c = (drop a + drop b) / &2 /\
4143         abs(drop a - drop b) <= &2 * k /\
4144         drop a <= drop(leftcut a b c) /\
4145         drop(leftcut a b c) <= drop c
4146         ==> abs(drop a - drop(leftcut a b c)) <= k`);
4147       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
4148       DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
4149       REWRITE_TAC[ARITH_RULE `SUC(2 * SUC(2 * j)) = 4 * j + 3`] THEN
4150       ASM_SIMP_TAC[ADD1] THEN
4151       MATCH_MP_TAC(REAL_ARITH
4152        `drop c = (drop a + drop b) / &2 /\
4153         abs(drop a - drop b) <= &2 * k /\
4154         drop c <= drop(rightcut a b c) /\
4155         drop(rightcut a b c) <= drop b
4156         ==> abs(drop(rightcut a b c) - drop b) <= k`)] THEN
4157     (CONJ_TAC THENL
4158       [UNDISCH_THEN `!x:real. midpoint(a x:real^1,b x) = c x`
4159         (fun th -> REWRITE_TAC[GSYM th]) THEN
4160        REWRITE_TAC[midpoint; DROP_CMUL; DROP_ADD] THEN REAL_ARITH_TAC;
4161        ALL_TAC] THEN
4162      CONJ_TAC THENL
4163       [REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN
4164        REWRITE_TAC[REAL_ARITH `&2 * x * inv y * inv(&2 pow 1) = x / y`] THEN
4165        ASM_SIMP_TAC[GSYM real_div; ODD_ADD; ODD_MULT; ARITH];
4166        ALL_TAC] THEN
4167      FIRST_X_ASSUM(MP_TAC o SPECL
4168       [`a(&(2 * j + 1) / &2 pow n):real^1`;
4169        `b(&(2 * j + 1) / &2 pow n):real^1`;
4170        `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
4171      ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN
4172      FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
4173        [GSYM th]) THEN
4174      REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4175      REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
4176      ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
4177       `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]);
4178     ALL_TAC] THEN
4179   SUBGOAL_THEN
4180    `!n j. 0 < 2 * j /\ 2 * j < 2 EXP n
4181           ==> (f:real^1->real^N)(b(&(2 * j - 1) / &2 pow n)) =
4182               f(a(&(2 * j + 1) / &2 pow n))`
4183   ASSUME_TAC THENL
4184    [MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
4185      [REWRITE_TAC[ARITH_RULE `0 < 2 * j <=> 0 < j`;
4186                   ARITH_RULE `2 * j < 2 <=> j < 1`] THEN
4187       ARITH_TAC;
4188       ALL_TAC] THEN
4189     X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "+") THEN
4190     DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL
4191      [ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN
4192       REWRITE_TAC[ARITH_RULE `0 < 2 * j <=> 0 < j`;
4193                    ARITH_RULE `2 * j < 2  <=> j < 1`] THEN
4194       ARITH_TAC;
4195       ALL_TAC] THEN
4196     X_GEN_TAC `k:num` THEN DISJ_CASES_TAC(SPEC `k:num` EVEN_OR_ODD) THENL
4197      [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
4198       DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
4199       REWRITE_TAC[EXP; ARITH_RULE `0 < 2 * j <=> 0 < j`; LT_MULT_LCANCEL] THEN
4200       CONV_TAC NUM_REDUCE_CONV THEN
4201       ASM_SIMP_TAC[ARITH_RULE `0 < j ==> 2 * 2 * j - 1 = 4 * (j - 1) + 3`;
4202         ADD1; ARITH_RULE `2 * 2 * j + 1 = 4 * j + 1`] THEN
4203       SIMP_TAC[ARITH_RULE `0 < j ==> 2 * (j - 1) + 1 = 2 * j - 1`] THEN
4204       STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
4205       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
4206       DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
4207       STRIP_TAC THEN
4208       ASM_SIMP_TAC[ADD1; ARITH_RULE `2 * SUC(2 * j) - 1 = 4 * j + 1`;
4209                    ARITH_RULE `2 * SUC(2 * j) + 1 = 4 * j + 3`] THEN
4210       FIRST_X_ASSUM(MP_TAC o SPECL
4211        [`a(&(2 * j + 1) / &2 pow n):real^1`;
4212         `b(&(2 * j + 1) / &2 pow n):real^1`;
4213         `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
4214       ANTS_TAC THENL
4215        [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
4216          [GSYM th]) THEN
4217         REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4218         REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
4219         ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
4220          `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`];
4221         REPLICATE_TAC 4 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4222         DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
4223         MATCH_MP_TAC(MESON[]
4224          `a IN s /\ b IN s ==> (!x. x IN s ==> f x = c) ==> f a = f b`) THEN
4225         REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN
4226         ASM_MESON_TAC[REAL_LE_TRANS]]];
4227     ALL_TAC] THEN
4228   SUBGOAL_THEN
4229    `!n j. 0 < j /\ j < 2 EXP n
4230           ==> (f:real^1->real^N)(b(&(2 * j - 1) / &2 pow (n + 1))) =
4231               f(c(&j / &2 pow n)) /\
4232               f(a(&(2 * j + 1) / &2 pow (n + 1))) = f(c(&j / &2 pow n))`
4233   ASSUME_TAC THENL
4234    [MATCH_MP_TAC num_INDUCTION THEN
4235     REWRITE_TAC[ARITH_RULE `~(0 < j /\ j < 2 EXP 0)`] THEN
4236     X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "*") THEN
4237     X_GEN_TAC `j:num` THEN
4238     DISJ_CASES_TAC(SPEC `j:num` EVEN_OR_ODD) THENL
4239      [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
4240       DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
4241       REWRITE_TAC[ADD_CLAUSES; EXP; ARITH_RULE `0 < 2 * k <=> 0 < k`;
4242                   ARITH_RULE `2 * x < 2 * y <=> x < y`] THEN STRIP_TAC THEN
4243       REMOVE_THEN "*" (MP_TAC o SPEC `k:num`) THEN
4244       ASM_REWRITE_TAC[] THEN
4245       MATCH_MP_TAC(MESON[]
4246        `c' = c /\ a' = a /\ b' = b
4247         ==> b = c /\ a = c ==> b' = c' /\ a' = c'`) THEN
4248       REPEAT CONJ_TAC THEN AP_TERM_TAC THENL
4249        [AP_TERM_TAC THEN
4250         REWRITE_TAC[real_pow; real_div; REAL_INV_MUL;
4251                     GSYM REAL_OF_NUM_MUL] THEN
4252         REAL_ARITH_TAC;
4253         REWRITE_TAC[ADD1; ARITH_RULE `2 * 2 * n = 4 * n`] THEN
4254         FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC;
4255         SUBGOAL_THEN `k = PRE k + 1` SUBST1_TAC THENL
4256          [ASM_ARITH_TAC; ALL_TAC] THEN
4257         REWRITE_TAC[ARITH_RULE `2 * (k + 1) - 1 = 2 * k + 1`;
4258                     ARITH_RULE `2 * 2 * (k + 1) - 1 = 4 * k + 3`] THEN
4259         REWRITE_TAC[ADD1] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC];
4260       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
4261       DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
4262       REWRITE_TAC[EXP; ARITH_RULE `SUC(2 * k) < 2 * n <=> k < n`] THEN
4263       STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
4264        [`a(&(2 * k + 1) / &2 pow (SUC n)):real^1`;
4265         `b(&(2 * k + 1) / &2 pow (SUC n)):real^1`;
4266         `c(&(2 * k + 1) / &2 pow (SUC n)):real^1`]) THEN
4267       ANTS_TAC THENL
4268        [ASM_REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1];
4269         REPLICATE_TAC 4 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4270         DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)] THEN
4271       REWRITE_TAC[ARITH_RULE `SUC(2 * k) = 2 * k + 1`] THEN
4272       DISCH_THEN(fun th -> CONJ_TAC THEN MATCH_MP_TAC th) THEN
4273       ASM_SIMP_TAC[ARITH_RULE `2 * (2 * k + 1) - 1 = 4 * k + 1`; ADD1;
4274                    ARITH_RULE `2 * (2 * k + 1) + 1 = 4 * k + 3`;
4275                    ARITH_RULE `0 < n + 1`] THEN
4276       ASM_REWRITE_TAC[IN_INTERVAL_1; GSYM ADD1] THEN
4277       ASM_SIMP_TAC[ARITH_RULE `SUC(2 * k) = 2 * k + 1`] THEN
4278       ASM_REAL_ARITH_TAC];
4279     ALL_TAC] THEN
4280   ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
4281   MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN
4282   REWRITE_TAC[COMPACT_INTERVAL] THEN
4283   MP_TAC(ISPECL [`\x. (f:real^1->real^N)(c(drop x))`;
4284                  `interval(vec 0,vec 1) INTER
4285                   {lift(&m / &2 pow n) | m IN (:num) /\ n IN (:num)}`]
4286         UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN
4287   SIMP_TAC[closure_dyadic_rationals_in_convex_set_pos_1;
4288            CONVEX_INTERVAL; INTERIOR_OPEN; OPEN_INTERVAL;
4289            UNIT_INTERVAL_NONEMPTY; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC;
4290            CLOSURE_OPEN_INTERVAL] THEN
4291   REWRITE_TAC[dyadics_in_open_unit_interval] THEN
4292   ANTS_TAC THENL
4293    [REWRITE_TAC[uniformly_continuous_on; FORALL_IN_GSPEC] THEN
4294     X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN
4295      `(f:real^1->real^N) uniformly_continuous_on interval[vec 0,vec 1]`
4296     MP_TAC THENL
4297      [ASM_SIMP_TAC[COMPACT_UNIFORMLY_CONTINUOUS; COMPACT_INTERVAL];
4298       REWRITE_TAC[uniformly_continuous_on]] THEN
4299     DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
4300     DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
4301     MP_TAC(SPECL [`inv(&2)`; `min (d:real) (&1 / &4)`] REAL_ARCH_POW_INV) THEN
4302     ASM_REWRITE_TAC[REAL_HALF; REAL_POW_INV; REAL_LT_MIN] THEN
4303     CONV_TAC REAL_RAT_REDUCE_CONV THEN
4304     DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN
4305     ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN
4306     CONV_TAC REAL_RAT_REDUCE_CONV THEN STRIP_TAC THEN
4307     EXISTS_TAC `inv(&2 pow n)` THEN
4308     REWRITE_TAC[REAL_LT_POW2; REAL_LT_INV_EQ] THEN
4309     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
4310     REWRITE_TAC[FORALL_IN_GSPEC] THEN
4311     SUBGOAL_THEN
4312      `!i j m. 0 < i /\ i < 2 EXP m /\ 0 < j /\ j < 2 EXP n /\
4313               abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n)
4314               ==> norm((f:real^1->real^N)(c(&i / &2 pow m)) -
4315                        f(c(&j / &2 pow n))) < e / &2`
4316     ASSUME_TAC THENL
4317      [REPEAT GEN_TAC THEN
4318       REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4319       DISCH_THEN(DISJ_CASES_THEN MP_TAC o MATCH_MP (REAL_ARITH
4320        `abs(x - a) < e
4321         ==> x = a \/
4322             abs(x - (a - e / &2)) < e / &2 \/
4323             abs(x - (a + e / &2)) < e / &2`))
4324       THENL
4325        [DISCH_THEN SUBST1_TAC THEN
4326         ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_HALF];
4327         ALL_TAC] THEN
4328       SUBGOAL_THEN
4329        `&j / &2 pow n = &(2 * j) / &2 pow (n + 1)`
4330        (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th])
4331       THENL
4332        [REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL;
4333                     GSYM REAL_OF_NUM_MUL] THEN
4334         REAL_ARITH_TAC;
4335         ALL_TAC] THEN
4336       REWRITE_TAC[real_div; GSYM REAL_INV_MUL] THEN
4337       REWRITE_TAC[GSYM real_div;
4338            GSYM(ONCE_REWRITE_RULE[REAL_MUL_SYM] (CONJUNCT2 real_pow))] THEN
4339       REWRITE_TAC[ADD1; REAL_ARITH `x / n + inv n = (x + &1) / n`;
4340                   REAL_ARITH `x / n - inv n = (x - &1) / n`] THEN
4341       ASM_SIMP_TAC[REAL_OF_NUM_SUB; ARITH_RULE `0 < j ==> 1 <= 2 * j`] THEN
4342       REWRITE_TAC[REAL_OF_NUM_ADD] THEN STRIP_TAC THENL
4343        [SUBGOAL_THEN `(f:real^1->real^N)(c(&j / &2 pow n)) =
4344                       f(b (&(2 * j - 1) / &2 pow (n + 1)))`
4345         SUBST1_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC];
4346         SUBGOAL_THEN `(f:real^1->real^N)(c(&j / &2 pow n)) =
4347                       f(a (&(2 * j + 1) / &2 pow (n + 1)))`
4348         SUBST1_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC]] THEN
4349       REWRITE_TAC[GSYM dist] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4350       REWRITE_TAC[IN_INTERVAL_1] THEN
4351       REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC]) THEN
4352       FIRST_X_ASSUM(MP_TAC o SPECL [`i:num`; `m:num`; `n + 1`]) THENL
4353        [DISCH_THEN(MP_TAC o SPEC `2 * j - 1`) THEN REWRITE_TAC[ODD_SUB];
4354         DISCH_THEN(MP_TAC o SPEC `2 * j + 1`) THEN REWRITE_TAC[ODD_ADD]] THEN
4355       ASM_REWRITE_TAC[ODD_MULT; ARITH; ARITH_RULE `1 < 2 * j <=> 0 < j`] THEN
4356       REWRITE_TAC[DIST_REAL; GSYM drop] THENL
4357        [MATCH_MP_TAC(NORM_ARITH
4358          `!t. abs(a - b) <= t /\ t < d
4359               ==> a <= c /\ c <= b ==> abs(c - b) < d`);
4360         MATCH_MP_TAC(NORM_ARITH
4361          `!t. abs(a - b) <= t /\ t < d
4362               ==> a <= c /\ c <= b ==> abs(c - a) < d`)] THEN
4363       EXISTS_TAC `&2 / &2 pow (n + 1)` THEN
4364       (CONJ_TAC THENL
4365         [FIRST_X_ASSUM MATCH_MP_TAC THEN
4366          REWRITE_TAC[ODD_SUB; ODD_ADD; ODD_MULT; ARITH_ODD] THEN
4367          ASM_REWRITE_TAC[ARITH_RULE `1 < 2 * j <=> 0 < j`];
4368          REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN
4369          ASM_REAL_ARITH_TAC]);
4370       ALL_TAC] THEN
4371     MAP_EVERY X_GEN_TAC [`i:num`; `m:num`] THEN STRIP_TAC THEN
4372     MAP_EVERY X_GEN_TAC [`k:num`; `p:num`] THEN STRIP_TAC THEN
4373     REWRITE_TAC[DIST_LIFT; LIFT_DROP] THEN STRIP_TAC THEN
4374     SUBGOAL_THEN
4375      `?j. 0 < j /\ j < 2 EXP n /\
4376           abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n) /\
4377           abs(&k / &2 pow p - &j / &2 pow n) < inv(&2 pow n)`
4378     STRIP_ASSUME_TAC THENL
4379      [MP_TAC(SPEC `max (&2 pow n * &i / &2 pow m)
4380                        (&2 pow n * &k / &2 pow p)`
4381         FLOOR_POS) THEN
4382       SIMP_TAC[REAL_LE_MUL; REAL_LE_MAX; REAL_LE_DIV;
4383                REAL_POS; REAL_POW_LE] THEN
4384       DISCH_THEN(X_CHOOSE_TAC `j:num`) THEN
4385       MP_TAC(SPEC `max (&2 pow n * &i / &2 pow m)
4386                        (&2 pow n * &k / &2 pow p)` FLOOR) THEN
4387       ASM_REWRITE_TAC[REAL_LE_MAX; REAL_MAX_LT] THEN
4388       ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
4389       SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
4390       REWRITE_TAC[REAL_ARITH `(j + &1) / n = j / n + inv n`] THEN
4391       ASM_CASES_TAC `j = 0` THENL
4392        [ASM_REWRITE_TAC[REAL_ARITH `&0 / x = &0`; REAL_ADD_LID] THEN
4393         DISCH_TAC THEN EXISTS_TAC `1` THEN CONV_TAC NUM_REDUCE_CONV THEN
4394         REWRITE_TAC[ARITH_RULE `1 < n <=> 2 EXP 1 <= n`] THEN
4395         ASM_SIMP_TAC[LE_EXP; LE_1] THEN CONV_TAC NUM_REDUCE_CONV THEN
4396         MATCH_MP_TAC(REAL_ARITH
4397          `&0 < x /\ x < inv n /\ &0 < y /\ y < inv n
4398           ==> abs(x - &1 / n) < inv n /\ abs(y - &1 / n) < inv n`) THEN
4399         ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; REAL_LT_POW2];
4400         DISCH_TAC THEN EXISTS_TAC `j:num` THEN ASM_SIMP_TAC[LE_1] THEN
4401         REWRITE_TAC[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_POW] THEN
4402         CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
4403         FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN
4404         SIMP_TAC[GSYM REAL_NOT_LE; REAL_LE_FLOOR; INTEGER_CLOSED] THEN
4405         REWRITE_TAC[REAL_NOT_LE; REAL_MAX_LT] THEN
4406         REWRITE_TAC[REAL_ARITH `n * x < n <=> n * x < n * &1`] THEN
4407         SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LT_POW2; REAL_LT_LDIV_EQ] THEN
4408         ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_POW; REAL_OF_NUM_LT]];
4409       MATCH_MP_TAC(NORM_ARITH
4410        `!u. dist(w:real^N,u) < e / &2 /\ dist(z,u) < e / &2
4411             ==> dist(w,z) < e`) THEN
4412       EXISTS_TAC `(f:real^1->real^N)(c(&j / &2 pow n))` THEN
4413       REWRITE_TAC[dist] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4414       ASM_REWRITE_TAC[]];
4415     ALL_TAC] THEN
4416   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^1->real^N` THEN
4417   REWRITE_TAC[FORALL_IN_GSPEC; LIFT_DROP] THEN
4418   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o CONJUNCT1)) THEN
4419   FIRST_ASSUM(ASSUME_TAC o MATCH_MP UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS) THEN
4420   ONCE_REWRITE_TAC[MESON[] `h x = f(c(drop x)) <=> f(c(drop x)) = h x`] THEN
4421   REWRITE_TAC[IN_INTER; IMP_CONJ_ALT; FORALL_IN_GSPEC] THEN
4422   ASM_REWRITE_TAC[IN_UNIV; LIFT_DROP; IMP_IMP; GSYM CONJ_ASSOC] THEN
4423   REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
4424   SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN
4425   REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN
4426   REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LT] THEN
4427   REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN DISCH_TAC THEN
4428   CONJ_TAC THENL
4429    [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
4430      [MP_TAC(ISPEC `interval(vec 0:real^1,vec 1)`
4431         closure_dyadic_rationals_in_convex_set_pos_1) THEN
4432       SIMP_TAC[CONVEX_INTERVAL; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC;
4433         INTERIOR_OPEN; OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; REAL_LT_01;
4434         CLOSURE_OPEN_INTERVAL] THEN
4435       DISCH_THEN(fun th ->
4436         GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM th]) THEN
4437       MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN REPEAT CONJ_TAC THENL
4438        [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
4439           CONTINUOUS_ON_SUBSET)) THEN
4440         MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_INTERVAL] THEN
4441         MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN
4442         REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED];
4443         MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
4444         MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
4445         ASM_REWRITE_TAC[COMPACT_INTERVAL];
4446         SIMP_TAC[dyadics_in_open_unit_interval; SUBSET; FORALL_IN_IMAGE] THEN
4447         ASM_SIMP_TAC[FORALL_IN_GSPEC] THEN
4448         MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN
4449         MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1] THEN
4450         ASM_MESON_TAC[REAL_LE_TRANS]];
4451       MATCH_MP_TAC SUBSET_TRANS THEN
4452       EXISTS_TAC `closure(IMAGE (h:real^1->real^N)
4453                                  (interval (vec 0,vec 1) INTER
4454         {lift (&m / &2 pow n) | m IN (:num) /\ n IN (:num)}))` THEN
4455       CONJ_TAC THENL
4456        [ALL_TAC;
4457         MATCH_MP_TAC CLOSURE_MINIMAL THEN
4458         ASM_SIMP_TAC[COMPACT_IMP_CLOSED; COMPACT_INTERVAL;
4459                      COMPACT_CONTINUOUS_IMAGE] THEN
4460         MATCH_MP_TAC IMAGE_SUBSET THEN
4461         MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN
4462         REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED]] THEN
4463       REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE; FORALL_IN_IMAGE] THEN
4464       REWRITE_TAC[dyadics_in_open_unit_interval;
4465                   EXISTS_IN_IMAGE; EXISTS_IN_GSPEC] THEN
4466       X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN
4467       X_GEN_TAC `e:real` THEN DISCH_TAC THEN UNDISCH_TAC
4468        `(f:real^1->real^N) continuous_on interval [vec 0,vec 1]` THEN
4469       DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
4470         COMPACT_UNIFORMLY_CONTINUOUS)) THEN
4471       REWRITE_TAC[COMPACT_INTERVAL; uniformly_continuous_on] THEN
4472       DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
4473       DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
4474       SUBGOAL_THEN
4475        `!n. ~(n = 0)
4476             ==> ?m y. ODD m /\ 0 < m /\ m < 2 EXP n /\
4477                       y IN interval[a(&m / &2 pow n),b(&m / &2 pow n)] /\
4478                      (f:real^1->real^N) y = f x`
4479       MP_TAC THENL
4480        [ALL_TAC;
4481         MP_TAC(SPECL [`inv(&2)`; `min (d / &2) (&1 / &4)`]
4482          REAL_ARCH_POW_INV) THEN
4483         ASM_REWRITE_TAC[REAL_HALF; REAL_POW_INV; REAL_LT_MIN] THEN
4484         CONV_TAC REAL_RAT_REDUCE_CONV THEN
4485         DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN
4486         ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN
4487         CONV_TAC REAL_RAT_REDUCE_CONV THEN STRIP_TAC THEN
4488         DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN
4489         MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN
4490         DISCH_THEN(X_CHOOSE_THEN `y:real^1` MP_TAC) THEN
4491         REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4492         DISCH_THEN(SUBST1_TAC o SYM) THEN EXISTS_TAC `n:num` THEN
4493         ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4494         RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
4495         REWRITE_TAC[DIST_REAL; GSYM drop; IN_INTERVAL_1] THEN
4496         REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC]) THEN
4497         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
4498          `a <= y /\ y <= b
4499           ==> a <= c /\ c <= b /\ abs(a - b) < d
4500               ==> abs(c - y) < d`)) THEN
4501         REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC]) THEN
4502         MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&2 / &2 pow n` THEN
4503         ASM_SIMP_TAC[] THEN ASM_REAL_ARITH_TAC] THEN
4504       MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[NOT_SUC] THEN
4505       X_GEN_TAC `n:num` THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THENL
4506        [EXISTS_TAC `1` THEN CONV_TAC NUM_REDUCE_CONV THEN
4507         ASM_REWRITE_TAC[REAL_POW_1] THEN
4508         SUBGOAL_THEN
4509          `x IN interval[vec 0:real^1,u] \/
4510           x IN interval[u,v] \/
4511           x IN interval[v,vec 1]`
4512         STRIP_ASSUME_TAC THENL
4513          [REWRITE_TAC[IN_INTERVAL_1] THEN
4514           RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
4515           ASM_REAL_ARITH_TAC;
4516           EXISTS_TAC `u:real^1` THEN
4517           ASM_MESON_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1];
4518           EXISTS_TAC `x:real^1` THEN ASM_MESON_TAC[];
4519           EXISTS_TAC `v:real^1` THEN
4520           ASM_MESON_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1]];
4521         DISCH_THEN(X_CHOOSE_THEN `m:num`
4522          (X_CHOOSE_THEN `y:real^1` MP_TAC)) THEN
4523         REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4524         DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (SUBST1_TAC o SYM)) THEN
4525         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
4526         DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST_ALL_TAC) THEN
4527         REWRITE_TAC[ADD1] THEN DISCH_TAC THEN
4528         SUBGOAL_THEN
4529         `y IN interval[a(&(2 * j + 1) / &2 pow n):real^1,
4530                        b(&(4 * j + 1) / &2 pow (n + 1))] \/
4531          y IN interval[b(&(4 * j + 1) / &2 pow (n + 1)),
4532                        a(&(4 * j + 3) / &2 pow (n + 1))] \/
4533          y IN interval[a(&(4 * j + 3) / &2 pow (n + 1)),
4534                        b(&(2 * j + 1) / &2 pow n)]`
4535         STRIP_ASSUME_TAC THENL
4536          [REWRITE_TAC[IN_INTERVAL_1] THEN
4537           RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
4538           ASM_REAL_ARITH_TAC;
4539           EXISTS_TAC `4 * j + 1` THEN
4540           EXISTS_TAC `y:real^1` THEN
4541           REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH; EXP_ADD] THEN
4542           REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN
4543           FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
4544            `y IN interval[a,b]
4545             ==> a = a' /\ b = b' ==> y IN interval[a',b']`)) THEN
4546           ASM_MESON_TAC[LE_1];
4547           EXISTS_TAC `4 * j + 1` THEN
4548           EXISTS_TAC `b(&(4 * j + 1) / &2 pow (n + 1)):real^1` THEN
4549           REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH; EXP_ADD] THEN
4550           REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN
4551           REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN
4552           CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN
4553           FIRST_X_ASSUM(MP_TAC o SPECL
4554            [`a(&(2 * j + 1) / &2 pow n):real^1`;
4555             `b(&(2 * j + 1) / &2 pow n):real^1`;
4556             `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
4557           ANTS_TAC THENL
4558            [ASM_REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1];
4559             REPLICATE_TAC 4
4560              (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4561             DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)] THEN
4562           MATCH_MP_TAC(MESON[]
4563            `a IN s /\ b IN s ==> (!x. x IN s ==> f x = k) ==> f a = f b`) THEN
4564           SUBGOAL_THEN
4565            `leftcut (a (&(2 * j + 1) / &2 pow n))
4566                     (b (&(2 * j + 1) / &2 pow n))
4567                     (c (&(2 * j + 1) / &2 pow n):real^1):real^1 =
4568             b(&(4 * j + 1) / &2 pow (n + 1)) /\
4569             rightcut (a (&(2 * j + 1) / &2 pow n))
4570                      (b (&(2 * j + 1) / &2 pow n))
4571                      (c (&(2 * j + 1) / &2 pow n)):real^1 =
4572             a(&(4 * j + 3) / &2 pow (n + 1))`
4573           (CONJUNCTS_THEN SUBST_ALL_TAC) THENL
4574             [ASM_MESON_TAC[LE_1]; ALL_TAC] THEN
4575           REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN
4576           CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
4577           FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
4578            `y IN interval[a,b]
4579             ==> a = a' /\ b = b' ==> y IN interval[a',b']`)) THEN
4580           ASM_MESON_TAC[LE_1];
4581           EXISTS_TAC `4 * j + 3` THEN
4582           EXISTS_TAC `y:real^1` THEN
4583           REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH; EXP_ADD] THEN
4584           REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN
4585           FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
4586            `y IN interval[a,b]
4587             ==> a = a' /\ b = b' ==> y IN interval[a',b']`)) THEN
4588           ASM_MESON_TAC[LE_1]]]];
4589     ALL_TAC] THEN
4590   SUBGOAL_THEN
4591    `!n m. drop(a(&m / &2 pow n)) < drop(b(&m / &2 pow n)) /\
4592           (!x. drop(a(&m / &2 pow n)) < drop x /\
4593                drop x <= drop(b(&m / &2 pow n))
4594                ==> ~(f x = f(a(&m / &2 pow n)))) /\
4595           (!x. drop(a(&m / &2 pow n)) <= drop x /\
4596                drop x < drop(b(&m / &2 pow n))
4597                ==> ~(f x :real^N = f(b(&m / &2 pow n))))`
4598   ASSUME_TAC THENL
4599    [SUBGOAL_THEN `drop u < drop v` ASSUME_TAC THENL
4600      [ASM_REWRITE_TAC[REAL_LT_LE; DROP_EQ] THEN DISCH_THEN SUBST_ALL_TAC THEN
4601       RULE_ASSUM_TAC(REWRITE_RULE
4602        [IN_DELETE; IN_INTERVAL_1; GSYM DROP_EQ; DROP_VEC]) THEN
4603       ASM_MESON_TAC[DROP_EQ];
4604       ALL_TAC] THEN
4605     SUBGOAL_THEN
4606      `(!x. drop u < drop x /\ drop x <= drop v
4607           ==> ~((f:real^1->real^N) x = f u)) /\
4608       (!x. drop u <= drop x /\ drop x < drop v
4609            ==> ~(f x = f v))`
4610     STRIP_ASSUME_TAC THENL
4611      [SUBGOAL_THEN
4612        `(f:real^1->real^N) u = f(vec 0) /\
4613         (f:real^1->real^N) v = f(vec 1)`
4614        (CONJUNCTS_THEN SUBST1_TAC)
4615       THENL
4616        [CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4617         ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL];
4618         ALL_TAC] THEN
4619       CONJ_TAC THEN GEN_TAC THEN STRIP_TAC THEN
4620       FIRST_X_ASSUM MATCH_MP_TAC THEN
4621       ASM_REWRITE_TAC[IN_DELETE; IN_INTERVAL_1; GSYM DROP_EQ] THEN
4622       ASM_REAL_ARITH_TAC;
4623       ALL_TAC] THEN
4624     MATCH_MP_TAC num_INDUCTION THEN
4625     ASM_REWRITE_TAC[REAL_ARITH `&m / &2 pow 0 = (&2 * &m) / &2`] THEN
4626     ASM_REWRITE_TAC[REAL_OF_NUM_MUL] THEN
4627     X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "*") THEN
4628     DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THEN
4629     ASM_REWRITE_TAC[ARITH; REAL_POW_1] THEN
4630     X_GEN_TAC `j:num` THEN
4631     DISJ_CASES_TAC(ISPEC `j:num` EVEN_OR_ODD) THENL
4632      [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
4633       DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
4634       SIMP_TAC[GSYM REAL_OF_NUM_MUL; real_div; REAL_INV_MUL; real_pow] THEN
4635       ASM_REWRITE_TAC[REAL_ARITH `(&2 * p) * inv(&2) * inv q = p / q`];
4636       ALL_TAC] THEN
4637     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
4638     DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
4639     DISJ_CASES_TAC(ISPEC `k:num` EVEN_OR_ODD) THENL
4640      [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
4641       DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
4642       ASM_SIMP_TAC[ARITH_RULE `2 * 2 * m = 4 * m`; ADD1] THEN
4643       FIRST_X_ASSUM(MP_TAC o SPECL
4644        [`a(&(2 * m + 1) / &2 pow n):real^1`;
4645         `b(&(2 * m + 1) / &2 pow n):real^1`;
4646         `c(&(2 * m + 1) / &2 pow n):real^1`]) THEN
4647       ANTS_TAC THENL
4648        [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4649         ASM_MESON_TAC[REAL_LE_TRANS];
4650         REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4651         DISCH_THEN(K ALL_TAC)] THEN
4652       SUBGOAL_THEN
4653        `(f:real^1->real^N)
4654         (leftcut (a (&(2 * m + 1) / &2 pow n):real^1)
4655                  (b (&(2 * m + 1) / &2 pow n):real^1)
4656                  (c (&(2 * m + 1) / &2 pow n):real^1)) =
4657         (f:real^1->real^N) (c(&(2 * m + 1) / &2 pow n))`
4658       ASSUME_TAC THENL
4659        [FIRST_X_ASSUM MATCH_MP_TAC THEN
4660         ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN ASM_REAL_ARITH_TAC;
4661         ASM_REWRITE_TAC[]] THEN
4662       GEN_REWRITE_TAC LAND_CONV [REAL_LT_LE] THEN ASM_REWRITE_TAC[DROP_EQ] THEN
4663       REPEAT CONJ_TAC THENL
4664        [DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
4665         UNDISCH_THEN
4666          `(f:real^1->real^N) (a (&(2 * m + 1) / &2 pow n)) =
4667           f(c (&(2 * m + 1) / &2 pow n))` (MP_TAC o SYM) THEN
4668         REWRITE_TAC[] THEN
4669         FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT1 o CONJUNCT2 o SPEC_ALL) THEN
4670         REWRITE_TAC[GSYM(ASSUME `!x. midpoint ((a:real->real^1) x,b x) = c x`);
4671                     midpoint; DROP_CMUL; DROP_ADD] THEN
4672         ASM_REWRITE_TAC[REAL_ARITH
4673          `a < inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a < b`];
4674         GEN_TAC THEN STRIP_TAC THEN
4675         FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT1 o CONJUNCT2 o SPEC_ALL) THEN
4676         ASM_MESON_TAC[REAL_LE_TRANS];
4677         GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM
4678          (fun th -> MATCH_MP_TAC th THEN
4679                     REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN
4680              GEN_REWRITE_TAC I [REAL_ARITH
4681               `(a <= x /\ x <= b) /\ ~(x = b) <=> a <= x /\ x < b`]) THEN
4682         ASM_REWRITE_TAC[]];
4683        FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
4684        DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
4685        ASM_SIMP_TAC[ARITH_RULE `2 * (2 * m + 1) + 1  = 4 * m + 3`; ADD1] THEN
4686        FIRST_X_ASSUM(MP_TAC o SPECL
4687         [`a(&(2 * m + 1) / &2 pow n):real^1`;
4688          `b(&(2 * m + 1) / &2 pow n):real^1`;
4689          `c(&(2 * m + 1) / &2 pow n):real^1`]) THEN
4690       ANTS_TAC THENL
4691        [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4692         ASM_MESON_TAC[REAL_LE_TRANS];
4693         REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4694         DISCH_THEN(K ALL_TAC)] THEN
4695       SUBGOAL_THEN
4696        `(f:real^1->real^N)
4697         (rightcut (a (&(2 * m + 1) / &2 pow n):real^1)
4698                   (b (&(2 * m + 1) / &2 pow n):real^1)
4699                   (c (&(2 * m + 1) / &2 pow n):real^1)) =
4700         (f:real^1->real^N) (c(&(2 * m + 1) / &2 pow n))`
4701       ASSUME_TAC THENL
4702        [FIRST_X_ASSUM MATCH_MP_TAC THEN
4703         ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN ASM_REAL_ARITH_TAC;
4704         ASM_REWRITE_TAC[]] THEN
4705       GEN_REWRITE_TAC LAND_CONV [REAL_LT_LE] THEN ASM_REWRITE_TAC[DROP_EQ] THEN
4706       REPEAT CONJ_TAC THENL
4707        [DISCH_THEN SUBST_ALL_TAC THEN
4708         UNDISCH_THEN
4709          `(f:real^1->real^N) (b (&(2 * m + 1) / &2 pow n)) =
4710           f(c (&(2 * m + 1) / &2 pow n))` (MP_TAC o SYM) THEN
4711         REWRITE_TAC[] THEN
4712         FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2 o CONJUNCT2 o SPEC_ALL) THEN
4713         REWRITE_TAC[GSYM(ASSUME `!x. midpoint ((a:real->real^1) x,b x) = c x`);
4714                     midpoint; DROP_CMUL; DROP_ADD] THEN
4715         ASM_REWRITE_TAC[REAL_ARITH
4716          `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) < b <=> a < b`];
4717         GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM
4718          (fun th -> MATCH_MP_TAC th THEN
4719                     REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN
4720              GEN_REWRITE_TAC I [REAL_ARITH
4721               `(a <= x /\ x <= b) /\ ~(x = a) <=> a < x /\ x <= b`]) THEN
4722         ASM_REWRITE_TAC[];
4723         GEN_TAC THEN STRIP_TAC THEN
4724         FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2 o CONJUNCT2 o SPEC_ALL) THEN
4725         ASM_MESON_TAC[REAL_LE_TRANS]]];
4726     ALL_TAC] THEN
4727   SUBGOAL_THEN
4728    `!m i n j. 0 < i /\ i < 2 EXP m /\ 0 < j /\ j < 2 EXP n /\
4729               &i / &2 pow m < &j / &2 pow n
4730               ==> drop(c(&i / &2 pow m)) <= drop(c(&j / &2 pow n))`
4731   ASSUME_TAC THENL
4732    [SUBGOAL_THEN
4733      `!N m p i k.
4734          0 < i /\ i < 2 EXP m /\ 0 < k /\ k < 2 EXP p /\
4735          &i / &2 pow m < &k / &2 pow p /\ m + p = N
4736          ==> ?j n. ODD(j) /\ ~(n = 0) /\
4737                    &i / &2 pow m <= &j / &2 pow n /\
4738                    &j / &2 pow n <= &k / &2 pow p /\
4739                    abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n) /\
4740                    abs(&k / &2 pow p - &j / &2 pow n) < inv(&2 pow n)`
4741     MP_TAC THENL
4742      [MATCH_MP_TAC num_WF THEN X_GEN_TAC `N:num` THEN
4743       DISCH_THEN(LABEL_TAC "I") THEN
4744       MAP_EVERY X_GEN_TAC [`m:num`; `p:num`; `i:num`; `k:num`] THEN
4745       STRIP_TAC THEN
4746       SUBGOAL_THEN
4747        `&i / &2 pow m <= &1 / &2 pow 1 /\
4748         &1 / &2 pow 1 <= &k / &2 pow p \/
4749         &k / &2 pow p < &1 / &2 \/
4750         &1 / &2 < &i / &2 pow m`
4751        (REPEAT_TCL DISJ_CASES_THEN STRIP_ASSUME_TAC)
4752       THENL
4753        [ASM_REAL_ARITH_TAC;
4754         MAP_EVERY EXISTS_TAC [`1`; `1`] THEN ASM_REWRITE_TAC[ARITH] THEN
4755         MATCH_MP_TAC(REAL_ARITH
4756          `&0 < i /\ i <= &1 / &2 pow 1 /\ &1 / &2 pow 1 <= k /\ k < &1
4757           ==> abs(i -  &1 / &2 pow 1) < inv(&2 pow 1) /\
4758               abs(k -  &1 / &2 pow 1) < inv(&2 pow 1)`) THEN
4759         ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN
4760         REWRITE_TAC[MULT_CLAUSES; REAL_OF_NUM_POW; REAL_OF_NUM_MUL] THEN
4761         ASM_REWRITE_TAC[REAL_OF_NUM_LT];
4762         REMOVE_THEN "I" MP_TAC THEN
4763         POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
4764         SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THEN
4765         REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN
4766         REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN
4767         SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN
4768         REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN
4769         REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN
4770         STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `m + p:num`) THEN
4771         ANTS_TAC THENL [EXPAND_TAC "N" THEN ARITH_TAC; ALL_TAC] THEN
4772         DISCH_THEN(MP_TAC o SPECL [`m:num`; `p:num`; `i:num`; `k:num`]) THEN
4773         ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
4774          [MAP_EVERY UNDISCH_TAC
4775            [`&k / &2 pow SUC p < &1 / &2`;
4776             `&i / &2 pow SUC m < &k / &2 pow SUC p`] THEN
4777           REWRITE_TAC[real_div; real_pow; REAL_INV_MUL;
4778                       REAL_ARITH `x * inv(&2) * y = (x * y) * inv(&2)`] THEN
4779           SIMP_TAC[GSYM real_div; REAL_LT_DIV2_EQ; REAL_OF_NUM_LT; ARITH] THEN
4780           REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
4781            `x < y /\ y < &1 ==> x < &1 /\ y < &1`)) THEN
4782           SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN
4783           REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LT];
4784           MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `j:num` THEN
4785           DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN
4786           EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[NOT_SUC] THEN
4787           REWRITE_TAC[real_div; real_pow; REAL_INV_MUL;
4788                       REAL_ARITH `inv(&2) * y = y * inv(&2)`] THEN
4789           REWRITE_TAC[GSYM REAL_SUB_RDISTRIB; REAL_MUL_ASSOC;
4790                       REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN
4791           REWRITE_TAC[GSYM real_div; REAL_ABS_NUM] THEN
4792           ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LE_DIV2_EQ;
4793                        REAL_OF_NUM_LT; ARITH]];
4794         REMOVE_THEN "I" MP_TAC THEN
4795         POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
4796         SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THEN
4797         REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN
4798         REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN
4799         SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN
4800         REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN
4801         REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN
4802         STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `m + p:num`) THEN
4803         ANTS_TAC THENL [EXPAND_TAC "N" THEN ARITH_TAC; ALL_TAC] THEN
4804         DISCH_THEN(MP_TAC o SPECL
4805          [`m:num`; `p:num`; `i - 2 EXP m`; `k - 2 EXP p`]) THEN
4806         ASM_REWRITE_TAC[] THEN
4807         MAP_EVERY UNDISCH_TAC
4808          [`&1 / &2 < &i / &2 pow SUC m`;
4809           `&i / &2 pow SUC m < &k / &2 pow SUC p`] THEN
4810         REWRITE_TAC[real_div; real_pow; REAL_INV_MUL;
4811                     REAL_ARITH `x * inv(&2) * y = (x * y) * inv(&2)`] THEN
4812         SIMP_TAC[GSYM real_div; REAL_LT_DIV2_EQ; REAL_OF_NUM_LT; ARITH] THEN
4813         GEN_REWRITE_TAC I [IMP_IMP] THEN DISCH_THEN(fun th ->
4814           STRIP_ASSUME_TAC th THEN MP_TAC(MATCH_MP
4815            (REAL_ARITH `i < k /\ &1 < i ==> &1 < i /\ &1 < k`) th)) THEN
4816         SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN
4817         GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_OF_NUM_POW] THEN
4818         SIMP_TAC[REAL_OF_NUM_LT; GSYM REAL_OF_NUM_SUB; LT_IMP_LE] THEN
4819         STRIP_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN ANTS_TAC THENL
4820          [ASM_SIMP_TAC[ARITH_RULE `a < b ==> 0 < b - a`] THEN
4821           ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
4822           REWRITE_TAC[real_div; REAL_SUB_RDISTRIB] THEN
4823           ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN
4824           ASM_REWRITE_TAC[REAL_ARITH `u * inv v - &1 < w * inv z - &1 <=>
4825                                       u / v < w / z`] THEN
4826           CONJ_TAC THEN MATCH_MP_TAC(ARITH_RULE
4827            `i < 2 * m ==> i - m < m`) THEN
4828           ASM_REWRITE_TAC[GSYM(CONJUNCT2 EXP)];
4829           REWRITE_TAC[real_div; REAL_SUB_RDISTRIB] THEN
4830           ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN
4831           REWRITE_TAC[GSYM real_div] THEN
4832           DISCH_THEN(X_CHOOSE_THEN `j:num` (X_CHOOSE_THEN `n:num`
4833            STRIP_ASSUME_TAC)) THEN
4834           EXISTS_TAC `2 EXP n + j` THEN EXISTS_TAC `SUC n` THEN
4835           ASM_REWRITE_TAC[NOT_SUC; ODD_ADD; ODD_EXP; ARITH] THEN
4836           REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_POW] THEN
4837           REWRITE_TAC[real_div; real_pow; REAL_INV_MUL;
4838                       REAL_ARITH `inv(&2) * y = y * inv(&2)`] THEN
4839           REWRITE_TAC[GSYM REAL_SUB_RDISTRIB; REAL_MUL_ASSOC;
4840                       REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN
4841           REWRITE_TAC[GSYM real_div; REAL_ABS_NUM] THEN
4842           ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LE_DIV2_EQ;
4843                        REAL_OF_NUM_LT; ARITH] THEN
4844           REWRITE_TAC[real_div; REAL_ADD_RDISTRIB] THEN
4845           ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN
4846           REWRITE_TAC[GSYM real_div] THEN ASM_REAL_ARITH_TAC]];
4847       DISCH_THEN(fun th ->
4848        MAP_EVERY X_GEN_TAC [`m:num`; `i:num`; `p:num`; `k:num`] THEN
4849        STRIP_TAC THEN MP_TAC(ISPECL
4850         [`m + p:num`; `m:num`; `p:num`; `i:num`; `k:num`] th)) THEN
4851       ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
4852       MAP_EVERY X_GEN_TAC [`j:num`; `n:num`] THEN STRIP_TAC THEN
4853       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
4854       REWRITE_TAC[ADD1; LEFT_IMP_EXISTS_THM] THEN
4855       X_GEN_TAC `q:num` THEN DISCH_THEN SUBST_ALL_TAC THEN
4856       MATCH_MP_TAC REAL_LE_TRANS THEN
4857       EXISTS_TAC `drop(c(&(2 * q + 1) / &2 pow n))` THEN CONJ_TAC THENL
4858        [ASM_CASES_TAC `&i / &2 pow m = &(2 * q + 1) / &2 pow n` THEN
4859         ASM_REWRITE_TAC[REAL_LE_REFL] THEN
4860         SUBGOAL_THEN
4861          `drop(a(&(4 * q + 1) / &2 pow (n + 1))) <= drop(c(&i / &2 pow m)) /\
4862           drop(c(&i / &2 pow m)) <= drop(b(&(4 * q + 1) / &2 pow (n + 1)))`
4863         MP_TAC THENL
4864          [FIRST_X_ASSUM MATCH_MP_TAC THEN
4865           REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN
4866           SIMP_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL; REAL_MUL_ASSOC] THEN
4867           REWRITE_TAC[GSYM real_div; REAL_POW_1] THEN
4868           FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
4869            `abs(i - q) < n
4870             ==> i <= q /\ ~(i = q) /\ q = q' + n / &2
4871                 ==> abs(i - q') < n / &2`)) THEN
4872           ASM_REWRITE_TAC[] THEN
4873           REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
4874           REAL_ARITH_TAC;
4875           ASM_SIMP_TAC[LE_1] THEN MATCH_MP_TAC(REAL_ARITH
4876            `l <= d ==> u <= v /\ c <= l ==> c <= d`) THEN
4877           FIRST_X_ASSUM(MP_TAC o SPECL
4878            [`a(&(2 * q + 1) / &2 pow n):real^1`;
4879             `b(&(2 * q + 1) / &2 pow n):real^1`;
4880             `c(&(2 * q + 1) / &2 pow n):real^1`]) THEN
4881           ANTS_TAC THENL
4882            [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4883             ASM_MESON_TAC[REAL_LE_TRANS];
4884             DISCH_THEN(fun th -> REWRITE_TAC[th])]];
4885         ASM_CASES_TAC `&k / &2 pow p = &(2 * q + 1) / &2 pow n` THEN
4886         ASM_REWRITE_TAC[REAL_LE_REFL] THEN
4887         SUBGOAL_THEN
4888          `drop(a(&(4 * q + 3) / &2 pow (n + 1))) <= drop(c(&k / &2 pow p)) /\
4889           drop(c(&k / &2 pow p)) <= drop(b(&(4 * q + 3) / &2 pow (n + 1)))`
4890         MP_TAC THENL
4891          [FIRST_X_ASSUM MATCH_MP_TAC THEN
4892           REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN
4893           SIMP_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL; REAL_MUL_ASSOC] THEN
4894           REWRITE_TAC[GSYM real_div; REAL_POW_1] THEN
4895           FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
4896            `abs(i - q) < n
4897             ==> q <= i /\ ~(i = q) /\ q' = q +  n / &2
4898                 ==> abs(i - q') < n / &2`)) THEN
4899           ASM_REWRITE_TAC[] THEN
4900           REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
4901           REAL_ARITH_TAC;
4902           ASM_SIMP_TAC[LE_1] THEN MATCH_MP_TAC(REAL_ARITH
4903            `d <= l ==> l <= c /\ u <= v ==> d <= c`) THEN
4904           FIRST_X_ASSUM(MP_TAC o SPECL
4905            [`a(&(2 * q + 1) / &2 pow n):real^1`;
4906             `b(&(2 * q + 1) / &2 pow n):real^1`;
4907             `c(&(2 * q + 1) / &2 pow n):real^1`]) THEN
4908           ANTS_TAC THENL
4909            [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
4910             ASM_MESON_TAC[REAL_LE_TRANS];
4911             DISCH_THEN(fun th -> REWRITE_TAC[th])]]]];
4912     ALL_TAC] THEN
4913   REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN
4914   REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
4915   REWRITE_TAC[FORALL_DROP; LIFT_DROP; IN_INTERVAL_1; DROP_VEC] THEN
4916   MAP_EVERY X_GEN_TAC [`x1:real^1`; `x2:real^1`] THEN REPEAT STRIP_TAC THEN
4917   SUBGOAL_THEN
4918    `?m n. 0 < m /\ m < 2 EXP n /\
4919           drop x1 < &m / &2 pow n /\ &m / &2 pow n < drop x2 /\
4920           ~(h(x1):real^N = h(lift(&m / &2 pow n)))`
4921   STRIP_ASSUME_TAC THENL
4922    [MP_TAC(ISPEC `interval(vec 0:real^1,vec 1)`
4923         closure_dyadic_rationals_in_convex_set_pos_1) THEN
4924     SIMP_TAC[CONVEX_INTERVAL; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC;
4925             INTERIOR_OPEN; OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; REAL_LT_01;
4926             CLOSURE_OPEN_INTERVAL] THEN
4927     REWRITE_TAC[EXTENSION] THEN
4928     DISCH_THEN(MP_TAC o SPEC `inv(&2) % (x1 + x2):real^1`) THEN
4929     REWRITE_TAC[dyadics_in_open_unit_interval; IN_INTERVAL_1; DROP_VEC] THEN
4930     REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
4931     MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (q <=> p) ==> r`) THEN
4932     CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[CLOSURE_APPROACHABLE]] THEN
4933     DISCH_THEN(MP_TAC o SPEC `(drop x2 - drop x1) / &64`) THEN
4934     ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[EXISTS_IN_GSPEC]] THEN
4935     REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP; DROP_CMUL; DROP_ADD] THEN
4936     DISCH_TAC THEN
4937     SUBGOAL_THEN
4938      `?m n. (0 < m /\ m < 2 EXP n) /\
4939             abs(&m / &2 pow n - inv (&2) * (drop x1 + drop x2)) <
4940             (drop x2 - drop x1) / &64 /\
4941             inv(&2 pow n) < (drop x2 - drop x1) / &128`
4942     STRIP_ASSUME_TAC THENL
4943      [MP_TAC(ISPECL [`inv(&2)`; `min (&1 / &4) ((drop x2 - drop x1) / &128)`]
4944       REAL_ARCH_POW_INV) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
4945       DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN
4946       ASM_CASES_TAC `N = 0` THENL
4947        [ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN
4948       REWRITE_TAC[REAL_INV_POW; REAL_LT_MIN; EXISTS_IN_GSPEC] THEN
4949       STRIP_TAC THEN
4950       FIRST_X_ASSUM(X_CHOOSE_THEN `m:num` (X_CHOOSE_THEN `n:num`
4951         STRIP_ASSUME_TAC)) THEN
4952       EXISTS_TAC `2 EXP N * m` THEN EXISTS_TAC `N + n:num` THEN
4953       ASM_SIMP_TAC[EXP_ADD; LT_MULT; EXP_LT_0; LT_MULT_LCANCEL; LE_1;
4954                    ARITH_EQ] THEN
4955       CONJ_TAC THENL
4956        [REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN
4957         REWRITE_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_POW; REAL_ARITH
4958          `(N * n) * inv N * inv m:real = (N / N) * (n / m)`] THEN
4959         ASM_SIMP_TAC[REAL_DIV_REFL; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ;
4960                      REAL_MUL_LID; GSYM real_div];
4961         MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2) pow N` THEN
4962         ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN
4963         CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LE_ADD]];
4964       REWRITE_TAC[CONJ_ASSOC] THEN MATCH_MP_TAC(MESON[]
4965        `!m n m' n'. (P m n /\ P m' n') /\
4966                     (P m n /\ P m' n' ==> ~(g m n = g m' n'))
4967         ==> (?m n. P m n /\ ~(a = g m n))`) THEN
4968       MAP_EVERY EXISTS_TAC
4969        [`2 * m + 1`; `n + 1`; `4 * m + 3`; `n + 2`] THEN
4970       CONJ_TAC THENL
4971        [REWRITE_TAC[EXP_ADD] THEN CONV_TAC NUM_REDUCE_CONV THEN CONJ_TAC THEN
4972         (REWRITE_TAC[GSYM CONJ_ASSOC] THEN
4973          REPLICATE_TAC 2 (CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC])) THEN
4974         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
4975          `abs(x - inv(&2) * (x1 + x2)) < (x2 - x1) / &64
4976           ==> abs(x - y) < (x2 - x1) / &4
4977               ==> x1 < y /\ y < x2`)) THEN
4978         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
4979          `n < x / &128 ==> &0 < x /\ y < &4 * n ==> y < x / &4`)) THEN
4980         ASM_REWRITE_TAC[REAL_SUB_LT] THEN
4981         REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
4982         MATCH_MP_TAC(REAL_ARITH
4983          `a / y = x /\ abs(b / y) < z
4984           ==> abs(x - (a + b) / y) < z`) THEN
4985         ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[REAL_POW_ADD] THEN
4986         SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_MUL; REAL_ABS_POW] THEN
4987         REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN
4988         SIMP_TAC[REAL_LT_RMUL_EQ; REAL_EQ_MUL_RCANCEL; REAL_LT_INV_EQ;
4989            REAL_LT_POW2; REAL_INV_EQ_0; REAL_POW_EQ_0; ARITH_EQ;
4990            REAL_OF_NUM_EQ] THEN
4991         CONV_TAC REAL_RAT_REDUCE_CONV THEN REAL_ARITH_TAC;
4992         ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN
4993         FIRST_X_ASSUM(MP_TAC o CONJUNCT1 o SPECL [`n + 2`; `4 * m + 3`]) THEN
4994         UNDISCH_THEN `!x. midpoint ((a:real->real^1) x,b x) = c x`
4995          (fun th -> REWRITE_TAC[GSYM th] THEN
4996               ASM_SIMP_TAC[ARITH_RULE `n + 2 = (n + 1) + 1 /\ 0 < n + 1`] THEN
4997               REWRITE_TAC[th] THEN ASSUME_TAC th) THEN
4998         DISCH_TAC THEN
4999         CONV_TAC(RAND_CONV SYM_CONV) THEN
5000         FIRST_X_ASSUM(MP_TAC o SPECL
5001          [`a(&(2 * m + 1) / &2 pow (n + 1)):real^1`;
5002           `b(&(2 * m + 1) / &2 pow (n + 1)):real^1`;
5003           `c(&(2 * m + 1) / &2 pow (n + 1)):real^1`]) THEN
5004         ANTS_TAC THENL
5005          [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
5006           ASM_MESON_TAC[REAL_LE_TRANS];
5007           REPLICATE_TAC 6 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5008           DISCH_THEN(MATCH_MP_TAC o CONJUNCT1)] THEN
5009         REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN
5010         REWRITE_TAC[REAL_ARITH
5011          `(a <= b /\ b <= c) /\ ~(b = a) <=> a < b /\ b <= c`] THEN
5012         REWRITE_TAC[midpoint; DROP_CMUL; DROP_ADD] THEN
5013         ASM_REWRITE_TAC[REAL_ARITH
5014            `a < inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a < b`] THEN
5015         ASM_REWRITE_TAC[REAL_LT_LE]]];
5016     ALL_TAC] THEN
5017   SUBGOAL_THEN
5018    `IMAGE h (interval[vec 0,lift(&m / &2 pow n)]) SUBSET
5019     IMAGE (f:real^1->real^N) (interval[vec 0,c(&m / &2 pow n)]) /\
5020     IMAGE h (interval[lift(&m / &2 pow n),vec 1]) SUBSET
5021     IMAGE (f:real^1->real^N) (interval[c(&m / &2 pow n),vec 1])`
5022   MP_TAC THENL
5023    [MP_TAC(ISPEC `interval(lift(&m / &2 pow n),vec 1)`
5024       closure_dyadic_rationals_in_convex_set_pos_1) THEN
5025     MP_TAC(ISPEC `interval(vec 0,lift(&m / &2 pow n))`
5026       closure_dyadic_rationals_in_convex_set_pos_1) THEN
5027     SUBGOAL_THEN `&0 < &m / &2 pow n /\ &m / &2 pow n < &1`
5028     STRIP_ASSUME_TAC THENL
5029      [ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2; REAL_OF_NUM_LT; REAL_LT_LDIV_EQ;
5030         REAL_OF_NUM_MUL; REAL_OF_NUM_LT; REAL_OF_NUM_POW; MULT_CLAUSES];
5031       ALL_TAC] THEN
5032     MATCH_MP_TAC(TAUT
5033      `(p1 /\ p2) /\ (q1 ==> r1) /\ (q2 ==> r2)
5034       ==> (p1 ==> q1) ==> (p2 ==> q2) ==> r1 /\ r2`) THEN
5035     ASM_SIMP_TAC[CONVEX_INTERVAL; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC;
5036      INTERIOR_OPEN; OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; REAL_LT_01;
5037      CLOSURE_OPEN_INTERVAL; LIFT_DROP] THEN
5038     CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
5039     CONJ_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
5040     (MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN REPEAT CONJ_TAC THENL
5041       [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
5042          CONTINUOUS_ON_SUBSET)) THEN
5043        MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_INTERVAL] THEN
5044        MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN
5045        ASM_SIMP_TAC[SUBSET_INTERVAL_1; LIFT_DROP; REAL_LT_IMP_LE; DROP_VEC;
5046                     REAL_LE_REFL];
5047        MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
5048        MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
5049        ASM_REWRITE_TAC[COMPACT_INTERVAL] THEN
5050        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
5051          CONTINUOUS_ON_SUBSET)) THEN
5052        REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL] THEN
5053        ASM_MESON_TAC[REAL_LE_TRANS];
5054        REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
5055        MATCH_MP_TAC(SET_RULE
5056         `i SUBSET interval(vec 0,vec 1) /\
5057          (!x. x IN interval(vec 0,vec 1) INTER l ==> x IN i ==> P x)
5058          ==> !x. x IN i INTER l ==> P x`) THEN
5059        ASM_SIMP_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC;
5060                     REAL_LT_IMP_LE; REAL_LE_REFL] THEN
5061        REWRITE_TAC[dyadics_in_open_unit_interval; FORALL_IN_GSPEC] THEN
5062        MAP_EVERY X_GEN_TAC [`k:num`; `p:num`] THEN STRIP_TAC THEN
5063        REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
5064        STRIP_TAC THEN ASM_SIMP_TAC[] THEN
5065        MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1] THEN
5066        ASM_SIMP_TAC[] THEN ASM_MESON_TAC[REAL_LE_TRANS]]);
5067     DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
5068      `IMAGE h s SUBSET t /\ IMAGE h s' SUBSET t'
5069       ==> !x y. x IN s /\ y IN s' ==> h(x) IN t /\ h(y) IN t'`)) THEN
5070     DISCH_THEN(MP_TAC o SPECL [`x1:real^1`; `x2:real^1`]) THEN
5071     ASM_SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC; REAL_LT_IMP_LE] THEN
5072     DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
5073      `a IN IMAGE f s /\ a IN IMAGE f t
5074       ==> ?x y. x IN s /\ y IN t /\ f x = a /\ f y = a`)) THEN
5075     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
5076     MAP_EVERY X_GEN_TAC [`t1:real^1`; `t2:real^1`] THEN
5077     REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN
5078     FIRST_X_ASSUM(MP_TAC o SPEC `(h:real^1->real^N) x2` o
5079      GEN_REWRITE_RULE BINDER_CONV [GSYM IS_INTERVAL_CONNECTED_1]) THEN
5080     REWRITE_TAC[IS_INTERVAL_1; IN_ELIM_THM] THEN
5081     DISCH_THEN(MP_TAC o SPECL
5082      [`t1:real^1`; `t2:real^1`; `c(&m / &2 pow n):real^1`]) THEN
5083     UNDISCH_TAC `~(h x1:real^N = h(lift (&m / &2 pow n)))` THEN
5084     ASM_SIMP_TAC[] THEN MATCH_MP_TAC(TAUT `q ==> p ==> ~q ==> r`) THEN
5085     ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
5086     ASM_MESON_TAC[REAL_LE_TRANS]]);;
5087
5088 let PATH_CONTAINS_ARC = prove
5089  (`!p:real^1->real^N a b.
5090         path p /\ pathstart p = a /\ pathfinish p = b /\ ~(a = b)
5091         ==> ?q. arc q /\ path_image q SUBSET path_image p /\
5092                 pathstart q = a /\ pathfinish q = b`,
5093   REWRITE_TAC[pathstart; pathfinish; path] THEN
5094   MAP_EVERY X_GEN_TAC [`f:real^1->real^N`; `a:real^N`; `b:real^N`] THEN
5095   STRIP_TAC THEN MP_TAC(ISPECL
5096    [`\s. s SUBSET interval[vec 0,vec 1] /\
5097          vec 0 IN s /\ vec 1 IN s /\
5098          (!x y. x IN s /\ y IN s /\ segment(x,y) INTER s = {}
5099                 ==> (f:real^1->real^N)(x) = f(y))`;
5100     `interval[vec 0:real^1,vec 1]`]
5101   BROUWER_REDUCTION_THEOREM_GEN) THEN
5102   ASM_REWRITE_TAC[GSYM path_image; CLOSED_INTERVAL; SUBSET_REFL] THEN
5103   ANTS_TAC THENL
5104    [CONJ_TAC THENL
5105      [ALL_TAC;
5106       REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
5107       REPEAT GEN_TAC THEN STRIP_TAC THEN
5108       FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
5109        `s INTER i = {} ==> s SUBSET i ==> s = {}`)) THEN
5110       REWRITE_TAC[SEGMENT_EQ_EMPTY] THEN
5111       ANTS_TAC THENL [ONCE_REWRITE_TAC[segment]; MESON_TAC[]] THEN
5112       MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF i SUBSET t`) THEN
5113       ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; CONVEX_INTERVAL]] THEN
5114     X_GEN_TAC `s:num->real^1->bool` THEN
5115     REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN CONJ_TAC THENL
5116      [REWRITE_TAC[INTERS_GSPEC; SUBSET; IN_ELIM_THM; IN_UNIV] THEN
5117       ASM SET_TAC[];
5118       ALL_TAC] THEN
5119     REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
5120     REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN
5121     REWRITE_TAC[] THEN CONJ_TAC THENL
5122      [REWRITE_TAC[SEGMENT_SYM] THEN MESON_TAC[];
5123       REWRITE_TAC[FORALL_DROP; LIFT_DROP]] THEN
5124     MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
5125     REWRITE_TAC[INTERS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN
5126     SIMP_TAC[SEGMENT_1; REAL_LT_IMP_LE] THEN DISCH_TAC THEN STRIP_TAC THEN
5127     MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
5128     FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
5129         COMPACT_UNIFORMLY_CONTINUOUS)) THEN
5130     REWRITE_TAC[COMPACT_INTERVAL; uniformly_continuous_on] THEN
5131     DISCH_THEN(MP_TAC o SPEC `norm((f:real^1->real^N) x - f y) / &2`) THEN
5132     ASM_REWRITE_TAC[REAL_HALF; NORM_POS_LT; VECTOR_SUB_EQ] THEN
5133     DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
5134     SUBGOAL_THEN
5135      `?u v. u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\
5136             norm(u - x) < e /\ norm(v - y) < e /\ (f:real^1->real^N) u = f v`
5137     STRIP_ASSUME_TAC THENL
5138      [ALL_TAC;
5139       FIRST_X_ASSUM(fun th ->
5140         MP_TAC(ISPECL [`x:real^1`; `u:real^1`] th) THEN
5141         MP_TAC(ISPECL [`y:real^1`; `v:real^1`] th)) THEN
5142       ASM_REWRITE_TAC[dist] THEN
5143       ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5144       MATCH_MP_TAC(TAUT `q /\ (p ==> ~r) ==> p ==> ~(q ==> r)`) THEN
5145       CONJ_TAC THENL [ASM SET_TAC[]; CONV_TAC NORM_ARITH]] THEN
5146     SUBGOAL_THEN
5147      `?w z. w IN interval(x,y) /\ z IN interval(x,y) /\ drop w < drop z /\
5148             norm(w - x) < e /\ norm(z - y) < e`
5149     STRIP_ASSUME_TAC THENL
5150      [EXISTS_TAC `x + lift(min e (drop y - drop x) / &3)` THEN
5151       EXISTS_TAC `y - lift(min e (drop y - drop x) / &3)` THEN
5152       REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; DROP_SUB; LIFT_DROP;
5153                   NORM_REAL; GSYM drop] THEN
5154       ASM_REAL_ARITH_TAC;
5155       ALL_TAC] THEN
5156     MP_TAC(ISPECL [`interval[w:real^1,z]`;
5157                    `{s n :real^1->bool | n IN (:num)}`] COMPACT_IMP_FIP) THEN
5158     ASM_REWRITE_TAC[COMPACT_INTERVAL; FORALL_IN_GSPEC] THEN
5159     MATCH_MP_TAC(TAUT `q /\ (~p ==> r) ==> (p ==> ~q) ==> r`) THEN
5160     CONJ_TAC THENL
5161      [REWRITE_TAC[INTERS_GSPEC; IN_UNIV] THEN FIRST_X_ASSUM(MATCH_MP_TAC o
5162        MATCH_MP (SET_RULE
5163         `s INTER u = {} ==> t SUBSET s ==> t INTER u = {}`)) THEN
5164       REWRITE_TAC[SUBSET_INTERVAL_1] THEN
5165       RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
5166       ASM_REAL_ARITH_TAC;
5167       ALL_TAC] THEN
5168     REWRITE_TAC[MESON[] `~(!x. P x /\ Q x ==> R x) <=>
5169                          (?x. P x /\ Q x /\ ~R x)`] THEN
5170     ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
5171     REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN
5172     DISCH_THEN(X_CHOOSE_THEN `k:num->bool` STRIP_ASSUME_TAC) THEN
5173     FIRST_X_ASSUM(MP_TAC o SPEC `\n:num. n` o MATCH_MP
5174       UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
5175     X_GEN_TAC `n:num` THEN DISCH_TAC THEN
5176     SUBGOAL_THEN
5177      `interval[w,z] INTER (s:num->real^1->bool) n = {}`
5178     ASSUME_TAC THENL
5179      [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
5180        `a INTER t = {} ==> s SUBSET t ==> a INTER s = {}`)) THEN
5181       REWRITE_TAC[SUBSET; INTERS_IMAGE; IN_ELIM_THM] THEN
5182       REWRITE_TAC[SET_RULE
5183        `(!x. x IN s n ==> !i. i IN k ==> x IN s i) <=>
5184         (!i. i IN k ==> s n SUBSET s i)`] THEN
5185       SUBGOAL_THEN
5186        `!i n. i <= n ==> (s:num->real^1->bool) n SUBSET s i`
5187        (fun th -> ASM_MESON_TAC[th]) THEN
5188       MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN
5189       SET_TAC[];
5190       ALL_TAC] THEN
5191     SUBGOAL_THEN
5192      `?u. u IN (s:num->real^1->bool) n /\ u IN interval[x,w] /\
5193           (interval[u,w] DELETE u) INTER (s n) = {}`
5194     MP_TAC THENL
5195      [ASM_CASES_TAC `w IN (s:num->real^1->bool) n` THENL
5196        [EXISTS_TAC `w:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN
5197         REWRITE_TAC[INTERVAL_SING; SET_RULE `{a} DELETE a = {}`] THEN
5198         REWRITE_TAC[INTER_EMPTY; INTERVAL_NE_EMPTY_1] THEN
5199         RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
5200         ALL_TAC] THEN
5201       MP_TAC(ISPECL [`(s:num->real^1->bool) n INTER interval[x,w]`;
5202                    `w:real^1`] SEGMENT_TO_POINT_EXISTS) THEN
5203       ASM_SIMP_TAC[CLOSED_INTER; CLOSED_INTERVAL] THEN ANTS_TAC THENL
5204        [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^1` THEN
5205         ASM_REWRITE_TAC[IN_INTER; IN_INTERVAL_1] THEN
5206         RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
5207         MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN
5208         REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5209         FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
5210          `s INTER t INTER u = {} ==> s SUBSET u ==> s INTER t = {}`)) THEN
5211         REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THENL
5212          [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
5213           ASM_MESON_TAC[DROP_EQ; REAL_LE_ANTISYM];
5214           ANTS_TAC THENL
5215            [REWRITE_TAC[SUBSET_INTERVAL_1] THEN
5216             RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
5217             ASM_REAL_ARITH_TAC;
5218             REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN ASM SET_TAC[]]]];
5219       ALL_TAC] THEN
5220     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN STRIP_TAC THEN
5221     SUBGOAL_THEN
5222      `?v. v IN (s:num->real^1->bool) n /\ v IN interval[z,y] /\
5223           (interval[z,v] DELETE v) INTER (s n) = {}`
5224     MP_TAC THENL
5225      [ASM_CASES_TAC `z IN (s:num->real^1->bool) n` THENL
5226        [EXISTS_TAC `z:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN
5227         REWRITE_TAC[INTERVAL_SING; SET_RULE `{a} DELETE a = {}`] THEN
5228         REWRITE_TAC[INTER_EMPTY; INTERVAL_NE_EMPTY_1] THEN
5229         RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
5230         ALL_TAC] THEN
5231       MP_TAC(ISPECL [`(s:num->real^1->bool) n INTER interval[z,y]`;
5232                    `z:real^1`] SEGMENT_TO_POINT_EXISTS) THEN
5233       ASM_SIMP_TAC[CLOSED_INTER; CLOSED_INTERVAL] THEN ANTS_TAC THENL
5234        [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `y:real^1` THEN
5235         ASM_REWRITE_TAC[IN_INTER; IN_INTERVAL_1] THEN
5236         RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
5237         MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^1` THEN
5238         REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5239         FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
5240          `s INTER t INTER u = {} ==> s SUBSET u ==> s INTER t = {}`)) THEN
5241         REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THENL
5242          [ANTS_TAC THENL
5243            [REWRITE_TAC[SUBSET_INTERVAL_1] THEN
5244             RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
5245             ASM_REAL_ARITH_TAC;
5246             REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN ASM SET_TAC[]];
5247           RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
5248           ASM_MESON_TAC[DROP_EQ; REAL_LE_ANTISYM]]];
5249       ALL_TAC] THEN
5250     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^1` THEN STRIP_TAC THEN
5251     REPEAT CONJ_TAC THENL
5252      [ASM SET_TAC[];
5253       ASM SET_TAC[];
5254       RULE_ASSUM_TAC(REWRITE_RULE[NORM_REAL; GSYM drop; DROP_SUB]) THEN
5255       REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN
5256       RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
5257       RULE_ASSUM_TAC(REWRITE_RULE[NORM_REAL; GSYM drop; DROP_SUB]) THEN
5258       REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN
5259       RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
5260       FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `n:num` THEN
5261       ASM_REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THENL
5262        [MAP_EVERY UNDISCH_TAC
5263          [`interval[w,z] INTER (s:num->real^1->bool) n = {}`;
5264           `interval[u,w] DELETE u INTER (s:num->real^1->bool) n = {}`;
5265           `interval[z,v] DELETE v INTER (s:num->real^1->bool) n = {}`] THEN
5266         REWRITE_TAC[IMP_IMP; SET_RULE
5267           `s1 INTER t = {} /\ s2 INTER t = {} <=>
5268            (s1 UNION s2) INTER t = {}`] THEN
5269         MATCH_MP_TAC(SET_RULE
5270          `t SUBSET s ==> s INTER u = {} ==> t INTER u = {}`) THEN
5271         REWRITE_TAC[SUBSET; IN_UNION; IN_DELETE;
5272                     GSYM DROP_EQ; IN_INTERVAL_1] THEN
5273         ASM_REAL_ARITH_TAC;
5274         RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC]];
5275     ALL_TAC] THEN
5276   DISCH_THEN(X_CHOOSE_THEN `t:real^1->bool` STRIP_ASSUME_TAC) THEN
5277   ASM_CASES_TAC `t:real^1->bool = {}` THENL
5278    [ASM_MESON_TAC[IN_IMAGE; NOT_IN_EMPTY]; ALL_TAC] THEN
5279   ABBREV_TAC
5280    `h = \x. (f:real^1->real^N)(@y. y IN t /\ segment(x,y) INTER t = {})` THEN
5281   SUBGOAL_THEN
5282    `!x y. y IN t /\ segment(x,y) INTER t = {} ==> h(x) = (f:real^1->real^N)(y)`
5283   ASSUME_TAC THENL
5284    [SUBGOAL_THEN
5285      `!x y z. y IN t /\ segment(x,y) INTER t = {} /\
5286               z IN t /\ segment(x,z) INTER t = {}
5287               ==> (f:real^1->real^N)(y) = f(z)`
5288     ASSUME_TAC THENL
5289      [REPEAT GEN_TAC THEN ASM_CASES_TAC `(x:real^1) IN t` THENL
5290        [ASM_MESON_TAC[]; UNDISCH_TAC `~((x:real^1) IN t)`] THEN
5291       ONCE_REWRITE_TAC[TAUT `p ==> a /\ b /\ c /\ d ==> q <=>
5292                              (a /\ c) ==> p /\ b /\ d ==> q`] THEN
5293       STRIP_TAC THEN
5294       REWRITE_TAC[SET_RULE `~(x IN t) /\ s INTER t = {} /\ s' INTER t = {} <=>
5295                             (x INSERT (s UNION s')) INTER t = {}`] THEN
5296       DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN
5297       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE
5298        `s SUBSET s' ==> s' INTER t = {} ==> s INTER t = {}`) THEN
5299       REWRITE_TAC[SEGMENT_1; SUBSET; IN_UNION; IN_INSERT; IN_INTERVAL_1] THEN
5300       GEN_TAC THEN REWRITE_TAC[GSYM DROP_EQ] THEN
5301       REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN
5302       ASM_REAL_ARITH_TAC;
5303       REPEAT STRIP_TAC THEN EXPAND_TAC "h" THEN ASM_MESON_TAC[]];
5304     ALL_TAC] THEN
5305   SUBGOAL_THEN `!x. x IN t ==> h(x) = (f:real^1->real^N)(x)` ASSUME_TAC THENL
5306    [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
5307     ASM_REWRITE_TAC[SEGMENT_REFL; INTER_EMPTY];
5308     ALL_TAC] THEN
5309   SUBGOAL_THEN `!x:real^1. ?y. y IN t /\ segment(x,y) INTER t = {}`
5310   ASSUME_TAC THENL
5311    [X_GEN_TAC `x:real^1` THEN
5312     EXISTS_TAC `closest_point t (x:real^1)` THEN
5313     ASM_SIMP_TAC[SEGMENT_TO_CLOSEST_POINT; CLOSEST_POINT_EXISTS];
5314     ALL_TAC] THEN
5315   SUBGOAL_THEN
5316    `!x y. segment(x,y) INTER t = {} ==> (h:real^1->real^N) x = h y`
5317   ASSUME_TAC THENL
5318    [MAP_EVERY X_GEN_TAC [`x:real^1`; `x':real^1`] THEN
5319     ASM_CASES_TAC `(x:real^1) IN t` THENL
5320      [ASM_MESON_TAC[SEGMENT_SYM]; ALL_TAC] THEN
5321     ASM_CASES_TAC `(x':real^1) IN t` THENL
5322      [ASM_MESON_TAC[]; ALL_TAC] THEN
5323     SUBGOAL_THEN
5324      `?y y'. y IN t /\ segment(x,y) INTER t = {} /\ h x = f y /\
5325              y' IN t /\ segment(x',y') INTER t = {} /\
5326              (h:real^1->real^N) x' = f y'`
5327     STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
5328     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
5329     ASM_REWRITE_TAC[] THEN MAP_EVERY UNDISCH_TAC
5330      [`~((x:real^1) IN t)`; `~((x':real^1) IN t)`;
5331       `segment(x:real^1,y) INTER t = {}`;
5332       `segment(x':real^1,y') INTER t = {}`;
5333       `segment(x:real^1,x') INTER t = {}`] THEN
5334     MATCH_MP_TAC(SET_RULE
5335      `s SUBSET (x1 INSERT x2 INSERT (s0 UNION s1 UNION s2))
5336       ==> s0 INTER t = {} ==> s1 INTER t = {} ==> s2 INTER t = {}
5337           ==> ~(x1 IN t) ==> ~(x2 IN t) ==> s INTER t = {}`) THEN
5338     REWRITE_TAC[SEGMENT_1; SUBSET; IN_UNION; IN_INSERT; IN_INTERVAL_1] THEN
5339       GEN_TAC THEN REWRITE_TAC[GSYM DROP_EQ] THEN
5340     REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN
5341     ASM_REAL_ARITH_TAC;
5342     ALL_TAC] THEN
5343   MP_TAC(ISPEC `h:real^1->real^N` HOMEOMORPHIC_MONOTONE_IMAGE_INTERVAL) THEN
5344   ANTS_TAC THENL
5345    [REPEAT CONJ_TAC THENL
5346      [REWRITE_TAC[continuous_on] THEN X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN
5347       X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5348       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_on]) THEN
5349       DISCH_THEN(MP_TAC o SPEC `u:real^1`) THEN ASM_REWRITE_TAC[] THEN
5350       DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
5351       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN
5352       ASM_REWRITE_TAC[] THEN X_GEN_TAC `v:real^1` THEN STRIP_TAC THEN
5353       ASM_CASES_TAC `segment(u:real^1,v) INTER t = {}` THENL
5354        [ASM_MESON_TAC[DIST_REFL]; ALL_TAC] THEN
5355       SUBGOAL_THEN
5356        `(?w:real^1. w IN t /\ w IN segment[u,v] /\ segment(u,w) INTER t = {}) /\
5357         (?z:real^1. z IN t /\ z IN segment[u,v] /\ segment(v,z) INTER t = {})`
5358       STRIP_ASSUME_TAC THENL
5359        [CONJ_TAC THENL
5360          [MP_TAC(ISPECL [`segment[u:real^1,v] INTER t`; `u:real^1`]
5361             SEGMENT_TO_POINT_EXISTS);
5362           MP_TAC(ISPECL [`segment[u:real^1,v] INTER t`; `v:real^1`]
5363           SEGMENT_TO_POINT_EXISTS)] THEN
5364        (ASM_SIMP_TAC[CLOSED_INTER; CLOSED_SEGMENT] THEN ANTS_TAC THENL
5365          [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
5366             `~(segment(u,v) INTER t = {})
5367              ==> segment(u,v) SUBSET segment[u,v]
5368                  ==> ~(segment[u,v] INTER t = {})`)) THEN
5369           REWRITE_TAC[SEGMENT_OPEN_SUBSET_CLOSED];
5370           ALL_TAC] THEN
5371         MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `w:real^1` THEN
5372         SIMP_TAC[IN_INTER] THEN
5373         MATCH_MP_TAC(SET_RULE
5374          `(w IN uv ==> uw SUBSET uv)
5375           ==> (w IN uv /\ w IN t) /\ (uw INTER uv INTER t = {})
5376           ==> uw INTER t = {}`) THEN
5377         DISCH_TAC THEN REWRITE_TAC[open_segment] THEN
5378         MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF u SUBSET t`) THEN
5379         REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
5380         REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL; CONVEX_SEGMENT] THEN
5381         ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; ENDS_IN_SEGMENT]);
5382         SUBGOAL_THEN `(h:real^1->real^N) u = (f:real^1->real^N) w /\
5383                       (h:real^1->real^N) v = (f:real^1->real^N) z`
5384           (fun th -> REWRITE_TAC[th]) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
5385         MATCH_MP_TAC(NORM_ARITH
5386          `!u. dist(w:real^N,u) < e / &2 /\ dist(z,u) < e / &2
5387               ==> dist(w,z) < e`) THEN
5388         EXISTS_TAC `(f:real^1->real^N) u` THEN CONJ_TAC THEN
5389         FIRST_X_ASSUM MATCH_MP_TAC THEN
5390         (CONJ_TAC THENL
5391           [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
5392             `x IN s ==> s SUBSET t ==> x IN t`)) THEN
5393            REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
5394            ASM_REWRITE_TAC[CONVEX_INTERVAL; INSERT_SUBSET; EMPTY_SUBSET];
5395            ASM_MESON_TAC[DIST_IN_CLOSED_SEGMENT; REAL_LET_TRANS; DIST_SYM]])];
5396       X_GEN_TAC `z:real^N` THEN
5397       REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
5398       MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN
5399       REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
5400       REWRITE_TAC[connected_component] THEN
5401       EXISTS_TAC `segment[u:real^1,v]` THEN
5402       REWRITE_TAC[CONNECTED_SEGMENT; ENDS_IN_SEGMENT] THEN
5403       ASM_CASES_TAC `segment(u:real^1,v) INTER t = {}` THENL
5404        [REWRITE_TAC[SET_RULE `s SUBSET {x | x IN t /\ P x} <=>
5405                               s SUBSET t /\ !x. x IN s ==> P x`] THEN
5406         CONJ_TAC THENL
5407          [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; CONVEX_INTERVAL];
5408           X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN
5409           SUBGOAL_THEN `segment(u:real^1,x) INTER t = {}`
5410             (fun th -> ASM_MESON_TAC[th]) THEN
5411           FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
5412            `uv INTER t = {} ==> ux SUBSET uv ==> ux INTER t = {}`)) THEN
5413           UNDISCH_TAC `(x:real^1) IN segment[u,v]` THEN
5414           REWRITE_TAC[SEGMENT_1] THEN
5415           REPEAT(COND_CASES_TAC THEN
5416                  ASM_REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1]) THEN
5417           ASM_REAL_ARITH_TAC];
5418         ALL_TAC] THEN
5419       FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF segment(u:real^1,v)`) THEN
5420       ASM_REWRITE_TAC[SET_RULE `t DIFF s PSUBSET t <=> ~(s INTER t = {})`] THEN
5421       MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN
5422       REPEAT CONJ_TAC THENL
5423        [ASM SET_TAC[];
5424         MATCH_MP_TAC CLOSED_DIFF THEN ASM_REWRITE_TAC[OPEN_SEGMENT_1];
5425         ASM SET_TAC[];
5426         ASM_REWRITE_TAC[IN_DIFF] THEN MAP_EVERY UNDISCH_TAC
5427          [`(u:real^1) IN interval[vec 0,vec 1]`;
5428           `(v:real^1) IN interval[vec 0,vec 1]`] THEN
5429         REWRITE_TAC[SEGMENT_1] THEN
5430         REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN
5431         ASM_REAL_ARITH_TAC;
5432         ASM_REWRITE_TAC[IN_DIFF] THEN MAP_EVERY UNDISCH_TAC
5433          [`(u:real^1) IN interval[vec 0,vec 1]`;
5434           `(v:real^1) IN interval[vec 0,vec 1]`] THEN
5435         REWRITE_TAC[SEGMENT_1] THEN
5436         REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN
5437         ASM_REAL_ARITH_TAC;
5438         MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
5439         REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
5440         ASM_CASES_TAC `segment(x:real^1,y) INTER segment(u,v) = {}` THENL
5441          [ASM SET_TAC[]; ALL_TAC] THEN
5442         SUBGOAL_THEN
5443          `(segment(x:real^1,u) SUBSET segment(x,y) DIFF segment(u,v) /\
5444            segment(y:real^1,v) SUBSET segment(x,y) DIFF segment(u,v)) \/
5445           (segment(y:real^1,u) SUBSET segment(x,y) DIFF segment(u,v) /\
5446            segment(x:real^1,v) SUBSET segment(x,y) DIFF segment(u,v))`
5447         MP_TAC THENL
5448          [MAP_EVERY UNDISCH_TAC
5449            [`~(x IN segment(u:real^1,v))`; `~(y IN segment(u:real^1,v))`;
5450             `~(segment(x:real^1,y) INTER segment (u,v) = {})`] THEN
5451           POP_ASSUM_LIST(K ALL_TAC) THEN
5452           MAP_EVERY (fun t -> SPEC_TAC(t,t))
5453            [`v:real^1`; `u:real^1`; `y:real^1`; `x:real^1`] THEN
5454           REWRITE_TAC[FORALL_LIFT] THEN
5455           MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL
5456            [REWRITE_TAC[SEGMENT_SYM] THEN MESON_TAC[]; ALL_TAC] THEN
5457           REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN
5458           MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN DISCH_TAC THEN
5459           REWRITE_TAC[FORALL_LIFT] THEN
5460           MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL
5461            [REWRITE_TAC[SEGMENT_SYM] THEN MESON_TAC[]; ALL_TAC] THEN
5462           REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN
5463           MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN DISCH_TAC THEN
5464           ASM_REWRITE_TAC[SEGMENT_1] THEN
5465           REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
5466           REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
5467           REWRITE_TAC[IN_INTERVAL_1; SUBSET; IN_DIFF; AND_FORALL_THM] THEN
5468           ASM_REAL_ARITH_TAC;
5469           DISCH_THEN(DISJ_CASES_THEN(CONJUNCTS_THEN
5470            (let sl = SET_RULE
5471              `i SUBSET xy DIFF uv
5472               ==> xy INTER (t DIFF uv) = {} ==> i INTER t = {}` in
5473             fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP (MATCH_MP sl th))))) THEN
5474           ASM_MESON_TAC[]]];
5475       ASM_MESON_TAC[]];
5476     DISCH_TAC] THEN
5477   SUBGOAL_THEN
5478    `?q:real^1->real^N.
5479         arc q /\ path_image q SUBSET path_image f /\
5480         a IN path_image q /\ b IN path_image q`
5481   STRIP_ASSUME_TAC THENL
5482    [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
5483     REWRITE_TAC[homeomorphism] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
5484     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^1->real^N` THEN
5485     REWRITE_TAC[arc; path; path_image] THEN
5486     REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
5487      [ASM MESON_TAC[];
5488       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; path_image] THEN ASM SET_TAC[];
5489       REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 0:real^1` THEN
5490       REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[];
5491       REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 1:real^1` THEN
5492       REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[]];
5493     SUBGOAL_THEN
5494      `?u v. u IN interval[vec 0,vec 1] /\ a = (q:real^1->real^N) u /\
5495             v IN interval[vec 0,vec 1] /\ b = (q:real^1->real^N) v`
5496     STRIP_ASSUME_TAC THENL
5497      [RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN ASM SET_TAC[];
5498       ALL_TAC] THEN
5499     EXISTS_TAC `subpath u v (q:real^1->real^N)` THEN REPEAT CONJ_TAC THENL
5500      [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN
5501       ASM_MESON_TAC[ARC_IMP_SIMPLE_PATH];
5502       ASM_MESON_TAC[SUBSET_TRANS; PATH_IMAGE_SUBPATH_SUBSET; ARC_IMP_PATH];
5503       ASM_MESON_TAC[pathstart; PATHSTART_SUBPATH];
5504       ASM_MESON_TAC[pathfinish; PATHFINISH_SUBPATH]]]);;
5505
5506 let PATH_CONNECTED_ARCWISE = prove
5507  (`!s:real^N->bool.
5508         path_connected s <=>
5509         !x y. x IN s /\ y IN s /\ ~(x = y)
5510               ==> ?g. arc g /\
5511                       path_image g SUBSET s /\
5512                       pathstart g = x /\
5513                       pathfinish g = y`,
5514   GEN_TAC THEN REWRITE_TAC[path_connected] THEN EQ_TAC THEN DISCH_TAC THEN
5515   MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
5516   FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN
5517   ASM_REWRITE_TAC[] THENL
5518    [DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
5519     MP_TAC(ISPECL [`g:real^1->real^N`; `x:real^N`; `y:real^N`]
5520         PATH_CONTAINS_ARC) THEN
5521     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
5522     ASM_MESON_TAC[SUBSET_TRANS];
5523     ASM_CASES_TAC `y:real^N = x` THEN ASM_REWRITE_TAC[] THENL
5524      [EXISTS_TAC `linepath(y:real^N,y)` THEN
5525       ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH;
5526                       PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET];
5527       MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[ARC_IMP_PATH]]]);;
5528
5529 let ARC_CONNECTED_TRANS = prove
5530  (`!g h:real^1->real^N.
5531         arc g /\ arc h /\
5532         pathfinish g = pathstart h /\ ~(pathstart g = pathfinish h)
5533         ==> ?i. arc i /\
5534                 path_image i SUBSET (path_image g UNION path_image h) /\
5535                 pathstart i = pathstart g /\
5536                 pathfinish i = pathfinish h`,
5537   REPEAT STRIP_TAC THEN
5538   MP_TAC(ISPECL [`g ++ h:real^1->real^N`; `pathstart(g):real^N`;
5539                  `pathfinish(h):real^N`] PATH_CONTAINS_ARC) THEN
5540   ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATH_JOIN_EQ; ARC_IMP_PATH;
5541                PATH_IMAGE_JOIN]);;
5542
5543 (* ------------------------------------------------------------------------- *)
5544 (* Local versions of topological properties in general.                      *)
5545 (* ------------------------------------------------------------------------- *)
5546
5547 let locally = new_definition
5548  `locally P (s:real^N->bool) <=>
5549         !w x. open_in (subtopology euclidean s) w /\ x IN w
5550               ==> ?u v. open_in (subtopology euclidean s) u /\ P v /\
5551                         x IN u /\ u SUBSET v /\ v SUBSET w`;;
5552
5553 let LOCALLY_MONO = prove
5554  (`!P Q s. (!t. P t ==> Q t) /\ locally P s ==> locally Q s`,
5555   REWRITE_TAC[locally] THEN MESON_TAC[]);;
5556
5557 let LOCALLY_OPEN_SUBSET = prove
5558  (`!P s t:real^N->bool.
5559         locally P s /\ open_in (subtopology euclidean s) t
5560         ==> locally P t`,
5561   REPEAT GEN_TAC THEN REWRITE_TAC[locally] THEN STRIP_TAC THEN
5562   MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
5563   FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^N->bool`; `x:real^N`]) THEN
5564   ANTS_TAC THENL [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN
5565   REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
5566   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5567   MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN
5568   EXISTS_TAC `s:real^N->bool` THEN ASM_MESON_TAC[open_in; SUBSET]);;
5569
5570 let LOCALLY_DIFF_CLOSED = prove
5571  (`!P s t:real^N->bool.
5572         locally P s /\ closed_in (subtopology euclidean s) t
5573         ==> locally P (s DIFF t)`,
5574   REPEAT STRIP_TAC THEN
5575   MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
5576   EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
5577   MATCH_MP_TAC OPEN_IN_DIFF THEN
5578   ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; SUBSET_UNIV; TOPSPACE_EUCLIDEAN]);;
5579
5580 let LOCALLY_EMPTY = prove
5581  (`!P. locally P {}`,
5582   REWRITE_TAC[locally] THEN MESON_TAC[open_in; SUBSET; NOT_IN_EMPTY]);;
5583
5584 let LOCALLY_SING = prove
5585  (`!P a. locally P {a} <=> P {a}`,
5586   REWRITE_TAC[locally; open_in] THEN
5587   REWRITE_TAC[SET_RULE
5588    `(w SUBSET {a} /\ P) /\ x IN w <=> w = {a} /\ x = a /\ P`] THEN
5589   SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2; IN_SING] THEN
5590   REWRITE_TAC[SET_RULE
5591    `(u SUBSET {a} /\ P) /\ Q /\ a IN u /\ u SUBSET v /\ v SUBSET {a} <=>
5592     u = {a} /\ v = {a} /\ P /\ Q`] THEN
5593   REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2; IN_SING] THEN
5594   REWRITE_TAC[FORALL_UNWIND_THM2; MESON[REAL_LT_01] `?x. &0 < x`]);;
5595
5596 let LOCALLY_INTER = prove
5597  (`!P:(real^N->bool)->bool.
5598         (!s t. P s /\ P t ==> P(s INTER t))
5599         ==> !s t. locally P s /\ locally P t ==> locally P (s INTER t)`,
5600   GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
5601   REWRITE_TAC[locally; OPEN_IN_OPEN] THEN
5602   REWRITE_TAC[LEFT_AND_EXISTS_THM; GSYM CONJ_ASSOC; MESON[]
5603    `(!w x. (?t. P t /\ w = f t) /\ Q w x ==> R w x) <=>
5604     (!t x. P t /\ Q (f t) x ==> R (f t) x)`] THEN
5605   ONCE_REWRITE_TAC[MESON[]
5606    `(?a b c. P a b c /\ Q a b c /\ R a b c) <=>
5607     (?b c a. Q a b c /\ P a b c /\ R a b c)`] THEN
5608   REWRITE_TAC[AND_FORALL_THM; UNWIND_THM2; IN_INTER] THEN
5609   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `w:real^N->bool` THEN
5610   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN
5611   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
5612   ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2
5613    (X_CHOOSE_THEN `u1:real^N->bool` (X_CHOOSE_THEN `v1:real^N->bool`
5614         STRIP_ASSUME_TAC))
5615    (X_CHOOSE_THEN `u2:real^N->bool` (X_CHOOSE_THEN `v2:real^N->bool`
5616         STRIP_ASSUME_TAC))) THEN
5617   EXISTS_TAC `u1 INTER u2:real^N->bool` THEN
5618   EXISTS_TAC `v1 INTER v2:real^N->bool` THEN
5619   ASM_SIMP_TAC[OPEN_INTER] THEN ASM SET_TAC[]);;
5620
5621 let HOMEOMORPHISM_LOCALLY = prove
5622  (`!P Q f:real^N->real^M g.
5623         (!s t. homeomorphism (s,t) (f,g) ==> (P s <=> Q t))
5624         ==> (!s t. homeomorphism (s,t) (f,g)
5625                    ==> (locally P s <=> locally Q t))`,
5626
5627   let lemma = prove
5628    (`!P Q f g.
5629         (!s t. P s /\ homeomorphism (s,t) (f,g) ==> Q t)
5630         ==> (!s:real^N->bool t:real^M->bool.
5631                 locally P s /\ homeomorphism (s,t) (f,g) ==> locally Q t)`,
5632     REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
5633     REWRITE_TAC[locally] THEN STRIP_TAC THEN
5634     FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN
5635     MAP_EVERY X_GEN_TAC [`w:real^M->bool`; `y:real^M`] THEN STRIP_TAC THEN
5636     FIRST_X_ASSUM(MP_TAC o SPECL
5637      [`IMAGE (g:real^M->real^N) w`; `(g:real^M->real^N) y`]) THEN
5638     ANTS_TAC THENL
5639      [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5640       SUBGOAL_THEN `IMAGE (g:real^M->real^N) w =
5641                      {x | x IN s /\ f(x) IN w}`
5642       SUBST1_TAC THENL
5643        [RULE_ASSUM_TAC(REWRITE_RULE[open_in]) THEN ASM SET_TAC[];
5644         MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN ASM_REWRITE_TAC[]];
5645       REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
5646     MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
5647     STRIP_TAC THEN MAP_EVERY EXISTS_TAC
5648      [`IMAGE (f:real^N->real^M) u`; `IMAGE (f:real^N->real^M) v`] THEN
5649     CONJ_TAC THENL
5650      [SUBGOAL_THEN `IMAGE (f:real^N->real^M) u =
5651                      {x | x IN t /\ g(x) IN u}`
5652       SUBST1_TAC THENL
5653        [RULE_ASSUM_TAC(REWRITE_RULE[open_in]) THEN ASM SET_TAC[];
5654         MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN ASM_REWRITE_TAC[]];
5655       ALL_TAC] THEN
5656     CONJ_TAC THENL
5657      [FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `v:real^N->bool` THEN
5658       ASM_REWRITE_TAC[homeomorphism] THEN
5659       REWRITE_TAC[homeomorphism] THEN REPEAT CONJ_TAC THEN
5660       TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
5661           CONTINUOUS_ON_SUBSET)));
5662       ALL_TAC] THEN
5663     RULE_ASSUM_TAC(REWRITE_RULE[open_in]) THEN ASM SET_TAC[]) in
5664   REPEAT STRIP_TAC THEN EQ_TAC THEN
5665   MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM;
5666         TAUT `p ==> q /\ r ==> s <=> p /\ r ==> q ==> s`] lemma) THEN
5667   ASM_MESON_TAC[HOMEOMORPHISM_SYM]);;
5668
5669 let HOMEOMORPHIC_LOCALLY = prove
5670  (`!P Q. (!s:real^N->bool t:real^M->bool. s homeomorphic t ==> (P s <=> Q t))
5671          ==> (!s t. s homeomorphic t ==> (locally P s <=> locally Q t))`,
5672   REPEAT GEN_TAC THEN STRIP_TAC THEN
5673   REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM] THEN
5674   ONCE_REWRITE_TAC[MESON[]
5675    `(!a b c d. P a b c d) <=> (!c d a b. P a b c d)`] THEN
5676   GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_LOCALLY THEN
5677   ASM_MESON_TAC[homeomorphic]);;
5678
5679 let LOCALLY_TRANSLATION = prove
5680  (`!P:(real^N->bool)->bool.
5681         (!a s. P (IMAGE (\x. a + x) s) <=> P s)
5682         ==> (!a s. locally P (IMAGE (\x. a + x) s) <=> locally P s)`,
5683   GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
5684   MP_TAC(ISPECL
5685    [`P:(real^N->bool)->bool`; `P:(real^N->bool)->bool`;
5686     `\x:real^N. a + x`; `\x:real^N. --a + x`]
5687      HOMEOMORPHISM_LOCALLY) THEN
5688   REWRITE_TAC[homeomorphism] THEN
5689   SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
5690   REWRITE_TAC[FORALL_UNWIND_THM1; IMP_CONJ; GSYM IMAGE_o; o_DEF; IMAGE_ID;
5691               VECTOR_ARITH `--a + a + x:real^N = x /\ a + --a + x = x`] THEN
5692   MESON_TAC[]);;
5693
5694 let LOCALLY_INJECTIVE_LINEAR_IMAGE = prove
5695  (`!P:(real^N->bool)->bool Q:(real^M->bool)->bool.
5696         (!f s. linear f /\ (!x y. f x = f y ==> x = y)
5697                ==> (P (IMAGE f s) <=> Q s))
5698         ==>  (!f s. linear f /\ (!x y. f x = f y ==> x = y)
5699                     ==> (locally P (IMAGE f s) <=> locally Q s))`,
5700   GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
5701   ASM_CASES_TAC `linear(f:real^M->real^N) /\ (!x y. f x = f y ==> x = y)` THEN
5702   ASM_REWRITE_TAC[] THEN
5703   FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_INJECTIVE_LEFT_INVERSE) THEN
5704   REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
5705   DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN
5706   MP_TAC(ISPECL
5707    [`Q:(real^M->bool)->bool`; `P:(real^N->bool)->bool`;
5708     `f:real^M->real^N`; `g:real^N->real^M`]
5709      HOMEOMORPHISM_LOCALLY) THEN
5710   ASM_SIMP_TAC[homeomorphism; LINEAR_CONTINUOUS_ON] THEN
5711   ASM_REWRITE_TAC[FORALL_UNWIND_THM1; IMP_CONJ; FORALL_IN_IMAGE] THEN
5712   ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID] THEN MESON_TAC[]);;
5713
5714 let LOCALLY_OPEN_MAP_IMAGE = prove
5715  (`!P Q f:real^M->real^N s.
5716         f continuous_on s /\
5717         (!t. open_in (subtopology euclidean s) t
5718               ==> open_in (subtopology euclidean (IMAGE f s)) (IMAGE f t)) /\
5719         (!t. t SUBSET s /\ P t ==> Q(IMAGE f t)) /\
5720         locally P s
5721         ==> locally Q (IMAGE f s)`,
5722   REPEAT GEN_TAC THEN
5723   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5724   REWRITE_TAC[locally] THEN DISCH_TAC THEN
5725   MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `y:real^N`] THEN
5726   STRIP_TAC THEN
5727   FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
5728   FIRST_ASSUM(MP_TAC o  SPEC `w:real^N->bool` o
5729     GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN
5730   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
5731   SUBGOAL_THEN `?x. x IN s /\ (f:real^M->real^N) x = y` STRIP_ASSUME_TAC THENL
5732    [ASM SET_TAC[]; ALL_TAC] THEN
5733   FIRST_X_ASSUM(MP_TAC o SPECL
5734    [`{x | x IN s /\ (f:real^M->real^N) x IN w}`; `x:real^M`]) THEN
5735   ASM_REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
5736   MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^M->bool`] THEN
5737   STRIP_TAC THEN MAP_EVERY EXISTS_TAC
5738    [`IMAGE (f:real^M->real^N) u`; `IMAGE (f:real^M->real^N) v`] THEN
5739   ASM_SIMP_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5740   FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]);;
5741
5742 (* ------------------------------------------------------------------------- *)
5743 (* Important special cases of local connectedness & path connectedness.      *)
5744 (* ------------------------------------------------------------------------- *)
5745
5746 let LOCALLY_CONNECTED,LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT =
5747  (CONJ_PAIR o prove)
5748  (`(!s:real^N->bool.
5749         locally connected s <=>
5750         !v x. open_in (subtopology euclidean s) v /\ x IN v
5751               ==> ?u. open_in (subtopology euclidean s) u /\
5752                       connected u /\
5753                       x IN u /\ u SUBSET v) /\
5754    (!s:real^N->bool.
5755         locally connected s <=>
5756         !t x. open_in (subtopology euclidean s) t /\ x IN t
5757               ==> open_in (subtopology euclidean s)
5758                           (connected_component t x))`,
5759   REWRITE_TAC[AND_FORALL_THM; locally] THEN X_GEN_TAC `s:real^N->bool` THEN
5760   MATCH_MP_TAC(TAUT
5761    `(q ==> p) /\ (p ==> r) /\ (r ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN
5762   REPEAT CONJ_TAC THENL
5763    [MESON_TAC[SUBSET_REFL];
5764     DISCH_TAC THEN
5765     MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN
5766     ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
5767     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
5768     FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP CONNECTED_COMPONENT_EQ) THEN
5769     FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN ANTS_TAC
5770     THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN
5771     DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (X_CHOOSE_THEN `a:real^N->bool`
5772           STRIP_ASSUME_TAC)) THEN
5773     EXISTS_TAC `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
5774     MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `a:real^N->bool` THEN
5775     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
5776     ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
5777     DISCH_TAC THEN
5778     MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
5779     EXISTS_TAC `connected_component u (x:real^N)` THEN
5780     REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_CONNECTED_COMPONENT] THEN
5781     ASM_SIMP_TAC[IN; CONNECTED_COMPONENT_REFL]]);;
5782
5783 let LOCALLY_PATH_CONNECTED,LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT =
5784  (CONJ_PAIR o prove)
5785  (`(!s:real^N->bool.
5786         locally path_connected s <=>
5787         !v x. open_in (subtopology euclidean s) v /\ x IN v
5788               ==> ?u. open_in (subtopology euclidean s) u /\
5789                       path_connected u /\
5790                       x IN u /\ u SUBSET v) /\
5791    (!s:real^N->bool.
5792         locally path_connected s <=>
5793         !t x. open_in (subtopology euclidean s) t /\ x IN t
5794               ==> open_in (subtopology euclidean s)
5795                           (path_component t x))`,
5796   REWRITE_TAC[AND_FORALL_THM; locally] THEN X_GEN_TAC `s:real^N->bool` THEN
5797   MATCH_MP_TAC(TAUT
5798    `(q ==> p) /\ (p ==> r) /\ (r ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN
5799   REPEAT CONJ_TAC THENL
5800    [MESON_TAC[SUBSET_REFL];
5801     DISCH_TAC THEN
5802     MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN
5803     ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
5804     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
5805     FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP PATH_COMPONENT_EQ) THEN
5806     FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN ANTS_TAC
5807     THENL [ASM_MESON_TAC[PATH_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN
5808     DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (X_CHOOSE_THEN `a:real^N->bool`
5809           STRIP_ASSUME_TAC)) THEN
5810     EXISTS_TAC `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
5811     MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `a:real^N->bool` THEN
5812     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN
5813     ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
5814     DISCH_TAC THEN
5815     MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
5816     EXISTS_TAC `path_component u (x:real^N)` THEN
5817     REWRITE_TAC[PATH_COMPONENT_SUBSET; PATH_CONNECTED_PATH_COMPONENT] THEN
5818     ASM_SIMP_TAC[IN; PATH_COMPONENT_REFL]]);;
5819
5820 let LOCALLY_CONNECTED_OPEN_COMPONENT = prove
5821  (`!s:real^N->bool.
5822         locally connected s <=>
5823         !t c. open_in (subtopology euclidean s) t /\ c IN components t
5824               ==> open_in (subtopology euclidean s) c`,
5825   REWRITE_TAC[LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT] THEN
5826   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; components; FORALL_IN_GSPEC]);;
5827
5828 let LOCALLY_CONNECTED_IM_KLEINEN = prove
5829  (`!s:real^N->bool.
5830       locally connected s <=>
5831       !v x. open_in (subtopology euclidean s) v /\ x IN v
5832             ==> ?u. open_in (subtopology euclidean s) u /\
5833                     x IN u /\ u SUBSET v /\
5834                     !y. y IN u
5835                         ==> ?c. connected c /\ c SUBSET v /\ x IN c /\ y IN c`,
5836   GEN_TAC THEN EQ_TAC THENL
5837    [REWRITE_TAC[LOCALLY_CONNECTED] THEN MESON_TAC[SUBSET_REFL]; DISCH_TAC] THEN
5838   REWRITE_TAC[LOCALLY_CONNECTED_OPEN_COMPONENT] THEN
5839   MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `c:real^N->bool`] THEN STRIP_TAC THEN
5840   ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
5841   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
5842   FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN
5843   ANTS_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_SUBSET; SUBSET]; ALL_TAC] THEN
5844   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN
5845   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5846   REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
5847   FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN
5848   DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN
5849   SUBGOAL_THEN `(k:real^N->bool) SUBSET c` MP_TAC THENL
5850    [ALL_TAC; ASM SET_TAC[]] THEN
5851   MATCH_MP_TAC COMPONENTS_MAXIMAL THEN
5852   EXISTS_TAC `u:real^N->bool` THEN ASM SET_TAC[]);;
5853
5854 let LOCALLY_PATH_CONNECTED_IM_KLEINEN = prove
5855  (`!s:real^N->bool.
5856       locally path_connected s <=>
5857       !v x. open_in (subtopology euclidean s) v /\ x IN v
5858             ==> ?u. open_in (subtopology euclidean s) u /\
5859                     x IN u /\ u SUBSET v /\
5860                     !y. y IN u
5861                         ==> ?p. path p /\ path_image p SUBSET v /\
5862                                 pathstart p = x /\ pathfinish p = y`,
5863   GEN_TAC THEN EQ_TAC THENL
5864    [REWRITE_TAC[LOCALLY_PATH_CONNECTED] THEN
5865     REWRITE_TAC[path_connected] THEN
5866     REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
5867     MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
5868     MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN
5869     ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
5870     REWRITE_TAC[LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT] THEN DISCH_TAC THEN
5871     MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `z:real^N`] THEN STRIP_TAC THEN
5872     ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
5873     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
5874     FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN
5875     ANTS_TAC THENL [ASM_MESON_TAC[PATH_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN
5876     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN
5877     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5878     REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
5879     FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN
5880     DISCH_THEN(X_CHOOSE_THEN `p:real^1->real^N` STRIP_ASSUME_TAC) THEN
5881     SUBGOAL_THEN
5882      `(path_image p) SUBSET path_component u (z:real^N)` MP_TAC
5883     THENL [ALL_TAC; ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE; SUBSET]] THEN
5884     FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP PATH_COMPONENT_EQ) THEN
5885     MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN
5886     ASM_SIMP_TAC[PATH_CONNECTED_PATH_IMAGE] THEN
5887     ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]]);;
5888
5889 let LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED = prove
5890  (`!s:real^N->bool. locally path_connected s ==> locally connected s`,
5891   MESON_TAC[LOCALLY_MONO; PATH_CONNECTED_IMP_CONNECTED]);;
5892
5893 let LOCALLY_CONNECTED_COMPONENTS = prove
5894  (`!s c:real^N->bool.
5895         locally connected s /\ c IN components s ==> locally connected c`,
5896   REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
5897    (REWRITE_RULE[IMP_CONJ] LOCALLY_OPEN_SUBSET)) THEN
5898   FIRST_X_ASSUM(MATCH_MP_TAC o
5899    GEN_REWRITE_RULE I [LOCALLY_CONNECTED_OPEN_COMPONENT]) THEN
5900   EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[OPEN_IN_REFL]);;
5901
5902 let LOCALLY_CONNECTED_CONNECTED_COMPONENT = prove
5903  (`!s x:real^N.
5904         locally connected s
5905         ==> locally connected (connected_component s x)`,
5906   REPEAT STRIP_TAC THEN
5907   ASM_CASES_TAC `connected_component s (x:real^N) = {}` THEN
5908   ASM_REWRITE_TAC[LOCALLY_EMPTY] THEN
5909   MATCH_MP_TAC LOCALLY_CONNECTED_COMPONENTS THEN
5910   EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[IN_COMPONENTS] THEN
5911   ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]);;
5912
5913 let LOCALLY_PATH_CONNECTED_COMPONENTS = prove
5914  (`!s c:real^N->bool.
5915         locally path_connected s /\ c IN components s
5916         ==> locally path_connected c`,
5917   REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
5918    (REWRITE_RULE[IMP_CONJ] LOCALLY_OPEN_SUBSET)) THEN
5919   FIRST_X_ASSUM(MATCH_MP_TAC o
5920    GEN_REWRITE_RULE I [LOCALLY_CONNECTED_OPEN_COMPONENT] o
5921    MATCH_MP LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED) THEN
5922   EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[OPEN_IN_REFL]);;
5923
5924 let LOCALLY_PATH_CONNECTED_CONNECTED_COMPONENT = prove
5925  (`!s x:real^N.
5926         locally path_connected s
5927         ==> locally path_connected (connected_component s x)`,
5928   REPEAT STRIP_TAC THEN
5929   ASM_CASES_TAC `connected_component s (x:real^N) = {}` THEN
5930   ASM_REWRITE_TAC[LOCALLY_EMPTY] THEN
5931   MATCH_MP_TAC LOCALLY_PATH_CONNECTED_COMPONENTS THEN
5932   EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[IN_COMPONENTS] THEN
5933   ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]);;
5934
5935 let OPEN_IMP_LOCALLY_PATH_CONNECTED = prove
5936  (`!s:real^N->bool. open s ==> locally path_connected s`,
5937   REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_MONO THEN
5938   EXISTS_TAC `convex:(real^N->bool)->bool` THEN
5939   REWRITE_TAC[CONVEX_IMP_PATH_CONNECTED] THEN
5940   ASM_SIMP_TAC[locally; OPEN_IN_OPEN_EQ] THEN
5941   ASM_MESON_TAC[OPEN_CONTAINS_BALL; CENTRE_IN_BALL; OPEN_BALL; CONVEX_BALL;
5942                 SUBSET]);;
5943
5944 let OPEN_IMP_LOCALLY_CONNECTED = prove
5945  (`!s:real^N->bool. open s ==> locally connected s`,
5946   REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_MONO THEN
5947   EXISTS_TAC `path_connected:(real^N->bool)->bool` THEN
5948   ASM_SIMP_TAC[OPEN_IMP_LOCALLY_PATH_CONNECTED;
5949                PATH_CONNECTED_IMP_CONNECTED]);;
5950
5951 let LOCALLY_PATH_CONNECTED_UNIV = prove
5952  (`locally path_connected (:real^N)`,
5953   SIMP_TAC[OPEN_IMP_LOCALLY_PATH_CONNECTED; OPEN_UNIV]);;
5954
5955 let LOCALLY_CONNECTED_UNIV = prove
5956  (`locally connected (:real^N)`,
5957   SIMP_TAC[OPEN_IMP_LOCALLY_CONNECTED; OPEN_UNIV]);;
5958
5959 let OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED = prove
5960  (`!s x:real^N.
5961         locally connected s
5962         ==> open_in (subtopology euclidean s) (connected_component s x)`,
5963   REWRITE_TAC[LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT] THEN
5964   REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THENL
5965    [FIRST_X_ASSUM MATCH_MP_TAC THEN
5966     ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; SUBSET_UNIV; TOPSPACE_EUCLIDEAN];
5967     ASM_MESON_TAC[OPEN_IN_EMPTY; CONNECTED_COMPONENT_EQ_EMPTY]]);;
5968
5969 let OPEN_IN_COMPONENTS_LOCALLY_CONNECTED = prove
5970  (`!s c:real^N->bool.
5971         locally connected s /\ c IN components s
5972         ==> open_in (subtopology euclidean s) c`,
5973   MESON_TAC[LOCALLY_CONNECTED_OPEN_COMPONENT; OPEN_IN_REFL]);;
5974
5975 let OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED = prove
5976  (`!s x:real^N.
5977         locally path_connected s
5978         ==> open_in (subtopology euclidean s) (path_component s x)`,
5979   REWRITE_TAC[LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT] THEN
5980   REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THENL
5981    [FIRST_X_ASSUM MATCH_MP_TAC THEN
5982     ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; SUBSET_UNIV; TOPSPACE_EUCLIDEAN];
5983     ASM_MESON_TAC[OPEN_IN_EMPTY; PATH_COMPONENT_EQ_EMPTY]]);;
5984
5985 let CLOSED_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED = prove
5986  (`!s x:real^N.
5987         locally path_connected s
5988         ==> closed_in (subtopology euclidean s) (path_component s x)`,
5989   REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY;
5990               PATH_COMPONENT_SUBSET] THEN
5991   REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEMENT_PATH_COMPONENT_UNIONS] THEN
5992   MATCH_MP_TAC OPEN_IN_UNIONS THEN
5993   REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC; IN_DELETE] THEN
5994   ASM_SIMP_TAC[OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED]);;
5995
5996 let CONVEX_IMP_LOCALLY_PATH_CONNECTED = prove
5997  (`!s:real^N->bool. convex s ==> locally path_connected s`,
5998   REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_PATH_CONNECTED] THEN
5999   MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
6000   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
6001   DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
6002   FIRST_X_ASSUM SUBST_ALL_TAC THEN
6003   RULE_ASSUM_TAC(REWRITE_RULE[IN_INTER]) THEN
6004   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN
6005   DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
6006   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6007   EXISTS_TAC `s INTER ball(x:real^N,e)` THEN REPEAT CONJ_TAC THENL
6008    [REWRITE_TAC[OPEN_IN_OPEN] THEN MESON_TAC[OPEN_BALL];
6009     MATCH_MP_TAC CONVEX_IMP_PATH_CONNECTED THEN
6010     ASM_SIMP_TAC[CONVEX_INTER; CONVEX_BALL];
6011     ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL];
6012     ASM SET_TAC[]]);;
6013
6014 let OPEN_IN_CONNECTED_COMPONENTS = prove
6015  (`!s c:real^N->bool.
6016         FINITE(components s) /\ c IN components s
6017         ==> open_in (subtopology euclidean s) c`,
6018   REWRITE_TAC[components; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN
6019   SIMP_TAC[OPEN_IN_CONNECTED_COMPONENT]);;
6020
6021 let FINITE_LOCALLY_CONNECTED_CONNECTED_COMPONENTS = prove
6022  (`!s:real^N->bool.
6023         compact s /\ locally connected s
6024         ==> FINITE {connected_component s x |x|  x IN s}`,
6025   REPEAT STRIP_TAC THEN
6026   FIRST_X_ASSUM(MP_TAC o SPEC `{connected_component s (x:real^N) |x| x IN s}` o
6027     GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN
6028   ASM_SIMP_TAC[OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED; FORALL_IN_GSPEC;
6029                UNIONS_CONNECTED_COMPONENT; SUBSET_REFL] THEN
6030   DISCH_THEN(X_CHOOSE_THEN `cs:(real^N->bool)->bool` MP_TAC) THEN
6031   ASM_CASES_TAC `{connected_component s (x:real^N) |x| x IN s} = cs` THEN
6032   ASM_SIMP_TAC[] THEN
6033   MATCH_MP_TAC(TAUT `(p ==> ~r) ==> p /\ q /\ r ==> s`) THEN DISCH_TAC THEN
6034   SUBGOAL_THEN
6035    `?x:real^N. x IN s /\ ~(connected_component s x IN cs)`
6036   MP_TAC THENL [ASM SET_TAC[]; SIMP_TAC[SUBSET; NOT_FORALL_THM]] THEN
6037   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN
6038   REWRITE_TAC[NOT_IMP] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6039   SUBGOAL_THEN `?y:real^N. y IN s /\ x IN connected_component s y /\
6040                            connected_component s y IN cs`
6041   STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
6042   FIRST_ASSUM(MP_TAC o MATCH_MP CONNECTED_COMPONENT_EQ) THEN
6043   ASM_MESON_TAC[]);;
6044
6045 let FINITE_LOCALLY_PATH_CONNECTED_PATH_COMPONENTS = prove
6046  (`!s:real^N->bool.
6047         compact s /\ locally path_connected s
6048         ==> FINITE {path_component s x |x|  x IN s}`,
6049   REPEAT STRIP_TAC THEN
6050   FIRST_X_ASSUM(MP_TAC o SPEC `{path_component s (x:real^N) |x| x IN s}` o
6051     GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN
6052   ASM_SIMP_TAC[OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED; FORALL_IN_GSPEC;
6053                UNIONS_PATH_COMPONENT; SUBSET_REFL] THEN
6054   DISCH_THEN(X_CHOOSE_THEN `cs:(real^N->bool)->bool` MP_TAC) THEN
6055   ASM_CASES_TAC `{path_component s (x:real^N) |x| x IN s} = cs` THEN
6056   ASM_SIMP_TAC[] THEN
6057   MATCH_MP_TAC(TAUT `(p ==> ~r) ==> p /\ q /\ r ==> s`) THEN DISCH_TAC THEN
6058   SUBGOAL_THEN
6059    `?x:real^N. x IN s /\ ~(path_component s x IN cs)`
6060   MP_TAC THENL [ASM SET_TAC[]; SIMP_TAC[SUBSET; NOT_FORALL_THM]] THEN
6061
6062   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN
6063   REWRITE_TAC[NOT_IMP] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6064   SUBGOAL_THEN `?y:real^N. y IN s /\ x IN path_component s y /\
6065                            path_component s y IN cs`
6066   STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
6067   FIRST_ASSUM(MP_TAC o MATCH_MP PATH_COMPONENT_EQ) THEN
6068   ASM_MESON_TAC[]);;
6069
6070 let FINITE_COMPONENTS = prove
6071  (`!s:real^N->bool. compact s /\ locally connected s ==> FINITE(components s)`,
6072   REWRITE_TAC[components; FINITE_LOCALLY_CONNECTED_CONNECTED_COMPONENTS]);;
6073
6074 let CONVEX_IMP_LOCALLY_CONNECTED = prove
6075  (`!s:real^N->bool. convex s ==> locally connected s`,
6076   MESON_TAC[CONVEX_IMP_LOCALLY_PATH_CONNECTED;
6077             LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);;
6078
6079 let HOMEOMORPHIC_LOCAL_CONNECTEDNESS = prove
6080  (`!s t. s homeomorphic t ==> (locally connected s <=> locally connected t)`,
6081   MATCH_MP_TAC HOMEOMORPHIC_LOCALLY THEN
6082   REWRITE_TAC[HOMEOMORPHIC_CONNECTEDNESS]);;
6083
6084 let HOMEOMORPHIC_LOCAL_PATH_CONNECTEDNESS = prove
6085  (`!s t. s homeomorphic t
6086          ==> (locally path_connected s <=> locally path_connected t)`,
6087   MATCH_MP_TAC HOMEOMORPHIC_LOCALLY THEN
6088   REWRITE_TAC[HOMEOMORPHIC_PATH_CONNECTEDNESS]);;
6089
6090 let LOCALLY_PATH_CONNECTED_TRANSLATION_EQ = prove
6091  (`!a:real^N s. locally path_connected (IMAGE (\x. a + x) s) <=>
6092                 locally path_connected s`,
6093   MATCH_MP_TAC LOCALLY_TRANSLATION THEN
6094   REWRITE_TAC[PATH_CONNECTED_TRANSLATION_EQ]);;
6095
6096 add_translation_invariants [LOCALLY_PATH_CONNECTED_TRANSLATION_EQ];;
6097
6098 let LOCALLY_CONNECTED_TRANSLATION_EQ = prove
6099  (`!a:real^N s. locally connected (IMAGE (\x. a + x) s) <=>
6100                 locally connected s`,
6101   MATCH_MP_TAC LOCALLY_TRANSLATION THEN
6102   REWRITE_TAC[CONNECTED_TRANSLATION_EQ]);;
6103
6104 add_translation_invariants [LOCALLY_CONNECTED_TRANSLATION_EQ];;
6105
6106 let LOCALLY_PATH_CONNECTED_LINEAR_IMAGE_EQ = prove
6107  (`!f:real^M->real^N s.
6108         linear f /\ (!x y. f x = f y ==> x = y)
6109         ==> (locally path_connected (IMAGE f s) <=> locally path_connected s)`,
6110   MATCH_MP_TAC LOCALLY_INJECTIVE_LINEAR_IMAGE THEN
6111   REWRITE_TAC[PATH_CONNECTED_LINEAR_IMAGE_EQ]);;
6112
6113 add_linear_invariants [LOCALLY_PATH_CONNECTED_LINEAR_IMAGE_EQ];;
6114
6115 let LOCALLY_CONNECTED_LINEAR_IMAGE_EQ = prove
6116  (`!f:real^M->real^N s.
6117         linear f /\ (!x y. f x = f y ==> x = y)
6118         ==> (locally connected (IMAGE f s) <=> locally connected s)`,
6119   MATCH_MP_TAC LOCALLY_INJECTIVE_LINEAR_IMAGE THEN
6120   REWRITE_TAC[CONNECTED_LINEAR_IMAGE_EQ]);;
6121
6122 add_linear_invariants [LOCALLY_CONNECTED_LINEAR_IMAGE_EQ];;
6123
6124 let LOCALLY_CONNECTED_QUOTIENT_IMAGE = prove
6125  (`!f:real^M->real^N s.
6126       (!t. t SUBSET IMAGE f s
6127            ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=>
6128                 open_in (subtopology euclidean (IMAGE f s)) t)) /\
6129       locally connected s
6130       ==> locally connected (IMAGE f s)`,
6131   REPEAT STRIP_TAC THEN
6132   REWRITE_TAC[LOCALLY_CONNECTED_OPEN_COMPONENT] THEN
6133   MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `c:real^N->bool`] THEN
6134   STRIP_TAC THEN
6135   FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
6136   FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
6137   FIRST_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN
6138   ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN
6139   ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `x:real^M` THEN
6140   REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN EXISTS_TAC
6141    `connected_component {w | w IN s /\ (f:real^M->real^N)(w) IN u} x` THEN
6142   REPEAT CONJ_TAC THENL
6143    [FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN
6144     ANTS_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN
6145     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
6146      [LOCALLY_CONNECTED_OPEN_COMPONENT]) THEN
6147     REWRITE_TAC[IMP_CONJ_ALT] THEN DISCH_THEN MATCH_MP_TAC THEN
6148     REWRITE_TAC[IN_COMPONENTS; IN_ELIM_THM] THEN ASM SET_TAC[];
6149     ALL_TAC;
6150     ASSUME_TAC(ISPECL [`{w | w IN s /\ (f:real^M->real^N) w IN u}`; `x:real^M`]
6151         CONNECTED_COMPONENT_SUBSET) THEN
6152     SUBGOAL_THEN
6153      `IMAGE (f:real^M->real^N) (connected_component {w | w IN s /\ f w IN u} x)
6154       SUBSET c`
6155     MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
6156     MATCH_MP_TAC COMPONENTS_MAXIMAL THEN EXISTS_TAC `u:real^N->bool` THEN
6157     ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
6158      [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
6159       REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN
6160       MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN
6161       CONJ_TAC THENL
6162        [REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN ASM_MESON_TAC[open_in];
6163         ASM SET_TAC[]];
6164       ASM SET_TAC[];
6165       REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
6166       EXISTS_TAC `(f:real^M->real^N) x` THEN ASM_REWRITE_TAC[] THEN
6167       MATCH_MP_TAC FUN_IN_IMAGE]] THEN
6168   GEN_REWRITE_TAC I [IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
6169   ASM SET_TAC[]);;
6170
6171 let LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE = prove
6172  (`!f:real^M->real^N s.
6173       (!t. t SUBSET IMAGE f s
6174            ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=>
6175                 open_in (subtopology euclidean (IMAGE f s)) t)) /\
6176       locally path_connected s
6177       ==> locally path_connected (IMAGE f s)`,
6178   REPEAT STRIP_TAC THEN
6179   REWRITE_TAC[LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT] THEN
6180   MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `y:real^N`] THEN
6181   STRIP_TAC THEN
6182   ASSUME_TAC(ISPECL [`u:real^N->bool`; `y:real^N`] PATH_COMPONENT_SUBSET) THEN
6183   FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
6184   FIRST_ASSUM(MP_TAC o SPEC `path_component u (y:real^N)`) THEN
6185   ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN
6186   ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `x:real^M` THEN
6187   REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN EXISTS_TAC
6188    `path_component {w | w IN s /\ (f:real^M->real^N)(w) IN u} x` THEN
6189   REPEAT CONJ_TAC THENL
6190    [FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN
6191     ANTS_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN
6192     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
6193      [LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT]) THEN
6194     REWRITE_TAC[IMP_CONJ_ALT] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[];
6195     ALL_TAC;
6196     ASSUME_TAC(ISPECL [`{w | w IN s /\ (f:real^M->real^N) w IN u}`; `x:real^M`]
6197         PATH_COMPONENT_SUBSET) THEN
6198     SUBGOAL_THEN
6199      `IMAGE (f:real^M->real^N) (path_component {w | w IN s /\ f w IN u} x)
6200       SUBSET path_component u y`
6201     MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
6202     FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP PATH_COMPONENT_EQ) THEN
6203     MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN
6204     ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
6205      [MATCH_MP_TAC FUN_IN_IMAGE;
6206       MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN
6207       REWRITE_TAC[PATH_CONNECTED_PATH_COMPONENT] THEN
6208       MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN
6209       CONJ_TAC THENL
6210        [REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN ASM_MESON_TAC[open_in];
6211         ASM SET_TAC[]];
6212       ASM SET_TAC[]]] THEN
6213   GEN_REWRITE_TAC I [IN] THEN REWRITE_TAC[PATH_COMPONENT_REFL_EQ] THEN
6214   ASM SET_TAC[]);;
6215
6216 let LOCALLY_CONNECTED_CONTINUOUS_IMAGE_COMPACT = prove
6217  (`!f:real^M->real^N s.
6218         locally connected s /\ compact s /\ f continuous_on s
6219         ==> locally connected (IMAGE f s)`,
6220   REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_CONNECTED_QUOTIENT_IMAGE THEN
6221   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_MAP_IMP_QUOTIENT_MAP THEN
6222   ASM_SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED;
6223                COMPACT_CONTINUOUS_IMAGE; IMAGE_SUBSET] THEN
6224   ASM_MESON_TAC[COMPACT_IMP_CLOSED; COMPACT_CONTINUOUS_IMAGE;
6225     CONTINUOUS_ON_SUBSET; BOUNDED_SUBSET; COMPACT_EQ_BOUNDED_CLOSED]);;
6226
6227 let LOCALLY_PATH_CONNECTED_CONTINUOUS_IMAGE_COMPACT = prove
6228  (`!f:real^M->real^N s.
6229         locally path_connected s /\ compact s /\ f continuous_on s
6230         ==> locally path_connected (IMAGE f s)`,
6231   REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE THEN
6232   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_MAP_IMP_QUOTIENT_MAP THEN
6233   ASM_SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED;
6234                COMPACT_CONTINUOUS_IMAGE; IMAGE_SUBSET] THEN
6235   ASM_MESON_TAC[COMPACT_IMP_CLOSED; COMPACT_CONTINUOUS_IMAGE;
6236     CONTINUOUS_ON_SUBSET; BOUNDED_SUBSET; COMPACT_EQ_BOUNDED_CLOSED]);;
6237
6238 let LOCALLY_PATH_CONNECTED_PATH_IMAGE = prove
6239  (`!p:real^1->real^N. path p ==> locally path_connected (path_image p)`,
6240   REWRITE_TAC[path; path_image] THEN REPEAT STRIP_TAC THEN
6241   MATCH_MP_TAC LOCALLY_PATH_CONNECTED_CONTINUOUS_IMAGE_COMPACT THEN
6242   ASM_SIMP_TAC[COMPACT_INTERVAL; CONVEX_INTERVAL;
6243                CONVEX_IMP_LOCALLY_PATH_CONNECTED]);;
6244
6245 let LOCALLY_CONNECTED_PATH_IMAGE = prove
6246  (`!p:real^1->real^N. path p ==> locally connected (path_image p)`,
6247   SIMP_TAC[LOCALLY_PATH_CONNECTED_PATH_IMAGE;
6248            LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);;
6249
6250 let LOCALLY_CONNECTED_LEFT_INVERTIBLE_IMAGE = prove
6251  (`!f:real^M->real^N g s.
6252         f continuous_on s /\ g continuous_on (IMAGE f s) /\
6253         (!x. x IN s ==> g(f x) = x) /\
6254         locally connected s
6255         ==> locally connected (IMAGE f s)`,
6256   REPEAT GEN_TAC THEN
6257   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
6258   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_CONNECTED_QUOTIENT_IMAGE) THEN
6259   MATCH_MP_TAC CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP THEN ASM_MESON_TAC[]);;
6260
6261 let LOCALLY_CONNECTED_RIGHT_INVERTIBLE_IMAGE = prove
6262  (`!f:real^M->real^N g s.
6263         f continuous_on s /\ g continuous_on (IMAGE f s) /\
6264         IMAGE g (IMAGE f s) SUBSET s /\ (!x. x IN IMAGE f s ==> f(g x) = x) /\
6265         locally connected s
6266         ==> locally connected (IMAGE f s)`,
6267   REPEAT GEN_TAC THEN
6268   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
6269   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_CONNECTED_QUOTIENT_IMAGE) THEN
6270   MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN
6271   EXISTS_TAC `g:real^N->real^M` THEN ASM SET_TAC[]);;
6272
6273 let LOCALLY_PATH_CONNECTED_LEFT_INVERTIBLE_IMAGE = prove
6274  (`!f:real^M->real^N g s.
6275         f continuous_on s /\ g continuous_on (IMAGE f s) /\
6276         (!x. x IN s ==> g(f x) = x) /\
6277         locally path_connected s
6278         ==> locally path_connected (IMAGE f s)`,
6279   REPEAT GEN_TAC THEN
6280   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
6281   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ]
6282     LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE) THEN
6283   MATCH_MP_TAC CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP THEN ASM_MESON_TAC[]);;
6284
6285 let LOCALLY_PATH_CONNECTED_RIGHT_INVERTIBLE_IMAGE = prove
6286  (`!f:real^M->real^N g s.
6287         f continuous_on s /\ g continuous_on (IMAGE f s) /\
6288         IMAGE g (IMAGE f s) SUBSET s /\ (!x. x IN IMAGE f s ==> f(g x) = x) /\
6289         locally path_connected s
6290         ==> locally path_connected (IMAGE f s)`,
6291   REPEAT GEN_TAC THEN
6292   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
6293   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ]
6294     LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE) THEN
6295   MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN
6296   EXISTS_TAC `g:real^N->real^M` THEN ASM SET_TAC[]);;
6297
6298 let LOCALLY_PCROSS = prove
6299  (`!P Q R.
6300         (!s:real^M->bool t:real^N->bool. P s /\ Q t ==> R(s PCROSS t))
6301         ==> (!s t. locally P s /\ locally Q t ==> locally R (s PCROSS t))`,
6302   REPEAT STRIP_TAC THEN REWRITE_TAC[locally; FORALL_PASTECART] THEN
6303   MAP_EVERY X_GEN_TAC
6304    [`w:real^(M,N)finite_sum->bool`; `x:real^M`; `y:real^N`] THEN
6305   DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN
6306    MP_TAC(MATCH_MP PASTECART_IN_INTERIOR_SUBTOPOLOGY
6307         (ONCE_REWRITE_RULE[CONJ_SYM] th))) THEN
6308   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6309   MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^N->bool`] THEN
6310   STRIP_TAC THEN
6311   FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^M->bool`; `x:real^M`] o
6312     GEN_REWRITE_RULE I [locally]) THEN
6313   FIRST_X_ASSUM(MP_TAC o SPECL [`v:real^N->bool`; `y:real^N`] o
6314     GEN_REWRITE_RULE I [locally]) THEN
6315   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6316   MAP_EVERY X_GEN_TAC [`v':real^N->bool`; `v'':real^N->bool`] THEN
6317   STRIP_TAC THEN
6318   MAP_EVERY X_GEN_TAC [`u':real^M->bool`; `u'':real^M->bool`] THEN
6319   STRIP_TAC THEN
6320   EXISTS_TAC `(u':real^M->bool) PCROSS (v':real^N->bool)` THEN
6321   EXISTS_TAC `(u'':real^M->bool) PCROSS (v'':real^N->bool)` THEN
6322   ASM_SIMP_TAC[PASTECART_IN_PCROSS; PCROSS_MONO; OPEN_IN_PCROSS] THEN
6323   ASM_MESON_TAC[PCROSS_MONO; SUBSET_TRANS]);;
6324
6325 let LOCALLY_CONNECTED_PCROSS = prove
6326  (`!s:real^M->bool t:real^N->bool.
6327         locally connected s /\ locally connected t
6328         ==> locally connected (s PCROSS t)`,
6329   MATCH_MP_TAC LOCALLY_PCROSS THEN REWRITE_TAC[CONNECTED_PCROSS]);;
6330
6331 let LOCALLY_PATH_CONNECTED_PCROSS = prove
6332  (`!s:real^M->bool t:real^N->bool.
6333         locally path_connected s /\ locally path_connected t
6334         ==> locally path_connected (s PCROSS t)`,
6335   MATCH_MP_TAC LOCALLY_PCROSS THEN REWRITE_TAC[PATH_CONNECTED_PCROSS]);;
6336
6337 let LOCALLY_CONNECTED_PCROSS_EQ = prove
6338  (`!s:real^M->bool t:real^N->bool.
6339         locally connected (s PCROSS t) <=>
6340         s = {} \/ t = {} \/ locally connected s /\ locally connected t`,
6341   REPEAT STRIP_TAC THEN
6342   ASM_CASES_TAC `s:real^M->bool = {}` THEN
6343   ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN
6344   ASM_CASES_TAC `t:real^N->bool = {}` THEN
6345   ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN
6346   EQ_TAC THEN REWRITE_TAC[LOCALLY_CONNECTED_PCROSS] THEN
6347   GEN_REWRITE_TAC LAND_CONV [LOCALLY_CONNECTED] THEN DISCH_TAC THEN
6348   REWRITE_TAC[LOCALLY_CONNECTED_IM_KLEINEN] THEN CONJ_TAC THENL
6349    [MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `x:real^M`] THEN STRIP_TAC THEN
6350     UNDISCH_TAC `~(t:real^N->bool = {})` THEN
6351     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
6352     DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN
6353     FIRST_X_ASSUM(MP_TAC o SPECL
6354      [`(u:real^M->bool) PCROSS (t:real^N->bool)`;
6355       `pastecart (x:real^M) (y:real^N)`]);
6356     MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN
6357     UNDISCH_TAC `~(s:real^M->bool = {})` THEN
6358     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
6359     DISCH_THEN(X_CHOOSE_TAC `x:real^M`) THEN
6360     FIRST_X_ASSUM(MP_TAC o SPECL
6361      [`(s:real^M->bool) PCROSS (v:real^N->bool)`;
6362       `pastecart (x:real^M) (y:real^N)`])] THEN
6363   ASM_SIMP_TAC[OPEN_IN_PCROSS_EQ; PASTECART_IN_PCROSS; SUBSET_UNIV;
6364     OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; LEFT_IMP_EXISTS_THM] THEN
6365   X_GEN_TAC `w:real^(M,N)finite_sum->bool` THEN STRIP_TAC THEN
6366   MP_TAC(ISPECL
6367    [`s:real^M->bool`; `t:real^N->bool`; `w:real^(M,N)finite_sum->bool`;
6368     `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN
6369   ASM_REWRITE_TAC[] THENL
6370    [MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u':real^M->bool` THEN
6371     DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
6372     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6373      [ALL_TAC;
6374       X_GEN_TAC `z:real^M` THEN DISCH_TAC THEN
6375       EXISTS_TAC `IMAGE fstcart (w:real^(M,N)finite_sum->bool)` THEN
6376       ASM_SIMP_TAC[CONNECTED_LINEAR_IMAGE; LINEAR_FSTCART] THEN
6377       REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART]];
6378     DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` MP_TAC) THEN
6379     MATCH_MP_TAC MONO_EXISTS THEN
6380     X_GEN_TAC `v':real^N->bool` THEN STRIP_TAC THEN
6381     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6382      [ALL_TAC;
6383       X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN
6384       EXISTS_TAC `IMAGE sndcart (w:real^(M,N)finite_sum->bool)` THEN
6385       ASM_SIMP_TAC[CONNECTED_LINEAR_IMAGE; LINEAR_SNDCART] THEN
6386       REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; SNDCART_PASTECART]]] THEN
6387   RULE_ASSUM_TAC(REWRITE_RULE
6388    [SUBSET; FORALL_IN_PCROSS; PASTECART_IN_PCROSS; FORALL_PASTECART]) THEN
6389   ASM SET_TAC[]);;
6390
6391 let LOCALLY_PATH_CONNECTED_PCROSS_EQ = prove
6392  (`!s:real^M->bool t:real^N->bool.
6393         locally path_connected (s PCROSS t) <=>
6394         s = {} \/ t = {} \/
6395         locally path_connected s /\ locally path_connected t`,
6396   REPEAT STRIP_TAC THEN
6397   ASM_CASES_TAC `s:real^M->bool = {}` THEN
6398   ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN
6399   ASM_CASES_TAC `t:real^N->bool = {}` THEN
6400   ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN
6401   EQ_TAC THEN REWRITE_TAC[LOCALLY_PATH_CONNECTED_PCROSS] THEN
6402   GEN_REWRITE_TAC LAND_CONV [LOCALLY_PATH_CONNECTED] THEN DISCH_TAC THEN
6403   REWRITE_TAC[LOCALLY_PATH_CONNECTED_IM_KLEINEN] THEN CONJ_TAC THENL
6404    [MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `x:real^M`] THEN STRIP_TAC THEN
6405     UNDISCH_TAC `~(t:real^N->bool = {})` THEN
6406     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
6407     DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN
6408     FIRST_X_ASSUM(MP_TAC o SPECL
6409      [`(u:real^M->bool) PCROSS (t:real^N->bool)`;
6410       `pastecart (x:real^M) (y:real^N)`]);
6411     MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN
6412     UNDISCH_TAC `~(s:real^M->bool = {})` THEN
6413     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
6414     DISCH_THEN(X_CHOOSE_TAC `x:real^M`) THEN
6415     FIRST_X_ASSUM(MP_TAC o SPECL
6416      [`(s:real^M->bool) PCROSS (v:real^N->bool)`;
6417       `pastecart (x:real^M) (y:real^N)`])] THEN
6418   ASM_SIMP_TAC[OPEN_IN_PCROSS_EQ; PASTECART_IN_PCROSS; SUBSET_UNIV;
6419     OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; LEFT_IMP_EXISTS_THM] THEN
6420   X_GEN_TAC `w:real^(M,N)finite_sum->bool` THEN STRIP_TAC THEN
6421   MP_TAC(ISPECL
6422    [`s:real^M->bool`; `t:real^N->bool`; `w:real^(M,N)finite_sum->bool`;
6423     `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN
6424   ASM_REWRITE_TAC[] THENL
6425    [MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u':real^M->bool` THEN
6426     DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
6427     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6428      [ALL_TAC;
6429       X_GEN_TAC `z:real^M` THEN DISCH_TAC THEN
6430       MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`;
6431                      `w:real^(M,N)finite_sum->bool`]
6432         PATH_CONNECTED_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_FSTCART] THEN
6433       REWRITE_TAC[path_connected] THEN
6434       DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `z:real^M`]) THEN ANTS_TAC THENL
6435        [REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART];
6436         MATCH_MP_TAC MONO_EXISTS THEN
6437         REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART] THEN
6438         REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]];
6439     DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` MP_TAC) THEN
6440     MATCH_MP_TAC MONO_EXISTS THEN
6441     X_GEN_TAC `v':real^N->bool` THEN STRIP_TAC THEN
6442     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6443      [ALL_TAC;
6444       X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN
6445       MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`;
6446                      `w:real^(M,N)finite_sum->bool`]
6447         PATH_CONNECTED_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_SNDCART] THEN
6448       REWRITE_TAC[path_connected] THEN
6449       DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `z:real^N`]) THEN ANTS_TAC THENL
6450        [REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; SNDCART_PASTECART];
6451         MATCH_MP_TAC MONO_EXISTS THEN
6452         REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; SNDCART_PASTECART] THEN
6453         REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]]] THEN
6454   RULE_ASSUM_TAC(REWRITE_RULE
6455    [SUBSET; FORALL_IN_PCROSS; PASTECART_IN_PCROSS; FORALL_PASTECART]) THEN
6456   ASM SET_TAC[]);;
6457
6458 let CARD_EQ_OPEN_IN = prove
6459  (`!u s:real^N->bool.
6460       locally connected u /\
6461       open_in (subtopology euclidean u) s /\
6462       (?x. x IN s /\ x limit_point_of u)
6463       ==> s =_c (:real)`,
6464   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
6465    [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
6466     SIMP_TAC[CARD_EQ_IMP_LE; CARD_EQ_EUCLIDEAN] THEN
6467     MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[SUBSET_UNIV];
6468     ALL_TAC] THEN
6469   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
6470   DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
6471   UNDISCH_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[IN_INTER] THEN
6472   STRIP_TAC THEN
6473   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_CONNECTED]) THEN
6474   DISCH_THEN(MP_TAC o SPECL [`u INTER t:real^N->bool`; `x:real^N`]) THEN
6475   ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; IN_INTER] THEN
6476   REWRITE_TAC[OPEN_IN_OPEN; GSYM CONJ_ASSOC; LEFT_AND_EXISTS_THM] THEN
6477   ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
6478   ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
6479   REWRITE_TAC[UNWIND_THM2; IN_INTER] THEN
6480   DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
6481   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [limit_point_of]) THEN
6482   DISCH_THEN(MP_TAC o SPEC `t INTER v:real^N->bool`) THEN
6483   ASM_SIMP_TAC[IN_INTER; OPEN_INTER] THEN
6484   DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
6485   TRANS_TAC CARD_LE_TRANS `u INTER v:real^N->bool` THEN
6486   ASM_SIMP_TAC[CARD_LE_SUBSET] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
6487   ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN MATCH_MP_TAC CARD_EQ_CONNECTED THEN
6488   ASM SET_TAC[]);;
6489
6490 let CARD_EQ_OPEN_IN_AFFINE = prove
6491  (`!u s:real^N->bool.
6492         affine u /\ ~(aff_dim u = &0) /\
6493         open_in (subtopology euclidean u) s /\ ~(s = {})
6494         ==> s =_c (:real)`,
6495   REPEAT STRIP_TAC THEN MATCH_MP_TAC CARD_EQ_OPEN_IN THEN
6496   EXISTS_TAC `u:real^N->bool` THEN
6497   ASM_SIMP_TAC[CONVEX_IMP_LOCALLY_CONNECTED; AFFINE_IMP_CONVEX] THEN
6498   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
6499   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
6500   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_IMP_PERFECT_AFF_DIM THEN
6501   ASM_SIMP_TAC[AFFINE_IMP_CONVEX; CONVEX_CONNECTED] THEN
6502   FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]);;
6503
6504 (* ------------------------------------------------------------------------- *)
6505 (* Locally convex sets.                                                      *)
6506 (* ------------------------------------------------------------------------- *)
6507
6508 let LOCALLY_CONVEX = prove
6509  (`!s:real^N->bool.
6510         locally convex s <=>
6511         !x. x IN s ==> ?u v. x IN u /\ u SUBSET v /\ v SUBSET s /\
6512                              open_in (subtopology euclidean s) u /\
6513                              convex v`,
6514   GEN_TAC THEN REWRITE_TAC[locally] THEN EQ_TAC THEN DISCH_TAC THENL
6515    [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM
6516      (MP_TAC o SPECL [`s INTER ball(x:real^N,&1)`; `x:real^N`]) THEN
6517     ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
6518     ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_LT_01] THEN
6519     MESON_TAC[SUBSET_INTER];
6520     MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN
6521     REWRITE_TAC[IMP_CONJ] THEN GEN_REWRITE_TAC LAND_CONV [OPEN_IN_OPEN] THEN
6522     DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
6523     ASM_REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN
6524     FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
6525     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6526     MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
6527     STRIP_TAC THEN
6528     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
6529     DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
6530     DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6531     EXISTS_TAC `(s INTER ball(x:real^N,e)) INTER u` THEN
6532     EXISTS_TAC `cball(x:real^N,e) INTER v` THEN
6533     ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_OPEN_INTER; OPEN_BALL; CENTRE_IN_BALL;
6534                  CONVEX_INTER; CONVEX_CBALL; IN_INTER] THEN
6535     MP_TAC(ISPECL [`x:real^N`; `e:real`] BALL_SUBSET_CBALL) THEN
6536     ASM SET_TAC[]]);;
6537
6538 (* ------------------------------------------------------------------------- *)
6539 (* Basic properties of local compactness.                                    *)
6540 (* ------------------------------------------------------------------------- *)
6541
6542 let LOCALLY_COMPACT = prove
6543  (`!s:real^N->bool.
6544         locally compact s <=>
6545         !x. x IN s ==> ?u v. x IN u /\ u SUBSET v /\ v SUBSET s /\
6546                              open_in (subtopology euclidean s) u /\
6547                              compact v`,
6548   GEN_TAC THEN REWRITE_TAC[locally] THEN EQ_TAC THEN DISCH_TAC THENL
6549    [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM
6550      (MP_TAC o SPECL [`s INTER ball(x:real^N,&1)`; `x:real^N`]) THEN
6551     ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
6552     ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_LT_01] THEN
6553     MESON_TAC[SUBSET_INTER];
6554     MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN
6555     REWRITE_TAC[IMP_CONJ] THEN GEN_REWRITE_TAC LAND_CONV [OPEN_IN_OPEN] THEN
6556     DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
6557     ASM_REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN
6558     FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
6559     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6560     MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
6561     STRIP_TAC THEN
6562     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
6563     DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
6564     DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6565     EXISTS_TAC `(s INTER ball(x:real^N,e)) INTER u` THEN
6566     EXISTS_TAC `cball(x:real^N,e) INTER v` THEN
6567     ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_OPEN_INTER; OPEN_BALL; CENTRE_IN_BALL;
6568                  COMPACT_INTER; COMPACT_CBALL; IN_INTER] THEN
6569     MP_TAC(ISPECL [`x:real^N`; `e:real`] BALL_SUBSET_CBALL) THEN
6570     ASM SET_TAC[]]);;
6571
6572 let LOCALLY_COMPACT_ALT = prove
6573  (`!s:real^N->bool.
6574         locally compact s <=>
6575         !x. x IN s
6576             ==> ?u. x IN u /\
6577                     open_in (subtopology euclidean s) u /\
6578                     compact(closure u) /\ closure u SUBSET s`,
6579   GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN EQ_TAC THEN
6580   DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
6581   FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
6582   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN
6583   MESON_TAC[CLOSURE_SUBSET; SUBSET_TRANS; CLOSURE_MINIMAL;
6584             COMPACT_CLOSURE; BOUNDED_SUBSET; COMPACT_EQ_BOUNDED_CLOSED]);;
6585
6586 let LOCALLY_COMPACT_INTER_CBALL = prove
6587  (`!s:real^N->bool.
6588         locally compact s <=>
6589         !x. x IN s ==> ?e. &0 < e /\ closed(cball(x,e) INTER s)`,
6590   GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT; OPEN_IN_CONTAINS_CBALL] THEN
6591   EQ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN
6592   ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THENL
6593    [MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
6594     STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
6595     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
6596     X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6597     SUBGOAL_THEN `cball(x:real^N,e) INTER s = cball (x,e) INTER v`
6598     SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
6599     ASM_SIMP_TAC[COMPACT_CBALL; COMPACT_INTER; COMPACT_IMP_CLOSED];
6600     X_GEN_TAC `e:real` THEN STRIP_TAC THEN
6601     EXISTS_TAC `ball(x:real^N,e) INTER s` THEN
6602     EXISTS_TAC `cball(x:real^N,e) INTER s` THEN
6603     REWRITE_TAC[GSYM OPEN_IN_CONTAINS_CBALL] THEN
6604     ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL; INTER_SUBSET] THEN
6605     ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_INTER; BOUNDED_CBALL] THEN
6606     ONCE_REWRITE_TAC[INTER_COMM] THEN
6607     SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
6608     MESON_TAC[SUBSET; IN_INTER; BALL_SUBSET_CBALL]]);;
6609
6610 let LOCALLY_COMPACT_INTER_CBALLS = prove
6611  (`!s:real^N->bool.
6612       locally compact s <=>
6613       !x. x IN s ==> ?e. &0 < e /\ !d. d <= e ==> closed(cball(x,d) INTER s)`,
6614   GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_INTER_CBALL] THEN
6615   EQ_TAC THENL [ALL_TAC; MESON_TAC[REAL_LE_REFL]] THEN
6616   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN
6617   ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN
6618   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN
6619   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN
6620   SUBGOAL_THEN
6621    `cball(x:real^N,d) INTER s = cball(x,d) INTER cball(x,e) INTER s`
6622   SUBST1_TAC THENL
6623    [REWRITE_TAC[GSYM INTER_ASSOC; GSYM CBALL_MIN_INTER] THEN
6624     AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
6625     BINOP_TAC THEN REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
6626     ASM_SIMP_TAC[CLOSED_INTER; CLOSED_CBALL]]);;
6627
6628 let LOCALLY_COMPACT_COMPACT = prove
6629  (`!s:real^N->bool.
6630         locally compact s <=>
6631         !k. k SUBSET s /\ compact k
6632             ==> ?u v. k SUBSET u /\
6633                       u SUBSET v /\
6634                       v SUBSET s /\
6635                       open_in (subtopology euclidean s) u /\
6636
6637                       compact v`,
6638   GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [LOCALLY_COMPACT] THEN EQ_TAC THEN
6639   REPEAT STRIP_TAC THENL
6640    [ALL_TAC; ASM_MESON_TAC[SING_SUBSET; COMPACT_SING]] THEN
6641   FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[RIGHT_IMP_EXISTS_THM] o
6642         check (is_forall o concl)) THEN
6643   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
6644   MAP_EVERY X_GEN_TAC [`u:real^N->real^N->bool`; `v:real^N->real^N->bool`] THEN
6645   DISCH_TAC THEN
6646   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
6647    [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN
6648   DISCH_THEN(MP_TAC o SPEC `IMAGE (\x:real^N. k INTER u x) k`) THEN
6649   ASM_SIMP_TAC[FORALL_IN_IMAGE; UNIONS_IMAGE] THEN ANTS_TAC THENL
6650    [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
6651     REPEAT STRIP_TAC THEN MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN
6652     EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
6653     MATCH_MP_TAC OPEN_IN_INTER THEN REWRITE_TAC[OPEN_IN_REFL] THEN
6654     ASM SET_TAC[];
6655     ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
6656     REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE; UNIONS_IMAGE] THEN
6657     DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
6658     EXISTS_TAC `UNIONS(IMAGE (u:real^N->real^N->bool) t)` THEN
6659     EXISTS_TAC `UNIONS(IMAGE (v:real^N->real^N->bool) t)` THEN
6660     REPEAT CONJ_TAC THENL
6661      [ALL_TAC; ALL_TAC; ALL_TAC; MATCH_MP_TAC OPEN_IN_UNIONS;
6662       MATCH_MP_TAC COMPACT_UNIONS THEN ASM_SIMP_TAC[FINITE_IMAGE]] THEN
6663     ASM SET_TAC[]]);;
6664
6665 let LOCALLY_COMPACT_COMPACT_ALT = prove
6666  (`!s:real^N->bool.
6667         locally compact s <=>
6668         !k. k SUBSET s /\ compact k
6669             ==> ?u. k SUBSET u /\
6670                     open_in (subtopology euclidean s) u /\
6671                     compact(closure u) /\ closure u SUBSET s`,
6672   GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_COMPACT] THEN EQ_TAC THEN
6673   DISCH_TAC THEN X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN
6674   FIRST_X_ASSUM(MP_TAC o SPEC `k:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN
6675   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN
6676   MESON_TAC[CLOSURE_SUBSET; SUBSET_TRANS; CLOSURE_MINIMAL;
6677             COMPACT_CLOSURE; BOUNDED_SUBSET; COMPACT_EQ_BOUNDED_CLOSED]);;
6678
6679 let LOCALLY_COMPACT_COMPACT_SUBOPEN = prove
6680  (`!s:real^N->bool.
6681         locally compact s <=>
6682         !k t. k SUBSET s /\ compact k /\ open t /\ k SUBSET t
6683               ==> ?u v. k SUBSET u /\ u SUBSET v /\ u SUBSET t /\ v SUBSET s /\
6684                         open_in (subtopology euclidean s) u /\
6685                         compact v`,
6686   GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_COMPACT] THEN
6687   EQ_TAC THEN DISCH_TAC THEN REPEAT STRIP_TAC THENL
6688    [FIRST_X_ASSUM(MP_TAC o SPEC `k:real^N->bool`) THEN
6689     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6690     MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
6691     STRIP_TAC THEN MAP_EVERY EXISTS_TAC
6692      [`u INTER t:real^N->bool`; `closure(u INTER t:real^N->bool)`] THEN
6693     REWRITE_TAC[CLOSURE_SUBSET; INTER_SUBSET] THEN REPEAT CONJ_TAC THENL
6694      [ASM SET_TAC[];
6695       TRANS_TAC SUBSET_TRANS `closure(u:real^N->bool)` THEN
6696       SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN
6697       TRANS_TAC SUBSET_TRANS `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
6698       MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED];
6699       ASM_SIMP_TAC[OPEN_IN_INTER_OPEN];
6700       REWRITE_TAC[COMPACT_CLOSURE] THEN
6701       ASM_MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET; SUBSET_TRANS;
6702                     COMPACT_IMP_BOUNDED]];
6703     FIRST_X_ASSUM(MP_TAC o SPECL [`k:real^N->bool`; `(:real^N)`]) THEN
6704     ASM_REWRITE_TAC[OPEN_UNIV; SUBSET_UNIV]]);;
6705
6706 let OPEN_IMP_LOCALLY_COMPACT = prove
6707  (`!s:real^N->bool. open s ==> locally compact s`,
6708   REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN
6709   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_ASSUM
6710    (MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
6711   DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
6712   ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN
6713   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6714   MAP_EVERY EXISTS_TAC [`ball(x:real^N,e)`; `cball(x:real^N,e)`] THEN
6715   ASM_REWRITE_TAC[BALL_SUBSET_CBALL; CENTRE_IN_BALL; COMPACT_CBALL] THEN
6716   MATCH_MP_TAC OPEN_OPEN_IN_TRANS THEN ASM_REWRITE_TAC[OPEN_BALL] THEN
6717   ASM_MESON_TAC[BALL_SUBSET_CBALL; SUBSET_TRANS]);;
6718
6719 let CLOSED_IMP_LOCALLY_COMPACT = prove
6720  (`!s:real^N->bool. closed s ==> locally compact s`,
6721   REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN
6722   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC
6723    [`s INTER ball(x:real^N,&1)`; `s INTER cball(x:real^N,&1)`] THEN
6724   ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; INTER_SUBSET; REAL_LT_01] THEN
6725   ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
6726   ASM_SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_CBALL] THEN
6727   MP_TAC(ISPECL [`x:real^N`; `&1`] BALL_SUBSET_CBALL) THEN ASM SET_TAC[]);;
6728
6729 let IS_INTERVAL_IMP_LOCALLY_COMPACT = prove
6730  (`!s:real^N->bool. is_interval s ==> locally compact s`,
6731   REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN
6732   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
6733   MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`]
6734    INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD) THEN
6735   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6736   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `d:real`] THEN STRIP_TAC THEN
6737   MAP_EVERY EXISTS_TAC
6738    [`s INTER ball(x:real^N,d)`; `interval[a:real^N,b]`] THEN
6739   ASM_SIMP_TAC[COMPACT_INTERVAL; OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
6740   ASM_REWRITE_TAC[CENTRE_IN_BALL; IN_INTER] THEN ASM SET_TAC[]);;
6741
6742 let LOCALLY_COMPACT_UNIV = prove
6743  (`locally compact (:real^N)`,
6744   SIMP_TAC[OPEN_IMP_LOCALLY_COMPACT; OPEN_UNIV]);;
6745
6746 let LOCALLY_COMPACT_INTER = prove
6747  (`!s t:real^N->bool.
6748         locally compact s /\ locally compact t
6749         ==> locally compact (s INTER t)`,
6750   MATCH_MP_TAC LOCALLY_INTER THEN REWRITE_TAC[COMPACT_INTER]);;
6751
6752 let LOCALLY_COMPACT_OPEN_IN = prove
6753  (`!s t:real^N->bool.
6754         open_in (subtopology euclidean s) t /\ locally compact s
6755         ==> locally compact t`,
6756   REWRITE_TAC[OPEN_IN_OPEN] THEN REPEAT STRIP_TAC THEN
6757   ASM_SIMP_TAC[LOCALLY_COMPACT_INTER; OPEN_IMP_LOCALLY_COMPACT]);;
6758
6759 let LOCALLY_COMPACT_CLOSED_IN = prove
6760  (`!s t:real^N->bool.
6761         closed_in (subtopology euclidean s) t /\ locally compact s
6762         ==> locally compact t`,
6763   REWRITE_TAC[CLOSED_IN_CLOSED] THEN REPEAT STRIP_TAC THEN
6764   ASM_SIMP_TAC[LOCALLY_COMPACT_INTER; CLOSED_IMP_LOCALLY_COMPACT]);;
6765
6766 let LOCALLY_COMPACT_DELETE = prove
6767  (`!s a:real^N. locally compact s ==> locally compact (s DELETE a)`,
6768   REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_COMPACT_OPEN_IN THEN
6769   EXISTS_TAC `s:real^N->bool` THEN
6770   ASM_SIMP_TAC[OPEN_IN_DELETE; OPEN_IN_REFL]);;
6771
6772 let SIGMA_COMPACT = prove
6773  (`!s:real^N->bool.
6774         locally compact s
6775         ==> ?f. COUNTABLE f /\ (!t. t IN f ==> compact t) /\ UNIONS f = s`,
6776   GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN
6777   GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
6778   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
6779   MAP_EVERY X_GEN_TAC [`u:real^N->real^N->bool`; `c:real^N->real^N->bool`] THEN
6780   DISCH_TAC THEN
6781   MP_TAC(ISPECL [`IMAGE (u:real^N->real^N->bool) s`; `s:real^N->bool`]
6782    LINDELOF_OPEN_IN) THEN
6783   ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN
6784   ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
6785   REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN
6786   DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
6787   EXISTS_TAC `IMAGE (c:real^N->real^N->bool) t` THEN
6788   REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; FORALL_IN_IMAGE; FORALL_IN_UNIONS] THEN
6789   ASM_SIMP_TAC[COUNTABLE_IMAGE] THEN ASM SET_TAC[]);;
6790
6791 let HOMEOMORPHIC_LOCAL_COMPACTNESS = prove
6792  (`!s t:real^N->bool.
6793         s homeomorphic t ==> (locally compact s <=> locally compact t)`,
6794   MATCH_MP_TAC HOMEOMORPHIC_LOCALLY THEN
6795   REWRITE_TAC[HOMEOMORPHIC_COMPACTNESS]);;
6796
6797 let LOCALLY_COMPACT_TRANSLATION_EQ = prove
6798  (`!a:real^N s. locally compact (IMAGE (\x. a + x) s) <=>
6799                 locally compact s`,
6800   MATCH_MP_TAC LOCALLY_TRANSLATION THEN
6801   REWRITE_TAC[COMPACT_TRANSLATION_EQ]);;
6802
6803 add_translation_invariants [LOCALLY_COMPACT_TRANSLATION_EQ];;
6804
6805 let LOCALLY_COMPACT_LINEAR_IMAGE_EQ = prove
6806  (`!f:real^M->real^N s.
6807         linear f /\ (!x y. f x = f y ==> x = y)
6808         ==> (locally compact (IMAGE f s) <=> locally compact s)`,
6809   MATCH_MP_TAC LOCALLY_INJECTIVE_LINEAR_IMAGE THEN
6810   REWRITE_TAC[COMPACT_LINEAR_IMAGE_EQ]);;
6811
6812 add_linear_invariants [LOCALLY_COMPACT_LINEAR_IMAGE_EQ];;
6813
6814 let LOCALLY_CLOSED = prove
6815  (`!s:real^N->bool. locally closed s <=> locally compact s`,
6816   GEN_TAC THEN EQ_TAC THENL
6817    [ALL_TAC; MESON_TAC[LOCALLY_MONO; COMPACT_IMP_CLOSED]] THEN
6818   REWRITE_TAC[locally] THEN DISCH_TAC THEN
6819   MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
6820   FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^N->bool`; `x:real^N`]) THEN
6821   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6822   MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
6823   STRIP_TAC THEN
6824   EXISTS_TAC `u INTER ball(x:real^N,&1)` THEN
6825   EXISTS_TAC `v INTER cball(x:real^N,&1)` THEN
6826   ASM_SIMP_TAC[OPEN_IN_INTER_OPEN; OPEN_BALL] THEN
6827   ASM_SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_CBALL] THEN
6828   ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_LT_01] THEN
6829   MP_TAC(ISPEC `x:real^N` BALL_SUBSET_CBALL) THEN ASM SET_TAC[]);;
6830
6831 let LOCALLY_COMPACT_OPEN_UNION = prove
6832  (`!s t:real^N->bool.
6833         locally compact s /\ locally compact t /\
6834         open_in (subtopology euclidean (s UNION t)) s /\
6835         open_in (subtopology euclidean (s UNION t)) t
6836         ==> locally compact (s UNION t)`,
6837   REPEAT GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_INTER_CBALL; IN_UNION] THEN
6838   INTRO_TAC "lcs lct os ot" THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THENL
6839    [REMOVE_THEN "lcs" (MP_TAC o SPEC `x:real^N`) THEN
6840     REMOVE_THEN "os"
6841      (MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_CBALL]);
6842     REMOVE_THEN "lct" (MP_TAC o SPEC `x:real^N`) THEN
6843     REMOVE_THEN "ot"
6844      (MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_CBALL])] THEN
6845   DISCH_THEN(MP_TAC o SPEC `x:real^N` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN
6846   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6847   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
6848   EXISTS_TAC `min d e:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
6849   REWRITE_TAC[CBALL_MIN_INTER; INTER_ASSOC] THEN
6850   FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE
6851    `u INTER st SUBSET s ==> s SUBSET st ==> u INTER st = u INTER s`)) THEN
6852   REWRITE_TAC[SUBSET_UNION] THEN DISCH_THEN SUBST1_TAC THEN
6853   ASM_MESON_TAC[CLOSED_INTER; CLOSED_CBALL; INTER_ACI]);;
6854
6855 let LOCALLY_COMPACT_CLOSED_UNION = prove
6856  (`!s t:real^N->bool.
6857         locally compact s /\ locally compact t /\
6858         closed_in (subtopology euclidean (s UNION t)) s /\
6859         closed_in (subtopology euclidean (s UNION t)) t
6860         ==> locally compact (s UNION t)`,
6861   REPEAT GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_INTER_CBALL; IN_UNION] THEN
6862   INTRO_TAC "lcs lct cs ct" THEN X_GEN_TAC `x:real^N` THEN
6863   DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP (TAUT
6864    `p \/ q ==> p /\ q \/ p /\ ~q \/ q /\ ~p`))
6865   THENL
6866    [REMOVE_THEN "lct" (MP_TAC o SPEC `x:real^N`) THEN
6867     REMOVE_THEN "lcs" (MP_TAC o SPEC `x:real^N`) THEN
6868     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
6869     X_GEN_TAC `d:real` THEN STRIP_TAC THEN
6870     X_GEN_TAC `e:real` THEN STRIP_TAC THEN
6871     EXISTS_TAC `min d e:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
6872     SIMP_TAC[SET_RULE `u INTER (s UNION t) = u INTER s UNION u INTER t`] THEN
6873     MATCH_MP_TAC CLOSED_UNION THEN REWRITE_TAC[CBALL_MIN_INTER] THEN
6874     ASM_MESON_TAC[CLOSED_CBALL; CLOSED_INTER; INTER_ACI];
6875     REMOVE_THEN "lcs" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
6876     DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6877     REMOVE_THEN "ct" (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [closed_in]);
6878     REMOVE_THEN "lct" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
6879     DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6880     REMOVE_THEN "cs" (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [closed_in])] THEN
6881   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_CBALL]) THEN
6882   REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; IN_DIFF; IN_UNION] THEN
6883   DISCH_THEN(MP_TAC o SPEC `x:real^N` o CONJUNCT2) THEN ASM_SIMP_TAC[] THEN
6884   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
6885   EXISTS_TAC `min d e:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THENL
6886    [SUBGOAL_THEN `cball (x:real^N,min d e) INTER (s UNION t) =
6887                   cball(x,d) INTER cball (x,e) INTER s` SUBST1_TAC
6888     THENL [REWRITE_TAC[CBALL_MIN_INTER] THEN ASM SET_TAC[]; ALL_TAC];
6889     SUBGOAL_THEN `cball (x:real^N,min d e) INTER (s UNION t) =
6890                   cball(x,d) INTER cball (x,e) INTER t` SUBST1_TAC
6891     THENL [REWRITE_TAC[CBALL_MIN_INTER] THEN ASM SET_TAC[]; ALL_TAC]] THEN
6892   ASM_MESON_TAC[CLOSED_INTER; CLOSED_CBALL]);;
6893
6894 let LOCALLY_COMPACT_PCROSS = prove
6895  (`!s:real^M->bool t:real^N->bool.
6896         locally compact s /\ locally compact t
6897         ==> locally compact (s PCROSS t)`,
6898   MATCH_MP_TAC LOCALLY_PCROSS THEN REWRITE_TAC[COMPACT_PCROSS]);;
6899
6900 let LOCALLY_COMPACT_PCROSS_EQ = prove
6901  (`!s:real^M->bool t:real^N->bool.
6902         locally compact (s PCROSS t) <=>
6903         s = {} \/ t = {} \/ locally compact s /\ locally compact t`,
6904   REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
6905   ASM_SIMP_TAC[LOCALLY_COMPACT_PCROSS; PCROSS_EMPTY; LOCALLY_EMPTY] THEN
6906   MATCH_MP_TAC(TAUT `(~p ==> s) /\ (~q ==> r) ==> p \/ q \/ r /\ s`) THEN
6907   CONJ_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THENL
6908    [X_GEN_TAC `a:real^M`; X_GEN_TAC `b:real^N`] THEN
6909   DISCH_TAC THEN FIRST_ASSUM
6910    (MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LOCALLY_COMPACT_INTER))
6911   THENL
6912    [DISCH_THEN(MP_TAC o SPEC `{a:real^M} PCROSS (:real^N)`);
6913     DISCH_THEN(MP_TAC o SPEC `(:real^M) PCROSS {b:real^N}`)] THEN
6914   ASM_SIMP_TAC[LOCALLY_COMPACT_PCROSS; CLOSED_IMP_LOCALLY_COMPACT;
6915                CLOSED_UNIV; CLOSED_SING; INTER_PCROSS; INTER_UNIV;
6916                SET_RULE `a IN s ==> s INTER {a} = {a}`] THEN
6917   ASM_MESON_TAC[HOMEOMORPHIC_PCROSS_SING; HOMEOMORPHIC_LOCAL_COMPACTNESS]);;
6918
6919 let OPEN_IN_LOCALLY_COMPACT = prove
6920  (`!s t:real^N->bool.
6921         locally compact s
6922         ==> (open_in (subtopology euclidean s) t <=>
6923              t SUBSET s /\
6924              !k. compact k /\ k SUBSET s
6925                  ==> open_in (subtopology euclidean k) (k INTER t))`,
6926   REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL
6927    [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET];
6928     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
6929     REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[];
6930     ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
6931     X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
6932     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_COMPACT]) THEN
6933     DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN
6934     ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
6935     MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
6936     STRIP_TAC THEN EXISTS_TAC `t INTER u:real^N->bool` THEN
6937     ASM_REWRITE_TAC[IN_INTER; INTER_SUBSET] THEN
6938     MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN
6939     ASM_REWRITE_TAC[] THEN
6940     FIRST_X_ASSUM(MP_TAC o SPEC `closure u:real^N->bool`) THEN
6941     ANTS_TAC THENL
6942      [SUBGOAL_THEN `(closure u:real^N->bool) SUBSET v` MP_TAC THENL
6943        [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED];
6944         REWRITE_TAC[COMPACT_CLOSURE] THEN
6945         ASM_MESON_TAC[SUBSET_TRANS; BOUNDED_SUBSET; COMPACT_IMP_BOUNDED]];
6946       REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN
6947       MP_TAC(ISPEC `u:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]]]);;
6948
6949 let LOCALLY_COMPACT_PROPER_IMAGE_EQ = prove
6950  (`!f:real^M->real^N s.
6951         f continuous_on s /\
6952         (!k. k SUBSET (IMAGE f s) /\ compact k
6953              ==> compact {x | x IN s /\ f x IN k})
6954         ==> (locally compact s <=> locally compact (IMAGE f s))`,
6955   REPEAT STRIP_TAC THEN
6956   MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`;
6957                  `IMAGE (f:real^M->real^N) s`] PROPER_MAP) THEN
6958   ASM_REWRITE_TAC[SUBSET_REFL] THEN STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
6959    [REWRITE_TAC[LOCALLY_COMPACT_ALT] THEN X_GEN_TAC `y:real^N` THEN
6960     DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `y:real^N`) THEN
6961     ANTS_TAC THENL [ASM_REWRITE_TAC[]; DISCH_TAC] THEN
6962     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_COMPACT_COMPACT_ALT]) THEN
6963     DISCH_THEN(MP_TAC o SPEC `{x | x IN s /\ (f:real^M->real^N) x = y}`) THEN
6964     ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN
6965     DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN
6966     SUBGOAL_THEN
6967      `?v. open_in (subtopology euclidean (IMAGE f s)) v /\
6968           y IN v /\
6969           {x | x IN s /\ (f:real^M->real^N) x IN v} SUBSET u`
6970     MP_TAC THENL
6971      [GEN_REWRITE_TAC (BINDER_CONV o RAND_CONV o LAND_CONV)
6972        [GSYM SING_SUBSET] THEN
6973       MATCH_MP_TAC CLOSED_MAP_OPEN_SUPERSET_PREIMAGE THEN
6974       ASM_REWRITE_TAC[SING_SUBSET; IN_SING];
6975       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN
6976       STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6977       SUBGOAL_THEN `closure v SUBSET IMAGE (f:real^M->real^N) (closure u)`
6978       ASSUME_TAC THENL
6979        [TRANS_TAC SUBSET_TRANS `closure(IMAGE (f:real^M->real^N) u)` THEN
6980         CONJ_TAC THENL
6981          [MATCH_MP_TAC SUBSET_CLOSURE THEN
6982           REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
6983           ASM SET_TAC[];
6984           MATCH_MP_TAC CLOSURE_MINIMAL THEN
6985           SIMP_TAC[CLOSURE_SUBSET; IMAGE_SUBSET] THEN
6986           MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
6987           MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
6988           ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]];
6989         CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
6990         REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE] THEN
6991         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
6992           BOUNDED_SUBSET)) THEN
6993         MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN
6994         MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
6995         ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]];
6996     REWRITE_TAC[LOCALLY_COMPACT_ALT] THEN
6997     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
6998     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_COMPACT_ALT]) THEN
6999     DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN
7000     ASM_SIMP_TAC[FUN_IN_IMAGE] THEN
7001     DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
7002     FIRST_X_ASSUM(MP_TAC o SPEC `closure v:real^N->bool`) THEN
7003     ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
7004     EXISTS_TAC `{x | x IN s /\ (f:real^M->real^N) x IN v}` THEN
7005     ASM_REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL
7006      [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
7007       ASM_MESON_TAC[SUBSET_REFL];
7008       ALL_TAC] THEN
7009     SUBGOAL_THEN
7010      `closure {x | x IN s /\ f x IN v} SUBSET
7011       {x | x IN s /\ (f:real^M->real^N) x IN closure v}`
7012     ASSUME_TAC THENL
7013      [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN
7014       MP_TAC(ISPEC `v:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[];
7015       CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
7016       REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE] THEN
7017       ASM_MESON_TAC[COMPACT_IMP_BOUNDED; BOUNDED_SUBSET]]]);;
7018
7019 let LOCALLY_COMPACT_PROPER_IMAGE = prove
7020  (`!f:real^M->real^N s.
7021         f continuous_on s /\
7022         (!k. k SUBSET (IMAGE f s) /\ compact k
7023              ==> compact {x | x IN s /\ f x IN k}) /\
7024         locally compact s
7025         ==> locally compact (IMAGE f s)`,
7026   MESON_TAC[LOCALLY_COMPACT_PROPER_IMAGE_EQ]);;
7027
7028 let MUMFORD_LEMMA = prove
7029  (`!f:real^M->real^N s t y.
7030         f continuous_on s /\ IMAGE f s SUBSET t /\ locally compact s /\
7031         y IN t /\ compact {x | x IN s /\ f x = y}
7032         ==> ?u v. open_in (subtopology euclidean s) u /\
7033                   open_in (subtopology euclidean t) v /\
7034                   {x | x IN s /\ f x = y} SUBSET u /\ y IN v /\
7035                   IMAGE f u SUBSET v /\
7036                   (!k. k SUBSET v /\ compact k
7037                        ==> compact {x | x IN u /\ f x IN k})`,
7038   REPEAT STRIP_TAC THEN
7039   FIRST_ASSUM(MP_TAC o SPEC `{x | x IN s /\ (f:real^M->real^N) x = y}` o
7040    GEN_REWRITE_RULE I [LOCALLY_COMPACT_COMPACT]) THEN
7041   ASM_REWRITE_TAC[SUBSET_RESTRICT; LEFT_IMP_EXISTS_THM] THEN
7042   MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^M->bool`] THEN
7043   STRIP_TAC THEN
7044   SUBGOAL_THEN `(closure u:real^M->bool) SUBSET v` ASSUME_TAC THENL
7045    [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED];
7046     ALL_TAC] THEN
7047   SUBGOAL_THEN `compact(closure u:real^M->bool)` ASSUME_TAC THENL
7048    [ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN
7049     ASM_MESON_TAC[BOUNDED_SUBSET; COMPACT_IMP_BOUNDED];
7050     ALL_TAC] THEN
7051   MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
7052   SUBGOAL_THEN
7053    `!b. open_in (subtopology euclidean t) b /\ y IN b
7054         ==> u INTER {x | x IN s /\ (f:real^M->real^N) x IN b} PSUBSET
7055             closure u INTER {x | x IN s /\ (f:real^M->real^N) x IN b}`
7056   MP_TAC THENL
7057    [REPEAT STRIP_TAC THEN REWRITE_TAC[PSUBSET] THEN
7058     SIMP_TAC[CLOSURE_SUBSET;
7059              SET_RULE `s SUBSET t ==> s INTER u SUBSET t INTER u`] THEN
7060     MATCH_MP_TAC(MESON[] `!P. ~P s /\ P t ==> ~(s = t)`) THEN
7061     EXISTS_TAC
7062      `\a. !k. k SUBSET b /\ compact k
7063               ==> compact {x | x IN a /\ (f:real^M->real^N) x IN k}` THEN
7064     REWRITE_TAC[] THEN CONJ_TAC THENL
7065      [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN
7066       REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL
7067        [`u INTER {x | x IN s /\ (f:real^M->real^N) x IN b}`;
7068         `b:real^N->bool`]) THEN
7069       ASM_REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`] THEN ANTS_TAC THENL
7070        [MATCH_MP_TAC OPEN_IN_INTER THEN ASM_REWRITE_TAC[] THEN
7071         MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN ASM SET_TAC[];
7072         ASM SET_TAC[]];
7073       X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN
7074       SUBGOAL_THEN
7075        `{x | x IN closure u INTER {x | x IN s /\ f x IN b} /\ f x IN k} =
7076         v INTER {x | x IN closure u /\ (f:real^M->real^N) x IN k}`
7077       SUBST1_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC COMPACT_INTER_CLOSED] THEN
7078       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
7079       ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_CLOSURE] THEN
7080       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_TRANS]];
7081     DISCH_THEN(MP_TAC o GEN `n:num` o SPEC
7082      `t INTER ball(y:real^N,inv(&n + &1))`) THEN
7083     SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; IN_INTER; CENTRE_IN_BALL] THEN
7084     ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
7085     SIMP_TAC[CLOSURE_SUBSET; SET_RULE
7086      `u SUBSET u'
7087       ==> (u INTER t PSUBSET u' INTER t <=>
7088            ?x. x IN u' /\ ~(x IN u) /\ x IN t)`] THEN
7089     REWRITE_TAC[SKOLEM_THM; IN_ELIM_THM; IN_BALL; FORALL_AND_THM] THEN
7090     DISCH_THEN(X_CHOOSE_THEN `x:num->real^M` STRIP_ASSUME_TAC) THEN
7091     MP_TAC(ISPEC `closure u:real^M->bool` compact) THEN
7092     ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `x:num->real^M`) THEN
7093     ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN
7094     MAP_EVERY X_GEN_TAC [`l:real^M`; `r:num->num`] THEN STRIP_TAC THEN
7095     SUBGOAL_THEN `(f:real^M->real^N) l = y` ASSUME_TAC THENL
7096      [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
7097       EXISTS_TAC `(f:real^M->real^N) o x o (r:num->num)` THEN
7098       ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL
7099        [SUBGOAL_THEN `(f:real^M->real^N) continuous_on closure u` MP_TAC THENL
7100          [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_TRANS]; ALL_TAC] THEN
7101         REWRITE_TAC[CONTINUOUS_ON_SEQUENTIALLY] THEN
7102         DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[o_THM];
7103         REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC LIM_SUBSEQUENCE THEN
7104         ASM_REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN
7105         X_GEN_TAC `e:real` THEN DISCH_TAC THEN
7106         MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN
7107         ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
7108         X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN
7109         DISCH_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN
7110         TRANS_TAC REAL_LT_TRANS `inv(&n + &1)` THEN ASM_REWRITE_TAC[] THEN
7111         TRANS_TAC REAL_LT_TRANS `inv(&N)` THEN ASM_REWRITE_TAC[] THEN
7112         MATCH_MP_TAC REAL_LT_INV2 THEN
7113         ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC];
7114       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_in]) THEN
7115       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `l:real^M`)) THEN
7116       REWRITE_TAC[NOT_IMP; NOT_EXISTS_THM] THEN
7117       CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `e:real` THEN STRIP_TAC] THEN
7118       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN
7119       DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
7120       DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
7121       ASM_REWRITE_TAC[LE_REFL; o_THM] THEN ASM SET_TAC[]]]);;
7122
7123 (* ------------------------------------------------------------------------- *)
7124 (* Locally compact sets are closed in an open set and are homeomorphic       *)
7125 (* to an absolutely closed set if we have one more dimension to play with.   *)
7126 (* ------------------------------------------------------------------------- *)
7127
7128 let LOCALLY_COMPACT_OPEN_INTER_CLOSURE = prove
7129  (`!s:real^N->bool. locally compact s ==> ?t. open t /\ s = t INTER closure s`,
7130   GEN_TAC THEN SIMP_TAC[LOCALLY_COMPACT; OPEN_IN_OPEN; CLOSED_IN_CLOSED] THEN
7131   REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN
7132   REWRITE_TAC[GSYM CONJ_ASSOC; TAUT `p /\ x = y /\ q <=> x = y /\ p /\ q`] THEN
7133   ONCE_REWRITE_TAC[MESON[] `(?a b c. P a b c) <=> (?c b a. P a b c)`] THEN
7134   REWRITE_TAC[UNWIND_THM2] THEN
7135   GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
7136   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
7137   MAP_EVERY X_GEN_TAC [`u:real^N->real^N->bool`; `v:real^N->real^N->bool`] THEN
7138   DISCH_TAC THEN EXISTS_TAC `UNIONS (IMAGE (u:real^N->real^N->bool) s)` THEN
7139   ASM_SIMP_TAC[CLOSED_CLOSURE; OPEN_UNIONS; FORALL_IN_IMAGE] THEN
7140   REWRITE_TAC[INTER_UNIONS] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
7141    `UNIONS {v INTER s | v | v IN IMAGE (u:real^N->real^N->bool) s}` THEN
7142   CONJ_TAC THENL
7143    [SIMP_TAC[UNIONS_GSPEC; EXISTS_IN_IMAGE] THEN ASM SET_TAC[]; ALL_TAC] THEN
7144   AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE
7145    `(!x. x IN s ==> f(g x) = f'(g x))
7146     ==> {f x | x IN IMAGE g s} = {f' x | x IN IMAGE g s}`) THEN
7147   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
7148   REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN CONJ_TAC THENL
7149    [MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[];
7150   REWRITE_TAC[SUBSET_INTER; INTER_SUBSET] THEN MATCH_MP_TAC  SUBSET_TRANS THEN
7151   EXISTS_TAC `closure((u:real^N->real^N->bool) x INTER s)` THEN
7152   ASM_SIMP_TAC[OPEN_INTER_CLOSURE_SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN
7153   EXISTS_TAC `(v:real^N->real^N->bool) x` THEN
7154   ASM_SIMP_TAC[] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN
7155   ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM SET_TAC[]]);;
7156
7157 let LOCALLY_COMPACT_CLOSED_IN_OPEN = prove
7158  (`!s:real^N->bool.
7159     locally compact s ==> ?t. open t /\ closed_in (subtopology euclidean t) s`,
7160   GEN_TAC THEN
7161   DISCH_THEN(MP_TAC o MATCH_MP LOCALLY_COMPACT_OPEN_INTER_CLOSURE) THEN
7162   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
7163   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
7164   FIRST_X_ASSUM SUBST1_TAC THEN
7165   SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_CLOSURE]);;
7166
7167 let LOCALLY_COMPACT_HOMEOMORPHISM_PROJECTION_CLOSED = prove
7168  (`!s:real^M->bool.
7169         locally compact s
7170         ==> ?t:real^(M,N)finite_sum->bool f.
7171                 closed t /\ homeomorphism (s,t) (f,fstcart)`,
7172   REPEAT STRIP_TAC THEN ASM_CASES_TAC `closed(s:real^M->bool)` THENL
7173    [EXISTS_TAC `(s:real^M->bool) PCROSS {vec 0:real^N}` THEN
7174     EXISTS_TAC `\x. (pastecart x (vec 0):real^(M,N)finite_sum)` THEN
7175     ASM_SIMP_TAC[CLOSED_PCROSS; CLOSED_SING; HOMEOMORPHISM] THEN
7176     SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID;
7177       LINEAR_FSTCART; LINEAR_CONTINUOUS_ON; SUBSET; FORALL_IN_IMAGE] THEN
7178     REWRITE_TAC[FORALL_IN_PCROSS; PASTECART_IN_PCROSS; IN_SING] THEN
7179     SIMP_TAC[FSTCART_PASTECART];
7180     ALL_TAC] THEN
7181   FIRST_X_ASSUM(MP_TAC o MATCH_MP LOCALLY_COMPACT_OPEN_INTER_CLOSURE) THEN
7182   DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` (STRIP_ASSUME_TAC o GSYM)) THEN
7183   DISJ_CASES_TAC(SET_RULE `t = (:real^M) \/ ~((:real^M) DIFF t = {})`) THENL
7184    [ASM_MESON_TAC[CLOSURE_EQ; INTER_UNIV]; ALL_TAC] THEN
7185   ABBREV_TAC
7186    `f:real^M->real^(M,N)finite_sum =
7187       \x. pastecart x (inv(setdist({x},(:real^M) DIFF t)) % vec 1)` THEN
7188   SUBGOAL_THEN
7189    `homeomorphism (t,IMAGE (f:real^M->real^(M,N)finite_sum) t) (f,fstcart)`
7190   ASSUME_TAC THENL
7191    [SIMP_TAC[HOMEOMORPHISM; SUBSET_REFL; LINEAR_CONTINUOUS_ON;
7192              LINEAR_FSTCART; FORALL_IN_IMAGE] THEN
7193     MATCH_MP_TAC(TAUT `(r ==> q /\ s) /\ r /\ p ==> p /\ q /\ r /\ s`) THEN
7194     CONJ_TAC THENL [SET_TAC[]; EXPAND_TAC "f"] THEN
7195     SIMP_TAC[FSTCART_PASTECART] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
7196     REWRITE_TAC[CONTINUOUS_ON_ID] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
7197     REWRITE_TAC[o_DEF; CONTINUOUS_ON_CONST] THEN
7198     MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
7199     REWRITE_TAC[SETDIST_EQ_0_SING; CONTINUOUS_ON_LIFT_SETDIST] THEN
7200     ASM_SIMP_TAC[CLOSURE_COMPLEMENT; IN_DIFF; IN_UNIV; INTERIOR_OPEN];
7201     ALL_TAC] THEN
7202   EXISTS_TAC `IMAGE (f:real^M->real^(M,N)finite_sum) s` THEN
7203   EXISTS_TAC `f:real^M->real^(M,N)finite_sum` THEN CONJ_TAC THENL
7204    [MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN
7205     EXISTS_TAC `IMAGE (f:real^M->real^(M,N)finite_sum) t` THEN CONJ_TAC THENL
7206      [MATCH_MP_TAC HOMEOMORPHISM_IMP_CLOSED_MAP THEN MAP_EVERY EXISTS_TAC
7207        [`fstcart:real^(M,N)finite_sum->real^M`; `t:real^M->bool`] THEN
7208       ASM_REWRITE_TAC[] THEN EXPAND_TAC "s" THEN
7209       SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_CLOSURE];
7210       SUBGOAL_THEN
7211        `IMAGE (f:real^M->real^(M,N)finite_sum) t =
7212         {z | (setdist({fstcart z},(:real^M) DIFF t) % sndcart z) IN {vec 1}}`
7213       SUBST1_TAC THENL
7214        [EXPAND_TAC "f" THEN
7215         REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM; PASTECART_INJ;
7216                     FSTCART_PASTECART; SNDCART_PASTECART; IN_IMAGE; IN_INTER;
7217                     GSYM CONJ_ASSOC; UNWIND_THM1; IN_SING] THEN
7218         REWRITE_TAC[CART_EQ; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN
7219         MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN
7220         MP_TAC(ISPECL [`(:real^M) DIFF t`; `x:real^M`]
7221           (CONJUNCT1 SETDIST_EQ_0_SING)) THEN
7222         ASM_SIMP_TAC[CLOSURE_COMPLEMENT; IN_DIFF; IN_UNIV; INTERIOR_OPEN] THEN
7223         ASM_CASES_TAC `(x:real^M) IN t` THEN ASM_SIMP_TAC[REAL_FIELD
7224          `~(x = &0) ==> (y = inv x * &1 <=> x * y = &1)`] THEN
7225         DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN
7226         REWRITE_TAC[LE_REFL; DIMINDEX_GE_1] THEN REAL_ARITH_TAC;
7227         MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN
7228         REWRITE_TAC[CLOSED_SING] THEN X_GEN_TAC `z:real^(M,N)finite_sum` THEN
7229         MATCH_MP_TAC CONTINUOUS_MUL THEN
7230         SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_SNDCART; o_DEF] THEN
7231         SUBGOAL_THEN
7232          `(\z:real^(M,N)finite_sum.
7233              lift(setdist({fstcart z},(:real^M) DIFF t))) =
7234           (\x. lift (setdist ({x},(:real^M) DIFF t))) o fstcart`
7235         SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN
7236         MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN
7237         SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_FSTCART] THEN
7238         REWRITE_TAC[CONTINUOUS_AT_LIFT_SETDIST]]];
7239     MATCH_MP_TAC HOMEOMORPHISM_OF_SUBSETS THEN MAP_EVERY EXISTS_TAC
7240      [`t:real^M->bool`; `IMAGE (f:real^M->real^(M,N)finite_sum) t`] THEN
7241     ASM SET_TAC[]]);;
7242
7243 let LOCALLY_COMPACT_CLOSED_INTER_OPEN = prove
7244  (`!s:real^N->bool.
7245         locally compact s <=> ?t u. closed t /\ open u /\ s = t INTER u`,
7246   MESON_TAC[CLOSED_IMP_LOCALLY_COMPACT; OPEN_IMP_LOCALLY_COMPACT;
7247             LOCALLY_COMPACT_INTER; INTER_COMM; CLOSED_CLOSURE;
7248             LOCALLY_COMPACT_OPEN_INTER_CLOSURE]);;
7249
7250 (* ------------------------------------------------------------------------- *)
7251 (* Sura-Bura's results about compact components of sets.                     *)
7252 (* ------------------------------------------------------------------------- *)
7253
7254 let SURA_BURA_COMPACT = prove
7255  (`!s c:real^N->bool.
7256         compact s /\ c IN components s
7257         ==> c = INTERS {t | c SUBSET t /\
7258                             open_in (subtopology euclidean s) t /\
7259                             closed_in (subtopology euclidean s) t}`,
7260   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
7261   CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
7262   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [components]) THEN
7263   REWRITE_TAC[IN_ELIM_THM] THEN
7264   DISCH_THEN(X_CHOOSE_THEN `x:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
7265   DISCH_THEN(fun th -> SUBST1_TAC th THEN ASSUME_TAC(SYM th)) THEN
7266   MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
7267   SUBGOAL_THEN `(x:real^N) IN c` ASSUME_TAC THENL
7268    [ASM_MESON_TAC[CONNECTED_COMPONENT_REFL; IN]; ALL_TAC] THEN
7269   SUBGOAL_THEN `(c:real^N->bool) SUBSET s` ASSUME_TAC THENL
7270    [ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET]; ALL_TAC] THEN
7271   CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL
7272    [ASM_REWRITE_TAC[];
7273     MATCH_MP_TAC(SET_RULE `s IN t ==> INTERS t SUBSET s`) THEN
7274     REWRITE_TAC[IN_ELIM_THM; CONNECTED_COMPONENT_SUBSET;
7275                 OPEN_IN_SUBTOPOLOGY_REFL; CLOSED_IN_SUBTOPOLOGY_REFL] THEN
7276     REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV]] THEN
7277   W(fun (asl,w) -> ABBREV_TAC(mk_eq(`k:real^N->bool`,rand w))) THEN
7278   SUBGOAL_THEN `closed(k:real^N->bool)` ASSUME_TAC THENL
7279    [EXPAND_TAC "k" THEN MATCH_MP_TAC CLOSED_INTERS THEN
7280     REWRITE_TAC[IN_ELIM_THM] THEN
7281     ASM_MESON_TAC[CLOSED_IN_CLOSED_TRANS; COMPACT_IMP_CLOSED];
7282     ALL_TAC] THEN
7283   REWRITE_TAC[CONNECTED_CLOSED_IN_EQ; NOT_EXISTS_THM] THEN
7284   MAP_EVERY X_GEN_TAC [`k1:real^N->bool`; `k2:real^N->bool`] THEN
7285   STRIP_TAC THEN
7286   MP_TAC(ISPECL [`k1:real^N->bool`; `k2:real^N->bool`] SEPARATION_NORMAL) THEN
7287   ASM_REWRITE_TAC[NOT_EXISTS_THM; NOT_IMP] THEN CONJ_TAC THENL
7288    [ASM_MESON_TAC[CLOSED_IN_CLOSED_TRANS; COMPACT_IMP_CLOSED]; ALL_TAC] THEN
7289   MAP_EVERY X_GEN_TAC [`v1:real^N->bool`; `v2:real^N->bool`] THEN
7290   STRIP_TAC THEN
7291   MP_TAC(ISPECL [`s DIFF (v1 UNION v2):real^N->bool`;
7292                  `{t:real^N->bool | connected_component s x SUBSET t /\
7293                                     open_in (subtopology euclidean s) t /\
7294                                     closed_in (subtopology euclidean s) t}`]
7295         COMPACT_IMP_FIP) THEN
7296   ASM_SIMP_TAC[NOT_IMP; COMPACT_DIFF; OPEN_UNION; IN_ELIM_THM] THEN
7297   REPEAT CONJ_TAC THENL
7298    [ASM_MESON_TAC[CLOSED_IN_CLOSED_TRANS; COMPACT_IMP_CLOSED];
7299     ONCE_REWRITE_TAC[SUBSET] THEN REWRITE_TAC[IN_ELIM_THM];
7300     ASM SET_TAC[]] THEN
7301   X_GEN_TAC `f:(real^N->bool)->bool` THEN REPEAT STRIP_TAC THEN
7302   SUBGOAL_THEN
7303    `?c0:real^N->bool.
7304         c SUBSET c0 /\ c0 SUBSET (v1 UNION v2) /\
7305         open_in (subtopology euclidean s) c0 /\
7306         closed_in (subtopology euclidean s) c0`
7307   STRIP_ASSUME_TAC THENL
7308    [ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL
7309      [EXISTS_TAC `s:real^N->bool` THEN
7310       ASM_REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV;
7311                 OPEN_IN_SUBTOPOLOGY_REFL; CLOSED_IN_SUBTOPOLOGY_REFL] THEN
7312       UNDISCH_TAC
7313        `(s DIFF (v1 UNION v2)) INTER INTERS f :real^N->bool = {}` THEN
7314       ASM_REWRITE_TAC[INTERS_0; INTER_UNIV] THEN SET_TAC[];
7315       EXISTS_TAC `INTERS f :real^N->bool` THEN REPEAT CONJ_TAC THENL
7316        [ASM SET_TAC[];
7317         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
7318          `(s DIFF u) INTER t = {}
7319           ==> t SUBSET s
7320               ==> t SUBSET u`)) THEN
7321         MATCH_MP_TAC(SET_RULE
7322          `~(f = {}) /\ (!s. s IN f ==> s SUBSET t) ==> INTERS f SUBSET t`) THEN
7323         ASM_MESON_TAC[CLOSED_IN_SUBSET; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY];
7324         MATCH_MP_TAC OPEN_IN_INTERS THEN ASM_SIMP_TAC[];
7325         MATCH_MP_TAC CLOSED_IN_INTERS THEN ASM_SIMP_TAC[]]];
7326     ALL_TAC] THEN
7327   SUBGOAL_THEN `connected(c:real^N->bool)` MP_TAC THENL
7328    [ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT]; ALL_TAC] THEN
7329   SUBGOAL_THEN
7330    `closed_in (subtopology euclidean c0) (c0 INTER v1 :real^N->bool) /\
7331     closed_in (subtopology euclidean c0) (c0 INTER v2 :real^N->bool)`
7332   MP_TAC THENL
7333    [CONJ_TAC THEN
7334     MATCH_MP_TAC(MESON[]
7335      `closed_in top (c INTER closure v) /\
7336       c INTER closure v = c INTER v
7337       ==> closed_in top (c INTER v)`) THEN
7338     (CONJ_TAC THENL
7339       [MESON_TAC[CLOSED_IN_CLOSED; CLOSED_CLOSURE]; ALL_TAC]) THEN
7340     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
7341      `c0 SUBSET vv ==> c0 INTER (vv INTER v') = c0 INTER v
7342         ==> c0 INTER v' = c0 INTER v`)) THEN
7343     REWRITE_TAC[ONCE_REWRITE_RULE[INTER_COMM] UNION_OVER_INTER;
7344                 UNION_OVER_INTER] THEN
7345     SIMP_TAC[SET_RULE `s SUBSET t ==> s INTER t = s`; CLOSURE_SUBSET] THENL
7346      [ALL_TAC; ONCE_REWRITE_TAC[UNION_COMM]] THEN
7347     MATCH_MP_TAC(SET_RULE `t = {} ==> s UNION (u INTER t) = s`) THEN
7348     ASM_SIMP_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY] THEN ASM SET_TAC[];
7349     ALL_TAC] THEN
7350   REWRITE_TAC[CLOSED_IN_CLOSED] THEN DISCH_THEN(CONJUNCTS_THEN2
7351    (X_CHOOSE_THEN `u1:real^N->bool` STRIP_ASSUME_TAC)
7352    (X_CHOOSE_THEN `u2:real^N->bool` STRIP_ASSUME_TAC)) THEN
7353   SUBGOAL_THEN `closed(c0:real^N->bool)` ASSUME_TAC THENL
7354    [ASM_MESON_TAC[CLOSED_IN_CLOSED_TRANS; COMPACT_IMP_CLOSED]; ALL_TAC] THEN
7355   REWRITE_TAC[CONNECTED_CLOSED] THEN MAP_EVERY EXISTS_TAC
7356    [`c0 INTER u1:real^N->bool`; `c0 INTER u2:real^N->bool`] THEN
7357   ASM_SIMP_TAC[CLOSED_INTER] THEN
7358   REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN CONJ_TAC THENL
7359    [STRIP_TAC THEN
7360     SUBGOAL_THEN `c SUBSET (c0 INTER v2 :real^N->bool)` MP_TAC THENL
7361      [ASM SET_TAC[]; ALL_TAC] THEN
7362     SUBGOAL_THEN `k SUBSET (c0 INTER v2 :real^N->bool)` ASSUME_TAC THENL
7363      [ALL_TAC; ASM SET_TAC[]];
7364     STRIP_TAC THEN
7365     SUBGOAL_THEN `c SUBSET (c0 INTER v1 :real^N->bool)` ASSUME_TAC THENL
7366      [ASM SET_TAC[]; ALL_TAC] THEN
7367     SUBGOAL_THEN `k SUBSET (c0 INTER v1 :real^N->bool)` ASSUME_TAC THENL
7368      [ALL_TAC; ASM SET_TAC[]]] THEN
7369   (UNDISCH_THEN `k1 UNION k2 :real^N->bool = k` (K ALL_TAC) THEN
7370    EXPAND_TAC "k" THEN
7371    MATCH_MP_TAC(SET_RULE `s IN t ==> INTERS t SUBSET s`) THEN
7372    REWRITE_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL
7373     [ASM SET_TAC[];
7374      MATCH_MP_TAC OPEN_IN_INTER_OPEN THEN ASM_REWRITE_TAC[];
7375      ASM_REWRITE_TAC[] THEN
7376      MATCH_MP_TAC CLOSED_IN_INTER_CLOSED THEN ASM_REWRITE_TAC[]]));;
7377
7378 let SURA_BURA_CLOPEN_SUBSET = prove
7379  (`!s c u:real^N->bool.
7380         locally compact s /\
7381         c IN components s /\ compact c /\
7382         open u /\ c SUBSET u
7383         ==> ?k. open_in (subtopology euclidean s) k /\ compact k /\
7384                 c SUBSET k /\ k SUBSET u`,
7385   REPEAT STRIP_TAC THEN FIRST_X_ASSUM
7386    (MP_TAC o GEN_REWRITE_RULE I [LOCALLY_COMPACT_COMPACT_SUBOPEN]) THEN
7387   DISCH_THEN(MP_TAC o SPECL [`c:real^N->bool`; `u:real^N->bool`]) THEN
7388   ASM_SIMP_TAC[IN_COMPONENTS_SUBSET; LEFT_IMP_EXISTS_THM] THEN
7389   MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `k:real^N->bool`] THEN
7390   STRIP_TAC THEN
7391   MP_TAC(ISPECL [`k:real^N->bool`; `c:real^N->bool`]
7392        SURA_BURA_COMPACT) THEN
7393   ASM_SIMP_TAC[CLOSED_IN_COMPACT_EQ] THEN ANTS_TAC THENL
7394    [MATCH_MP_TAC COMPONENTS_INTERMEDIATE_SUBSET THEN
7395     EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
7396     DISCH_THEN(ASSUME_TAC o SYM)] THEN
7397   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
7398   DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN
7399   MP_TAC(ISPECL
7400    [`(:real^N) DIFF (u INTER w)`;
7401     `{t:real^N->bool | c SUBSET t /\ open_in (subtopology euclidean k) t /\
7402                        compact t /\ t SUBSET k}`]
7403    CLOSED_IMP_FIP_COMPACT) THEN
7404   ASM_SIMP_TAC[GSYM OPEN_CLOSED; OPEN_INTER; FORALL_IN_GSPEC] THEN
7405   GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN
7406   FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN
7407   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
7408   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SUBSET] THEN
7409   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; IN_ELIM_THM; SET_RULE
7410     `(UNIV DIFF u) INTER s = {} <=> s SUBSET u`] THEN
7411   DISCH_THEN(X_CHOOSE_THEN `f:(real^N->bool)->bool` MP_TAC) THEN
7412   ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL
7413    [ASM_REWRITE_TAC[NOT_IN_EMPTY; INTERS_0; FINITE_EMPTY] THEN
7414     REWRITE_TAC[SET_RULE `UNIV SUBSET s INTER t <=> s = UNIV /\ t = UNIV`] THEN
7415     DISCH_THEN(CONJUNCTS_THEN SUBST_ALL_TAC) THEN
7416     RULE_ASSUM_TAC(REWRITE_RULE[INTER_UNIV]) THEN
7417     UNDISCH_THEN `s:real^N->bool = v` (SUBST_ALL_TAC o SYM) THEN
7418     SUBGOAL_THEN `k:real^N->bool = s` SUBST_ALL_TAC THENL
7419      [ASM SET_TAC[]; REWRITE_TAC[SUBSET_UNIV]] THEN
7420     EXISTS_TAC `s:real^N->bool` THEN
7421     ASM_SIMP_TAC[IN_COMPONENTS_SUBSET; OPEN_IN_REFL];
7422     STRIP_TAC THEN EXISTS_TAC `INTERS f:real^N->bool` THEN
7423     ASM_SIMP_TAC[COMPACT_INTERS] THEN
7424     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
7425     MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `v:real^N->bool` THEN
7426     ASM_REWRITE_TAC[] THEN
7427     MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN
7428     EXISTS_TAC `k:real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
7429      [MATCH_MP_TAC OPEN_IN_INTERS THEN ASM_SIMP_TAC[];
7430       EXPAND_TAC "v" THEN REWRITE_TAC[SUBSET_INTER] THEN
7431       CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
7432       MATCH_MP_TAC(SET_RULE
7433        `(!t. t IN f ==> t SUBSET s) /\ ~(f = {}) ==> INTERS f SUBSET s`) THEN
7434       ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET_TRANS]]]);;
7435
7436 let SURA_BURA = prove
7437  (`!s c:real^N->bool.
7438         locally compact s /\ c IN components s /\ compact c
7439         ==> c = INTERS {k | c SUBSET k /\ compact k /\
7440                             open_in (subtopology euclidean s) k}`,
7441   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
7442    [SET_TAC[]; ALL_TAC] THEN
7443   REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN
7444   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
7445   MP_TAC(ISPECL [`{x:real^N}`; `c:real^N->bool`] SEPARATION_NORMAL) THEN
7446   ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_SING] THEN
7447   ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
7448   MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
7449   STRIP_TAC THEN
7450   MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N->bool`; `v:real^N->bool`]
7451         SURA_BURA_CLOPEN_SUBSET) THEN
7452   ASM_REWRITE_TAC[IN_INTERS; NOT_FORALL_THM; IN_ELIM_THM; NOT_IMP] THEN
7453   MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM SET_TAC[]);;
7454
7455 (* ------------------------------------------------------------------------- *)
7456 (* Relations between components and path components.                         *)
7457 (* ------------------------------------------------------------------------- *)
7458
7459 let OPEN_CONNECTED_COMPONENT = prove
7460  (`!s x:real^N. open s ==> open(connected_component s x)`,
7461   REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
7462   DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
7463   FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN
7464   ANTS_TAC THENL
7465    [ASM_MESON_TAC[SUBSET; CONNECTED_COMPONENT_SUBSET]; ALL_TAC] THEN
7466   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN
7467   ASM_REWRITE_TAC[] THEN
7468   SUBGOAL_THEN `connected_component s (x:real^N) = connected_component s y`
7469   SUBST1_TAC THENL
7470    [ASM_MESON_TAC[CONNECTED_COMPONENT_EQ];
7471     MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
7472     ASM_REWRITE_TAC[CENTRE_IN_BALL; CONNECTED_BALL]]);;
7473
7474 let IN_CLOSURE_CONNECTED_COMPONENT = prove
7475  (`!x y:real^N.
7476         x IN s /\ open s
7477         ==> (x IN closure(connected_component s y) <=>
7478              x IN connected_component s y)`,
7479   REPEAT STRIP_TAC THEN EQ_TAC THEN
7480   REWRITE_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN
7481   DISCH_TAC THEN SUBGOAL_THEN
7482    `~((connected_component s (x:real^N)) INTER
7483       closure(connected_component s y) = {})`
7484   MP_TAC THENL
7485    [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^N` THEN
7486     ASM_REWRITE_TAC[IN_INTER] THEN
7487     ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ];
7488     ASM_SIMP_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_CONNECTED_COMPONENT] THEN
7489     REWRITE_TAC[CONNECTED_COMPONENT_OVERLAP] THEN
7490     STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
7491     ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ]]);;
7492
7493 let PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT = prove
7494  (`!s x:real^N. (path_component s x) SUBSET (connected_component s x)`,
7495   REPEAT STRIP_TAC THEN
7496   ASM_CASES_TAC `(x:real^N) IN s` THENL
7497    [MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
7498     ASM_REWRITE_TAC[PATH_COMPONENT_SUBSET; IN; PATH_COMPONENT_REFL_EQ] THEN
7499     SIMP_TAC[PATH_CONNECTED_IMP_CONNECTED; PATH_CONNECTED_PATH_COMPONENT];
7500     ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY; SUBSET_REFL;
7501                   CONNECTED_COMPONENT_EQ_EMPTY]]);;
7502
7503 let PATH_COMPONENT_EQ_CONNECTED_COMPONENT = prove
7504  (`!s x:real^N.
7505         locally path_connected s
7506         ==> (path_component s x = connected_component s x)`,
7507   REPEAT STRIP_TAC THEN
7508   ASM_CASES_TAC `(x:real^N) IN s` THENL
7509    [ALL_TAC;
7510     ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY; CONNECTED_COMPONENT_EQ_EMPTY]] THEN
7511   MP_TAC(ISPECL[`s:real^N->bool`; `x:real^N`]
7512     CONNECTED_CONNECTED_COMPONENT) THEN REWRITE_TAC[CONNECTED_CLOPEN] THEN
7513   REWRITE_TAC[TAUT `p ==> q \/ r <=> p /\ ~q ==> r`] THEN
7514   DISCH_THEN MATCH_MP_TAC THEN
7515   ASM_REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY] THEN CONJ_TAC THENL
7516    [MATCH_MP_TAC OPEN_IN_SUBSET_TRANS;
7517     MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS] THEN
7518   EXISTS_TAC `s:real^N->bool` THEN
7519   ASM_SIMP_TAC[OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED;
7520                CLOSED_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED;
7521                PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT;
7522                CONNECTED_COMPONENT_SUBSET]);;
7523
7524 let LOCALLY_PATH_CONNECTED_PATH_COMPONENT = prove
7525  (`!s x:real^N.
7526         locally path_connected s
7527         ==> locally path_connected (path_component s x)`,
7528   MESON_TAC[LOCALLY_PATH_CONNECTED_CONNECTED_COMPONENT;
7529             PATH_COMPONENT_EQ_CONNECTED_COMPONENT]);;
7530
7531 let OPEN_PATH_CONNECTED_COMPONENT = prove
7532  (`!s x:real^N. open s ==> path_component s x = connected_component s x`,
7533   SIMP_TAC[PATH_COMPONENT_EQ_CONNECTED_COMPONENT;
7534   OPEN_IMP_LOCALLY_PATH_CONNECTED]);;
7535
7536 let PATH_CONNECTED_EQ_CONNECTED_LPC = prove
7537  (`!s. locally path_connected s ==> (path_connected s <=> connected s)`,
7538   REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT;
7539               CONNECTED_IFF_CONNECTED_COMPONENT] THEN
7540   SIMP_TAC[PATH_COMPONENT_EQ_CONNECTED_COMPONENT]);;
7541
7542 let PATH_CONNECTED_EQ_CONNECTED = prove
7543  (`!s. open s ==> (path_connected s <=> connected s)`,
7544   SIMP_TAC[PATH_CONNECTED_EQ_CONNECTED_LPC; OPEN_IMP_LOCALLY_PATH_CONNECTED]);;
7545
7546 let CONNECTED_OPEN_PATH_CONNECTED = prove
7547  (`!s:real^N->bool. open s /\ connected s ==> path_connected s`,
7548   SIMP_TAC[PATH_CONNECTED_EQ_CONNECTED]);;
7549
7550 let CONNECTED_OPEN_ARC_CONNECTED = prove
7551  (`!s:real^N->bool.
7552       open s /\ connected s
7553       ==> !x y. x IN s /\ y IN s
7554                 ==> x = y \/
7555                     ?g. arc g /\
7556                         path_image g SUBSET s /\
7557                         pathstart g = x /\
7558                         pathfinish g = y`,
7559   GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_OPEN_PATH_CONNECTED) THEN
7560   REWRITE_TAC[PATH_CONNECTED_ARCWISE] THEN
7561   REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MESON_TAC[]);;
7562
7563 let OPEN_COMPONENTS = prove
7564  (`!u:real^N->bool s. open u /\ s IN components u ==> open s`,
7565   REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC (MESON[IN_COMPONENTS;
7566   ASSUME `s:real^N->bool IN components u`] `?x. s:real^N->bool =
7567   connected_component u x`) THEN ASM_SIMP_TAC [OPEN_CONNECTED_COMPONENT]);;
7568
7569 let COMPONENTS_OPEN_UNIQUE = prove
7570  (`!f:(real^N->bool)->bool s.
7571         (!c. c IN f ==> open c /\ connected c /\ ~(c = {})) /\
7572         pairwise DISJOINT f /\ UNIONS f = s
7573         ==> components s = f`,
7574   REPEAT STRIP_TAC THEN
7575   MATCH_MP_TAC CONNECTED_DISJOINT_UNIONS_OPEN_UNIQUE THEN
7576   ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; PAIRWISE_DISJOINT_COMPONENTS] THEN
7577   ASM_MESON_TAC[OPEN_COMPONENTS; IN_COMPONENTS_NONEMPTY;
7578                 IN_COMPONENTS_CONNECTED; OPEN_UNIONS]);;
7579
7580 let CONTINUOUS_ON_COMPONENTS = prove
7581  (`!f:real^M->real^N s.
7582         locally connected s /\ (!c. c IN components s ==> f continuous_on c)
7583         ==> f continuous_on s`,
7584   REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPONENTS_GEN THEN
7585   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[OPEN_IN_COMPONENTS_LOCALLY_CONNECTED]);;
7586
7587 let CONTINUOUS_ON_COMPONENTS_EQ = prove
7588  (`!f s. locally connected s
7589          ==> (f continuous_on s <=>
7590               !c. c IN components s ==> f continuous_on c)`,
7591   REPEAT STRIP_TAC THEN EQ_TAC THENL
7592    [MESON_TAC[CONTINUOUS_ON_SUBSET; IN_COMPONENTS_SUBSET];
7593     ASM_MESON_TAC[CONTINUOUS_ON_COMPONENTS]]);;
7594
7595 let CONTINUOUS_ON_COMPONENTS_OPEN = prove
7596  (`!f:real^M->real^N s.
7597         open s /\ (!c. c IN components s ==> f continuous_on c)
7598         ==> f continuous_on s`,
7599   ASM_MESON_TAC[CONTINUOUS_ON_COMPONENTS; OPEN_IMP_LOCALLY_CONNECTED]);;
7600
7601 let CONTINUOUS_ON_COMPONENTS_OPEN_EQ = prove
7602  (`!f s. open s
7603          ==> (f continuous_on s <=>
7604               !c. c IN components s ==> f continuous_on c)`,
7605   REPEAT STRIP_TAC THEN EQ_TAC THENL
7606    [MESON_TAC[CONTINUOUS_ON_SUBSET; IN_COMPONENTS_SUBSET];
7607     ASM_MESON_TAC[CONTINUOUS_ON_COMPONENTS_OPEN]]);;
7608
7609 let CLOSED_IN_UNION_COMPLEMENT_COMPONENTS = prove
7610  (`!u s:real^N->bool c.
7611         locally connected u /\
7612         closed_in (subtopology euclidean u) s /\ c SUBSET components(u DIFF s)
7613         ==> closed_in (subtopology euclidean u) (s UNION UNIONS c)`,
7614   REPEAT STRIP_TAC THEN
7615   SUBGOAL_THEN
7616    `s UNION UNIONS c:real^N->bool =
7617     u DIFF (UNIONS(components(u DIFF s) DIFF c))`
7618   SUBST1_TAC THENL
7619    [MATCH_MP_TAC(SET_RULE
7620      `s SUBSET u /\ u DIFF s = c UNION c' /\ DISJOINT c c'
7621       ==> s UNION c = u DIFF c'`) THEN
7622     FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
7623     ASM_SIMP_TAC[GSYM UNIONS_UNION; GSYM UNIONS_COMPONENTS; SET_RULE
7624      `s SUBSET t ==> s UNION (t DIFF s) = t`] THEN
7625     MATCH_MP_TAC(SET_RULE
7626      `(!s t. s IN c /\ t IN c' ==> DISJOINT s t)
7627       ==> DISJOINT (UNIONS c) (UNIONS c')`) THEN
7628     REWRITE_TAC[IN_DIFF] THEN REPEAT STRIP_TAC THEN
7629     MP_TAC(ISPEC `(u:real^N->bool) DIFF s`
7630        PAIRWISE_DISJOINT_COMPONENTS) THEN
7631     REWRITE_TAC[pairwise] THEN DISCH_THEN MATCH_MP_TAC THEN
7632     REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN ASM_MESON_TAC[];
7633     REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_DIFF] THEN
7634     MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
7635     MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN
7636     MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[IN_DIFF] THEN
7637     X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN
7638     MATCH_MP_TAC OPEN_IN_TRANS THEN
7639     EXISTS_TAC `u DIFF s:real^N->bool` THEN CONJ_TAC THENL
7640      [MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN
7641       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
7642       EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[];
7643       ALL_TAC] THEN
7644     MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_SIMP_TAC[OPEN_IN_REFL]]);;
7645
7646 let CLOSED_UNION_COMPLEMENT_COMPONENTS = prove
7647  (`!s c. closed s /\ c SUBSET components((:real^N) DIFF s)
7648          ==> closed(s UNION UNIONS c)`,
7649   ONCE_REWRITE_TAC[CLOSED_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
7650   REPEAT STRIP_TAC THEN
7651   MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENTS THEN
7652   ASM_REWRITE_TAC[LOCALLY_CONNECTED_UNIV]);;
7653
7654 let CLOSED_IN_UNION_COMPLEMENT_COMPONENT = prove
7655  (`!u s c:real^N->bool.
7656         locally connected u /\
7657         closed_in (subtopology euclidean u) s /\
7658         c IN components(u DIFF s)
7659         ==> closed_in (subtopology euclidean u) (s UNION c)`,
7660   REPEAT STRIP_TAC THEN
7661   GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM UNIONS_1] THEN
7662   MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENTS THEN
7663   ASM_REWRITE_TAC[SING_SUBSET]);;
7664
7665 let CLOSED_UNION_COMPLEMENT_COMPONENT = prove
7666  (`!s c. closed s /\ c IN components((:real^N) DIFF s) ==> closed(s UNION c)`,
7667   ONCE_REWRITE_TAC[CLOSED_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
7668   REPEAT STRIP_TAC THEN
7669   MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENT THEN
7670   ASM_REWRITE_TAC[LOCALLY_CONNECTED_UNIV]);;
7671
7672 let COUNTABLE_CONNECTED_COMPONENTS = prove
7673  (`!s:real^N->bool t.
7674     locally connected s ==> COUNTABLE {connected_component s x | x IN t}`,
7675   REPEAT STRIP_TAC THEN
7676   MP_TAC(ISPECL [`{connected_component s (x:real^N) |x| x IN s}`;
7677                 `s:real^N->bool`] LINDELOF_OPEN_IN) THEN
7678   ASM_SIMP_TAC[FORALL_IN_GSPEC; OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED;
7679                UNIONS_CONNECTED_COMPONENT] THEN
7680   DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
7681   MATCH_MP_TAC COUNTABLE_SUBSET THEN
7682   EXISTS_TAC `({}:real^N->bool) INSERT u` THEN
7683   ASM_REWRITE_TAC[COUNTABLE_INSERT] THEN
7684   REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_INSERT] THEN
7685   X_GEN_TAC `x:real^N` THEN REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY] THEN
7686   DISCH_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN
7687   MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`]
7688     COMPLEMENT_CONNECTED_COMPONENT_UNIONS) THEN
7689   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
7690   REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
7691   ASM_REWRITE_TAC[IN_DIFF] THEN
7692   ASM_CASES_TAC `(x:real^N) IN connected_component s x` THENL
7693    [ALL_TAC; ASM_MESON_TAC[IN; CONNECTED_COMPONENT_REFL]] THEN
7694   ASM_REWRITE_TAC[] THEN
7695   SUBGOAL_THEN `(x:real^N) IN UNIONS u` MP_TAC THENL
7696    [ASM_MESON_TAC[]; ALL_TAC] THEN
7697   MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN
7698   MATCH_MP_TAC SUBSET_UNIONS THEN ASM SET_TAC[]);;
7699
7700 let COUNTABLE_PATH_COMPONENTS = prove
7701  (`!s:real^N->bool t.
7702     locally path_connected s ==> COUNTABLE {path_component s x | x IN t}`,
7703   REPEAT STRIP_TAC THEN
7704   MP_TAC(ISPECL [`{path_component s (x:real^N) |x| x IN s}`;
7705                 `s:real^N->bool`] LINDELOF_OPEN_IN) THEN
7706   ASM_SIMP_TAC[FORALL_IN_GSPEC; OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED;
7707                UNIONS_PATH_COMPONENT] THEN
7708   DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
7709   MATCH_MP_TAC COUNTABLE_SUBSET THEN
7710   EXISTS_TAC `({}:real^N->bool) INSERT u` THEN
7711   ASM_REWRITE_TAC[COUNTABLE_INSERT] THEN
7712   REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_INSERT] THEN
7713   X_GEN_TAC `x:real^N` THEN REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY] THEN
7714   DISCH_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN
7715   MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`]
7716     COMPLEMENT_PATH_COMPONENT_UNIONS) THEN
7717   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
7718   REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
7719   ASM_REWRITE_TAC[IN_DIFF] THEN
7720   ASM_CASES_TAC `(x:real^N) IN path_component s x` THENL
7721    [ALL_TAC; ASM_MESON_TAC[IN; PATH_COMPONENT_REFL]] THEN
7722   ASM_REWRITE_TAC[] THEN
7723   SUBGOAL_THEN `(x:real^N) IN UNIONS u` MP_TAC THENL
7724    [ASM_MESON_TAC[]; ALL_TAC] THEN
7725   MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN
7726   MATCH_MP_TAC SUBSET_UNIONS THEN ASM SET_TAC[]);;
7727
7728 let COUNTABLE_COMPONENTS = prove
7729  (`!s:real^N->bool. locally connected s ==> COUNTABLE(components s)`,
7730   SIMP_TAC[components; COUNTABLE_CONNECTED_COMPONENTS]);;
7731
7732 let FRONTIER_MINIMAL_SEPARATING_CLOSED = prove
7733  (`!s c. closed s /\ ~connected((:real^N) DIFF s) /\
7734          (!t. closed t /\ t PSUBSET s ==> connected((:real^N) DIFF t)) /\
7735          c IN components ((:real^N) DIFF s)
7736          ==> frontier c = s`,
7737   REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o
7738     GEN_REWRITE_RULE RAND_CONV [CONNECTED_EQ_CONNECTED_COMPONENTS_EQ]) THEN
7739   DISCH_THEN(MP_TAC o MATCH_MP (MESON[]
7740    `~(!x x'. x IN s /\ x' IN s ==> x = x')
7741     ==> !x. x IN s ==> ?y. y IN s /\ ~(y = x)`)) THEN
7742   DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN
7743   DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN
7744   FIRST_X_ASSUM(MP_TAC o SPEC `frontier c:real^N->bool`) THEN
7745   REWRITE_TAC[SET_RULE `s PSUBSET t <=> s SUBSET t /\ ~(t SUBSET s)`;
7746               GSYM SUBSET_ANTISYM_EQ] THEN
7747   ASM_SIMP_TAC[FRONTIER_OF_COMPONENTS_CLOSED_COMPLEMENT; FRONTIER_CLOSED] THEN
7748   MATCH_MP_TAC(TAUT `~r ==> (~p ==> r) ==> p`) THEN
7749   REWRITE_TAC[connected] THEN
7750   MAP_EVERY EXISTS_TAC [`c:real^N->bool`; `(:real^N) DIFF closure c`] THEN
7751   REPEAT CONJ_TAC THENL
7752    [ASM_MESON_TAC[OPEN_COMPONENTS; closed];
7753     REWRITE_TAC[GSYM closed; CLOSED_CLOSURE];
7754     MP_TAC(ISPEC `c:real^N->bool` INTERIOR_SUBSET) THEN
7755     REWRITE_TAC[frontier] THEN SET_TAC[];
7756     MATCH_MP_TAC(SET_RULE
7757      `c SUBSET c' ==> c INTER (UNIV DIFF c') INTER s = {}`) THEN
7758     REWRITE_TAC[GSYM INTERIOR_COMPLEMENT; CLOSURE_SUBSET];
7759     REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE
7760      `ci = c /\ ~(c = {})
7761       ==> ~(c INTER (UNIV DIFF (cc DIFF ci)) = {})`) THEN
7762     ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY; INTERIOR_OPEN; closed;
7763                   OPEN_COMPONENTS];
7764     REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE
7765      `~(UNIV DIFF c = {})
7766       ==> ~((UNIV DIFF c) INTER (UNIV DIFF (c DIFF i)) = {})`) THEN
7767     REWRITE_TAC[GSYM INTERIOR_COMPLEMENT] THEN
7768     MATCH_MP_TAC(SET_RULE `!t. t SUBSET s /\ ~(t = {}) ==> ~(s = {})`) THEN
7769     EXISTS_TAC `d:real^N->bool` THEN CONJ_TAC THENL
7770      [ALL_TAC; ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]] THEN
7771     MATCH_MP_TAC INTERIOR_MAXIMAL THEN
7772     REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN
7773     ASM_MESON_TAC[COMPONENTS_NONOVERLAP; OPEN_COMPONENTS; GSYM closed]]);;
7774
7775 let FRONTIER_MINIMAL_SEPARATING_CLOSED_POINTWISE = prove
7776  (`!s a b. closed s /\ ~(a IN s) /\
7777            ~connected_component ((:real^N) DIFF s) a b /\
7778            (!t. closed t /\ t PSUBSET s
7779                 ==> connected_component((:real^N) DIFF t) a b)
7780            ==> frontier(connected_component ((:real^N) DIFF s) a) = s`,
7781   REPEAT STRIP_TAC THEN
7782   MATCH_MP_TAC(SET_RULE `s SUBSET t /\ ~(s PSUBSET t) ==> s = t`) THEN
7783   CONJ_TAC THENL
7784    [MATCH_MP_TAC FRONTIER_OF_COMPONENTS_CLOSED_COMPLEMENT THEN
7785     ASM_REWRITE_TAC[IN_COMPONENTS; IN_UNIV; IN_DIFF] THEN ASM SET_TAC[];
7786     DISCH_TAC THEN  FIRST_X_ASSUM(MP_TAC o SPEC
7787      `frontier (connected_component ((:real^N) DIFF s) a)`) THEN
7788     ASM_REWRITE_TAC[FRONTIER_CLOSED] THEN
7789     GEN_REWRITE_TAC RAND_CONV [connected_component] THEN
7790     DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
7791     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
7792      `t SUBSET UNIV DIFF f ==> ~(t INTER f = {}) ==> F`)) THEN
7793     MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN
7794     ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_DIFF] THEN
7795     CONJ_TAC THENL [EXISTS_TAC `a:real^N`; EXISTS_TAC `b:real^N`] THEN
7796     ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[IN] THEN
7797     ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ; IN_UNIV; IN_DIFF]]);;
7798
7799 (* ------------------------------------------------------------------------- *)
7800 (* If two points are separated by a closed set, there's a minimal one.       *)
7801 (* ------------------------------------------------------------------------- *)
7802
7803 let CLOSED_IRREDUCIBLE_SEPARATOR = prove
7804  (`!s a b:real^N.
7805       closed s /\ ~connected_component ((:real^N) DIFF s) a b
7806       ==> ?t. t SUBSET s /\ closed t /\ ~(t = {}) /\
7807               ~connected_component ((:real^N) DIFF t) a b /\
7808               !u. u PSUBSET t ==> connected_component ((:real^N) DIFF u) a b`,
7809   MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `a:real^N`; `b:real^N`] THEN
7810   STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN c` THENL
7811    [EXISTS_TAC `{a:real^N}` THEN ASM_REWRITE_TAC[CLOSED_SING; SING_SUBSET] THEN
7812     SIMP_TAC[SET_RULE `s PSUBSET {a} <=> s = {}`; NOT_INSERT_EMPTY] THEN
7813     REWRITE_TAC[DIFF_EMPTY; CONNECTED_COMPONENT_UNIV] THEN
7814     CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[UNIV]] THEN
7815     DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN SET_TAC[];
7816     ALL_TAC] THEN
7817   ASM_CASES_TAC `(b:real^N) IN c` THENL
7818    [EXISTS_TAC `{b:real^N}` THEN ASM_REWRITE_TAC[CLOSED_SING; SING_SUBSET] THEN
7819     SIMP_TAC[SET_RULE `s PSUBSET {a} <=> s = {}`; NOT_INSERT_EMPTY] THEN
7820     REWRITE_TAC[DIFF_EMPTY; CONNECTED_COMPONENT_UNIV] THEN
7821     CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[UNIV]] THEN
7822     DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN SET_TAC[];
7823     ALL_TAC] THEN
7824   MAP_EVERY ABBREV_TAC
7825    [`r = connected_component ((:real^N) DIFF c) a`;
7826     `s = connected_component ((:real^N) DIFF closure r) b`] THEN
7827   EXISTS_TAC `frontier s:real^N->bool` THEN REWRITE_TAC[FRONTIER_CLOSED] THEN
7828   SUBGOAL_THEN `(a:real^N) IN r` ASSUME_TAC THENL
7829    [EXPAND_TAC "r" THEN REWRITE_TAC[IN] THEN
7830     REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM SET_TAC[];
7831     ALL_TAC] THEN
7832   SUBGOAL_THEN `(b:real^N) IN s` ASSUME_TAC THENL
7833    [EXPAND_TAC "s" THEN
7834     REWRITE_TAC[IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
7835     ASM_REWRITE_TAC[IN_UNIV; IN_DIFF] THEN
7836     REWRITE_TAC[CLOSURE_UNION_FRONTIER; IN_UNION; DE_MORGAN_THM] THEN
7837     CONJ_TAC THENL [ASM_REWRITE_TAC[IN]; EXPAND_TAC "r"] THEN
7838     DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET]
7839       FRONTIER_OF_CONNECTED_COMPONENT_SUBSET)) THEN
7840     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
7841      `~(b IN s) ==> t SUBSET s ==> b IN t ==> F`)) THEN
7842     ASM_REWRITE_TAC[FRONTIER_COMPLEMENT; FRONTIER_SUBSET_EQ];
7843     ALL_TAC] THEN
7844   SUBGOAL_THEN `frontier(s:real^N->bool) SUBSET frontier r` ASSUME_TAC THENL
7845    [EXPAND_TAC "s" THEN
7846     MATCH_MP_TAC(MESON[SUBSET_TRANS; FRONTIER_OF_CONNECTED_COMPONENT_SUBSET]
7847      `frontier s SUBSET t ==> frontier(connected_component s a) SUBSET t`) THEN
7848     REWRITE_TAC[FRONTIER_COMPLEMENT; FRONTIER_CLOSURE_SUBSET];
7849     ALL_TAC] THEN
7850   MATCH_MP_TAC(TAUT
7851    `(q ==> r) /\ p /\ ~r /\ s ==> p /\ ~q /\ ~r /\ s`) THEN
7852   CONJ_TAC THENL
7853    [SIMP_TAC[DIFF_EMPTY; CONNECTED_COMPONENT_UNIV] THEN REWRITE_TAC[UNIV];
7854     ALL_TAC] THEN
7855   REPEAT CONJ_TAC THENL
7856    [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
7857       SUBSET_TRANS)) THEN
7858     EXPAND_TAC "r" THEN
7859     MATCH_MP_TAC(MESON[SUBSET_TRANS; FRONTIER_OF_CONNECTED_COMPONENT_SUBSET]
7860      `frontier s SUBSET t ==>frontier (connected_component s a) SUBSET t`) THEN
7861     ASM_REWRITE_TAC[FRONTIER_COMPLEMENT; FRONTIER_SUBSET_EQ];
7862     REWRITE_TAC[connected_component; NOT_EXISTS_THM; SET_RULE
7863                   `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN
7864     X_GEN_TAC `t:real^N->bool` THEN
7865     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
7866      (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN
7867     REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN
7868     ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN CONJ_TAC THENL
7869      [EXISTS_TAC `b:real^N` THEN ASM_REWRITE_TAC[]; EXISTS_TAC `a:real^N`] THEN
7870     ASM_REWRITE_TAC[IN_DIFF] THEN EXPAND_TAC "s" THEN REWRITE_TAC[IN] THEN
7871     DISCH_THEN(MP_TAC o CONJUNCT2 o MATCH_MP CONNECTED_COMPONENT_IN) THEN
7872     REWRITE_TAC[IN_DIFF; IN_UNIV] THEN
7873     MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN
7874     ASM_REWRITE_TAC[];
7875     X_GEN_TAC `u:real^N->bool` THEN REWRITE_TAC[PSUBSET_ALT] THEN
7876     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
7877     DISCH_THEN(X_CHOOSE_THEN `p:real^N` STRIP_ASSUME_TAC) THEN
7878     REWRITE_TAC[connected_component] THEN
7879     EXISTS_TAC `(p:real^N) INSERT (s UNION r)` THEN
7880     ASM_REWRITE_TAC[IN_INSERT; IN_UNION] THEN CONJ_TAC THENL
7881      [ONCE_REWRITE_TAC[SET_RULE
7882        `a INSERT (s UNION t) = (a INSERT s) UNION (a INSERT t)`] THEN
7883       MATCH_MP_TAC CONNECTED_UNION THEN REWRITE_TAC[CONJ_ASSOC] THEN
7884       CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
7885       CONJ_TAC THEN MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THENL
7886        [EXISTS_TAC `s:real^N->bool`; EXISTS_TAC `r:real^N->bool`] THEN
7887       (CONJ_TAC THENL
7888         [ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT]; ALL_TAC] THEN
7889        CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[INSERT_SUBSET]] THEN
7890        REWRITE_TAC[CLOSURE_SUBSET] THEN
7891        ASM_REWRITE_TAC[CLOSURE_UNION_FRONTIER; IN_UNION] THEN ASM SET_TAC[]);
7892       MATCH_MP_TAC(SET_RULE
7893        `s INTER u = {} /\ t INTER u = {} /\ ~(p IN u)
7894         ==> p INSERT (s UNION t) SUBSET UNIV DIFF u`) THEN
7895       ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
7896        [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
7897          `u SUBSET t ==> t INTER s = {} ==> s INTER u = {}`)) THEN
7898         REWRITE_TAC[FRONTIER_DISJOINT_EQ] THEN EXPAND_TAC "s";
7899         SUBGOAL_THEN `frontier(r:real^N->bool) INTER r = {}`
7900          (fun th -> ASM SET_TAC[th]) THEN
7901         REWRITE_TAC[FRONTIER_DISJOINT_EQ] THEN EXPAND_TAC "r"] THEN
7902       MATCH_MP_TAC OPEN_CONNECTED_COMPONENT THEN
7903       ASM_REWRITE_TAC[GSYM closed; CLOSED_CLOSURE]]]);;
7904
7905 (* ------------------------------------------------------------------------- *)
7906 (* Lower bound on norms within segment between vectors.                      *)
7907 (* Could have used these for connectedness results below, in fact.           *)
7908 (* ------------------------------------------------------------------------- *)
7909
7910 let NORM_SEGMENT_LOWERBOUND = prove
7911  (`!a b x:real^N r d.
7912         &0 < r /\
7913         norm(a) = r /\ norm(b) = r /\ x IN segment[a,b] /\
7914         a dot b = d * r pow 2
7915         ==> sqrt((&1 - abs d) / &2) * r <= norm(x)`,
7916   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM real_ge] THEN
7917   REWRITE_TAC[NORM_GE_SQUARE] THEN DISJ2_TAC THEN
7918   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN
7919   DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN
7920   ASM_REWRITE_TAC[real_ge; DOT_LMUL; DOT_RMUL; REAL_MUL_RZERO; VECTOR_ARITH
7921    `(a + b) dot (a + b) = a dot a + b dot b + &2 * a dot b`] THEN
7922   MATCH_MP_TAC REAL_LE_TRANS THEN
7923   EXISTS_TAC `(&1 - u) * (&1 - u) * r pow 2 + u * u * r pow 2 -
7924               &2 * (&1 - u) * u * abs d * r pow 2` THEN
7925   CONJ_TAC THENL
7926    [REWRITE_TAC[REAL_POW_MUL; REAL_MUL_ASSOC] THEN
7927     REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN
7928     MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN
7929     REWRITE_TAC[GSYM REAL_POW_2; REAL_ARITH
7930      `(&1 - u) pow 2 + u pow 2 - ((&2 * (&1 - u)) * u) * d =
7931       (&1 + d) * (&1 - &2 * u + &2 * u pow 2) - d`] THEN
7932     MATCH_MP_TAC REAL_LE_TRANS THEN
7933     EXISTS_TAC `(&1 + abs d) * &1 / &2 - abs d` THEN CONJ_TAC THENL
7934      [REWRITE_TAC[REAL_ARITH `(&1 + d) * &1 / &2 - d = (&1 - d) / &2`] THEN
7935       MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SQRT_POW_2 THEN
7936       MP_TAC(ISPECL [`a:real^N`; `b:real^N`] NORM_CAUCHY_SCHWARZ_ABS) THEN
7937       ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_POW2_ABS] THEN
7938       ASM_REWRITE_TAC[REAL_ARITH `r * r = &1 * r pow 2`] THEN
7939       ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_POW_LT] THEN REAL_ARITH_TAC;
7940       MATCH_MP_TAC(REAL_ARITH `x <= y ==> x - a <= y - a`) THEN
7941       MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL
7942        [REAL_ARITH_TAC;
7943         MATCH_MP_TAC(REAL_ARITH
7944          `&0 <= (u - &1 / &2) * (u - &1 / &2)
7945           ==> &1 / &2 <= &1 - &2 * u + &2 * u pow 2`) THEN
7946         REWRITE_TAC[REAL_LE_SQUARE]]];
7947     ASM_REWRITE_TAC[GSYM NORM_POW_2; REAL_LE_LADD; real_sub] THEN
7948     MATCH_MP_TAC(REAL_ARITH `abs(a) <= --x ==> x <= a`) THEN
7949     ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_MUL_LNEG; REAL_NEG_NEG] THEN
7950     REWRITE_TAC[REAL_ABS_POW; REAL_POW2_ABS; REAL_ABS_NUM] THEN
7951     REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN
7952     REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN
7953     ASM_REWRITE_TAC[real_abs; GSYM real_sub; REAL_SUB_LE; REAL_POS] THEN
7954     MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THEN
7955     REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN
7956           CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
7957     ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]);;
7958
7959 (* ------------------------------------------------------------------------- *)
7960 (* Special case of orthogonality (could replace 2 by sqrt(2)).               *)
7961 (* ------------------------------------------------------------------------- *)
7962
7963 let NORM_SEGMENT_ORTHOGONAL_LOWERBOUND = prove
7964  (`!a b:real^N x r.
7965         r <= norm(a) /\ r <= norm(b) /\ orthogonal a b /\ x IN segment[a,b]
7966         ==> r / &2 <= norm(x)`,
7967   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM real_ge] THEN
7968   REWRITE_TAC[NORM_GE_SQUARE] THEN REWRITE_TAC[real_ge] THEN
7969   ASM_CASES_TAC `r <= &0` THEN ASM_REWRITE_TAC[] THENL
7970    [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
7971   REWRITE_TAC[orthogonal] THEN STRIP_TAC THEN DISJ2_TAC THEN
7972   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN
7973   DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN
7974   ASM_REWRITE_TAC[DOT_LMUL; DOT_RMUL; REAL_MUL_RZERO; VECTOR_ARITH
7975    `(a + b) dot (a + b) = a dot a + b dot b + &2 * a dot b`] THEN
7976   MATCH_MP_TAC REAL_LE_TRANS THEN
7977   EXISTS_TAC `(&1 - u) * (&1 - u) * r pow 2 + u * u * r pow 2` THEN
7978   CONJ_TAC THENL
7979    [REWRITE_TAC[REAL_ARITH `(r / &2) pow 2 = &1 / &4 * r pow 2`] THEN
7980     REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; REAL_MUL_ASSOC] THEN
7981     MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN
7982     MATCH_MP_TAC(REAL_ARITH
7983      `&0 <= (u - &1 / &2) * (u - &1 / &2)
7984       ==> &1 / &4 <= (&1 - u) * (&1 - u) + u * u`) THEN
7985     REWRITE_TAC[REAL_LE_SQUARE];
7986     REWRITE_TAC[REAL_ADD_RID] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN
7987     CONJ_TAC THEN
7988     REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN
7989         CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
7990     ASM_REWRITE_TAC[]]);;
7991
7992 (* ------------------------------------------------------------------------- *)
7993 (* Accessibility of frontier points.                                         *)
7994 (* ------------------------------------------------------------------------- *)
7995
7996 let DENSE_ACCESSIBLE_FRONTIER_POINTS = prove
7997  (`!s:real^N->bool v.
7998         open s /\ open_in (subtopology euclidean (frontier s)) v /\ ~(v = {})
7999         ==> ?g. arc g /\
8000                 IMAGE g (interval [vec 0,vec 1] DELETE vec 1) SUBSET s /\
8001                 pathstart g IN s /\ pathfinish g IN v`,
8002   REPEAT STRIP_TAC THEN
8003   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
8004   DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN
8005   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN
8006   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `z:real^N`)) THEN
8007   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
8008   X_GEN_TAC `r:real` THEN STRIP_TAC THEN
8009   SUBGOAL_THEN `(z:real^N) IN frontier s` MP_TAC THENL
8010    [ASM SET_TAC[];
8011     DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
8012     REWRITE_TAC[frontier] THEN ASM_SIMP_TAC[IN_DIFF; INTERIOR_OPEN]] THEN
8013   REWRITE_TAC[closure; IN_UNION; TAUT `(p \/ q) /\ ~p <=> ~p /\ q`] THEN
8014   REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
8015   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_INFINITE_BALL]) THEN
8016   DISCH_THEN(MP_TAC o SPEC `r:real`) THEN ASM_REWRITE_TAC[] THEN
8017   ASM_CASES_TAC `s INTER ball(z:real^N,r) = {}` THENL
8018    [ASM_MESON_TAC[INFINITE; FINITE_EMPTY]; DISCH_THEN(K ALL_TAC)] THEN
8019   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
8020   REWRITE_TAC[IN_INTER] THEN
8021   DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
8022   SUBGOAL_THEN `~((y:real^N) IN frontier s)` ASSUME_TAC THENL
8023    [ASM_SIMP_TAC[IN_DIFF; INTERIOR_OPEN; frontier]; ALL_TAC] THEN
8024   SUBGOAL_THEN `path_connected(ball(z:real^N,r))` MP_TAC THENL
8025    [ASM_SIMP_TAC[CONVEX_BALL; CONVEX_IMP_PATH_CONNECTED]; ALL_TAC] THEN
8026   REWRITE_TAC[PATH_CONNECTED_ARCWISE] THEN
8027   DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `z:real^N`]) THEN
8028   ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN
8029   ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
8030   DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
8031   MP_TAC(ISPEC
8032     `IMAGE drop {t | t IN interval[vec 0,vec 1] /\
8033                      (g:real^1->real^N) t IN frontier s}`
8034    COMPACT_ATTAINS_INF) THEN
8035   REWRITE_TAC[EXISTS_IN_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE; IMP_CONJ] THEN
8036   REWRITE_TAC[IMP_IMP; FORALL_IN_GSPEC; EXISTS_IN_GSPEC; GSYM IMAGE_o] THEN
8037   REWRITE_TAC[o_DEF; LIFT_DROP; IMAGE_ID] THEN
8038   ANTS_TAC THENL
8039    [CONJ_TAC THENL
8040      [REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL
8041        [MATCH_MP_TAC BOUNDED_SUBSET THEN
8042         EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
8043         REWRITE_TAC[BOUNDED_INTERVAL; SUBSET_RESTRICT];
8044         MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
8045         REWRITE_TAC[FRONTIER_CLOSED; CLOSED_INTERVAL; GSYM path] THEN
8046         ASM_MESON_TAC[arc]];
8047       REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `vec 1:real^1` THEN
8048       ASM_REWRITE_TAC[IN_ELIM_THM; ENDS_IN_UNIT_INTERVAL] THEN
8049       ASM_MESON_TAC[pathfinish; SUBSET]];
8050     DISCH_THEN(X_CHOOSE_THEN `t:real^1` STRIP_ASSUME_TAC) THEN
8051     EXISTS_TAC `subpath (vec 0) t (g:real^1->real^N)` THEN
8052     ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
8053     MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
8054      [MATCH_MP_TAC ARC_SUBPATH_ARC THEN
8055       ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
8056       ASM_MESON_TAC[pathstart];
8057       REWRITE_TAC[arc] THEN STRIP_TAC] THEN
8058     GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o LAND_CONV) [GSYM pathstart] THEN
8059     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
8060      [ALL_TAC; RULE_ASSUM_TAC(SIMP_RULE[path_image]) THEN ASM SET_TAC[]] THEN
8061     MATCH_MP_TAC(SET_RULE
8062      `a IN s /\ IMAGE f s DELETE (f a) SUBSET t /\
8063       (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
8064       ==> IMAGE f (s DELETE a) SUBSET t`) THEN
8065     ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; GSYM path_image] THEN
8066     W(MP_TAC o PART_MATCH (lhand o rand) PATH_IMAGE_SUBPATH o lhand o lhand o
8067       snd) THEN
8068     ANTS_TAC THENL [ASM_MESON_TAC[IN_INTERVAL_1]; DISCH_THEN SUBST1_TAC] THEN
8069     REWRITE_TAC[REWRITE_RULE[pathfinish] PATHFINISH_SUBPATH] THEN
8070     MATCH_MP_TAC(SET_RULE
8071      `IMAGE f (s DELETE a) DIFF t = {}
8072       ==> IMAGE f s DELETE f a SUBSET t`) THEN
8073     MATCH_MP_TAC(REWRITE_RULE[TAUT
8074      `p /\ q /\ ~r ==> ~s <=> p /\ q /\ s ==> r`]
8075      CONNECTED_INTER_FRONTIER) THEN
8076     REPEAT CONJ_TAC THENL
8077      [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN CONJ_TAC THENL
8078        [FIRST_X_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [arc]) THEN
8079         REWRITE_TAC[path] THEN MATCH_MP_TAC
8080          (REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET) THEN
8081         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
8082         REWRITE_TAC[SUBSET; IN_DELETE; GSYM DROP_EQ; IN_INTERVAL_1] THEN
8083         REAL_ARITH_TAC;
8084         MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
8085         EXISTS_TAC `interval(vec 0:real^1,t)` THEN
8086         REWRITE_TAC[CONNECTED_INTERVAL; CLOSURE_INTERVAL] THEN
8087         REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN
8088         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
8089         COND_CASES_TAC THEN
8090         ASM_REWRITE_TAC[SUBSET; IN_DELETE; GSYM DROP_EQ; IN_INTERVAL_1] THEN
8091         REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_REAL_ARITH_TAC];
8092       REWRITE_TAC[SET_RULE
8093         `~(IMAGE f s INTER t = {}) <=> ?x. x IN s /\ f x IN t`] THEN
8094       EXISTS_TAC `vec 0:real^1` THEN
8095       REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; REAL_LE_REFL] THEN
8096       RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
8097       ASM SET_TAC[pathstart];
8098       REWRITE_TAC[SET_RULE
8099        `IMAGE g i INTER s = {} <=> !x. x IN i ==> ~(g x IN s)`] THEN
8100       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE; IN_UNIV; IN_DIFF] THEN
8101       X_GEN_TAC `z:real^1` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
8102       REWRITE_TAC[GSYM DROP_EQ; IN_INTERVAL_1] THEN DISCH_TAC THEN
8103       DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
8104       ASM_REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
8105       FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN
8106       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
8107       ASM_REAL_ARITH_TAC]]);;
8108
8109 let DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED = prove
8110  (`!s:real^N->bool v x.
8111         open s /\ connected s /\ x IN s /\
8112         open_in (subtopology euclidean (frontier s)) v /\ ~(v = {})
8113         ==> ?g. arc g /\
8114                 IMAGE g (interval [vec 0,vec 1] DELETE vec 1) SUBSET s /\
8115                 pathstart g = x /\ pathfinish g IN v`,
8116   REPEAT STRIP_TAC THEN
8117   MP_TAC(ISPECL [`s:real^N->bool`; `v:real^N->bool`]
8118         DENSE_ACCESSIBLE_FRONTIER_POINTS) THEN
8119   ASM_REWRITE_TAC[] THEN
8120   DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
8121   SUBGOAL_THEN `path_connected(s:real^N->bool)` MP_TAC THENL
8122    [ASM_MESON_TAC[CONNECTED_OPEN_PATH_CONNECTED]; ALL_TAC] THEN
8123   REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
8124   DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `pathstart g:real^N`]) THEN
8125   ASM_REWRITE_TAC[path_component; LEFT_IMP_EXISTS_THM] THEN
8126   X_GEN_TAC `f:real^1->real^N` THEN STRIP_TAC THEN
8127   MP_TAC(ISPECL [`f ++ g:real^1->real^N`; `x:real^N`; `pathfinish g:real^N`]
8128         PATH_CONTAINS_ARC) THEN
8129   ASM_SIMP_TAC[PATH_JOIN_EQ; ARC_IMP_PATH; PATH_IMAGE_JOIN;
8130                PATHSTART_JOIN; PATHFINISH_JOIN] THEN
8131   FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
8132   GEN_REWRITE_TAC LAND_CONV [SUBSET] THEN
8133   ASM_SIMP_TAC[frontier; INTERIOR_OPEN; IN_DIFF] THEN
8134   DISCH_TAC THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
8135   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^1->real^N` THEN
8136   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE
8137    `a IN s /\ IMAGE f s DELETE (f a) SUBSET t /\
8138     (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
8139     ==> IMAGE f (s DELETE a) SUBSET t`) THEN
8140   REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
8141   CONJ_TAC THENL [REWRITE_TAC[GSYM path_image]; ASM_MESON_TAC[arc]] THEN
8142   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
8143    `h SUBSET f UNION g
8144     ==> f SUBSET s /\ g DELETE a SUBSET s ==> h DELETE a SUBSET s`)) THEN
8145   ASM_REWRITE_TAC[] THEN
8146   RULE_ASSUM_TAC(REWRITE_RULE[path_image; pathstart; pathfinish]) THEN
8147   REWRITE_TAC[path_image] THEN ASM SET_TAC[]);;
8148
8149 let DENSE_ACCESSIBLE_FRONTIER_POINT_PAIRS = prove
8150  (`!s u v:real^N->bool.
8151          open s /\ connected s /\
8152          open_in (subtopology euclidean (frontier s)) u /\
8153          open_in (subtopology euclidean (frontier s)) v /\
8154          ~(u = {}) /\ ~(v = {}) /\ ~(u = v)
8155          ==> ?g. arc g /\
8156                  pathstart g IN u /\ pathfinish g IN v /\
8157                  IMAGE g (interval(vec 0,vec 1)) SUBSET s`,
8158   GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN
8159   ONCE_REWRITE_TAC[IMP_CONJ_ALT] THEN
8160   GEN_REWRITE_TAC (funpow 2 BINDER_CONV o LAND_CONV o RAND_CONV)
8161     [GSYM SUBSET_ANTISYM_EQ] THEN
8162   REWRITE_TAC[DE_MORGAN_THM; GSYM CONJ_ASSOC] THEN
8163   MATCH_MP_TAC(MESON[]
8164    `(!u v. R u v ==> R v u) /\ (!u v. P u v ==> R u v)
8165     ==> !u v. P u v \/ P v u ==> R u v`) THEN
8166   CONJ_TAC THENL
8167    [REPEAT GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
8168     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:real^1->real^N` THEN
8169     STRIP_TAC THEN EXISTS_TAC `reversepath g:real^1->real^N` THEN
8170     ASM_SIMP_TAC[ARC_REVERSEPATH; PATHSTART_REVERSEPATH;
8171                  PATHFINISH_REVERSEPATH] THEN
8172     REWRITE_TAC[reversepath] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN
8173     REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
8174      (SET_RULE `IMAGE f i SUBSET t
8175                 ==> IMAGE r i SUBSET i ==> IMAGE f (IMAGE r i) SUBSET t`)) THEN
8176     SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN
8177     REAL_ARITH_TAC;
8178     ALL_TAC] THEN
8179   REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
8180   ASM_REWRITE_TAC[FRONTIER_EMPTY; OPEN_IN_SUBTOPOLOGY_EMPTY] THENL
8181    [CONV_TAC TAUT; STRIP_TAC THEN UNDISCH_TAC `~(s:real^N->bool = {})`] THEN
8182   REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN
8183   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
8184   MP_TAC(ISPECL
8185    [`s:real^N->bool`; `v:real^N->bool`; `x:real^N`]
8186    DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED) THEN
8187   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
8188   X_GEN_TAC `g:real^1->real^N` THEN STRIP_TAC THEN
8189   MP_TAC(ISPECL
8190    [`s:real^N->bool`; `(u DELETE pathfinish g):real^N->bool`; `x:real^N`]
8191    DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED) THEN
8192   ASM_SIMP_TAC[OPEN_IN_DELETE; IN_DELETE; LEFT_IMP_EXISTS_THM] THEN
8193   ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
8194   X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THEN
8195   MP_TAC(ISPECL [`(reversepath h ++ g):real^1->real^N`;
8196                  `pathfinish h:real^N`; `pathfinish g:real^N`]
8197         PATH_CONTAINS_ARC) THEN
8198   ASM_SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN;
8199                PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH;
8200                PATH_REVERSEPATH; ARC_IMP_PATH; PATH_IMAGE_JOIN;
8201                PATH_IMAGE_REVERSEPATH] THEN
8202   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^1->real^N` THEN
8203   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
8204   REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN
8205   MATCH_MP_TAC(SET_RULE
8206    `(!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
8207     t SUBSET s /\ IMAGE f s SUBSET u UNION IMAGE f t
8208     ==> IMAGE f (s DIFF t) SUBSET u`) THEN
8209   REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; ENDS_IN_UNIT_INTERVAL] THEN
8210   CONJ_TAC THENL [ASM_MESON_TAC[arc]; REWRITE_TAC[GSYM path_image]] THEN
8211   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
8212         SUBSET_TRANS)) THEN
8213   RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish; path_image]) THEN
8214   REWRITE_TAC[path_image] THEN ASM SET_TAC[]);;
8215
8216 (* ------------------------------------------------------------------------- *)
8217 (* Some simple positive connection theorems.                                 *)
8218 (* ------------------------------------------------------------------------- *)
8219
8220 let PATH_CONNECTED_CONVEX_DIFF_CARD_LT = prove
8221  (`!u s:real^N->bool.
8222     convex u /\ ~(collinear u) /\ s <_c (:real) ==> path_connected(u DIFF s)`,
8223   REPEAT STRIP_TAC THEN
8224   REWRITE_TAC[path_connected; IN_DIFF; IN_UNIV] THEN
8225   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN
8226   ASM_CASES_TAC `a:real^N = b` THENL
8227    [EXISTS_TAC `linepath(a:real^N,b)` THEN
8228     REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_LINEPATH] THEN
8229     ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN ASM SET_TAC[];
8230     ALL_TAC] THEN
8231   ABBREV_TAC `m:real^N = midpoint(a,b)` THEN
8232   SUBGOAL_THEN `~(m:real^N = a) /\ ~(m = b)` STRIP_ASSUME_TAC THENL
8233    [ASM_MESON_TAC[MIDPOINT_EQ_ENDPOINT]; ALL_TAC] THEN
8234   POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
8235   GEOM_ORIGIN_TAC `m:real^N` THEN REPEAT GEN_TAC THEN
8236   GEOM_NORMALIZE_TAC `b:real^N` THEN REWRITE_TAC[] THEN GEN_TAC THEN
8237   GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN X_GEN_TAC `bbb:real` THEN
8238   DISCH_TAC THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
8239   ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN
8240   DISCH_THEN SUBST1_TAC THEN POP_ASSUM(K ALL_TAC) THEN
8241   REPEAT GEN_TAC THEN REWRITE_TAC[midpoint; VECTOR_MUL_LID] THEN
8242   REWRITE_TAC[VECTOR_ARITH `inv(&2) % (a + b):real^N = vec 0 <=> a = --b`] THEN
8243   ASM_CASES_TAC `a:real^N = --(basis 1)` THEN ASM_REWRITE_TAC[] THEN
8244   POP_ASSUM(K ALL_TAC) THEN
8245   REPLICATE_TAC 7 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
8246   DISCH_THEN(K ALL_TAC) THEN
8247   SUBGOAL_THEN `segment[--basis 1:real^N,basis 1] SUBSET u` ASSUME_TAC THENL
8248    [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
8249     ASM SET_TAC[];
8250     ALL_TAC] THEN
8251   SUBGOAL_THEN `(vec 0:real^N) IN u` ASSUME_TAC THENL
8252    [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
8253     REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `&1 / &2` THEN
8254     CONV_TAC REAL_RAT_REDUCE_CONV THEN VECTOR_ARITH_TAC;
8255     ALL_TAC] THEN
8256   SUBGOAL_THEN `?c:real^N k. 1 <= k /\ ~(k = 1) /\ k <= dimindex(:N) /\
8257                              c IN u /\ ~(c$k = &0)`
8258   STRIP_ASSUME_TAC THENL
8259    [REWRITE_TAC[GSYM NOT_FORALL_THM; TAUT
8260      `a /\ ~b /\ c /\ d /\ ~e <=> ~(d ==> a /\ c ==> ~b ==> e)`] THEN
8261     DISCH_TAC THEN UNDISCH_TAC `~collinear(u:real^N->bool)` THEN
8262     REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN
8263     MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `basis 1:real^N`] THEN
8264     SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT; SPAN_INSERT_0] THEN
8265     REWRITE_TAC[SPAN_SING; SUBSET; IN_ELIM_THM; IN_UNIV] THEN
8266     X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN EXISTS_TAC `(c:real^N)$1` THEN
8267     SIMP_TAC[CART_EQ; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN
8268     REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
8269     ASM_REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RZERO] THEN
8270     ASM_MESON_TAC[];
8271     ALL_TAC] THEN
8272   SUBGOAL_THEN `~(c:real^N = vec 0)` ASSUME_TAC THENL
8273    [ASM_SIMP_TAC[CART_EQ; VEC_COMPONENT] THEN ASM_MESON_TAC[]; ALL_TAC] THEN
8274   SUBGOAL_THEN `segment[vec 0:real^N,c] SUBSET u` ASSUME_TAC THENL
8275    [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
8276     ASM SET_TAC[];
8277     ALL_TAC] THEN
8278   SUBGOAL_THEN
8279    `?z:real^N. z IN segment[vec 0,c] /\
8280                (segment[--basis 1,z] UNION segment[z,basis 1]) INTER s = {}`
8281   STRIP_ASSUME_TAC THENL
8282    [ALL_TAC;
8283     EXISTS_TAC `linepath(--basis 1:real^N,z) ++ linepath(z,basis 1)` THEN
8284     ASM_SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; PATH_LINEPATH;
8285                  PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_JOIN] THEN
8286     REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN
8287     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
8288      `(t UNION v) INTER s = {}
8289       ==> t SUBSET u /\ v SUBSET u
8290           ==> (t UNION v) SUBSET u DIFF s`)) THEN
8291     REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN
8292     CONJ_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM SET_TAC[]] THEN
8293   MATCH_MP_TAC(SET_RULE
8294    `~(s SUBSET {z | z IN s /\ ~P z}) ==> ?z. z IN s /\ P z`) THEN
8295   DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN
8296   REWRITE_TAC[CARD_NOT_LE; SET_RULE
8297    `~((b UNION c) INTER s = {}) <=>
8298     ~(b INTER s = {}) \/ ~(c INTER s = {})`] THEN
8299   REWRITE_TAC[SET_RULE
8300    `{x | P x /\ (Q x \/ R x)} = {x | P x /\ Q x} UNION {x | P x /\ R x}`] THEN
8301   W(MP_TAC o PART_MATCH lhand UNION_LE_ADD_C o lhand o snd) THEN
8302   MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] CARD_LET_TRANS) THEN
8303   TRANS_TAC CARD_LTE_TRANS `(:real)` THEN CONJ_TAC THENL
8304    [MATCH_MP_TAC CARD_ADD2_ABSORB_LT THEN REWRITE_TAC[real_INFINITE];
8305     MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
8306     ASM_SIMP_TAC[CARD_EQ_SEGMENT]] THEN
8307   REWRITE_TAC[MESON[SEGMENT_SYM] `segment[--a:real^N,b] = segment[b,--a]`] THEN
8308   SUBGOAL_THEN
8309    `!b:real^N.
8310        b IN u /\ ~(b IN s) /\ ~(b = vec 0) /\ b$k = &0
8311        ==> {z | z IN segment[vec 0,c] /\ ~(segment[z,b] INTER s = {})} <_c
8312            (:real)`
8313    (fun th -> CONJ_TAC THEN MATCH_MP_TAC th THEN
8314               REWRITE_TAC[VECTOR_NEG_EQ_0; VECTOR_NEG_COMPONENT] THEN
8315               ASM_SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL;
8316                            BASIS_COMPONENT] THEN
8317               REWRITE_TAC[REAL_NEG_0]) THEN
8318   REPEAT STRIP_TAC THEN TRANS_TAC CARD_LET_TRANS `s:real^N->bool` THEN
8319   ASM_REWRITE_TAC[] THEN
8320   REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; RIGHT_AND_EXISTS_THM] THEN
8321   ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> r /\ p /\ q`] THEN
8322   MATCH_MP_TAC CARD_LE_RELATIONAL THEN
8323   MAP_EVERY X_GEN_TAC [`w:real^N`; `x1:real^N`; `x2:real^N`] THEN
8324   REWRITE_TAC[SEGMENT_SYM] THEN STRIP_TAC THEN
8325   ASM_CASES_TAC `x2:real^N = x1` THEN ASM_REWRITE_TAC[] THEN
8326   MP_TAC(ISPECL
8327    [`x1:real^N`; `b:real^N`; `x2:real^N`] INTER_SEGMENT) THEN
8328   REWRITE_TAC[NOT_IMP; SEGMENT_SYM] THEN
8329   CONJ_TAC THENL [DISJ2_TAC; REWRITE_TAC[SEGMENT_SYM] THEN ASM SET_TAC[]] THEN
8330   ONCE_REWRITE_TAC[SET_RULE `{x1,b,x2} = {x1,x2,b}`] THEN
8331   ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL] THEN STRIP_TAC THEN
8332   SUBGOAL_THEN `(b:real^N) IN affine hull {vec 0,c}` MP_TAC THENL
8333    [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
8334      `b IN s ==> s SUBSET t ==> b IN t`)) THEN
8335     MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[AFFINE_AFFINE_HULL] THEN
8336     MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `segment[c:real^N,vec 0]` THEN
8337     CONJ_TAC THENL [ASM SET_TAC[]; ONCE_REWRITE_TAC[SEGMENT_SYM]] THEN
8338     REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_SUBSET_AFFINE_HULL];
8339     REWRITE_TAC[AFFINE_HULL_2_ALT; IN_ELIM_THM; IN_UNIV] THEN
8340     REWRITE_TAC[VECTOR_ADD_LID; VECTOR_SUB_RZERO; NOT_EXISTS_THM] THEN
8341     X_GEN_TAC `r:real` THEN
8342     ASM_CASES_TAC `r = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
8343     CONV_TAC(RAND_CONV SYM_CONV) THEN
8344     DISCH_THEN(MP_TAC o AP_TERM `\x:real^N. x$k`) THEN
8345     ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_ENTIRE]]);;
8346
8347 let CONNECTED_CONVEX_DIFF_CARD_LT = prove
8348  (`!u s. convex u /\ ~collinear u /\ s <_c (:real) ==> connected(u DIFF s)`,
8349   SIMP_TAC[PATH_CONNECTED_CONVEX_DIFF_CARD_LT; PATH_CONNECTED_IMP_CONNECTED]);;
8350
8351 let PATH_CONNECTED_CONVEX_DIFF_COUNTABLE = prove
8352  (`!u s. convex u /\ ~collinear u /\ COUNTABLE s ==> path_connected(u DIFF s)`,
8353   MESON_TAC[COUNTABLE_IMP_CARD_LT_REAL; PATH_CONNECTED_CONVEX_DIFF_CARD_LT]);;
8354
8355 let CONNECTED_CONVEX_DIFF_COUNTABLE = prove
8356  (`!u s. convex u /\ ~collinear u /\ COUNTABLE s ==> connected(u DIFF s)`,
8357   MESON_TAC[COUNTABLE_IMP_CARD_LT_REAL; CONNECTED_CONVEX_DIFF_CARD_LT]);;
8358
8359 let PATH_CONNECTED_PUNCTURED_CONVEX = prove
8360  (`!s a:real^N. convex s /\ ~(aff_dim s = &1) ==> path_connected(s DELETE a)`,
8361   REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (INT_ARITH
8362    `~(x:int = &1) ==> --(&1) <= x ==> x = -- &1 \/ x = &0 \/ &2 <= x`)) THEN
8363   ASM_REWRITE_TAC[AFF_DIM_GE; AFF_DIM_EQ_MINUS1; AFF_DIM_EQ_0] THEN
8364   DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN
8365   ASM_REWRITE_TAC[PATH_CONNECTED_EMPTY; SET_RULE `{} DELETE a = {}`] THENL
8366    [FIRST_X_ASSUM(X_CHOOSE_THEN `b:real^N` SUBST1_TAC) THEN
8367     ASM_CASES_TAC `b:real^N = a` THEN
8368     ASM_REWRITE_TAC[PATH_CONNECTED_EMPTY; SET_RULE `{a} DELETE a = {}`] THEN
8369     ASM_SIMP_TAC[SET_RULE `~(b = a) ==> {a} DELETE b = {a}`] THEN
8370     REWRITE_TAC[PATH_CONNECTED_SING];
8371     REPEAT STRIP_TAC THEN
8372     ONCE_REWRITE_TAC[SET_RULE `s DELETE a = s DIFF {a}`] THEN
8373     MATCH_MP_TAC PATH_CONNECTED_CONVEX_DIFF_COUNTABLE THEN
8374     ASM_REWRITE_TAC[COUNTABLE_SING; COLLINEAR_AFF_DIM] THEN
8375     ASM_INT_ARITH_TAC]);;
8376
8377 let CONNECTED_PUNCTURED_CONVEX = prove
8378  (`!s a:real^N. convex s /\ ~(aff_dim s = &1) ==> connected(s DELETE a)`,
8379   SIMP_TAC[PATH_CONNECTED_PUNCTURED_CONVEX; PATH_CONNECTED_IMP_CONNECTED]);;
8380
8381 let PATH_CONNECTED_COMPLEMENT_CARD_LT = prove
8382  (`!s. 2 <= dimindex(:N) /\ s <_c (:real)
8383        ==> path_connected((:real^N) DIFF s)`,
8384   REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_CONVEX_DIFF_CARD_LT THEN
8385   ASM_REWRITE_TAC[CONVEX_UNIV; COLLINEAR_AFF_DIM; AFF_DIM_UNIV] THEN
8386   REWRITE_TAC[INT_OF_NUM_LE] THEN ASM_ARITH_TAC);;
8387
8388 let PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT = prove
8389  (`!s t:real^N->bool.
8390         connected s /\ open_in (subtopology euclidean (affine hull s)) s /\
8391         ~collinear s /\ t <_c (:real)
8392         ==> path_connected(s DIFF t)`,
8393   REPEAT STRIP_TAC THEN
8394   REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT; IN_DIFF] THEN
8395   REWRITE_TAC[TAUT `(p /\ q) /\ (r /\ s) <=> p /\ r /\ q /\ s`] THEN
8396   MATCH_MP_TAC CONNECTED_EQUIVALENCE_RELATION_GEN THEN
8397   ASM_REWRITE_TAC[IN_DIFF] THEN
8398   REWRITE_TAC[PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS] THEN CONJ_TAC THENL
8399    [MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
8400     SUBGOAL_THEN
8401       `open_in (subtopology euclidean (affine hull s)) (u:real^N->bool)`
8402     MP_TAC THENL [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN
8403     REWRITE_TAC[OPEN_IN_CONTAINS_BALL] THEN
8404     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:real^N`)) THEN
8405     ASM_REWRITE_TAC[] THEN
8406     DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
8407     MATCH_MP_TAC(SET_RULE `~(s SUBSET t) ==> ?x. x IN s /\ ~(x IN t)`) THEN
8408     DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN
8409     REWRITE_TAC[CARD_NOT_LE] THEN TRANS_TAC CARD_LTE_TRANS `(:real)` THEN
8410     ASM_REWRITE_TAC[] THEN
8411     TRANS_TAC CARD_LE_TRANS `ball(x:real^N,r) INTER affine hull s` THEN
8412     ASM_SIMP_TAC[CARD_LE_SUBSET] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
8413     ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN MATCH_MP_TAC CARD_EQ_CONVEX THEN
8414     EXISTS_TAC `x:real^N` THEN
8415     ASM_SIMP_TAC[CONVEX_INTER; AFFINE_IMP_CONVEX; CONVEX_BALL;
8416                  AFFINE_AFFINE_HULL; IN_INTER; CENTRE_IN_BALL; HULL_INC] THEN
8417     SUBGOAL_THEN `~(s SUBSET {x:real^N})` MP_TAC THENL
8418      [ASM_MESON_TAC[COLLINEAR_SUBSET; COLLINEAR_SING]; ALL_TAC] THEN
8419     REWRITE_TAC[SUBSET; IN_SING; NOT_FORALL_THM; NOT_IMP] THEN
8420     DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
8421     EXISTS_TAC `x + r / &2 / norm(y - x) % (y - x):real^N` THEN
8422     RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN
8423     ASM_SIMP_TAC[HULL_INC; IN_AFFINE_ADD_MUL_DIFF; AFFINE_AFFINE_HULL] THEN
8424     REWRITE_TAC[IN_BALL; VECTOR_ARITH `x:real^N = x + y <=> y = vec 0`] THEN
8425     ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_DIV_EQ_0; NORM_EQ_0; VECTOR_SUB_EQ;
8426             REAL_LT_IMP_NZ; NORM_ARITH `dist(x:real^N,x + y) = norm y`] THEN
8427     REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_NORM] THEN
8428     ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
8429     ASM_REAL_ARITH_TAC;
8430     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
8431     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN
8432     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:real^N`)) THEN
8433     ASM_REWRITE_TAC[] THEN
8434     DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
8435     EXISTS_TAC `ball(x:real^N,r) INTER affine hull s` THEN
8436     ASM_SIMP_TAC[IN_INTER; HULL_INC; CENTRE_IN_BALL] THEN CONJ_TAC THENL
8437      [MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN
8438       EXISTS_TAC `affine hull s:real^N->bool` THEN
8439       ASM_SIMP_TAC[ONCE_REWRITE_RULE[INTER_COMM]OPEN_IN_OPEN_INTER; OPEN_BALL];
8440       MAP_EVERY X_GEN_TAC [`y:real^N`; `z:real^N`] THEN STRIP_TAC THEN
8441       MP_TAC(ISPECL [`ball(x:real^N,r) INTER affine hull s`; `t:real^N->bool`]
8442         PATH_CONNECTED_CONVEX_DIFF_CARD_LT) THEN
8443       ASM_SIMP_TAC[CONVEX_INTER; AFFINE_IMP_CONVEX; CONVEX_BALL;
8444                    AFFINE_AFFINE_HULL] THEN
8445       ANTS_TAC THENL
8446        [REWRITE_TAC[COLLINEAR_AFF_DIM] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN
8447         W(MP_TAC o PART_MATCH (lhs o rand) AFF_DIM_CONVEX_INTER_OPEN o
8448           lhand o rand o snd) THEN
8449         SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; OPEN_BALL] THEN
8450         ANTS_TAC THENL [ASM SET_TAC[CENTRE_IN_BALL]; ALL_TAC] THEN
8451         DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN
8452         ASM_REWRITE_TAC[GSYM COLLINEAR_AFF_DIM];
8453         REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
8454         DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `z:real^N`]) THEN
8455         ASM_REWRITE_TAC[IN_INTER; IN_DIFF] THEN
8456         MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] PATH_COMPONENT_OF_SUBSET) THEN
8457         ASM SET_TAC[]]]]);;
8458
8459 let CONNECTED_OPEN_IN_DIFF_CARD_LT = prove
8460  (`!s t:real^N->bool.
8461         connected s /\ open_in (subtopology euclidean (affine hull s)) s /\
8462         ~collinear s /\ t <_c (:real)
8463         ==> connected(s DIFF t)`,
8464   REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_IMP_CONNECTED THEN
8465   MATCH_MP_TAC PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT THEN
8466   ASM_REWRITE_TAC[]);;
8467
8468 let PATH_CONNECTED_OPEN_DIFF_CARD_LT = prove
8469  (`!s t:real^N->bool.
8470         2 <= dimindex(:N) /\ open s /\ connected s /\ t <_c (:real)
8471         ==> path_connected(s DIFF t)`,
8472   REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
8473   ASM_REWRITE_TAC[EMPTY_DIFF; PATH_CONNECTED_EMPTY] THEN
8474   MATCH_MP_TAC PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT THEN
8475   ASM_REWRITE_TAC[COLLINEAR_AFF_DIM] THEN
8476   ASM_SIMP_TAC[AFFINE_HULL_OPEN; AFF_DIM_OPEN] THEN
8477   ASM_REWRITE_TAC[INT_OF_NUM_LE; SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN
8478   ASM_ARITH_TAC);;
8479
8480 let CONNECTED_OPEN_DIFF_CARD_LT = prove
8481  (`!s t:real^N->bool.
8482         2 <= dimindex(:N) /\ open s /\ connected s /\ t <_c (:real)
8483         ==> connected(s DIFF t)`,
8484   SIMP_TAC[PATH_CONNECTED_OPEN_DIFF_CARD_LT; PATH_CONNECTED_IMP_CONNECTED]);;
8485
8486 let PATH_CONNECTED_OPEN_DIFF_COUNTABLE = prove
8487  (`!s t:real^N->bool.
8488         2 <= dimindex(:N) /\ open s /\ connected s /\ COUNTABLE t
8489         ==> path_connected(s DIFF t)`,
8490   REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_OPEN_DIFF_CARD_LT THEN
8491   ASM_REWRITE_TAC[GSYM CARD_NOT_LE] THEN
8492   ASM_MESON_TAC[UNCOUNTABLE_REAL; CARD_LE_COUNTABLE]);;
8493
8494 let CONNECTED_OPEN_DIFF_COUNTABLE = prove
8495  (`!s t:real^N->bool.
8496         2 <= dimindex(:N) /\ open s /\ connected s /\ COUNTABLE t
8497         ==> connected(s DIFF t)`,
8498   SIMP_TAC[PATH_CONNECTED_OPEN_DIFF_COUNTABLE; PATH_CONNECTED_IMP_CONNECTED]);;
8499
8500 let PATH_CONNECTED_OPEN_DELETE = prove
8501  (`!s a:real^N. 2 <= dimindex(:N) /\ open s /\ connected s
8502                 ==> path_connected(s DELETE a)`,
8503   REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE `s DELETE a = s DIFF {a}`] THEN
8504   MATCH_MP_TAC PATH_CONNECTED_OPEN_DIFF_COUNTABLE THEN
8505   ASM_REWRITE_TAC[COUNTABLE_SING]);;
8506
8507 let CONNECTED_OPEN_DELETE = prove
8508  (`!s a:real^N. 2 <= dimindex(:N) /\ open s /\ connected s
8509                 ==> connected(s DELETE a)`,
8510   SIMP_TAC[PATH_CONNECTED_OPEN_DELETE; PATH_CONNECTED_IMP_CONNECTED]);;
8511
8512 let PATH_CONNECTED_PUNCTURED_UNIVERSE = prove
8513  (`!a. 2 <= dimindex(:N) ==> path_connected((:real^N) DIFF {a})`,
8514   REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_OPEN_DIFF_COUNTABLE THEN
8515   ASM_REWRITE_TAC[OPEN_UNIV; CONNECTED_UNIV; COUNTABLE_SING]);;
8516
8517 let CONNECTED_PUNCTURED_UNIVERSE = prove
8518  (`!a. 2 <= dimindex(:N) ==> connected((:real^N) DIFF {a})`,
8519   SIMP_TAC[PATH_CONNECTED_PUNCTURED_UNIVERSE; PATH_CONNECTED_IMP_CONNECTED]);;
8520
8521 let PATH_CONNECTED_PUNCTURED_BALL = prove
8522  (`!a:real^N r. 2 <= dimindex(:N) ==> path_connected(ball(a,r) DELETE a)`,
8523   SIMP_TAC[PATH_CONNECTED_OPEN_DELETE; OPEN_BALL; CONNECTED_BALL]);;
8524
8525 let CONNECTED_PUNCTURED_BALL = prove
8526  (`!a:real^N r. 2 <= dimindex(:N) ==> connected(ball(a,r) DELETE a)`,
8527   SIMP_TAC[CONNECTED_OPEN_DELETE; OPEN_BALL; CONNECTED_BALL]);;
8528
8529 let PATH_CONNECTED_SPHERE = prove
8530  (`!a:real^N r. 2 <= dimindex(:N) ==> path_connected(sphere(a,r))`,
8531   REPEAT GEN_TAC THEN
8532   REWRITE_TAC[sphere; dist] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN
8533   GEOM_ORIGIN_TAC `a:real^N` THEN GEN_TAC THEN
8534   REWRITE_TAC[VECTOR_SUB_RZERO] THEN DISCH_TAC THEN
8535   REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
8536    (REAL_ARITH `r < &0 \/ r = &0 \/ &0 < r`)
8537   THENL
8538    [ASM_SIMP_TAC[NORM_ARITH `r < &0 ==> ~(norm(x:real^N) = r)`] THEN
8539     REWRITE_TAC[EMPTY_GSPEC; PATH_CONNECTED_EMPTY];
8540     ASM_REWRITE_TAC[NORM_EQ_0; SING_GSPEC; PATH_CONNECTED_SING];
8541     SUBGOAL_THEN
8542      `{x:real^N | norm x = r} =
8543       IMAGE (\x. r / norm x % x) ((:real^N) DIFF {vec 0})`
8544     SUBST1_TAC THENL
8545      [MATCH_MP_TAC SUBSET_ANTISYM THEN
8546       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
8547       REWRITE_TAC[IN_IMAGE; IN_ELIM_THM; IN_DIFF; IN_SING; IN_UNIV] THEN
8548       ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL;
8549                    NORM_EQ_0; REAL_ARITH `&0 < r ==> abs r = r`] THEN
8550       X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `x:real^N` THEN
8551       ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; VECTOR_MUL_LID] THEN
8552       ASM_MESON_TAC[NORM_0; REAL_LT_IMP_NZ];
8553       MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN
8554       ASM_SIMP_TAC[PATH_CONNECTED_PUNCTURED_UNIVERSE] THEN
8555       MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN
8556     REWRITE_TAC[o_DEF; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
8557     X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_DIFF; IN_UNIV; IN_SING] THEN
8558     DISCH_TAC THEN REWRITE_TAC[real_div; LIFT_CMUL] THEN
8559     MATCH_MP_TAC CONTINUOUS_CMUL THEN
8560     MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_AT_WITHIN_INV) THEN
8561     ASM_REWRITE_TAC[NORM_EQ_0] THEN MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN
8562     REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_NORM]]]);;
8563
8564 let CONNECTED_SPHERE = prove
8565  (`!a:real^N r. 2 <= dimindex(:N) ==> connected(sphere(a,r))`,
8566   SIMP_TAC[PATH_CONNECTED_SPHERE; PATH_CONNECTED_IMP_CONNECTED]);;
8567
8568 let CONNECTED_SPHERE_EQ = prove
8569  (`!a:real^N r. connected(sphere(a,r)) <=> 2 <= dimindex(:N) \/ r <= &0`,
8570   let lemma = prove
8571    (`!a:real^1 r. &0 < r
8572          ==> ?x y. ~(x = y) /\ dist(a,x) = r /\ dist(a,y) = r`,
8573     MP_TAC SPHERE_1 THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
8574     COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
8575     REWRITE_TAC[EXTENSION; IN_SPHERE; IN_INSERT; NOT_IN_EMPTY] THEN
8576     REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[]
8577     `~(a = b) ==> ?x y. ~(x = y) /\ (x = a \/ x = b) /\ (y = a \/ y = b)`) THEN
8578     REWRITE_TAC[VECTOR_ARITH `a - r:real^1 = a + r <=> r = vec 0`] THEN
8579     REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN ASM_REAL_ARITH_TAC) in
8580   REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THEN
8581   ASM_SIMP_TAC[SPHERE_EMPTY; CONNECTED_EMPTY; REAL_LT_IMP_LE] THEN
8582   ASM_CASES_TAC `r = &0` THEN
8583   ASM_SIMP_TAC[SPHERE_SING; REAL_LE_REFL; CONNECTED_SING] THEN
8584   SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL
8585    [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[GSYM REAL_NOT_LT]] THEN
8586   EQ_TAC THEN SIMP_TAC[CONNECTED_SPHERE] THEN
8587   DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_FINITE_IFF_SING) THEN
8588   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
8589   SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (2 <= n <=> ~(n = 1))`] THEN
8590   GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM DIMINDEX_1] THEN
8591   DISCH_TAC THEN FIRST_ASSUM (fun th ->
8592     REWRITE_TAC[GEOM_EQUAL_DIMENSION_RULE th FINITE_SPHERE_1]) THEN
8593   REWRITE_TAC[SET_RULE
8594    `~(s = {} \/ ?a. s = {a}) <=> ?x y. ~(x = y) /\ x IN s /\ y IN s`] THEN
8595   REWRITE_TAC[IN_SPHERE] THEN
8596   FIRST_X_ASSUM(MATCH_MP_TAC o C GEOM_EQUAL_DIMENSION_RULE lemma) THEN
8597   ASM_REWRITE_TAC[]);;
8598
8599 let PATH_CONNECTED_SPHERE_EQ = prove
8600  (`!a:real^N r. path_connected(sphere(a,r)) <=> 2 <= dimindex(:N) \/ r <= &0`,
8601   REPEAT GEN_TAC THEN EQ_TAC THENL
8602    [REWRITE_TAC[GSYM CONNECTED_SPHERE_EQ; PATH_CONNECTED_IMP_CONNECTED];
8603     STRIP_TAC THEN ASM_SIMP_TAC[PATH_CONNECTED_SPHERE]] THEN
8604   ASM_CASES_TAC `r < &0` THEN
8605   ASM_SIMP_TAC[SPHERE_EMPTY; PATH_CONNECTED_EMPTY] THEN
8606   ASM_CASES_TAC `r = &0` THEN
8607   ASM_SIMP_TAC[SPHERE_SING; PATH_CONNECTED_SING] THEN
8608   ASM_REAL_ARITH_TAC);;
8609
8610 let FINITE_SPHERE = prove
8611  (`!a:real^N r. FINITE(sphere(a,r)) <=> r <= &0 \/ dimindex(:N) = 1`,
8612   REPEAT GEN_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THEN
8613   ASM_REWRITE_TAC[] THENL
8614    [RULE_ASSUM_TAC(REWRITE_RULE[GSYM DIMINDEX_1]) THEN
8615     FIRST_ASSUM(MATCH_ACCEPT_TAC o C PROVE_HYP
8616       (GEOM_EQUAL_DIMENSION_RULE(ASSUME `dimindex(:N) = dimindex(:1)`)
8617       FINITE_SPHERE_1));
8618     ASM_SIMP_TAC[CONNECTED_SPHERE; ARITH_RULE `2 <= n <=> 1 <= n /\ ~(n = 1)`;
8619                  DIMINDEX_GE_1; CONNECTED_FINITE_IFF_SING] THEN
8620     REWRITE_TAC[SET_RULE `(s = {} \/ ?a. s = {a}) <=>
8621                           (!a b. a IN s /\ b IN s ==> a = b)`] THEN
8622     SIMP_TAC[IN_SPHERE] THEN EQ_TAC THENL [ALL_TAC; CONV_TAC NORM_ARITH] THEN
8623     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
8624     REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN
8625     MP_TAC(ISPECL [`a:real^N`; `r:real`] VECTOR_CHOOSE_DIST) THEN
8626     ASM_SIMP_TAC[REAL_LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN
8627     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
8628     DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `a - (x - a):real^N`]) THEN
8629     FIRST_X_ASSUM(K ALL_TAC o check (is_neg o concl)) THEN
8630     REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC NORM_ARITH]);;
8631
8632 let LIMIT_POINT_OF_SPHERE = prove
8633  (`!a r x:real^N. x limit_point_of sphere(a,r) <=>
8634                   &0 < r /\ 2 <= dimindex(:N) /\ x IN sphere(a,r)`,
8635   REPEAT GEN_TAC THEN ASM_CASES_TAC `FINITE(sphere(a:real^N,r))` THENL
8636    [ASM_SIMP_TAC[LIMIT_POINT_FINITE]; ALL_TAC] THEN
8637   FIRST_ASSUM(MP_TAC o REWRITE_RULE[FINITE_SPHERE]) THEN
8638   REWRITE_TAC[DE_MORGAN_THM] THEN
8639   STRIP_TAC THEN ASM_REWRITE_TAC[REAL_NOT_LE; ARITH; REAL_NOT_LT] THEN
8640   ASM_SIMP_TAC[GSYM REAL_NOT_LE; DIMINDEX_GE_1;
8641                ARITH_RULE `1 <= n ==> (2 <= n <=> ~(n = 1))`] THEN
8642   EQ_TAC THEN REWRITE_TAC[REWRITE_RULE[CLOSED_LIMPT] CLOSED_SPHERE] THEN
8643   DISCH_TAC THEN MATCH_MP_TAC CONNECTED_IMP_PERFECT THEN
8644   ASM_SIMP_TAC[CONNECTED_SPHERE_EQ; DIMINDEX_GE_1;
8645                ARITH_RULE `1 <= n ==> (2 <= n <=> ~(n = 1))`] THEN
8646   ASM_MESON_TAC[FINITE_SING]);;
8647
8648 let CARD_EQ_SPHERE = prove
8649  (`!a:real^N r. 2 <= dimindex(:N) /\ &0 < r ==> sphere(a,r) =_c (:real)`,
8650   SIMP_TAC[CONNECTED_CARD_EQ_IFF_NONTRIVIAL; CONNECTED_SPHERE] THEN
8651   REPEAT STRIP_TAC THEN
8652   FIRST_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN
8653   ASM_REWRITE_TAC[FINITE_SING; FINITE_SPHERE; REAL_NOT_LE; DE_MORGAN_THM] THEN
8654   ASM_ARITH_TAC);;
8655
8656 let PATH_CONNECTED_ANNULUS = prove
8657  (`(!a:real^N r1 r2.
8658         2 <= dimindex(:N)
8659         ==> path_connected {x | r1 < norm(x - a) /\ norm(x - a) < r2}) /\
8660    (!a:real^N r1 r2.
8661         2 <= dimindex(:N)
8662         ==> path_connected {x | r1 < norm(x - a) /\ norm(x - a) <= r2}) /\
8663    (!a:real^N r1 r2.
8664         2 <= dimindex(:N)
8665         ==> path_connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2}) /\
8666    (!a:real^N r1 r2.
8667         2 <= dimindex(:N)
8668         ==> path_connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2})`,
8669   let lemma = prove
8670    (`!a:real^N P.
8671       2 <= dimindex(:N) /\ path_connected {lift r | &0 <= r /\ P r}
8672       ==> path_connected {x | P(norm(x - a))}`,
8673     REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN
8674     REWRITE_TAC[VECTOR_SUB_RZERO] THEN REPEAT STRIP_TAC THEN
8675     SUBGOAL_THEN
8676      `{x:real^N | P(norm(x))} =
8677       IMAGE (\z. drop(fstcart z) % sndcart z)
8678             {pastecart x y | x IN {lift x | &0 <= x /\ P x} /\
8679                              y IN {y | norm y = &1}}`
8680     SUBST1_TAC THENL
8681      [REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
8682       REWRITE_TAC[EXISTS_IN_GSPEC; FSTCART_PASTECART; SNDCART_PASTECART] THEN
8683       X_GEN_TAC `z:real^N` THEN REWRITE_TAC[EXISTS_LIFT; LIFT_DROP] THEN
8684       ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
8685       REWRITE_TAC[LIFT_IN_IMAGE_LIFT; IMAGE_ID] THEN
8686       REWRITE_TAC[IN_ELIM_THM] THEN
8687       EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[NORM_MUL; REAL_MUL_RID] THEN
8688       ASM_REWRITE_TAC[real_abs] THEN ASM_CASES_TAC `z:real^N = vec 0` THENL
8689        [MAP_EVERY EXISTS_TAC [`&0`; `basis 1:real^N`] THEN
8690         ASM_SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL; VECTOR_MUL_LZERO] THEN
8691         ASM_MESON_TAC[NORM_0; REAL_ABS_NUM; REAL_LE_REFL];
8692         MAP_EVERY EXISTS_TAC [`norm(z:real^N)`; `inv(norm z) % z:real^N`] THEN
8693         ASM_SIMP_TAC[REAL_ABS_NORM; NORM_MUL; VECTOR_MUL_ASSOC; VECTOR_MUL_LID;
8694           NORM_POS_LE; REAL_ABS_INV; REAL_MUL_RINV; REAL_MUL_LINV; NORM_EQ_0]];
8695       MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN CONJ_TAC THENL
8696        [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
8697         REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN
8698         SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART];
8699         REWRITE_TAC[GSYM PCROSS] THEN
8700         MATCH_MP_TAC PATH_CONNECTED_PCROSS THEN ASM_REWRITE_TAC[] THEN
8701         ONCE_REWRITE_TAC[NORM_ARITH `norm y = norm(y - vec 0:real^N)`] THEN
8702         ONCE_REWRITE_TAC[NORM_SUB] THEN
8703         REWRITE_TAC[REWRITE_RULE[dist] (GSYM sphere)] THEN
8704         ASM_SIMP_TAC[PATH_CONNECTED_SPHERE]]]) in
8705   REPEAT STRIP_TAC THEN
8706   MP_TAC(ISPEC `a:real^N` lemma) THEN
8707   DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
8708   MATCH_MP_TAC CONVEX_IMP_PATH_CONNECTED THEN
8709   MATCH_MP_TAC IS_INTERVAL_CONVEX THEN
8710   REWRITE_TAC[is_interval] THEN
8711   ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
8712   REWRITE_TAC[IN_IMAGE_LIFT_DROP; FORALL_1; DIMINDEX_1] THEN
8713   REWRITE_TAC[IN_ELIM_THM; GSYM drop] THEN REAL_ARITH_TAC);;
8714
8715 let CONNECTED_ANNULUS = prove
8716  (`(!a:real^N r1 r2.
8717         2 <= dimindex(:N)
8718         ==> connected {x | r1 < norm(x - a) /\ norm(x - a) < r2}) /\
8719    (!a:real^N r1 r2.
8720         2 <= dimindex(:N)
8721         ==> connected {x | r1 < norm(x - a) /\ norm(x - a) <= r2}) /\
8722    (!a:real^N r1 r2.
8723         2 <= dimindex(:N)
8724         ==> connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2}) /\
8725    (!a:real^N r1 r2.
8726         2 <= dimindex(:N)
8727         ==> connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2})`,
8728   REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_IMP_CONNECTED THEN
8729   ASM_SIMP_TAC[PATH_CONNECTED_ANNULUS]);;
8730
8731 let PATH_CONNECTED_COMPLEMENT_BOUNDED_CONVEX = prove
8732  (`!s. 2 <= dimindex(:N) /\ bounded s /\ convex s
8733        ==> path_connected((:real^N) DIFF s)`,
8734   REPEAT STRIP_TAC THEN
8735   ASM_CASES_TAC `s:real^N->bool = {}` THEN
8736   ASM_SIMP_TAC[DIFF_EMPTY; CONVEX_IMP_PATH_CONNECTED; CONVEX_UNIV] THEN
8737   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
8738   DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN
8739   REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
8740   MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
8741   REWRITE_TAC[IN_DIFF; IN_UNIV] THEN STRIP_TAC THEN
8742   SUBGOAL_THEN `~(x:real^N = a) /\ ~(y = a)` STRIP_ASSUME_TAC THENL
8743    [ASM_MESON_TAC[]; ALL_TAC] THEN
8744   SUBGOAL_THEN `bounded((x:real^N) INSERT y INSERT s)` MP_TAC THENL
8745    [ASM_REWRITE_TAC[BOUNDED_INSERT]; ALL_TAC] THEN
8746   DISCH_THEN(MP_TAC o SPEC `a:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
8747   REWRITE_TAC[INSERT_SUBSET] THEN
8748   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
8749   MATCH_MP_TAC PATH_COMPONENT_TRANS THEN
8750   ABBREV_TAC `C = (B / norm(x - a:real^N))` THEN
8751   EXISTS_TAC `a + C % (x - a):real^N` THEN CONJ_TAC THENL
8752    [MATCH_MP_TAC PATH_CONNECTED_LINEPATH THEN
8753     REWRITE_TAC[SUBSET; segment; FORALL_IN_GSPEC; IN_DIFF; IN_UNIV] THEN
8754     REWRITE_TAC[VECTOR_ARITH
8755      `(&1 - u) % x + u % (a + B % (x - a)):real^N =
8756       a + (&1 + (B - &1) * u) % (x - a)`] THEN
8757     X_GEN_TAC `u:real` THEN STRIP_TAC THEN DISCH_TAC THEN
8758     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN
8759     DISCH_THEN(MP_TAC o SPECL
8760      [`a:real^N`; `a + (&1 + (C - &1) * u) % (x - a):real^N`;
8761       `&1 / (&1 + (C - &1) * u)`]) THEN
8762     SUBGOAL_THEN `&1 <= &1 + (C - &1) * u` ASSUME_TAC THENL
8763      [REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC REAL_LE_MUL THEN
8764       ASM_REWRITE_TAC[REAL_SUB_LE] THEN
8765       EXPAND_TAC "C" THEN
8766       ASM_SIMP_TAC[REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN
8767       RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL; dist]) THEN
8768       ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_ARITH `&1 * norm(x - a) = norm(a - x)`];
8769       FIRST_ASSUM(ASSUME_TAC o MATCH_MP
8770        (REAL_ARITH `&1 <= a ==> &0 < a`))] THEN
8771     ASM_REWRITE_TAC[NOT_IMP] THEN
8772     ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE; REAL_LE_LDIV_EQ;
8773                  REAL_MUL_LID] THEN
8774     ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; REAL_DIV_RMUL;
8775                  REAL_LT_IMP_NZ] THEN
8776     UNDISCH_TAC `~((x:real^N) IN s)` THEN
8777     MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
8778     VECTOR_ARITH_TAC;
8779     ALL_TAC] THEN
8780   MATCH_MP_TAC PATH_COMPONENT_SYM THEN
8781   MATCH_MP_TAC PATH_COMPONENT_TRANS THEN
8782   ABBREV_TAC `D = (B / norm(y - a:real^N))` THEN
8783   EXISTS_TAC `a + D % (y - a):real^N` THEN CONJ_TAC THENL
8784    [MATCH_MP_TAC PATH_CONNECTED_LINEPATH THEN
8785     REWRITE_TAC[SUBSET; segment; FORALL_IN_GSPEC; IN_DIFF; IN_UNIV] THEN
8786     REWRITE_TAC[VECTOR_ARITH
8787      `(&1 - u) % y + u % (a + B % (y - a)):real^N =
8788       a + (&1 + (B - &1) * u) % (y - a)`] THEN
8789     X_GEN_TAC `u:real` THEN STRIP_TAC THEN DISCH_TAC THEN
8790     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN
8791     DISCH_THEN(MP_TAC o SPECL
8792      [`a:real^N`; `a + (&1 + (D - &1) * u) % (y - a):real^N`;
8793       `&1 / (&1 + (D - &1) * u)`]) THEN
8794     SUBGOAL_THEN `&1 <= &1 + (D - &1) * u` ASSUME_TAC THENL
8795      [REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC REAL_LE_MUL THEN
8796       ASM_REWRITE_TAC[REAL_SUB_LE] THEN
8797       EXPAND_TAC "D" THEN
8798       ASM_SIMP_TAC[REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN
8799       RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL; dist]) THEN
8800       ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_ARITH `&1 * norm(y - a) = norm(a - y)`];
8801       FIRST_ASSUM(ASSUME_TAC o MATCH_MP
8802        (REAL_ARITH `&1 <= a ==> &0 < a`))] THEN
8803     ASM_REWRITE_TAC[NOT_IMP] THEN
8804     ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE; REAL_LE_LDIV_EQ;
8805                  REAL_MUL_LID] THEN
8806     ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; REAL_DIV_RMUL;
8807                  REAL_LT_IMP_NZ] THEN
8808     UNDISCH_TAC `~((y:real^N) IN s)` THEN
8809     MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
8810     VECTOR_ARITH_TAC;
8811     ALL_TAC] THEN
8812   MATCH_MP_TAC PATH_COMPONENT_OF_SUBSET THEN
8813   EXISTS_TAC `{x:real^N | norm(x - a) = B}` THEN CONJ_TAC THENL
8814    [UNDISCH_TAC `s SUBSET ball(a:real^N,B)` THEN
8815     REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_DIFF; IN_UNIV; IN_BALL; dist] THEN
8816     MESON_TAC[NORM_SUB; REAL_LT_REFL];
8817     MP_TAC(ISPECL [`a:real^N`; `B:real`] PATH_CONNECTED_SPHERE) THEN
8818     REWRITE_TAC[REWRITE_RULE[ONCE_REWRITE_RULE[DIST_SYM] dist] sphere] THEN
8819     ASM_REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
8820     DISCH_THEN MATCH_MP_TAC THEN
8821     REWRITE_TAC[IN_ELIM_THM; VECTOR_ADD_SUB; NORM_MUL] THEN
8822     MAP_EVERY EXPAND_TAC ["C"; "D"] THEN
8823     REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NORM] THEN
8824     ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
8825     ASM_REAL_ARITH_TAC]);;
8826
8827 let CONNECTED_COMPLEMENT_BOUNDED_CONVEX = prove
8828  (`!s. 2 <= dimindex(:N) /\ bounded s /\ convex s
8829        ==> connected((:real^N) DIFF s)`,
8830   SIMP_TAC[PATH_CONNECTED_IMP_CONNECTED;
8831            PATH_CONNECTED_COMPLEMENT_BOUNDED_CONVEX]);;
8832
8833 let CONNECTED_DIFF_BALL = prove
8834  (`!s a:real^N r.
8835         2 <= dimindex(:N) /\ connected s /\ cball(a,r) SUBSET s
8836         ==> connected(s DIFF ball(a,r))`,
8837   REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_DIFF_OPEN_FROM_CLOSED THEN
8838   EXISTS_TAC `cball(a:real^N,r)` THEN
8839   ASM_REWRITE_TAC[OPEN_BALL; CLOSED_CBALL; BALL_SUBSET_CBALL] THEN
8840   REWRITE_TAC[CBALL_DIFF_BALL] THEN
8841   REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
8842   ASM_SIMP_TAC[CONNECTED_SPHERE]);;
8843
8844 let PATH_CONNECTED_DIFF_BALL = prove
8845  (`!s a:real^N r.
8846         2 <= dimindex(:N) /\ path_connected s /\ cball(a,r) SUBSET s
8847         ==> path_connected(s DIFF ball(a,r))`,
8848   REPEAT STRIP_TAC THEN ASM_CASES_TAC `ball(a:real^N,r) = {}` THEN
8849   ASM_SIMP_TAC[DIFF_EMPTY] THEN
8850   RULE_ASSUM_TAC(REWRITE_RULE[BALL_EQ_EMPTY; REAL_NOT_LE]) THEN
8851   REWRITE_TAC[path_connected] THEN
8852   FIRST_ASSUM(MP_TAC o SPEC `a:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN
8853   ASM_SIMP_TAC[CENTRE_IN_CBALL; REAL_LT_IMP_LE] THEN DISCH_TAC THEN
8854   MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
8855   REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
8856   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
8857   DISCH_THEN(fun th ->
8858    MP_TAC(SPECL [`x:real^N`; `a:real^N`] th) THEN
8859    MP_TAC(SPECL [`y:real^N`; `a:real^N`] th)) THEN
8860   ASM_REWRITE_TAC[] THEN
8861   DISCH_THEN(X_CHOOSE_THEN `g2:real^1->real^N` STRIP_ASSUME_TAC) THEN
8862   DISCH_THEN(X_CHOOSE_THEN `g1:real^1->real^N` STRIP_ASSUME_TAC) THEN
8863   MP_TAC(ISPECL [`g2:real^1->real^N`; `(:real^N) DIFF ball(a,r)`]
8864         EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN
8865   MP_TAC(ISPECL [`g1:real^1->real^N`; `(:real^N) DIFF ball(a,r)`]
8866         EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN
8867   ASM_SIMP_TAC[CENTRE_IN_BALL; IN_DIFF; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN
8868   ASM_SIMP_TAC[FRONTIER_COMPLEMENT; INTERIOR_COMPLEMENT; CLOSURE_BALL] THEN
8869   ASM_SIMP_TAC[FRONTIER_BALL; IN_SPHERE] THEN
8870   X_GEN_TAC `h1:real^1->real^N` THEN STRIP_TAC THEN
8871   X_GEN_TAC `h2:real^1->real^N` THEN STRIP_TAC THEN
8872   MP_TAC(ISPECL [`a:real^N`; `r:real`] PATH_CONNECTED_SPHERE) THEN
8873   ASM_REWRITE_TAC[path_connected] THEN
8874   DISCH_THEN(MP_TAC o SPECL
8875    [`pathfinish h1:real^N`; `pathfinish h2:real^N`]) THEN
8876   ASM_SIMP_TAC[IN_SPHERE] THEN
8877   DISCH_THEN(X_CHOOSE_THEN `h:real^1->real^N` STRIP_ASSUME_TAC) THEN
8878   EXISTS_TAC `h1 ++ h ++ reversepath h2:real^1->real^N` THEN
8879   ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_REVERSEPATH;
8880                PATHFINISH_REVERSEPATH; PATH_JOIN; PATH_REVERSEPATH;
8881                PATH_IMAGE_JOIN; PATH_IMAGE_REVERSEPATH] THEN
8882   REWRITE_TAC[UNION_SUBSET] THEN REPEAT CONJ_TAC THENL
8883    [ALL_TAC;
8884     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
8885           SUBSET_TRANS)) THEN
8886     UNDISCH_TAC `cball(a:real^N,r) SUBSET s` THEN
8887     SIMP_TAC[SUBSET; IN_CBALL; IN_SPHERE; IN_BALL; IN_DIFF] THEN
8888     MESON_TAC[REAL_LE_REFL; REAL_LT_REFL];
8889     ALL_TAC] THEN
8890   MATCH_MP_TAC(SET_RULE
8891    `s SUBSET t /\ s INTER u = {} ==> s SUBSET t DIFF u`) THEN
8892   (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
8893   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
8894    `s DELETE a SUBSET (UNIV DIFF t) ==> ~(a IN u) /\ u SUBSET t
8895       ==> s INTER u = {}`)) THEN
8896   ASM_REWRITE_TAC[BALL_SUBSET_CBALL; IN_BALL; REAL_LT_REFL]);;
8897
8898 let CONNECTED_OPEN_DIFF_CBALL = prove
8899  (`!s a:real^N r.
8900         2 <= dimindex (:N) /\ open s /\ connected s /\ cball(a,r) SUBSET s
8901         ==> connected(s DIFF cball(a,r))`,
8902   REPEAT STRIP_TAC THEN
8903   ASM_CASES_TAC `cball(a:real^N,r) = {}` THEN ASM_REWRITE_TAC[DIFF_EMPTY] THEN
8904   RULE_ASSUM_TAC(REWRITE_RULE[CBALL_EQ_EMPTY; REAL_NOT_LT]) THEN
8905   SUBGOAL_THEN `?r'. r < r' /\ cball(a:real^N,r') SUBSET s`
8906   STRIP_ASSUME_TAC THENL
8907    [ASM_CASES_TAC `s = (:real^N)` THENL
8908      [EXISTS_TAC `r + &1` THEN ASM_SIMP_TAC[SUBSET_UNIV] THEN REAL_ARITH_TAC;
8909       ALL_TAC] THEN
8910     MP_TAC(ISPECL [`cball(a:real^N,r)`; `(:real^N) DIFF s`]
8911       SETDIST_POS_LE) THEN
8912     REWRITE_TAC[REAL_ARITH `&0 <= x <=> &0 < x \/ x = &0`] THEN
8913     ASM_SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; GSYM OPEN_CLOSED;
8914                  COMPACT_CBALL; CBALL_EQ_EMPTY] THEN
8915     ASM_REWRITE_TAC[SET_RULE `UNIV DIFF s = {} <=> s = UNIV`] THEN
8916     ASM_SIMP_TAC[SET_RULE `b INTER (UNIV DIFF s) = {} <=> b SUBSET s`;
8917                  REAL_ARITH `&0 <= r ==> ~(r < &0)`] THEN
8918     STRIP_TAC THEN
8919     EXISTS_TAC `r + setdist(cball(a,r),(:real^N) DIFF s) / &2` THEN
8920     ASM_REWRITE_TAC[REAL_LT_ADDR; REAL_HALF; SUBSET; IN_CBALL] THEN
8921     X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `x:real^N = a` THENL
8922      [ASM_MESON_TAC[SUBSET; DIST_REFL; IN_CBALL]; ALL_TAC] THEN
8923     ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[REAL_NOT_LE] THEN
8924     MP_TAC(ISPECL [`cball(a:real^N,r)`; `(:real^N) DIFF s`;
8925                    `a + r / dist(a,x) % (x - a):real^N`; `x:real^N`]
8926       SETDIST_LE_DIST) THEN
8927     ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; IN_CBALL] THEN
8928     REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN
8929     ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; ONCE_REWRITE_RULE[DIST_SYM] dist;
8930                  REAL_ABS_NORM; REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
8931     ASM_REWRITE_TAC[REAL_ARITH `abs r <= r <=> &0 <= r`] THEN
8932     REWRITE_TAC[NORM_MUL; VECTOR_ARITH
8933      `x - (a + d % (x - a)):real^N = (&1 - d) % (x - a)`] THEN
8934     ONCE_REWRITE_TAC[GSYM REAL_ABS_NORM] THEN
8935     REWRITE_TAC[GSYM REAL_ABS_MUL] THEN
8936     REWRITE_TAC[REAL_ABS_NORM; REAL_SUB_RDISTRIB] THEN
8937     ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
8938     FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o REWRITE_RULE[SUBSET]) THEN
8939     ASM_REWRITE_TAC[IN_CBALL; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
8940     REAL_ARITH_TAC;
8941     SUBGOAL_THEN `s DIFF cball(a:real^N,r) =
8942                   s DIFF ball(a,r') UNION
8943                   {x | r < norm(x - a) /\ norm(x - a) <= r'}`
8944     SUBST1_TAC THENL
8945      [REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN
8946       REWRITE_TAC[GSYM REAL_NOT_LE; GSYM IN_CBALL] THEN MATCH_MP_TAC(SET_RULE
8947        `b' SUBSET c' /\ c' SUBSET s /\ c SUBSET b'
8948         ==> s DIFF c = (s DIFF b') UNION {x | ~(x IN c) /\ x IN c'}`) THEN
8949       ASM_REWRITE_TAC[BALL_SUBSET_CBALL] THEN
8950       REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN ASM_REAL_ARITH_TAC;
8951       MATCH_MP_TAC CONNECTED_UNION THEN
8952       ASM_SIMP_TAC[CONNECTED_ANNULUS; PATH_CONNECTED_DIFF_BALL;
8953         PATH_CONNECTED_IMP_CONNECTED; CONNECTED_OPEN_PATH_CONNECTED] THEN
8954       REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN
8955       REWRITE_TAC[GSYM REAL_NOT_LE; GSYM IN_CBALL] THEN MATCH_MP_TAC(SET_RULE
8956        `c' SUBSET s /\ (?x. x IN c' /\ ~(x IN b') /\ ~(x IN c))
8957         ==> ~((s DIFF b') INTER {x | ~(x IN c) /\ x IN c'} = {})`) THEN
8958       ASM_REWRITE_TAC[] THEN EXISTS_TAC `a + r' % basis 1:real^N` THEN
8959       REWRITE_TAC[IN_BALL; IN_CBALL] THEN
8960       REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN
8961       SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
8962       ASM_REAL_ARITH_TAC]]);;
8963
8964 (* ------------------------------------------------------------------------- *)
8965 (* Existence of unbounded components.                                        *)
8966 (* ------------------------------------------------------------------------- *)
8967
8968 let COBOUNDED_UNBOUNDED_COMPONENT = prove
8969  (`!s. bounded((:real^N) DIFF s)
8970        ==> ?x. x IN s /\ ~bounded(connected_component s x)`,
8971   REPEAT STRIP_TAC THEN
8972   FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
8973   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
8974   EXISTS_TAC `B % basis 1:real^N` THEN CONJ_TAC THENL
8975    [FIRST_X_ASSUM(MP_TAC o SPEC `B % basis 1:real^N` o
8976      GEN_REWRITE_RULE I [SUBSET]) THEN
8977     REWRITE_TAC[IN_UNIV; IN_DIFF; IN_BALL_0] THEN
8978     SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
8979     ASM_SIMP_TAC[REAL_ARITH `&0 < B ==> ~(abs B * &1 < B)`];
8980     MP_TAC(ISPECL [`basis 1:real^N`; `B:real`] BOUNDED_HALFSPACE_GE) THEN
8981     SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL; CONTRAPOS_THM] THEN
8982     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN
8983     MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
8984     SIMP_TAC[CONVEX_HALFSPACE_GE; CONVEX_CONNECTED] THEN
8985     ASM_SIMP_TAC[IN_ELIM_THM; DOT_RMUL; DOT_BASIS_BASIS; DIMINDEX_GE_1;
8986                  LE_REFL; real_ge; REAL_MUL_RID; REAL_LE_REFL] THEN
8987     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
8988     `UNIV DIFF s SUBSET b ==> (!x. x IN h ==> ~(x IN b)) ==> h SUBSET s`)) THEN
8989     SIMP_TAC[IN_ELIM_THM; DOT_BASIS; IN_BALL_0; DIMINDEX_GE_1; LE_REFL] THEN
8990     GEN_TAC THEN REWRITE_TAC[REAL_NOT_LT] THEN
8991     MATCH_MP_TAC(REAL_ARITH `abs x <= n ==> b <= x ==> b <= n`) THEN
8992     SIMP_TAC[COMPONENT_LE_NORM; DIMINDEX_GE_1; LE_REFL]]);;
8993
8994 let COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT = prove
8995  (`!s x y:real^N.
8996         2 <= dimindex(:N) /\ bounded((:real^N) DIFF s) /\
8997         ~bounded(connected_component s x) /\
8998         ~bounded(connected_component s y)
8999         ==> connected_component s x = connected_component s y`,
9000   REPEAT STRIP_TAC THEN
9001   FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
9002   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
9003   MP_TAC(ISPEC `ball(vec 0:real^N,B)` CONNECTED_COMPLEMENT_BOUNDED_CONVEX) THEN
9004   ASM_REWRITE_TAC[BOUNDED_BALL; CONVEX_BALL] THEN DISCH_TAC THEN
9005   MAP_EVERY
9006    (MP_TAC o SPEC `B:real` o REWRITE_RULE[bounded; NOT_EXISTS_THM] o ASSUME)
9007    [`~bounded(connected_component s (y:real^N))`;
9008     `~bounded(connected_component s (x:real^N))`] THEN
9009   REWRITE_TAC[NOT_FORALL_THM; IN; NOT_IMP] THEN
9010   DISCH_THEN(X_CHOOSE_THEN `x':real^N` STRIP_ASSUME_TAC) THEN
9011   DISCH_THEN(X_CHOOSE_THEN `y':real^N` STRIP_ASSUME_TAC) THEN
9012   MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN REWRITE_TAC[IN] THEN
9013   SUBGOAL_THEN `connected_component s (x':real^N) (y':real^N)` ASSUME_TAC THENL
9014    [REWRITE_TAC[connected_component] THEN
9015     EXISTS_TAC `(:real^N) DIFF ball (vec 0,B)` THEN ASM_REWRITE_TAC[] THEN
9016     CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_DIFF; IN_UNIV]] THEN
9017     REWRITE_TAC[IN_BALL_0] THEN ASM_MESON_TAC[REAL_LT_IMP_LE];
9018     ASM_MESON_TAC[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS]]);;
9019
9020 let COBOUNDED_UNBOUNDED_COMPONENTS = prove
9021  (`!s. bounded ((:real^N) DIFF s) ==> ?c. c IN components s /\ ~bounded c`,
9022   REWRITE_TAC[components; EXISTS_IN_GSPEC; COBOUNDED_UNBOUNDED_COMPONENT]);;
9023
9024 let COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS = prove
9025  (`!s c c'.
9026         2 <= dimindex(:N) /\
9027         bounded ((:real^N) DIFF s) /\
9028         c IN components s /\ ~bounded c /\
9029         c' IN components s /\ ~bounded c'
9030         ==> c' = c`,
9031   REWRITE_TAC[components; IN_ELIM_THM] THEN
9032   MESON_TAC[COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT]);;
9033
9034 let COBOUNDED_HAS_BOUNDED_COMPONENT = prove
9035  (`!s. 2 <= dimindex(:N) /\ bounded((:real^N) DIFF s) /\ ~connected s
9036        ==> ?c. c IN components s /\ bounded c`,
9037   REPEAT STRIP_TAC THEN
9038   SUBGOAL_THEN
9039    `?c c':real^N->bool. c IN components s /\ c' IN components s /\ ~(c = c')`
9040   STRIP_ASSUME_TAC THENL
9041    [MATCH_MP_TAC(SET_RULE
9042      `~(s = {}) /\ ~(?a. s = {a}) ==> ?x y. x IN s /\ y IN s /\ ~(x = y)`) THEN
9043     ASM_REWRITE_TAC[COMPONENTS_EQ_SING_EXISTS; COMPONENTS_EQ_EMPTY] THEN
9044     ASM_MESON_TAC[DIFF_EMPTY; NOT_BOUNDED_UNIV];
9045     ASM_MESON_TAC[COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS]]);;
9046
9047 (* ------------------------------------------------------------------------- *)
9048 (* Self-homeomorphisms shuffling points about in various ways.               *)
9049 (* ------------------------------------------------------------------------- *)
9050
9051 let HOMEOMORPHISM_MOVING_POINT_EXISTS = prove
9052  (`!s t a b:real^N.
9053         open_in (subtopology euclidean (affine hull s)) s /\
9054         s SUBSET t /\ t SUBSET affine hull s /\
9055         connected s /\ a IN s /\ b IN s
9056         ==> ?f g. homeomorphism (t,t) (f,g) /\ f a = b /\
9057                   {x | ~(f x = x /\ g x = x)} SUBSET s /\
9058                   bounded {x | ~(f x = x /\ g x = x)}`,
9059   let lemma1 = prove
9060    (`!a t r u:real^N.
9061           affine t /\ a IN t /\ u IN ball(a,r) INTER t
9062           ==> ?f g. homeomorphism (cball(a,r) INTER t,cball(a,r) INTER t)
9063                                   (f,g) /\
9064                     f(a) = u /\ (!x. x IN sphere(a,r) ==> f(x) = x)`,
9065     REPEAT STRIP_TAC THEN
9066     DISJ_CASES_TAC(REAL_ARITH `r <= &0 \/ &0 < r`) THENL
9067      [ASM_MESON_TAC[BALL_EMPTY; INTER_EMPTY; NOT_IN_EMPTY]; ALL_TAC] THEN
9068     EXISTS_TAC `\x:real^N. (&1 - norm(x - a) / r) % (u - a) + x` THEN
9069     REWRITE_TAC[LEFT_EXISTS_AND_THM] THEN CONJ_TAC THENL
9070      [MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN
9071       ASM_SIMP_TAC[COMPACT_INTER_CLOSED; COMPACT_CBALL; CLOSED_AFFINE];
9072       ASM_SIMP_TAC[IN_SPHERE; ONCE_REWRITE_RULE[NORM_SUB] dist;
9073                    REAL_DIV_REFL; REAL_LT_IMP_NZ; IN_INTER] THEN
9074       REWRITE_TAC[real_div; VECTOR_SUB_REFL; NORM_0; REAL_MUL_LZERO] THEN
9075       REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC] THEN
9076     CONJ_TAC THENL
9077      [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN
9078       MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF; LIFT_SUB] THEN
9079       SIMP_TAC[CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB] THEN
9080       MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
9081       REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div; LIFT_CMUL] THEN
9082       MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
9083       MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN
9084       SIMP_TAC[CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB];
9085       ALL_TAC] THEN
9086     CONJ_TAC THENL
9087      [MATCH_MP_TAC(SET_RULE
9088        `(!x. x IN s ==> f x IN s) /\ (!y. y IN s ==> ?x. x IN s /\ f x = y)
9089         ==> IMAGE f s = s`) THEN REWRITE_TAC[] THEN
9090       ONCE_REWRITE_TAC[VECTOR_ARITH
9091        `(&1 - n) % (u - a) + x:real^N = a + (&1 - n) % (u - a) + (x - a)`];
9092       ALL_TAC] THEN
9093     REPEAT(POP_ASSUM MP_TAC) THEN GEOM_ORIGIN_TAC `a:real^N` THEN
9094     REWRITE_TAC[IN_BALL_0; VECTOR_SUB_RZERO; IN_CBALL_0; IN_INTER] THEN
9095     REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID;
9096                 VECTOR_ARITH `a + x:real^N = a + y <=> x = y`;
9097                 VECTOR_ARITH `(&1 - n) % u + a + x = (&1 - m) % u + a + y <=>
9098                               (n - m) % u:real^N = x - y`] THEN
9099     REWRITE_TAC[REAL_ARITH `x / r - y / r:real = (x - y) / r`] THENL
9100      [ALL_TAC;
9101       REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN REPEAT GEN_TAC THEN
9102       ASM_CASES_TAC `x:real^N = y` THEN ASM_REWRITE_TAC[] THEN
9103       ASM_CASES_TAC `norm(x:real^N) = norm(y:real^N)` THEN
9104       ASM_REWRITE_TAC[real_div; REAL_SUB_REFL; REAL_MUL_LZERO; VECTOR_MUL_LZERO;
9105                       VECTOR_ARITH `vec 0:real^N = x - y <=> x = y`] THEN
9106       STRIP_TAC THEN FIRST_ASSUM(MP_TAC o AP_TERM `norm:real^N->real`) THEN
9107       ASM_SIMP_TAC[NORM_MUL; REAL_ABS_MUL; REAL_ABS_INV] THEN
9108       DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH
9109        `r = norm(x - y:real^N) ==> r < abs(norm x - norm y) * &1 ==> F`)) THEN
9110       REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LT_LMUL THEN
9111       CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ONCE_REWRITE_TAC[REAL_MUL_SYM]] THEN
9112       ASM_SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ;
9113                    REAL_ARITH `&0 < r ==> &0 < abs r`] THEN
9114       ASM_REAL_ARITH_TAC] THEN
9115     REPEAT GEN_TAC THEN
9116     ASM_CASES_TAC `subspace(t:real^N->bool)` THENL
9117      [ALL_TAC; ASM_MESON_TAC[AFFINE_IMP_SUBSPACE]] THEN
9118     ASM_SIMP_TAC[SUBSPACE_ADD; SUBSPACE_MUL] THEN
9119     REPEAT STRIP_TAC THENL
9120      [MATCH_MP_TAC(NORM_ARITH
9121        `norm(x) + norm(y) <= &1 * r ==> norm(x + y:real^N) <= r`) THEN
9122       ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LE_LDIV_EQ; REAL_ARITH
9123        `(a * u + x) / r:real = a * u / r + x / r`] THEN
9124       MATCH_MP_TAC(REAL_ARITH
9125        `x <= &1 /\ a <= abs(&1 - x) * &1 ==> a + x <= &1`) THEN
9126       ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN
9127       CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
9128       MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN
9129       ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_MUL_LID; REAL_LT_IMP_LE];
9130       ALL_TAC] THEN
9131     MP_TAC(ISPECL
9132      [`\a. lift((&1 - drop a) * r - norm(y - drop a % u:real^N))`;
9133       `vec 0:real^1`; `vec 1:real^1`; `&0`; `1`]
9134           IVT_DECREASING_COMPONENT_1) THEN
9135     REWRITE_TAC[DIMINDEX_1; GSYM drop; LIFT_DROP; DROP_VEC] THEN
9136     REWRITE_TAC[REAL_POS; LE_REFL; REAL_SUB_REFL; VECTOR_MUL_LZERO] THEN
9137     REWRITE_TAC[REAL_SUB_RZERO; VECTOR_SUB_RZERO; REAL_MUL_LID] THEN
9138     REWRITE_TAC[NORM_ARITH `&0 * r - norm(x:real^N) <= &0`] THEN
9139     ASM_REWRITE_TAC[REAL_SUB_LE; GSYM EXISTS_DROP; IN_INTERVAL_1] THEN
9140     ANTS_TAC THENL
9141      [REPEAT STRIP_TAC THEN
9142       REWRITE_TAC[REAL_ARITH `(&1 - x) * r - b:real = r - r * x - b`] THEN
9143       REWRITE_TAC[LIFT_SUB; LIFT_CMUL; LIFT_DROP] THEN
9144       REPEAT(MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THEN
9145              REWRITE_TAC[CONTINUOUS_CONST]) THEN
9146       SIMP_TAC[CONTINUOUS_CMUL; CONTINUOUS_AT_ID] THEN
9147       MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE THEN
9148       MATCH_MP_TAC CONTINUOUS_SUB THEN REWRITE_TAC[CONTINUOUS_CONST] THEN
9149       MATCH_MP_TAC CONTINUOUS_MUL THEN
9150       REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_AT_ID; CONTINUOUS_CONST];
9151
9152       ASM_SIMP_TAC[DROP_VEC; REAL_FIELD
9153        `&0 < r ==> ((&1 - x) * r - n = &0 <=> &1 - n / r = x)`] THEN
9154       DISCH_THEN(X_CHOOSE_THEN `a:real` STRIP_ASSUME_TAC) THEN
9155       EXISTS_TAC `y - a % u:real^N` THEN ASM_REWRITE_TAC[] THEN
9156       CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN
9157       ASM_SIMP_TAC[SUBSPACE_SUB; SUBSPACE_MUL] THEN
9158       GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
9159       ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN ASM_REAL_ARITH_TAC]) in
9160   let lemma2 = prove
9161    (`!a t u v:real^N r.
9162           affine t /\ a IN t /\
9163           u IN ball(a,r) INTER t /\ v IN ball(a,r) INTER t
9164           ==> ?f g. homeomorphism (cball(a,r) INTER t,cball(a,r) INTER t)
9165                                   (f,g) /\ f(u) = v /\
9166                     !x. x IN sphere(a,r) /\ x IN t ==> f(x) = x`,
9167     REPEAT GEN_TAC THEN
9168     DISJ_CASES_TAC(REAL_ARITH `r <= &0 \/ &0 < r`) THENL
9169      [ASM_MESON_TAC[BALL_EMPTY; INTER_EMPTY; NOT_IN_EMPTY];
9170       REPLICATE_TAC 2 (DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
9171       DISCH_TAC] THEN
9172     MP_TAC(ISPECL [`a:real^N`; `t:real^N->bool`; `r:real`] lemma1) THEN
9173     ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th ->
9174         FIRST_ASSUM(CONJUNCTS_THEN(MP_TAC o MATCH_MP th))) THEN
9175     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9176     MAP_EVERY X_GEN_TAC [`f1:real^N->real^N`; `g1:real^N->real^N`] THEN
9177     STRIP_TAC THEN
9178     MAP_EVERY X_GEN_TAC [`f2:real^N->real^N`; `g2:real^N->real^N`] THEN
9179     STRIP_TAC THEN
9180     EXISTS_TAC `(f1:real^N->real^N) o (g2:real^N->real^N)` THEN
9181     EXISTS_TAC `(f2:real^N->real^N) o (g1:real^N->real^N)` THEN
9182     REWRITE_TAC[o_THM; SUBSET; IN_ELIM_THM] THEN CONJ_TAC THENL
9183      [MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN ASM_MESON_TAC[HOMEOMORPHISM_SYM];
9184       RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; IN_INTER]) THEN CONJ_TAC THENL
9185        [MP_TAC(ISPECL [`a:real^N`; `r:real`] CENTRE_IN_CBALL) THEN
9186         ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN ASM SET_TAC[];
9187         MP_TAC(ISPECL [`a:real^N`; `r:real`] SPHERE_SUBSET_CBALL) THEN
9188         ASM SET_TAC[]]]) in
9189   let lemma3 = prove
9190    (`!a t u v:real^N r s.
9191         affine t /\ a IN t /\ ball(a,r) INTER t SUBSET s /\ s SUBSET t /\
9192         u IN ball(a,r) INTER t /\ v IN ball(a,r) INTER t
9193         ==> ?f g. homeomorphism (s,s) (f,g) /\ f(u) = v /\
9194                   {x | ~(f x = x /\ g x = x)} SUBSET ball(a,r) INTER t`,
9195     REPEAT STRIP_TAC THEN
9196     MP_TAC(ISPECL [`a:real^N`; `t:real^N->bool`; `u:real^N`; `v:real^N`;
9197                    `r:real`] lemma2) THEN
9198     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9199     MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN
9200     STRIP_TAC THEN
9201     EXISTS_TAC `\x:real^N. if x IN ball(a,r) INTER t then f x else x` THEN
9202     EXISTS_TAC `\x:real^N. if x IN ball(a,r) INTER t then g x else x` THEN
9203     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
9204     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN
9205     REWRITE_TAC[HOMEOMORPHISM; SUBSET; FORALL_IN_IMAGE] THEN
9206     STRIP_TAC THEN
9207     SUBGOAL_THEN `(!x:real^N. x IN ball(a,r) INTER t ==> f x IN ball(a,r)) /\
9208                   (!x:real^N. x IN ball(a,r) INTER t ==> g x IN ball(a,r))`
9209     STRIP_ASSUME_TAC THENL
9210      [REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN ASM SET_TAC[]; ALL_TAC] THEN
9211     RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN
9212     REWRITE_TAC[IN_INTER] THEN REPEAT CONJ_TAC THEN
9213     TRY(X_GEN_TAC `x:real^N` THEN
9214         ASM_CASES_TAC `x IN ball(a:real^N,r)` THEN ASM_SIMP_TAC[] THEN
9215         MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN
9216         REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[]) THEN
9217         ASM SET_TAC[]) THEN
9218     MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
9219     EXISTS_TAC `(cball(a,r) INTER t) UNION
9220                 ((t:real^N->bool) DIFF ball(a,r))` THEN
9221     (CONJ_TAC THENL
9222       [ALL_TAC;
9223        MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN
9224        ASM SET_TAC[]]) THEN
9225     MATCH_MP_TAC CONTINUOUS_ON_CASES THEN
9226     ASM_SIMP_TAC[CLOSED_CBALL; CLOSED_DIFF; OPEN_BALL; CONTINUOUS_ON_ID;
9227              GSYM IN_DIFF; CBALL_DIFF_BALL; CLOSED_AFFINE; CLOSED_INTER] THEN
9228     MP_TAC(ISPECL [`a:real^N`; `r:real`] SPHERE_SUBSET_CBALL) THEN
9229     MP_TAC(ISPECL [`a:real^N`; `r:real`] CBALL_DIFF_BALL) THEN
9230     ASM SET_TAC[]) in
9231   REWRITE_TAC[TAUT `p /\ q /\ r /\ s /\ t ==> u <=>
9232                     p /\ q /\ r /\ s ==> t ==> u`] THEN
9233   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
9234   FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
9235   ONCE_REWRITE_TAC[TAUT `p ==> q <=> p ==> p /\ q`] THEN
9236   MATCH_MP_TAC CONNECTED_EQUIVALENCE_RELATION THEN ASM_REWRITE_TAC[] THEN
9237   REPEAT CONJ_TAC THEN X_GEN_TAC `a:real^N` THENL
9238    [X_GEN_TAC `b:real^N` THEN
9239     REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
9240     ASM_REWRITE_TAC[] THEN
9241     GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN
9242     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^N` THEN
9243     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^N` THEN
9244     REWRITE_TAC[HOMEOMORPHISM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
9245     ONCE_REWRITE_TAC[TAUT `~(p /\ q) <=> ~(q /\ p)`] THEN
9246     ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
9247     MAP_EVERY X_GEN_TAC [`b:real^N`; `c:real^N`] THEN
9248     MAP_EVERY (fun t -> ASM_CASES_TAC t THEN ASM_REWRITE_TAC[])
9249      [`(a:real^N) IN s`; `(b:real^N) IN s`; `(c:real^N) IN s`] THEN
9250     ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
9251     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9252     MAP_EVERY X_GEN_TAC [`f1:real^N->real^N`; `g1:real^N->real^N`] THEN
9253     STRIP_TAC THEN
9254     MAP_EVERY X_GEN_TAC [`f2:real^N->real^N`; `g2:real^N->real^N`] THEN
9255     STRIP_TAC THEN
9256     EXISTS_TAC `(f2:real^N->real^N) o (f1:real^N->real^N)` THEN
9257     EXISTS_TAC `(g1:real^N->real^N) o (g2:real^N->real^N)` THEN
9258     ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL
9259      [ASM_MESON_TAC[HOMEOMORPHISM_COMPOSE]; ALL_TAC] THEN
9260     CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
9261     MATCH_MP_TAC BOUNDED_SUBSET THEN
9262     EXISTS_TAC `{x | ~(f1 x = x /\ g1 x = x)} UNION
9263                 {x:real^N | ~(f2 x = x /\ g2 x = x)}` THEN
9264     ASM_REWRITE_TAC[BOUNDED_UNION] THEN ASM SET_TAC[];
9265     DISCH_TAC THEN
9266     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN
9267     DISCH_THEN(MP_TAC o SPEC `a:real^N` o CONJUNCT2) THEN ASM_SIMP_TAC[] THEN
9268     DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
9269     EXISTS_TAC `s INTER ball(a:real^N,r)` THEN
9270     ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL; OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
9271     X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN
9272     MP_TAC(ISPECL
9273      [`a:real^N`; `affine hull s:real^N->bool`;
9274       `a:real^N`; `b:real^N`; `r:real`; `t:real^N->bool`]
9275         lemma3) THEN
9276     ASM_SIMP_TAC[CENTRE_IN_BALL; AFFINE_AFFINE_HULL; HULL_INC; IN_INTER] THEN
9277     ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
9278     REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
9279     ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL; INTER_SUBSET; SUBSET_TRANS]]);;
9280
9281 let HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN = prove
9282  (`!s t x (y:A->real^N) k.
9283         &2 <= aff_dim s /\ open_in (subtopology euclidean (affine hull s)) s /\
9284         s SUBSET t /\ t SUBSET affine hull s /\ connected s /\
9285         FINITE k /\ (!i. i IN k ==> x i IN s /\ y i IN s) /\
9286         pairwise (\i j. ~(x i = x j) /\ ~(y i = y j)) k
9287         ==> ?f g. homeomorphism (t,t) (f,g) /\
9288                   (!i. i IN k ==> f(x i) = y i) /\
9289                   {x | ~(f x = x /\ g x = x)} SUBSET s /\
9290                   bounded {x | ~(f x = x /\ g x = x)}`,
9291   REPEAT GEN_TAC THEN
9292   ASM_CASES_TAC `FINITE(k:A->bool)` THEN ASM_REWRITE_TAC[] THEN
9293   SPEC_TAC(`s:real^N->bool`,`s:real^N->bool`) THEN POP_ASSUM MP_TAC THEN
9294   SPEC_TAC(`k:A->bool`,`k:A->bool`) THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
9295   CONJ_TAC THENL
9296    [GEN_TAC THEN STRIP_TAC THEN REPEAT(EXISTS_TAC `I:real^N->real^N`) THEN
9297     REWRITE_TAC[HOMEOMORPHISM_I; NOT_IN_EMPTY; I_THM; EMPTY_GSPEC] THEN
9298     REWRITE_TAC[EMPTY_SUBSET; BOUNDED_EMPTY];
9299     ALL_TAC] THEN
9300   MAP_EVERY X_GEN_TAC [`i:A`; `k:A->bool`] THEN STRIP_TAC THEN
9301   X_GEN_TAC `s:real^N->bool` THEN
9302   REWRITE_TAC[PAIRWISE_INSERT; FORALL_IN_INSERT] THEN STRIP_TAC THEN
9303   FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`) THEN
9304   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9305   MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN
9306   STRIP_TAC THEN MP_TAC(ISPECL
9307    [`s DIFF IMAGE (y:A->real^N) k`; `t:real^N->bool`;
9308     `(f:real^N->real^N) ((x:A->real^N) i)`; `(y:A->real^N) i`]
9309    HOMEOMORPHISM_MOVING_POINT_EXISTS) THEN
9310   SUBGOAL_THEN
9311    `affine hull (s DIFF (IMAGE (y:A->real^N) k)) = affine hull s`
9312   SUBST1_TAC THENL
9313    [MATCH_MP_TAC AFFINE_HULL_OPEN_IN THEN CONJ_TAC THENL
9314      [TRANS_TAC OPEN_IN_TRANS `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
9315       MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
9316       MATCH_MP_TAC FINITE_IMP_CLOSED_IN THEN
9317       ASM_SIMP_TAC[FINITE_IMAGE] THEN ASM SET_TAC[];
9318
9319       REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN
9320       DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
9321         FINITE_SUBSET)) THEN
9322       ASM_SIMP_TAC[FINITE_IMAGE; CONNECTED_FINITE_IFF_SING] THEN
9323       UNDISCH_TAC `&2 <= aff_dim(s:real^N->bool)` THEN
9324       ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
9325       REWRITE_TAC[] THEN STRIP_TAC THEN
9326       ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_SING] THEN
9327       CONV_TAC INT_REDUCE_CONV];
9328     ASM_REWRITE_TAC[]] THEN
9329   ANTS_TAC THENL
9330    [REPEAT CONJ_TAC THENL
9331      [MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[] THEN
9332       MATCH_MP_TAC FINITE_IMP_CLOSED_IN THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN
9333       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN
9334       MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[];
9335       ASM SET_TAC[];
9336       MATCH_MP_TAC CONNECTED_OPEN_IN_DIFF_CARD_LT THEN
9337       ASM_REWRITE_TAC[COLLINEAR_AFF_DIM;
9338                       INT_ARITH `~(s:int <= &1) <=> &2 <= s`] THEN
9339       MATCH_MP_TAC CARD_LT_FINITE_INFINITE THEN
9340       ASM_SIMP_TAC[FINITE_IMAGE; real_INFINITE];
9341       ALL_TAC; ALL_TAC] THEN
9342     RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN REWRITE_TAC[IN_DIFF] THEN
9343     (CONJ_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[IN_DIFF]]) THEN
9344     SIMP_TAC[SET_RULE `~(y IN IMAGE f s) <=> !x. x IN s ==> ~(f x = y)`] THEN
9345     ASM SET_TAC[];
9346     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9347     MAP_EVERY X_GEN_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN
9348     STRIP_TAC THEN MAP_EVERY EXISTS_TAC
9349      [`(h:real^N->real^N) o (f:real^N->real^N)`;
9350       `(g:real^N->real^N) o (k:real^N->real^N)`] THEN
9351     CONJ_TAC THENL [ASM_MESON_TAC[HOMEOMORPHISM_COMPOSE]; ALL_TAC] THEN
9352     ASM_SIMP_TAC[o_THM] THEN
9353     REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
9354     MATCH_MP_TAC BOUNDED_SUBSET THEN
9355     EXISTS_TAC `{x | ~(f x = x /\ g x = x)} UNION
9356                 {x:real^N | ~(h x = x /\ k x = x)}` THEN
9357     ASM_REWRITE_TAC[BOUNDED_UNION] THEN ASM SET_TAC[]]);;
9358
9359 let HOMEOMORPHISM_MOVING_POINTS_EXISTS = prove
9360  (`!s t x (y:A->real^N) k.
9361         2 <= dimindex(:N) /\ open s /\ connected s /\ s SUBSET t /\
9362         FINITE k /\ (!i. i IN k ==> x i IN s /\ y i IN s) /\
9363         pairwise (\i j. ~(x i = x j) /\ ~(y i = y j)) k
9364         ==> ?f g. homeomorphism (t,t) (f,g) /\
9365                   (!i. i IN k ==> f(x i) = y i) /\
9366                   {x | ~(f x = x /\ g x = x)} SUBSET s /\
9367                   bounded {x | ~(f x = x /\ g x = x)}`,
9368   REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL
9369    [STRIP_TAC THEN REPEAT(EXISTS_TAC `I:real^N->real^N`) THEN
9370     REWRITE_TAC[HOMEOMORPHISM_I; NOT_IN_EMPTY; I_THM; EMPTY_GSPEC] THEN
9371     REWRITE_TAC[EMPTY_SUBSET; BOUNDED_EMPTY] THEN ASM SET_TAC[];
9372     STRIP_TAC] THEN
9373   MATCH_MP_TAC HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN THEN
9374   ASM_REWRITE_TAC[] THEN
9375   ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN
9376   SUBGOAL_THEN `affine hull s = (:real^N)` SUBST1_TAC THENL
9377    [MATCH_MP_TAC AFFINE_HULL_OPEN THEN ASM SET_TAC[];
9378     ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; AFF_DIM_UNIV] THEN
9379     ASM_REWRITE_TAC[INT_OF_NUM_LE; SUBSET_UNIV]]);;
9380
9381 let HOMEOMORPHISM_GROUPING_POINTS_EXISTS = prove
9382  (`!u s t k:real^N->bool.
9383         open u /\ open s /\ connected s /\ ~(u = {}) /\
9384         FINITE k /\ k SUBSET s /\ u SUBSET s /\ s SUBSET t
9385         ==> ?f g. homeomorphism (t,t) (f,g) /\
9386                   {x | ~(f x = x /\ g x = x)} SUBSET s /\
9387                   bounded {x | ~(f x = x /\ g x = x)} /\
9388                   !x. x IN k ==> (f x) IN u`,
9389   let lemma1 = prove
9390    (`!a b:real^1 c d:real^1.
9391           drop a < drop b /\ drop c < drop d
9392           ==> ?f g. homeomorphism (interval[a,b],interval[c,d]) (f,g) /\
9393                     f(a) = c /\ f(b) = d`,
9394     REPEAT STRIP_TAC THEN EXISTS_TAC
9395      `\x. c + (drop x - drop a) / (drop b - drop a) % (d - c:real^1)` THEN
9396     ASM_SIMP_TAC[REAL_DIV_REFL; REAL_SUB_LT; REAL_LT_IMP_NZ;
9397                  REAL_ARITH `(a - a) / x = &0`; LEFT_EXISTS_AND_THM] THEN
9398     CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN
9399     MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN
9400     REWRITE_TAC[COMPACT_INTERVAL] THEN REPEAT CONJ_TAC THENL
9401      [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
9402       MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN
9403       REWRITE_TAC[LIFT_CMUL; real_div; o_DEF] THEN
9404       MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN
9405       REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP] THEN
9406       SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID];
9407       REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_IMAGE] THEN
9408       ASM_SIMP_TAC[GSYM DROP_EQ; DROP_ADD; DROP_CMUL; DROP_SUB; REAL_FIELD
9409        `a < b /\ c < d
9410         ==> (x = c + (y - a) / (b - a) * (d - c) <=>
9411              a + (x - c) / (d - c) * (b - a) = y)`] THEN
9412       REWRITE_TAC[GSYM EXISTS_DROP; UNWIND_THM1] THEN
9413       REWRITE_TAC[REAL_ARITH
9414        `c <= c + x /\ c + x <= d <=> &0 <= x /\ x <= &1 * (d - c)`] THEN
9415       ASM_SIMP_TAC[REAL_LE_MUL_EQ; REAL_LE_RMUL_EQ; REAL_SUB_LT] THEN
9416       ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN
9417       REAL_ARITH_TAC;
9418       ASM_SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`;
9419                   REAL_FIELD `a < b ==> (x / (b - a) = y / (b - a) <=> x = y)`;
9420                   REAL_ARITH `x - a:real = y - a <=> x = y`;
9421                   VECTOR_MUL_RCANCEL; DROP_EQ; VECTOR_SUB_EQ] THEN
9422       ASM_MESON_TAC[REAL_LT_REFL]]) in
9423   let lemma2 = prove
9424    (`!a b c:real^1 u v w:real^1 f1 g1 f2 g2.
9425           homeomorphism (interval[a,b],interval[u,v]) (f1,g1) /\
9426           homeomorphism (interval[b,c],interval[v,w]) (f2,g2)
9427           ==> b IN interval[a,c] /\ v IN interval[u,w] /\
9428               f1 a = u /\ f1 b = v /\ f2 b = v /\ f2 c = w
9429               ==> ?f g. homeomorphism(interval[a,c],interval[u,w]) (f,g) /\
9430                         f a = u /\ f c = w /\
9431                         (!x. x IN interval[a,b] ==> f x = f1 x) /\
9432                         (!x. x IN interval[b,c] ==> f x = f2 x)`,
9433     REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM
9434      (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism])) THEN
9435     EXISTS_TAC `\x. if drop x <= drop b then (f1:real^1->real^1) x
9436                     else f2 x` THEN
9437     ASM_REWRITE_TAC[LEFT_EXISTS_AND_THM; REAL_LE_REFL] THEN
9438     ASM_SIMP_TAC[DROP_EQ; REAL_ARITH `b <= c ==> (c <= b <=> c = b)`] THEN
9439     CONJ_TAC THENL [REWRITE_TAC[GSYM CONJ_ASSOC]; ASM_MESON_TAC[]] THEN
9440     MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN
9441     REWRITE_TAC[COMPACT_INTERVAL] THEN REPEAT CONJ_TAC THENL
9442      [MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN
9443       ASM_SIMP_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID; DROP_EQ] THEN
9444       CONJ_TAC THEN
9445       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
9446         CONTINUOUS_ON_SUBSET)) THEN
9447       SIMP_TAC[SUBSET; FORALL_DROP; IN_ELIM_THM; IN_INTERVAL_1];
9448       SUBGOAL_THEN
9449        `interval[a:real^1,c] = interval[a,b] UNION interval[b,c] /\
9450         interval[u:real^1,w] = interval[u,v] UNION interval[v,w]`
9451       (CONJUNCTS_THEN SUBST1_TAC) THENL
9452        [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN
9453         ASM_REAL_ARITH_TAC;
9454         REWRITE_TAC[IMAGE_UNION] THEN BINOP_TAC THEN FIRST_X_ASSUM(fun th ->
9455           GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
9456         MATCH_MP_TAC(SET_RULE
9457          `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN
9458         SIMP_TAC[IN_INTERVAL_1; REAL_ARITH
9459            `b <= c ==> (c <= b <=> c = b)`] THEN
9460         ASM_MESON_TAC[DROP_EQ]];
9461       REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN
9462       REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
9463       REWRITE_TAC[FORALL_DROP; LIFT_DROP; IN_INTERVAL_1] THEN
9464       MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN DISCH_TAC THEN
9465       ASM_CASES_TAC `drop y <= drop b` THEN ASM_REWRITE_TAC[] THENL
9466        [COND_CASES_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
9467         RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; REAL_NOT_LE]) THEN
9468         ASM_MESON_TAC[];
9469         ALL_TAC] THEN
9470       COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
9471       RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; REAL_NOT_LE]) THENL
9472        [ALL_TAC; ASM_MESON_TAC[REAL_LT_IMP_LE]] THEN
9473       STRIP_TAC THEN
9474       SUBGOAL_THEN `(f1:real^1->real^1) x IN interval[u,v] INTER interval[v,w]`
9475       MP_TAC THENL
9476        [REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL
9477          [ALL_TAC; ASM_REWRITE_TAC[]] THEN
9478         FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
9479         MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN
9480         ASM_REAL_ARITH_TAC;
9481         ALL_TAC] THEN
9482       REWRITE_TAC[IN_INTER; IN_INTERVAL_1] THEN DISCH_THEN(MP_TAC o MATCH_MP
9483        (REAL_ARITH `(a <= x /\ x <= b) /\ (b <= x /\ x <= c) ==> x = b`)) THEN
9484       REWRITE_TAC[DROP_EQ] THEN DISCH_TAC THEN
9485       SUBGOAL_THEN
9486        `(f1:real^1->real^1) x = f1 b /\ (f2:real^1->real^1) y = f2 b`
9487       MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
9488       MATCH_MP_TAC(MESON[]
9489        `!g1:real^1->real^1 g2:real^1->real^1.
9490           g1(f1 x) = x /\ g1(f1 b) = b /\ g2(f2 y) = y /\ g2(f2 b) = b
9491           ==> f1 x = f1 b /\ f2 y = f2 b ==> x = y`) THEN
9492       MAP_EVERY EXISTS_TAC [`g1:real^1->real^1`; `g2:real^1->real^1`] THEN
9493       REPEAT CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
9494       ASM_REAL_ARITH_TAC]) in
9495   let lemma3 = prove
9496    (`!a b c d u v:real^1.
9497           interval[c,d] SUBSET interval(a,b) /\
9498           interval[u,v] SUBSET interval(a,b) /\
9499           ~(interval(c,d) = {}) /\ ~(interval(u,v) = {})
9500           ==> ?f g. homeomorphism (interval[a,b],interval[a,b]) (f,g) /\
9501                     f a = a /\ f b = b /\
9502                     !x. x IN interval[c,d] ==> f(x) IN interval[u,v]`,
9503     REPEAT GEN_TAC THEN
9504     REWRITE_TAC[SUBSET_INTERVAL_1; INTERVAL_NE_EMPTY_1] THEN
9505     ASM_CASES_TAC `drop u < drop v` THEN
9506     ASM_SIMP_TAC[REAL_ARITH `u < v ==> ~(v < u)`] THEN
9507     ASM_CASES_TAC `interval[c:real^1,d] = {}` THENL
9508      [DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
9509       REPEAT(EXISTS_TAC `I:real^1->real^1`) THEN
9510       REWRITE_TAC[HOMEOMORPHISM_I; NOT_IN_EMPTY; I_THM];
9511       RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN
9512       ASM_SIMP_TAC[REAL_ARITH `c <= d ==> ~(d < c)`] THEN STRIP_TAC] THEN
9513     MP_TAC(ISPECL [`d:real^1`; `b:real^1`; `v:real^1`; `b:real^1`] lemma1) THEN
9514     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9515     MAP_EVERY X_GEN_TAC [`f3:real^1->real^1`; `g3:real^1->real^1`] THEN
9516     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
9517     MP_TAC(ISPECL [`c:real^1`; `d:real^1`; `u:real^1`; `v:real^1`] lemma1) THEN
9518     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9519     MAP_EVERY X_GEN_TAC [`f2:real^1->real^1`; `g2:real^1->real^1`] THEN
9520     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
9521     MP_TAC(ISPECL [`a:real^1`; `c:real^1`; `a:real^1`; `u:real^1`] lemma1) THEN
9522     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9523     MAP_EVERY X_GEN_TAC [`f1:real^1->real^1`; `g1:real^1->real^1`] THEN
9524     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
9525     GEN_REWRITE_TAC I [IMP_IMP] THEN DISCH_THEN(fun th ->
9526       ASSUME_TAC(CONJUNCT2 th) THEN MP_TAC(MATCH_MP lemma2 th)) THEN
9527     ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN
9528     MAP_EVERY X_GEN_TAC [`f4:real^1->real^1`; `g4:real^1->real^1`] THEN
9529     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
9530     GEN_REWRITE_TAC I [IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP lemma2) THEN
9531     ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN
9532     ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
9533     REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SIMP_TAC[] THEN
9534     DISCH_THEN(STRIP_ASSUME_TAC o CONJUNCT2) THEN
9535     X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN
9536     FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN
9537     RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1]) THEN
9538     SUBGOAL_THEN `drop a <= drop x` ASSUME_TAC THENL
9539      [ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[]]) in
9540   let lemma4 = prove
9541    (`!s k u t:real^1->bool.
9542           open u /\ open s /\ connected s /\ ~(u = {}) /\
9543           FINITE k /\ k SUBSET s /\ u SUBSET s /\ s SUBSET t
9544           ==> ?f g. homeomorphism (t,t) (f,g) /\
9545                     (!x. x IN k ==> f(x) IN u) /\
9546                     {x | ~(f x = x /\ g x = x)} SUBSET s /\
9547                     bounded {x | ~(f x = x /\ g x = x)}`,
9548     REPEAT STRIP_TAC THEN
9549     SUBGOAL_THEN
9550      `?c d:real^1. ~(interval(c,d) = {}) /\ interval[c,d] SUBSET u`
9551     STRIP_ASSUME_TAC THENL
9552      [UNDISCH_TAC `open(u:real^1->bool)` THEN
9553       REWRITE_TAC[OPEN_CONTAINS_INTERVAL] THEN
9554       FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
9555       DISCH_THEN(X_CHOOSE_TAC `y:real^1`) THEN
9556       DISCH_THEN(MP_TAC o SPEC `y:real^1`) THEN
9557       ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MESON_TAC[];
9558       ALL_TAC] THEN
9559     SUBGOAL_THEN
9560      `?a b:real^1. ~(interval(a,b) = {}) /\
9561                    k SUBSET interval[a,b] /\
9562                    interval[a,b] SUBSET s`
9563     STRIP_ASSUME_TAC THENL
9564      [ASM_CASES_TAC `k:real^1->bool = {}` THENL
9565        [ASM_MESON_TAC[SUBSET_TRANS; EMPTY_SUBSET]; ALL_TAC] THEN
9566       MP_TAC(SPEC `IMAGE drop k` COMPACT_ATTAINS_SUP) THEN
9567       MP_TAC(SPEC `IMAGE drop k` COMPACT_ATTAINS_INF) THEN
9568       ASM_SIMP_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_EQ_EMPTY;
9569         IMAGE_ID; FINITE_IMP_COMPACT; EXISTS_IN_IMAGE; FORALL_IN_IMAGE] THEN
9570       DISCH_THEN(X_CHOOSE_THEN `a:real^1` STRIP_ASSUME_TAC) THEN
9571       DISCH_THEN(X_CHOOSE_THEN `b:real^1` STRIP_ASSUME_TAC) THEN
9572       UNDISCH_TAC `open(s:real^1->bool)` THEN
9573       REWRITE_TAC[OPEN_CONTAINS_INTERVAL] THEN
9574       DISCH_THEN(MP_TAC o SPEC `b:real^1`) THEN
9575       ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
9576       MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN
9577       REWRITE_TAC[SUBSET; IN_INTERVAL_1] THEN STRIP_TAC THEN
9578       MAP_EVERY EXISTS_TAC [`a:real^1`; `v:real^1`] THEN
9579       REWRITE_TAC[INTERVAL_NE_EMPTY_1] THEN FIRST_X_ASSUM(MP_TAC o
9580         GEN_REWRITE_RULE I [GSYM IS_INTERVAL_CONNECTED_1]) THEN
9581       REWRITE_TAC[IS_INTERVAL_1] THEN
9582       ASM_MESON_TAC[GSYM MEMBER_NOT_EMPTY; REAL_LET_TRANS; REAL_LE_TRANS;
9583                     REAL_LT_IMP_LE; SUBSET; REAL_LE_TOTAL];
9584       ALL_TAC] THEN
9585     SUBGOAL_THEN
9586      `?w z:real^1. interval[w,z] SUBSET s /\
9587                    interval[a,b] UNION interval[c,d] SUBSET interval(w,z)`
9588     STRIP_ASSUME_TAC THENL
9589      [SUBGOAL_THEN
9590         `?w z:real^1. interval[w,z] SUBSET s /\
9591                       interval[a,b] UNION interval[c,d] SUBSET interval[w,z]`
9592       STRIP_ASSUME_TAC THENL
9593        [EXISTS_TAC `lift(min (drop a) (drop c))` THEN
9594         EXISTS_TAC `lift(max (drop b) (drop d))` THEN
9595         REWRITE_TAC[UNION_SUBSET; SUBSET_INTERVAL_1; LIFT_DROP] THEN
9596         CONJ_TAC THENL
9597          [FIRST_X_ASSUM(MP_TAC o
9598            GEN_REWRITE_RULE I [GSYM IS_INTERVAL_CONNECTED_1]) THEN
9599           REWRITE_TAC[IS_INTERVAL_1; SUBSET; IN_INTERVAL_1; LIFT_DROP] THEN
9600           REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
9601           EXISTS_TAC `lift(min (drop a) (drop c))` THEN
9602           EXISTS_TAC `lift(max (drop b) (drop d))` THEN
9603           ASM_REWRITE_TAC[LIFT_DROP] THEN
9604           REWRITE_TAC[real_min; real_max] THEN CONJ_TAC THEN
9605           COND_CASES_TAC THEN ASM_REWRITE_TAC[LIFT_DROP] THEN
9606           ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET; INTERVAL_EQ_EMPTY_1;
9607                         REAL_LT_IMP_LE];
9608           ASM_REAL_ARITH_TAC];
9609         UNDISCH_TAC `open(s:real^1->bool)` THEN
9610         REWRITE_TAC[OPEN_CONTAINS_INTERVAL] THEN DISCH_THEN(fun th ->
9611           MP_TAC(SPEC `z:real^1` th) THEN MP_TAC(SPEC `w:real^1` th)) THEN
9612         SUBGOAL_THEN `(w:real^1) IN interval[w,z] /\ z IN interval[w,z]`
9613         STRIP_ASSUME_TAC THENL
9614          [REWRITE_TAC[ENDS_IN_INTERVAL] THEN MP_TAC
9615            (ISPECL [`a:real^1`; `b:real^1`] INTERVAL_OPEN_SUBSET_CLOSED) THEN
9616           ASM SET_TAC[];
9617           REWRITE_TAC[UNION_SUBSET]] THEN
9618         ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
9619         MAP_EVERY X_GEN_TAC [`w0:real^1`; `w1:real^1`] THEN
9620         REWRITE_TAC[IN_INTERVAL_1; SUBSET] THEN STRIP_TAC THEN
9621         ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
9622         MAP_EVERY X_GEN_TAC [`z0:real^1`; `z1:real^1`] THEN
9623         STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`w0:real^1`; `z1:real^1`] THEN
9624         RULE_ASSUM_TAC
9625          (REWRITE_RULE[ENDS_IN_UNIT_INTERVAL; INTERVAL_NE_EMPTY_1;
9626                        UNION_SUBSET; SUBSET_INTERVAL_1]) THEN
9627         CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
9628         RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_INTERVAL_1]) THEN
9629         X_GEN_TAC `x:real^1` THEN
9630         REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`)) THEN
9631         ASM_CASES_TAC `(x:real^1) IN s` THEN ASM_REWRITE_TAC[] THEN
9632         ASM_REAL_ARITH_TAC];
9633       ALL_TAC] THEN
9634     FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [UNION_SUBSET]) THEN
9635     MP_TAC(ISPECL
9636      [`w:real^1`; `z:real^1`; `a:real^1`; `b:real^1`; `c:real^1`; `d:real^1`]
9637      lemma3) THEN
9638     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9639     MAP_EVERY X_GEN_TAC [`f:real^1->real^1`; `g:real^1->real^1`] THEN
9640     REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN
9641     EXISTS_TAC `\x:real^1. if x IN interval[w,z] then f x else x` THEN
9642     EXISTS_TAC `\x:real^1. if x IN interval[w,z] then g x else x` THEN
9643     ASSUME_TAC(ISPECL [`w:real^1`; `z:real^1`]INTERVAL_OPEN_SUBSET_CLOSED) THEN
9644     REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
9645      [ASM SET_TAC[];
9646       ASM SET_TAC[];
9647       ALL_TAC;
9648       ASM SET_TAC[];
9649       ASM SET_TAC[];
9650       ALL_TAC;
9651       ASM SET_TAC[];
9652       ASM SET_TAC[];
9653       MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `interval[w:real^1,z]` THEN
9654       REWRITE_TAC[BOUNDED_INTERVAL] THEN ASM SET_TAC[]] THEN
9655     (SUBGOAL_THEN
9656       `t = interval[w:real^1,z] UNION (t DIFF interval(w,z))`
9657       (fun th -> SUBST1_TAC th THEN
9658                  MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
9659                  ASSUME_TAC(SYM th))
9660      THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN
9661      ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN REPEAT CONJ_TAC THENL
9662       [MATCH_MP_TAC CLOSED_SUBSET THEN REWRITE_TAC[CLOSED_INTERVAL] THEN
9663        ASM SET_TAC[];
9664        MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN
9665        MATCH_MP_TAC OPEN_SUBSET THEN REWRITE_TAC[OPEN_INTERVAL] THEN
9666        ASM SET_TAC[];
9667        REWRITE_TAC[CLOSED_DIFF_OPEN_INTERVAL_1; SET_RULE
9668         `p /\ ~p \/ x IN t DIFF s /\ x IN u <=> x IN t /\ x IN u DIFF s`] THEN
9669        MAP_EVERY (MP_TAC o ISPECL [`w:real^1`; `z:real^1`])
9670                  (CONJUNCTS ENDS_IN_INTERVAL) THEN
9671        ASM SET_TAC[]])) in
9672   REPEAT STRIP_TAC THEN ASM_CASES_TAC `2 <= dimindex(:N)` THENL
9673    [MP_TAC(ISPECL
9674      [`CARD(k:real^N->bool)`; `u:real^N->bool`] CHOOSE_SUBSET_STRONG) THEN
9675     ANTS_TAC THENL [ASM_MESON_TAC[FINITE_IMP_NOT_OPEN]; ALL_TAC] THEN
9676     REWRITE_TAC[HAS_SIZE; LEFT_IMP_EXISTS_THM] THEN
9677     X_GEN_TAC `p:real^N->bool` THEN STRIP_TAC THEN
9678     MP_TAC(ISPECL [`k:real^N->bool`; `p:real^N->bool`] CARD_EQ_BIJECTION) THEN
9679     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9680     X_GEN_TAC `y:real^N->real^N` THEN STRIP_TAC THEN
9681     MP_TAC(ISPECL
9682      [`s:real^N->bool`; `t:real^N->bool`; `\x:real^N. x`;
9683       `y:real^N->real^N`; `k:real^N->bool`]
9684      HOMEOMORPHISM_MOVING_POINTS_EXISTS) THEN
9685     ASM_REWRITE_TAC[pairwise] THEN
9686     ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
9687     REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
9688     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN
9689     ASM SET_TAC[];
9690     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_LE]) THEN
9691     SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (n < 2 <=> n = 1)`] THEN
9692     REWRITE_TAC[GSYM DIMINDEX_1] THEN
9693     DISCH_THEN(MP_TAC o MATCH_MP ISOMORPHISMS_UNIV_UNIV) THEN
9694     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9695     MAP_EVERY X_GEN_TAC [`h:real^N->real^1`; `j:real^1->real^N`] THEN
9696     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
9697     MP_TAC(ISPECL
9698      [`IMAGE (h:real^N->real^1) s`;
9699       `IMAGE (h:real^N->real^1) k`;
9700       `IMAGE (h:real^N->real^1) u`;
9701       `IMAGE (h:real^N->real^1) t`]
9702         lemma4) THEN
9703     ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_SUBSET; IMAGE_EQ_EMPTY;
9704                  CONNECTED_CONTINUOUS_IMAGE; LINEAR_CONTINUOUS_ON] THEN
9705     ANTS_TAC THENL
9706      [ASM_MESON_TAC[OPEN_BIJECTIVE_LINEAR_IMAGE_EQ];
9707       REWRITE_TAC[LEFT_IMP_EXISTS_THM; homeomorphism]] THEN
9708     MAP_EVERY X_GEN_TAC [`f:real^1->real^1`; `g:real^1->real^1`] THEN
9709     STRIP_TAC THEN MAP_EVERY EXISTS_TAC
9710      [`(j:real^1->real^N) o (f:real^1->real^1) o (h:real^N->real^1)`;
9711       `(j:real^1->real^N) o (g:real^1->real^1) o (h:real^N->real^1)`] THEN
9712     ASM_REWRITE_TAC[o_THM; IMAGE_o] THEN
9713     ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_CONTINUOUS_ON] THEN
9714     ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID] THEN
9715     CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
9716     SUBGOAL_THEN
9717      `{x | ~(j ((f:real^1->real^1) (h x)) = x /\ j (g (h x)) = x)} =
9718       IMAGE (j:real^1->real^N) {x | ~(f x = x /\ g x = x)}`
9719     SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
9720     CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
9721     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
9722     ASM_SIMP_TAC[BOUNDED_LINEAR_IMAGE]]);;
9723
9724 let HOMEOMORPHISM_GROUPING_POINTS_EXISTS_GEN = prove
9725  (`!u s t k:real^N->bool.
9726         open_in (subtopology euclidean (affine hull s)) s /\
9727         s SUBSET t /\ t SUBSET affine hull s /\ connected s /\
9728         FINITE k /\ k SUBSET s /\
9729         open_in (subtopology euclidean s) u /\ ~(u = {})
9730         ==> ?f g. homeomorphism (t,t) (f,g) /\
9731                   (!x. x IN k ==> f(x) IN u) /\
9732                   {x | ~(f x = x /\ g x = x)} SUBSET s /\
9733                   bounded {x | ~(f x = x /\ g x = x)}`,
9734   REPEAT STRIP_TAC THEN ASM_CASES_TAC `&2 <= aff_dim(s:real^N->bool)` THENL
9735    [MP_TAC(ISPECL
9736      [`CARD(k:real^N->bool)`; `u:real^N->bool`] CHOOSE_SUBSET_STRONG) THEN
9737     ANTS_TAC THENL
9738      [MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[GSYM INFINITE] THEN
9739       MATCH_MP_TAC INFINITE_OPEN_IN THEN
9740       EXISTS_TAC `affine hull s:real^N->bool` THEN CONJ_TAC THENL
9741        [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN
9742       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
9743       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN
9744       STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
9745       MATCH_MP_TAC CONNECTED_IMP_PERFECT_AFF_DIM THEN
9746       ASM_SIMP_TAC[CONVEX_CONNECTED; AFFINE_AFFINE_HULL; AFFINE_IMP_CONVEX;
9747                    AFF_DIM_AFFINE_HULL] THEN
9748       CONJ_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN
9749       ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET];
9750       REWRITE_TAC[HAS_SIZE; LEFT_IMP_EXISTS_THM] THEN
9751       X_GEN_TAC `p:real^N->bool` THEN STRIP_TAC THEN MP_TAC
9752        (ISPECL [`k:real^N->bool`; `p:real^N->bool`] CARD_EQ_BIJECTION) THEN
9753       ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9754       X_GEN_TAC `y:real^N->real^N` THEN STRIP_TAC THEN
9755       MP_TAC(ISPECL
9756        [`s:real^N->bool`; `t:real^N->bool`; `\x:real^N. x`;
9757         `y:real^N->real^N`; `k:real^N->bool`]
9758        HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN) THEN
9759       ASM_REWRITE_TAC[pairwise] THEN
9760       REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
9761       ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
9762       REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
9763       STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN
9764       ASM SET_TAC[]];
9765     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INT_NOT_LE])] THEN
9766   SIMP_TAC[AFF_DIM_GE; INT_ARITH
9767    `--(&1):int <= x ==> (x < &2 <=> x = --(&1) \/ x = &0 \/ x = &1)`] THEN
9768   REWRITE_TAC[AFF_DIM_EQ_MINUS1; AFF_DIM_EQ_0] THEN
9769   SUBGOAL_THEN
9770    `(u:real^N->bool) SUBSET s /\ s SUBSET affine hull s`
9771   STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[open_in]; ALL_TAC] THEN
9772   DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN
9773   STRIP_TAC THENL
9774    [REPEAT(EXISTS_TAC `I:real^N->real^N`) THEN
9775     REWRITE_TAC[HOMEOMORPHISM_I; I_THM; EMPTY_GSPEC; BOUNDED_EMPTY] THEN
9776     ASM SET_TAC[];
9777     ALL_TAC] THEN
9778   MP_TAC(ISPECL [`affine hull s:real^N->bool`; `(:real^1)`]
9779    HOMEOMORPHIC_AFFINE_SETS) THEN
9780   ASM_REWRITE_TAC[AFF_DIM_UNIV; AFFINE_AFFINE_HULL; AFFINE_UNIV] THEN
9781   ASM_REWRITE_TAC[DIMINDEX_1; AFF_DIM_AFFINE_HULL] THEN
9782   REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN
9783   MAP_EVERY X_GEN_TAC [`h:real^N->real^1`; `j:real^1->real^N`] THEN
9784   STRIP_TAC THEN MP_TAC(ISPECL
9785    [`IMAGE (h:real^N->real^1) u`; `IMAGE (h:real^N->real^1) s`;
9786     `IMAGE (h:real^N->real^1) t`; `IMAGE (h:real^N->real^1) k`]
9787     HOMEOMORPHISM_GROUPING_POINTS_EXISTS) THEN
9788   ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_SUBSET; IMAGE_EQ_EMPTY] THEN
9789   ANTS_TAC THENL
9790    [MP_TAC(ISPECL
9791      [`h:real^N->real^1`; `j:real^1->real^N`;
9792       `affine hull s:real^N->bool`; `(:real^1)`]
9793      HOMEOMORPHISM_IMP_OPEN_MAP) THEN
9794     ASM_SIMP_TAC[homeomorphism; SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN
9795     REPEAT STRIP_TAC THENL [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN
9796     MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
9797     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
9798     REWRITE_TAC[LEFT_IMP_EXISTS_THM; homeomorphism]] THEN
9799   MAP_EVERY X_GEN_TAC [`f:real^1->real^1`; `g:real^1->real^1`] THEN
9800   STRIP_TAC THEN MAP_EVERY EXISTS_TAC
9801    [`\x. if x IN affine hull s
9802          then ((j:real^1->real^N) o (f:real^1->real^1) o (h:real^N->real^1)) x
9803          else x`;
9804     `\x. if x IN affine hull s
9805          then ((j:real^1->real^N) o (g:real^1->real^1) o (h:real^N->real^1)) x
9806          else x`] THEN
9807   ASM_SIMP_TAC[o_THM; IMAGE_o] THEN REPEAT CONJ_TAC THENL
9808    [ASM SET_TAC[];
9809     ASM_SIMP_TAC[SET_RULE
9810      `t SUBSET s ==> IMAGE (\x. if x IN s then f x else x) t = IMAGE f t`] THEN
9811     REPLICATE_TAC 3 (ONCE_REWRITE_TAC[GSYM o_DEF]) THEN
9812     ASM_REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
9813     MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC
9814      `(j:real^1->real^N) o (f:real^1->real^1) o (h:real^N->real^1)` THEN
9815     REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
9816     REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN
9817     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
9818           CONTINUOUS_ON_SUBSET)) THEN
9819     ASM SET_TAC[];
9820     ASM SET_TAC[];
9821     ASM_SIMP_TAC[SET_RULE
9822      `t SUBSET s ==> IMAGE (\x. if x IN s then f x else x) t = IMAGE f t`] THEN
9823     REPLICATE_TAC 3 (ONCE_REWRITE_TAC[GSYM o_DEF]) THEN
9824     ASM_REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
9825     MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC
9826      `(j:real^1->real^N) o (g:real^1->real^1) o (h:real^N->real^1)` THEN
9827     REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
9828     REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN
9829     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
9830           CONTINUOUS_ON_SUBSET)) THEN
9831     ASM SET_TAC[];
9832     ASM SET_TAC[];
9833     ALL_TAC;
9834     ALL_TAC] THEN
9835   REWRITE_TAC[MESON[] `(if P then f x else x) = x <=> ~P \/ f x = x`] THEN
9836   REWRITE_TAC[DE_MORGAN_THM; GSYM LEFT_OR_DISTRIB] THEN
9837   (SUBGOAL_THEN
9838    `{x | x IN affine hull s /\ (~(j (f (h x)) = x) \/ ~(j (g (h x)) = x))} =
9839     IMAGE (j:real^1->real^N) {x | ~(f x = x /\ g x = x)}`
9840    SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC])
9841   THENL
9842    [TRANS_TAC SUBSET_TRANS
9843      `IMAGE (j:real^1->real^N) (IMAGE (h:real^N->real^1) s)` THEN
9844     ASM SET_TAC[];
9845     MATCH_MP_TAC(MESON[CLOSURE_SUBSET; BOUNDED_SUBSET; IMAGE_SUBSET]
9846      `bounded (IMAGE f (closure s)) ==> bounded (IMAGE f s)`) THEN
9847     MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN
9848     MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
9849     ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN
9850     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]]);;
9851
9852 (* ------------------------------------------------------------------------- *)
9853 (* The "inside" and "outside" of a set, i.e. the points respectively in a    *)
9854 (* bounded or unbounded connected component of the set's complement.         *)
9855 (* ------------------------------------------------------------------------- *)
9856
9857 let inside = new_definition
9858  `inside s = {x | ~(x IN s) /\
9859                   bounded(connected_component ((:real^N) DIFF s) x)}`;;
9860
9861 let outside = new_definition
9862  `outside s = {x | ~(x IN s) /\
9863                    ~bounded(connected_component ((:real^N) DIFF s) x)}`;;
9864
9865 let INSIDE_TRANSLATION = prove
9866  (`!a s. inside(IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (inside s)`,
9867   REWRITE_TAC[inside] THEN GEOM_TRANSLATE_TAC[]);;
9868
9869 let OUTSIDE_TRANSLATION = prove
9870  (`!a s. outside(IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (outside s)`,
9871   REWRITE_TAC[outside] THEN GEOM_TRANSLATE_TAC[]);;
9872
9873 add_translation_invariants [INSIDE_TRANSLATION; OUTSIDE_TRANSLATION];;
9874
9875 let INSIDE_LINEAR_IMAGE = prove
9876  (`!f s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
9877          ==> inside(IMAGE f s) = IMAGE f (inside s)`,
9878   REWRITE_TAC[inside] THEN GEOM_TRANSFORM_TAC[]);;
9879
9880 let OUTSIDE_LINEAR_IMAGE = prove
9881  (`!f s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
9882          ==> outside(IMAGE f s) = IMAGE f (outside s)`,
9883   REWRITE_TAC[outside] THEN GEOM_TRANSFORM_TAC[]);;
9884
9885 add_linear_invariants [INSIDE_LINEAR_IMAGE; OUTSIDE_LINEAR_IMAGE];;
9886
9887 let OUTSIDE = prove
9888  (`!s. outside s = {x | ~bounded(connected_component((:real^N) DIFF s) x)}`,
9889   GEN_TAC THEN REWRITE_TAC[outside; EXTENSION; IN_ELIM_THM] THEN
9890   X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN s` THEN
9891   ASM_REWRITE_TAC[] THEN
9892   ASM_MESON_TAC[BOUNDED_EMPTY; CONNECTED_COMPONENT_EQ_EMPTY; IN_DIFF]);;
9893
9894 let INSIDE_NO_OVERLAP = prove
9895  (`!s. inside s INTER s = {}`,
9896   REWRITE_TAC[inside] THEN SET_TAC[]);;
9897
9898 let OUTSIDE_NO_OVERLAP = prove
9899  (`!s. outside s INTER s = {}`,
9900   REWRITE_TAC[outside] THEN SET_TAC[]);;
9901
9902 let INSIDE_INTER_OUTSIDE = prove
9903  (`!s. inside s INTER outside s = {}`,
9904   REWRITE_TAC[inside; outside] THEN SET_TAC[]);;
9905
9906 let INSIDE_UNION_OUTSIDE = prove
9907  (`!s. inside s UNION outside s = (:real^N) DIFF s`,
9908   REWRITE_TAC[inside; outside] THEN SET_TAC[]);;
9909
9910 let INSIDE_EQ_OUTSIDE = prove
9911  (`!s. inside s = outside s <=> s = (:real^N)`,
9912   REWRITE_TAC[inside; outside] THEN SET_TAC[]);;
9913
9914 let INSIDE_OUTSIDE = prove
9915  (`!s. inside s = (:real^N) DIFF (s UNION outside s)`,
9916   GEN_TAC THEN MAP_EVERY (MP_TAC o ISPEC `s:real^N->bool`)
9917    [INSIDE_INTER_OUTSIDE; INSIDE_UNION_OUTSIDE] THEN
9918   SET_TAC[]);;
9919
9920 let OUTSIDE_INSIDE = prove
9921  (`!s. outside s = (:real^N) DIFF (s UNION inside s)`,
9922   GEN_TAC THEN MAP_EVERY (MP_TAC o ISPEC `s:real^N->bool`)
9923    [INSIDE_INTER_OUTSIDE; INSIDE_UNION_OUTSIDE] THEN
9924   SET_TAC[]);;
9925
9926 let UNION_WITH_INSIDE = prove
9927  (`!s. s UNION inside s = (:real^N) DIFF outside s`,
9928   REWRITE_TAC[OUTSIDE_INSIDE] THEN SET_TAC[]);;
9929
9930 let UNION_WITH_OUTSIDE = prove
9931  (`!s. s UNION outside s = (:real^N) DIFF inside s`,
9932   REWRITE_TAC[INSIDE_OUTSIDE] THEN SET_TAC[]);;
9933
9934 let OUTSIDE_MONO = prove
9935  (`!s t. s SUBSET t ==> outside t SUBSET outside s`,
9936   REPEAT GEN_TAC THEN REWRITE_TAC[OUTSIDE; SUBSET; IN_ELIM_THM] THEN
9937   DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN
9938   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN
9939   MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN ASM SET_TAC[]);;
9940
9941 let INSIDE_MONO = prove
9942  (`!s t. s SUBSET t ==> inside s DIFF t SUBSET inside t`,
9943   REPEAT STRIP_TAC THEN SIMP_TAC[SUBSET; IN_DIFF; inside; IN_ELIM_THM] THEN
9944   GEN_TAC THEN
9945   DISCH_THEN(CONJUNCTS_THEN2 (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)
9946     ASSUME_TAC) THEN
9947   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN
9948   MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN ASM SET_TAC[]);;
9949
9950 let COBOUNDED_OUTSIDE = prove
9951  (`!s:real^N->bool. bounded s ==> bounded((:real^N) DIFF outside s)`,
9952   GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[outside] THEN
9953   REWRITE_TAC[SET_RULE `UNIV DIFF {x | ~(x IN s) /\ ~P x} =
9954                         s UNION {x | P x}`] THEN
9955   ASM_REWRITE_TAC[BOUNDED_UNION] THEN
9956   FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
9957   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
9958   MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(vec 0:real^N,B)` THEN
9959   REWRITE_TAC[BOUNDED_BALL; SUBSET; IN_ELIM_THM; IN_BALL_0] THEN
9960   X_GEN_TAC `x:real^N` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
9961   REWRITE_TAC[REAL_NOT_LT] THEN
9962   ASM_CASES_TAC `x:real^N = vec 0` THENL
9963    [ASM_REWRITE_TAC[NORM_0] THEN ASM_REAL_ARITH_TAC; DISCH_TAC] THEN
9964   REWRITE_TAC[BOUNDED_POS] THEN
9965   DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN
9966   FIRST_X_ASSUM(MP_TAC o SPEC `(B + C) / norm(x) % x:real^N`) THEN
9967   REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
9968   ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; NOT_IMP] THEN
9969   CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
9970   REWRITE_TAC[IN] THEN REWRITE_TAC[connected_component] THEN
9971   EXISTS_TAC `segment[x:real^N,(B + C) / norm(x) % x]` THEN
9972   REWRITE_TAC[ENDS_IN_SEGMENT; CONNECTED_SEGMENT] THEN
9973   MATCH_MP_TAC SUBSET_TRANS THEN
9974   EXISTS_TAC `(:real^N) DIFF ball(vec 0,B)` THEN
9975   ASM_REWRITE_TAC[SET_RULE
9976    `UNIV DIFF s SUBSET UNIV DIFF t <=> t SUBSET s`] THEN
9977   REWRITE_TAC[SUBSET; IN_DIFF; IN_UNIV; IN_BALL_0] THEN
9978   REWRITE_TAC[segment; FORALL_IN_GSPEC] THEN X_GEN_TAC `u:real` THEN
9979   STRIP_TAC THEN REWRITE_TAC[REAL_NOT_LT] THEN
9980   REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB; NORM_MUL; VECTOR_MUL_ASSOC] THEN
9981   GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_ABS_NORM] THEN
9982   REWRITE_TAC[GSYM REAL_ABS_MUL] THEN MATCH_MP_TAC(REAL_ARITH
9983    `&0 < B /\ B <= x ==> B <= abs x`) THEN
9984   ASM_SIMP_TAC[REAL_ADD_RDISTRIB; REAL_DIV_RMUL; NORM_EQ_0; GSYM
9985                REAL_MUL_ASSOC] THEN
9986   MATCH_MP_TAC REAL_LE_TRANS THEN
9987   EXISTS_TAC `(&1 - u) * B + u * (B + C)` THEN
9988   ASM_SIMP_TAC[REAL_LE_RADD; REAL_LE_LMUL; REAL_SUB_LE] THEN
9989   SIMP_TAC[REAL_ARITH `B <= (&1 - u) * B + u * (B + C) <=> &0 <= u * C`] THEN
9990   MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC);;
9991
9992 let UNBOUNDED_OUTSIDE = prove
9993  (`!s:real^N->bool. bounded s ==> ~bounded(outside s)`,
9994   MESON_TAC[COBOUNDED_IMP_UNBOUNDED; COBOUNDED_OUTSIDE]);;
9995
9996 let BOUNDED_INSIDE = prove
9997  (`!s:real^N->bool. bounded s ==> bounded(inside s)`,
9998   REPEAT STRIP_TAC THEN
9999   MATCH_MP_TAC BOUNDED_SUBSET THEN
10000   EXISTS_TAC `(:real^N) DIFF outside s` THEN
10001   ASM_SIMP_TAC[COBOUNDED_OUTSIDE] THEN
10002   MP_TAC(ISPEC `s:real^N->bool` INSIDE_INTER_OUTSIDE) THEN SET_TAC[]);;
10003
10004 let CONNECTED_OUTSIDE = prove
10005  (`!s:real^N->bool. 2 <= dimindex(:N) /\ bounded s ==> connected(outside s)`,
10006   REPEAT STRIP_TAC THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
10007   MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
10008   REWRITE_TAC[outside; IN_ELIM_THM] THEN STRIP_TAC THEN
10009   MATCH_MP_TAC CONNECTED_COMPONENT_OF_SUBSET THEN
10010   EXISTS_TAC `connected_component ((:real^N) DIFF s) x` THEN
10011   REWRITE_TAC[SUBSET; IN_UNIV; IN_DIFF; IN_ELIM_THM] THEN CONJ_TAC THENL
10012    [X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN
10013     FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET]
10014       CONNECTED_COMPONENT_SUBSET)) THEN
10015     REWRITE_TAC[IN_DIFF] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_EQ];
10016     REWRITE_TAC[CONNECTED_COMPONENT_IDEMP] THEN
10017     SUBGOAL_THEN `connected_component ((:real^N) DIFF s) x =
10018                   connected_component ((:real^N) DIFF s) y`
10019     SUBST1_TAC THENL
10020      [MATCH_MP_TAC COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT THEN
10021       ASM_REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`];
10022       ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ; IN_DIFF; IN_UNIV]]]);;
10023
10024 let OUTSIDE_CONNECTED_COMPONENT_LT = prove
10025  (`!s. outside s =
10026             {x | !B. ?y. B < norm(y) /\
10027                          connected_component((:real^N) DIFF s) x y}`,
10028   REWRITE_TAC[OUTSIDE; bounded; EXTENSION; IN_ELIM_THM] THEN
10029   REWRITE_TAC[IN] THEN ASM_MESON_TAC[REAL_NOT_LE]);;
10030
10031 let OUTSIDE_CONNECTED_COMPONENT_LE = prove
10032  (`!s. outside s =
10033             {x | !B. ?y. B <= norm(y) /\
10034                          connected_component((:real^N) DIFF s) x y}`,
10035   GEN_TAC THEN REWRITE_TAC[OUTSIDE_CONNECTED_COMPONENT_LT] THEN
10036   GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN
10037   REWRITE_TAC[IN_ELIM_THM] THEN
10038   MESON_TAC[REAL_LT_IMP_LE; REAL_ARITH `B + &1 <= x ==> B < x`]);;
10039
10040 let NOT_OUTSIDE_CONNECTED_COMPONENT_LT = prove
10041  (`!s. 2 <= dimindex(:N) /\ bounded s
10042        ==> (:real^N) DIFF (outside s) =
10043            {x | !B. ?y. B < norm(y) /\
10044                         ~(connected_component((:real^N) DIFF s) x y)}`,
10045   REPEAT STRIP_TAC THEN REWRITE_TAC[OUTSIDE] THEN
10046   REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN
10047   X_GEN_TAC `x:real^N` THEN REWRITE_TAC[bounded] THEN EQ_TAC THENL
10048    [DISCH_THEN(X_CHOOSE_TAC `C:real`) THEN X_GEN_TAC `B:real` THEN
10049     EXISTS_TAC `(abs B + abs C + &1) % basis 1:real^N` THEN
10050     RULE_ASSUM_TAC(ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM]) THEN
10051     RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN
10052     CONJ_TAC THENL [ALL_TAC; FIRST_X_ASSUM MATCH_MP_TAC] THEN
10053     SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
10054     REAL_ARITH_TAC;
10055     DISCH_TAC THEN
10056     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
10057     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN
10058     X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN] THEN DISCH_TAC THEN
10059     ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN
10060     FIRST_X_ASSUM(MP_TAC o SPEC `B:real`) THEN DISCH_THEN
10061      (X_CHOOSE_THEN `z:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
10062     REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN
10063     EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[] THEN
10064     MATCH_MP_TAC CONNECTED_COMPONENT_OF_SUBSET THEN
10065     EXISTS_TAC `(:real^N) DIFF cball(vec 0,B)` THEN
10066     ASM_REWRITE_TAC[SUBSET; IN_DIFF; IN_CBALL_0; IN_UNIV; CONTRAPOS_THM] THEN
10067     REWRITE_TAC[connected_component] THEN
10068     EXISTS_TAC `(:real^N) DIFF cball(vec 0,B)` THEN
10069     ASM_SIMP_TAC[SUBSET_REFL; IN_DIFF; IN_UNIV; IN_CBALL_0; REAL_NOT_LE] THEN
10070     MATCH_MP_TAC CONNECTED_COMPLEMENT_BOUNDED_CONVEX THEN
10071     ASM_SIMP_TAC[BOUNDED_CBALL; CONVEX_CBALL]]);;
10072
10073 let NOT_OUTSIDE_CONNECTED_COMPONENT_LE = prove
10074  (`!s. 2 <= dimindex(:N) /\ bounded s
10075        ==> (:real^N) DIFF (outside s) =
10076            {x | !B. ?y. B <= norm(y) /\
10077                         ~(connected_component((:real^N) DIFF s) x y)}`,
10078   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[NOT_OUTSIDE_CONNECTED_COMPONENT_LT] THEN
10079   GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN
10080   REWRITE_TAC[IN_ELIM_THM] THEN
10081   MESON_TAC[REAL_LT_IMP_LE; REAL_ARITH `B + &1 <= x ==> B < x`]);;
10082
10083 let INSIDE_CONNECTED_COMPONENT_LT = prove
10084  (`!s. 2 <= dimindex(:N) /\ bounded s
10085        ==> inside s =
10086             {x:real^N | ~(x IN s) /\
10087                         !B. ?y. B < norm(y) /\
10088                                 ~(connected_component((:real^N) DIFF s) x y)}`,
10089   REPEAT STRIP_TAC THEN REWRITE_TAC[INSIDE_OUTSIDE] THEN
10090   REWRITE_TAC[SET_RULE `UNIV DIFF (s UNION t) = (UNIV DIFF t) DIFF s`] THEN
10091   ASM_SIMP_TAC[NOT_OUTSIDE_CONNECTED_COMPONENT_LT] THEN SET_TAC[]);;
10092
10093 let INSIDE_CONNECTED_COMPONENT_LE = prove
10094  (`!s. 2 <= dimindex(:N) /\ bounded s
10095        ==> inside s =
10096             {x:real^N | ~(x IN s) /\
10097                         !B. ?y. B <= norm(y) /\
10098                                 ~(connected_component((:real^N) DIFF s) x y)}`,
10099   REPEAT STRIP_TAC THEN REWRITE_TAC[INSIDE_OUTSIDE] THEN
10100   REWRITE_TAC[SET_RULE `UNIV DIFF (s UNION t) = (UNIV DIFF t) DIFF s`] THEN
10101   ASM_SIMP_TAC[NOT_OUTSIDE_CONNECTED_COMPONENT_LE] THEN SET_TAC[]);;
10102
10103 let OUTSIDE_UNION_OUTSIDE_UNION = prove
10104  (`!c c1 c2:real^N->bool.
10105         c INTER outside(c1 UNION c2) = {}
10106         ==> outside(c1 UNION c2) SUBSET outside(c1 UNION c)`,
10107   REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN
10108   X_GEN_TAC `x:real^N` THEN
10109   DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
10110   REWRITE_TAC[OUTSIDE_CONNECTED_COMPONENT_LT; IN_ELIM_THM] THEN
10111   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `B:real` THEN
10112   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN
10113   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
10114   ASM_REWRITE_TAC[connected_component] THEN
10115   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
10116   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
10117   SUBGOAL_THEN `t SUBSET outside(c1 UNION c2:real^N->bool)`
10118   MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
10119   MATCH_MP_TAC SUBSET_TRANS THEN
10120   EXISTS_TAC `connected_component((:real^N) DIFF (c1 UNION c2)) x` THEN
10121   CONJ_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_MAXIMAL]; ALL_TAC] THEN
10122   UNDISCH_TAC `(x:real^N) IN outside(c1 UNION c2)` THEN
10123   REWRITE_TAC[OUTSIDE; IN_ELIM_THM; SUBSET] THEN
10124   MESON_TAC[CONNECTED_COMPONENT_EQ]);;
10125
10126 let INSIDE_SUBSET = prove
10127  (`!s t u. connected u /\ ~bounded u /\ t UNION u = (:real^N) DIFF s
10128            ==> inside s SUBSET t`,
10129   REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET; inside; IN_ELIM_THM] THEN
10130   X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
10131   MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
10132   UNDISCH_TAC `~bounded(u:real^N->bool)` THEN REWRITE_TAC[] THEN
10133   MATCH_MP_TAC BOUNDED_SUBSET THEN
10134   EXISTS_TAC `connected_component((:real^N) DIFF s) x` THEN
10135   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
10136   ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);;
10137
10138 let INSIDE_UNIQUE = prove
10139  (`!s t u. connected t /\ bounded t /\
10140            connected u /\ ~(bounded u) /\
10141            ~connected((:real^N) DIFF s) /\
10142            t UNION u = (:real^N) DIFF s
10143            ==> inside s = t`,
10144   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
10145    [ASM_MESON_TAC[INSIDE_SUBSET]; ALL_TAC] THEN
10146   REWRITE_TAC[SUBSET; inside; IN_ELIM_THM] THEN
10147   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
10148   CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
10149   MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `t:real^N->bool` THEN
10150   ASM_REWRITE_TAC[] THEN
10151   MATCH_MP_TAC(SET_RULE
10152    `!s u. c INTER s = {} /\ c INTER u = {} /\ t UNION u = UNIV DIFF s
10153           ==> c SUBSET t`) THEN
10154   MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `u:real^N->bool`] THEN
10155   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
10156    [REWRITE_TAC[SET_RULE `c INTER s = {} <=> c SUBSET (UNIV DIFF s)`] THEN
10157     REWRITE_TAC[CONNECTED_COMPONENT_SUBSET];
10158     ALL_TAC] THEN
10159   MATCH_MP_TAC(SET_RULE `(!x. x IN s /\ x IN t ==> F) ==> s INTER t = {}`) THEN
10160   X_GEN_TAC `y:real^N` THEN
10161   GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [IN] THEN STRIP_TAC THEN
10162   UNDISCH_TAC `~connected((:real^N) DIFF s)` THEN
10163   REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
10164   MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN
10165   SUBGOAL_THEN
10166    `(!w. w IN t ==> connected_component ((:real^N) DIFF s) x w) /\
10167     (!w. w IN u ==> connected_component ((:real^N) DIFF s) y w)`
10168   STRIP_ASSUME_TAC THENL
10169    [CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN
10170     REWRITE_TAC[connected_component] THENL
10171      [EXISTS_TAC `t:real^N->bool`; EXISTS_TAC `u:real^N->bool`] THEN
10172     ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
10173     FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[IN_UNION] THEN
10174     ASM_REWRITE_TAC[] THEN
10175     ASM_MESON_TAC[CONNECTED_COMPONENT_TRANS; CONNECTED_COMPONENT_SYM]]);;
10176
10177 let INSIDE_OUTSIDE_UNIQUE = prove
10178  (`!s t u. connected t /\ bounded t /\
10179            connected u /\ ~(bounded u) /\
10180            ~connected((:real^N) DIFF s) /\
10181            t UNION u = (:real^N) DIFF s
10182            ==> inside s = t /\ outside s = u`,
10183   REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[OUTSIDE_INSIDE] THEN
10184   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
10185    [ASM_MESON_TAC[INSIDE_UNIQUE];
10186     MP_TAC(ISPEC `(:real^N) DIFF s` INSIDE_NO_OVERLAP) THEN
10187     SUBGOAL_THEN `t INTER u:real^N->bool = {}` MP_TAC THENL
10188      [ALL_TAC; ASM SET_TAC[]] THEN
10189     UNDISCH_TAC `~connected ((:real^N) DIFF s)` THEN
10190     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
10191     FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN DISCH_TAC THEN
10192     REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_UNION THEN
10193     ASM_REWRITE_TAC[]]);;
10194
10195 let INTERIOR_INSIDE_FRONTIER = prove
10196  (`!s:real^N->bool. bounded s ==> interior s SUBSET inside(frontier s)`,
10197   REPEAT STRIP_TAC THEN REWRITE_TAC[inside; SUBSET; IN_ELIM_THM] THEN
10198   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
10199   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
10200    [ASM_REWRITE_TAC[frontier; IN_DIFF]; DISCH_TAC] THEN
10201   MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN
10202   ASM_REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
10203   MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
10204   SUBGOAL_THEN `~(connected_component((:real^N) DIFF frontier s) x INTER
10205                   frontier s = {})`
10206   MP_TAC THENL
10207    [MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN
10208     REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; GSYM MEMBER_NOT_EMPTY] THEN
10209     CONJ_TAC THENL [REWRITE_TAC[IN_INTER]; ASM SET_TAC[]] THEN
10210     EXISTS_TAC `x:real^N` THEN CONJ_TAC THENL
10211      [REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ] THEN
10212       GEN_REWRITE_TAC I [GSYM IN] THEN ASM SET_TAC[];
10213       ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]];
10214     REWRITE_TAC[SET_RULE `s INTER t = {} <=> s SUBSET (UNIV DIFF t)`] THEN
10215     REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]]);;
10216
10217 let INSIDE_EMPTY = prove
10218  (`inside {} = {}`,
10219   REWRITE_TAC[inside; NOT_IN_EMPTY; DIFF_EMPTY; CONNECTED_COMPONENT_UNIV] THEN
10220   REWRITE_TAC[NOT_BOUNDED_UNIV; EMPTY_GSPEC]);;
10221
10222 let OUTSIDE_EMPTY = prove
10223  (`outside {} = (:real^N)`,
10224   REWRITE_TAC[OUTSIDE_INSIDE; INSIDE_EMPTY] THEN SET_TAC[]);;
10225
10226 let INSIDE_SAME_COMPONENT = prove
10227  (`!s x y. connected_component((:real^N) DIFF s) x y /\ x IN inside s
10228            ==> y IN inside s`,
10229   REPEAT GEN_TAC THEN
10230   DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o GEN_REWRITE_RULE I [GSYM IN])
10231         MP_TAC) THEN
10232   REWRITE_TAC[inside; IN_ELIM_THM] THEN
10233   FIRST_ASSUM(SUBST1_TAC o MATCH_MP CONNECTED_COMPONENT_EQ) THEN
10234   RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN
10235   FIRST_ASSUM(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN
10236   SIMP_TAC[IN_DIFF]);;
10237
10238 let OUTSIDE_SAME_COMPONENT = prove
10239  (`!s x y. connected_component((:real^N) DIFF s) x y /\ x IN outside s
10240            ==> y IN outside s`,
10241   REPEAT GEN_TAC THEN
10242   DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o GEN_REWRITE_RULE I [GSYM IN])
10243         MP_TAC) THEN
10244   REWRITE_TAC[outside; IN_ELIM_THM] THEN
10245   FIRST_ASSUM(SUBST1_TAC o MATCH_MP CONNECTED_COMPONENT_EQ) THEN
10246   RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN
10247   FIRST_ASSUM(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN
10248   SIMP_TAC[IN_DIFF]);;
10249
10250 let OUTSIDE_CONVEX = prove
10251  (`!s. convex s ==> outside s = (:real^N) DIFF s`,
10252   REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ;
10253               REWRITE_RULE[SET_RULE `t INTER s = {} <=> t SUBSET UNIV DIFF s`]
10254                           OUTSIDE_NO_OVERLAP] THEN
10255   REWRITE_TAC[SUBSET; IN_UNIV; IN_DIFF] THEN
10256   MATCH_MP_TAC SET_PROVE_CASES THEN REWRITE_TAC[OUTSIDE_EMPTY; IN_UNIV] THEN
10257   X_GEN_TAC `a:real^N` THEN GEOM_ORIGIN_TAC `a:real^N` THEN
10258   X_GEN_TAC `t:real^N->bool` THEN DISCH_THEN(K ALL_TAC) THEN
10259   MP_TAC(SET_RULE `(vec 0:real^N) IN (vec 0 INSERT t)`) THEN
10260   SPEC_TAC(`(vec 0:real^N) INSERT t`,`s:real^N->bool`) THEN
10261   GEN_TAC THEN DISCH_TAC THEN DISCH_TAC THEN
10262   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
10263   ASM_REWRITE_TAC[outside; IN_ELIM_THM] THEN
10264   SUBGOAL_THEN `~(x:real^N = vec 0)` ASSUME_TAC THENL
10265    [ASM_MESON_TAC[]; ALL_TAC] THEN
10266   REWRITE_TAC[BOUNDED_POS; NOT_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN
10267   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
10268   DISCH_THEN(MP_TAC o SPEC `(max (&2) ((B + &1) / norm(x))) % x:real^N`) THEN
10269   REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
10270    [REWRITE_TAC[IN] THEN REWRITE_TAC[connected_component] THEN
10271     EXISTS_TAC `segment[x:real^N,(max (&2) ((B + &1) / norm(x))) % x]` THEN
10272     REWRITE_TAC[ENDS_IN_SEGMENT; CONNECTED_SEGMENT] THEN
10273     REWRITE_TAC[segment; SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `u:real` THEN
10274     ASM_CASES_TAC `u = &0` THEN
10275     ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID; REAL_SUB_RZERO;
10276                     VECTOR_ADD_RID; IN_DIFF; IN_UNIV] THEN
10277     DISCH_TAC THEN
10278     REWRITE_TAC[VECTOR_ARITH `a % x + b % c % x:real^N = (a + b * c) % x`] THEN
10279     ABBREV_TAC `c = &1 - u + u * max (&2) ((B + &1) / norm(x:real^N))` THEN
10280     DISCH_TAC THEN SUBGOAL_THEN `&1 < c` ASSUME_TAC THENL
10281      [EXPAND_TAC "c" THEN
10282       REWRITE_TAC[REAL_ARITH `&1 < &1 - u + u * x <=> &0 < u * (x - &1)`] THEN
10283       MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC;
10284       UNDISCH_TAC `~((x:real^N) IN s)` THEN REWRITE_TAC[] THEN
10285       SUBGOAL_THEN `x:real^N = (&1 - inv c) % vec 0 + inv c % c % x`
10286       SUBST1_TAC THENL
10287        [REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; VECTOR_MUL_ASSOC] THEN
10288         ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `&1 < x ==> ~(x = &0)`] THEN
10289         REWRITE_TAC[VECTOR_MUL_LID];
10290         MATCH_MP_TAC IN_CONVEX_SET THEN
10291         ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_INV_LE_1; REAL_LT_IMP_LE] THEN
10292         ASM_REAL_ARITH_TAC]];
10293     ASM_SIMP_TAC[NORM_MUL; REAL_NOT_LE; GSYM REAL_LT_LDIV_EQ; NORM_POS_LT] THEN
10294     MATCH_MP_TAC(REAL_ARITH `&0 < b /\ b < c ==> b < abs(max (&2) c)`) THEN
10295     ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; REAL_LT_DIV2_EQ] THEN
10296     REAL_ARITH_TAC]);;
10297
10298 let INSIDE_CONVEX = prove
10299  (`!s. convex s ==> inside s = {}`,
10300   SIMP_TAC[INSIDE_OUTSIDE; OUTSIDE_CONVEX] THEN SET_TAC[]);;
10301
10302 let OUTSIDE_SUBSET_CONVEX = prove
10303  (`!s t. convex t /\ s SUBSET t ==> (:real^N) DIFF t SUBSET outside s`,
10304   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN
10305   EXISTS_TAC `outside(t:real^N->bool)` THEN
10306   ASM_SIMP_TAC[OUTSIDE_MONO] THEN
10307   ASM_SIMP_TAC[OUTSIDE_CONVEX; SUBSET_REFL]);;
10308
10309 let OUTSIDE_FRONTIER_MISSES_CLOSURE = prove
10310  (`!s. bounded s ==> outside(frontier s) SUBSET (:real^N) DIFF closure s`,
10311   REPEAT STRIP_TAC THEN REWRITE_TAC[OUTSIDE_INSIDE] THEN
10312   SIMP_TAC[SET_RULE `(UNIV DIFF s) SUBSET (UNIV DIFF t) <=> t SUBSET s`] THEN
10313   REWRITE_TAC[frontier] THEN
10314   MATCH_MP_TAC(SET_RULE
10315    `i SUBSET ins ==> c SUBSET (c DIFF i) UNION ins`) THEN
10316   ASM_SIMP_TAC[GSYM frontier; INTERIOR_INSIDE_FRONTIER]);;
10317
10318 let OUTSIDE_FRONTIER_EQ_COMPLEMENT_CLOSURE = prove
10319  (`!s. bounded s /\ convex s
10320        ==> outside(frontier s) = (:real^N) DIFF closure s`,
10321   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
10322   ASM_SIMP_TAC[OUTSIDE_FRONTIER_MISSES_CLOSURE] THEN
10323   MATCH_MP_TAC OUTSIDE_SUBSET_CONVEX THEN
10324   ASM_SIMP_TAC[CONVEX_CLOSURE; frontier] THEN SET_TAC[]);;
10325
10326 let INSIDE_FRONTIER_EQ_INTERIOR = prove
10327  (`!s:real^N->bool.
10328         bounded s /\ convex s ==> inside(frontier s) = interior s`,
10329   REPEAT STRIP_TAC THEN
10330   ASM_SIMP_TAC[INSIDE_OUTSIDE; OUTSIDE_FRONTIER_EQ_COMPLEMENT_CLOSURE] THEN
10331   REWRITE_TAC[frontier] THEN
10332   MAP_EVERY (MP_TAC o ISPEC `s:real^N->bool`)
10333    [CLOSURE_SUBSET; INTERIOR_SUBSET] THEN
10334   ASM SET_TAC[]);;
10335
10336 let OPEN_INSIDE = prove
10337  (`!s:real^N->bool. closed s ==> open(inside s)`,
10338   REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
10339   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
10340   SUBGOAL_THEN `open(connected_component ((:real^N) DIFF s) x)` MP_TAC THENL
10341    [MATCH_MP_TAC OPEN_CONNECTED_COMPONENT THEN ASM_REWRITE_TAC[GSYM closed];
10342     REWRITE_TAC[open_def] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
10343     ANTS_TAC THENL
10344      [REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ] THEN
10345       GEN_REWRITE_TAC I [GSYM IN] THEN
10346       ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN
10347       MP_TAC(ISPEC `s:real^N->bool` INSIDE_NO_OVERLAP) THEN
10348       ASM SET_TAC[];
10349       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN
10350       STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN
10351       X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
10352       MATCH_MP_TAC INSIDE_SAME_COMPONENT THEN
10353       EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN
10354       RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN
10355       FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[DIST_SYM]]]);;
10356
10357 let OPEN_OUTSIDE = prove
10358  (`!s:real^N->bool. closed s ==> open(outside s)`,
10359   REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
10360   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
10361   SUBGOAL_THEN `open(connected_component ((:real^N) DIFF s) x)` MP_TAC THENL
10362    [MATCH_MP_TAC OPEN_CONNECTED_COMPONENT THEN ASM_REWRITE_TAC[GSYM closed];
10363     REWRITE_TAC[open_def] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
10364     ANTS_TAC THENL
10365      [REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ] THEN
10366       GEN_REWRITE_TAC I [GSYM IN] THEN
10367       ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN
10368       MP_TAC(ISPEC `s:real^N->bool` OUTSIDE_NO_OVERLAP) THEN
10369       ASM SET_TAC[];
10370       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN
10371       STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN
10372       X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
10373       MATCH_MP_TAC OUTSIDE_SAME_COMPONENT THEN
10374       EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN
10375       RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN
10376       FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[DIST_SYM]]]);;
10377
10378 let CLOSURE_INSIDE_SUBSET = prove
10379  (`!s:real^N->bool. closed s ==> closure(inside s) SUBSET s UNION inside s`,
10380   REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN
10381   ASM_SIMP_TAC[closed; GSYM OUTSIDE_INSIDE; OPEN_OUTSIDE] THEN SET_TAC[]);;
10382
10383 let FRONTIER_INSIDE_SUBSET = prove
10384  (`!s:real^N->bool. closed s ==> frontier(inside s) SUBSET s`,
10385   REPEAT STRIP_TAC THEN
10386   ASM_SIMP_TAC[frontier; OPEN_INSIDE; INTERIOR_OPEN] THEN
10387   FIRST_ASSUM(MP_TAC o MATCH_MP CLOSURE_INSIDE_SUBSET) THEN SET_TAC[]);;
10388
10389 let CLOSURE_OUTSIDE_SUBSET = prove
10390  (`!s:real^N->bool. closed s ==> closure(outside s) SUBSET s UNION outside s`,
10391   REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN
10392   ASM_SIMP_TAC[closed; GSYM INSIDE_OUTSIDE; OPEN_INSIDE] THEN SET_TAC[]);;
10393
10394 let FRONTIER_OUTSIDE_SUBSET = prove
10395  (`!s:real^N->bool. closed s ==> frontier(outside s) SUBSET s`,
10396   REPEAT STRIP_TAC THEN
10397   ASM_SIMP_TAC[frontier; OPEN_OUTSIDE; INTERIOR_OPEN] THEN
10398   FIRST_ASSUM(MP_TAC o MATCH_MP CLOSURE_OUTSIDE_SUBSET) THEN SET_TAC[]);;
10399
10400 let INSIDE_COMPLEMENT_UNBOUNDED_CONNECTED_EMPTY = prove
10401  (`!s. connected((:real^N) DIFF s) /\ ~bounded((:real^N) DIFF s)
10402        ==> inside s = {}`,
10403   REWRITE_TAC[inside; CONNECTED_CONNECTED_COMPONENT_SET] THEN
10404   REWRITE_TAC[SET_RULE `s = {} <=> !x. x IN s ==> F`] THEN
10405   SIMP_TAC[IN_ELIM_THM; IN_DIFF; IN_UNIV; TAUT `~(a /\ b) <=> a ==> ~b`]);;
10406
10407 let INSIDE_BOUNDED_COMPLEMENT_CONNECTED_EMPTY = prove
10408  (`!s. connected((:real^N) DIFF s) /\ bounded s
10409        ==> inside s = {}`,
10410   MESON_TAC[INSIDE_COMPLEMENT_UNBOUNDED_CONNECTED_EMPTY;
10411             COBOUNDED_IMP_UNBOUNDED]);;
10412
10413 let INSIDE_INSIDE = prove
10414  (`!s t:real^N->bool.
10415         s SUBSET inside t ==> inside s DIFF t SUBSET inside t`,
10416   REPEAT STRIP_TAC THEN SIMP_TAC[SUBSET; inside; IN_DIFF; IN_ELIM_THM] THEN
10417   X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
10418   ASM_CASES_TAC `s INTER connected_component ((:real^N) DIFF t) x = {}` THENL
10419    [MATCH_MP_TAC BOUNDED_SUBSET THEN
10420     EXISTS_TAC `connected_component ((:real^N) DIFF s) x` THEN
10421     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
10422     REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; IN] THEN
10423     REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM SET_TAC[];
10424     FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
10425      `~(s INTER t = {}) ==> ?x. x IN s /\ x IN t`)) THEN
10426     DISCH_THEN(X_CHOOSE_THEN `y:real^N`
10427      (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
10428     DISCH_THEN(SUBST_ALL_TAC o SYM o MATCH_MP CONNECTED_COMPONENT_EQ) THEN
10429     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
10430     DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN
10431     ASM_SIMP_TAC[inside; IN_ELIM_THM]]);;
10432
10433 let INSIDE_INSIDE_SUBSET = prove
10434  (`!s:real^N->bool. inside(inside s) SUBSET s`,
10435   GEN_TAC THEN MP_TAC
10436    (ISPECL [`inside s:real^N->bool`; `s:real^N->bool`] INSIDE_INSIDE) THEN
10437   REWRITE_TAC[SUBSET_REFL] THEN
10438   MP_TAC(ISPEC `inside s:real^N->bool` INSIDE_NO_OVERLAP) THEN SET_TAC[]);;
10439
10440 let INSIDE_OUTSIDE_INTERSECT_CONNECTED = prove
10441  (`!s t:real^N->bool.
10442         connected t /\ ~(inside s INTER t = {}) /\ ~(outside s INTER t = {})
10443         ==> ~(s INTER t = {})`,
10444   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
10445   DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
10446   REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
10447   REWRITE_TAC[inside; outside; IN_ELIM_THM] THEN
10448   DISCH_THEN(CONJUNCTS_THEN2
10449    (X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC)
10450    (X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC)) THEN
10451   SUBGOAL_THEN
10452    `connected_component ((:real^N) DIFF s) y =
10453     connected_component ((:real^N) DIFF s) x`
10454    (fun th -> ASM_MESON_TAC[th]) THEN
10455   ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EQ; IN_DIFF; IN_UNIV] THEN
10456   REWRITE_TAC[connected_component] THEN
10457   EXISTS_TAC `t:real^N->bool` THEN ASM SET_TAC[]);;
10458
10459 let OUTSIDE_BOUNDED_NONEMPTY = prove
10460  (`!s:real^N->bool. bounded s ==> ~(outside s = {})`,
10461   GEN_TAC THEN
10462   DISCH_THEN(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
10463   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
10464   FIRST_ASSUM(MP_TAC o MATCH_MP
10465    (REWRITE_RULE[IMP_CONJ_ALT] OUTSIDE_SUBSET_CONVEX)) THEN
10466   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
10467   SIMP_TAC[CONVEX_BALL; SUBSET_EMPTY] THEN
10468   REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN
10469   MESON_TAC[BOUNDED_BALL; BOUNDED_SUBSET; NOT_BOUNDED_UNIV]);;
10470
10471 let OUTSIDE_COMPACT_IN_OPEN = prove
10472  (`!s t:real^N->bool.
10473         compact s /\ open t /\ s SUBSET t /\ ~(t = {})
10474         ==> ~(outside s INTER t = {})`,
10475   REPEAT GEN_TAC THEN STRIP_TAC THEN
10476   FIRST_ASSUM(MP_TAC o MATCH_MP OUTSIDE_BOUNDED_NONEMPTY o
10477         MATCH_MP COMPACT_IMP_BOUNDED) THEN
10478   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
10479   REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM; IN_INTER] THEN
10480   X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN
10481   X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
10482   ASM_CASES_TAC `(a:real^N) IN t` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
10483   MP_TAC(ISPECL [`linepath(a:real^N,b)`; `(:real^N) DIFF t`]
10484         EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN
10485   REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
10486   ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN
10487   X_GEN_TAC `g:real^1->real^N` THEN REWRITE_TAC[FRONTIER_COMPLEMENT] THEN
10488   REWRITE_TAC[PATH_IMAGE_LINEPATH; INTERIOR_DIFF; INTERIOR_UNIV] THEN
10489   ABBREV_TAC `c:real^N = pathfinish g` THEN STRIP_TAC THEN
10490   SUBGOAL_THEN `frontier t SUBSET (:real^N) DIFF s` MP_TAC THENL
10491    [ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN
10492     REWRITE_TAC[frontier] THEN
10493     ASM_SIMP_TAC[CLOSURE_CLOSED; GSYM OPEN_CLOSED] THEN ASM SET_TAC[];
10494     REWRITE_TAC[SUBSET; IN_DIFF; IN_UNIV]] THEN
10495   DISCH_THEN(MP_TAC o SPEC `c:real^N`) THEN ASM_REWRITE_TAC[] THEN
10496   DISCH_TAC THEN MP_TAC(ISPEC `(:real^N) DIFF s` OPEN_CONTAINS_CBALL) THEN
10497   ASM_SIMP_TAC[GSYM closed; COMPACT_IMP_CLOSED; IN_DIFF; IN_UNIV] THEN
10498   DISCH_THEN(MP_TAC o SPEC `c:real^N`) THEN ASM_REWRITE_TAC[] THEN
10499   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
10500   MP_TAC(ISPECL [`c:real^N`; `t:real^N->bool`]
10501         CLOSURE_APPROACHABLE) THEN
10502   RULE_ASSUM_TAC(REWRITE_RULE[frontier; IN_DIFF]) THEN
10503   ASM_REWRITE_TAC[] THEN
10504   DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
10505   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^N` THEN
10506   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
10507   MATCH_MP_TAC OUTSIDE_SAME_COMPONENT THEN
10508   EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN
10509   REWRITE_TAC[connected_component] THEN
10510   EXISTS_TAC `path_image(g) UNION segment[c:real^N,d]` THEN
10511   REWRITE_TAC[IN_UNION; ENDS_IN_SEGMENT] THEN CONJ_TAC THENL
10512    [MATCH_MP_TAC CONNECTED_UNION THEN
10513     ASM_SIMP_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY;
10514                  CONNECTED_PATH_IMAGE] THEN
10515     EXISTS_TAC `c:real^N` THEN REWRITE_TAC[ENDS_IN_SEGMENT; IN_INTER] THEN
10516     ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE; SUBSET];
10517     CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]] THEN
10518     REWRITE_TAC[UNION_SUBSET] THEN CONJ_TAC THENL
10519      [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
10520        `~(c IN s)
10521         ==> (t DELETE c) SUBSET (UNIV DIFF s)
10522             ==> t SUBSET (UNIV DIFF s)`)) THEN
10523       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10524         SUBSET_TRANS)) THEN
10525       SIMP_TAC[SET_RULE `UNIV DIFF s SUBSET UNIV DIFF t <=> t SUBSET s`] THEN
10526       ASM_MESON_TAC[SUBSET_TRANS; CLOSURE_SUBSET];
10527       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
10528         SUBSET_TRANS)) THEN
10529      REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
10530       ASM_SIMP_TAC[CONVEX_CBALL; INSERT_SUBSET; REAL_LT_IMP_LE;
10531                    EMPTY_SUBSET; CENTRE_IN_CBALL] THEN
10532       REWRITE_TAC[IN_CBALL] THEN
10533       ASM_MESON_TAC[DIST_SYM; REAL_LT_IMP_LE]]]);;
10534
10535 let INSIDE_INSIDE_COMPACT_CONNECTED = prove
10536  (`!s t:real^N->bool.
10537         closed s /\ compact t /\ s SUBSET inside t /\ connected t
10538         ==> inside s SUBSET inside t`,
10539   REPEAT GEN_TAC THEN
10540   ASM_CASES_TAC `inside t:real^N->bool = {}` THEN
10541   ASM_SIMP_TAC[INSIDE_EMPTY; SUBSET_EMPTY; EMPTY_SUBSET] THEN
10542   SUBGOAL_THEN `1 <= dimindex(:N)` MP_TAC THENL
10543    [REWRITE_TAC[DIMINDEX_GE_1];
10544     REWRITE_TAC[ARITH_RULE `1 <= n <=> n = 1 \/ 2 <= n`]] THEN
10545   STRIP_TAC THEN ASM_SIMP_TAC[GSYM CONNECTED_CONVEX_1_GEN] THENL
10546    [ASM_MESON_TAC[INSIDE_CONVEX]; ALL_TAC] THEN
10547   STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP INSIDE_INSIDE) THEN
10548   MATCH_MP_TAC(SET_RULE
10549    `s INTER t = {} ==> s DIFF t SUBSET u ==> s SUBSET u`) THEN
10550   SUBGOAL_THEN `compact(s:real^N->bool)` ASSUME_TAC THENL
10551    [ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET; BOUNDED_INSIDE];
10552     ALL_TAC] THEN
10553   MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`]
10554         INSIDE_OUTSIDE_INTERSECT_CONNECTED) THEN
10555   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT
10556    `r /\ q ==> (~p /\ q ==> ~r) ==> p`) THEN
10557   CONJ_TAC THENL
10558    [MP_TAC(ISPEC `t:real^N->bool` INSIDE_NO_OVERLAP) THEN ASM SET_TAC[];
10559     ONCE_REWRITE_TAC[INTER_COMM]] THEN
10560   MATCH_MP_TAC INSIDE_OUTSIDE_INTERSECT_CONNECTED THEN
10561   ASM_SIMP_TAC[CONNECTED_OUTSIDE; COMPACT_IMP_BOUNDED] THEN CONJ_TAC THENL
10562    [ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC OUTSIDE_COMPACT_IN_OPEN THEN
10563     ASM_SIMP_TAC[OPEN_INSIDE; COMPACT_IMP_CLOSED];
10564     MP_TAC(ISPECL [`s UNION t:real^N->bool`; `vec 0:real^N`]
10565         BOUNDED_SUBSET_BALL) THEN
10566     ASM_SIMP_TAC[BOUNDED_UNION; COMPACT_IMP_BOUNDED] THEN
10567     DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
10568     MATCH_MP_TAC(SET_RULE
10569      `!u. ~(u = UNIV) /\ UNIV DIFF u SUBSET s /\ UNIV DIFF u SUBSET t
10570           ==> ~(s INTER t = {})`) THEN
10571     EXISTS_TAC `ball(vec 0:real^N,r)` THEN CONJ_TAC THENL
10572      [ASM_MESON_TAC[NOT_BOUNDED_UNIV; BOUNDED_BALL]; ALL_TAC] THEN
10573     CONJ_TAC THEN MATCH_MP_TAC OUTSIDE_SUBSET_CONVEX THEN
10574     REWRITE_TAC[CONVEX_BALL] THEN ASM SET_TAC[]]);;
10575
10576 let CONNECTED_WITH_INSIDE = prove
10577  (`!s:real^N->bool. closed s /\ connected s ==> connected(s UNION inside s)`,
10578   GEN_TAC THEN ASM_CASES_TAC `s UNION inside s = (:real^N)` THEN
10579   ASM_REWRITE_TAC[CONNECTED_UNIV] THEN
10580   REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
10581   REWRITE_TAC[CONNECTED_COMPONENT_SET; IN_ELIM_THM] THEN STRIP_TAC THEN
10582   SUBGOAL_THEN
10583    `!x. x IN (s UNION inside s)
10584         ==> ?y:real^N t. y IN s /\ connected t /\ x IN t /\ y IN t /\
10585                          t SUBSET (s UNION inside s)`
10586   MP_TAC THENL
10587    [X_GEN_TAC `a:real^N` THEN REWRITE_TAC[IN_UNION] THEN STRIP_TAC THENL
10588      [MAP_EVERY EXISTS_TAC [`a:real^N`; `{a:real^N}`] THEN
10589       ASM_REWRITE_TAC[IN_SING; CONNECTED_SING] THEN ASM SET_TAC[];
10590       FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
10591        `~(s UNION t = UNIV) ==> ?b. ~(b IN s) /\ ~(b IN t)`)) THEN
10592       DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN
10593       MP_TAC(ISPECL [`linepath(a:real^N,b)`; `inside s:real^N->bool`]
10594         EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN
10595       ASM_SIMP_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH;
10596                    IN_UNION; OPEN_INSIDE; INTERIOR_OPEN] THEN
10597       DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
10598       EXISTS_TAC `pathfinish g :real^N` THEN
10599       EXISTS_TAC `path_image g :real^N->bool` THEN
10600       ASM_SIMP_TAC[PATHFINISH_IN_PATH_IMAGE; CONNECTED_PATH_IMAGE] THEN
10601       MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN
10602       REPEAT STRIP_TAC THENL
10603        [ASM_MESON_TAC[FRONTIER_INSIDE_SUBSET; SUBSET];
10604         ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE];
10605         ASM SET_TAC[]]];
10606     DISCH_THEN(fun th ->
10607       MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
10608       MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN
10609     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
10610     MAP_EVERY X_GEN_TAC [`a:real^N`; `t:real^N->bool`] THEN STRIP_TAC THEN
10611     MAP_EVERY X_GEN_TAC [`b:real^N`; `u:real^N->bool`] THEN STRIP_TAC THEN
10612     FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
10613     ASM_REWRITE_TAC[] THEN
10614     DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
10615     EXISTS_TAC `t UNION v UNION u:real^N->bool` THEN
10616     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
10617     REPEAT(MATCH_MP_TAC CONNECTED_UNION THEN
10618            ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC) THEN
10619     ASM SET_TAC[]]);;
10620
10621 let CONNECTED_WITH_OUTSIDE = prove
10622  (`!s:real^N->bool. closed s /\ connected s ==> connected(s UNION outside s)`,
10623   GEN_TAC THEN ASM_CASES_TAC `s UNION outside s = (:real^N)` THEN
10624   ASM_REWRITE_TAC[CONNECTED_UNIV] THEN
10625   REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
10626   REWRITE_TAC[CONNECTED_COMPONENT_SET; IN_ELIM_THM] THEN STRIP_TAC THEN
10627   SUBGOAL_THEN
10628    `!x. x IN (s UNION outside s)
10629         ==> ?y:real^N t. y IN s /\ connected t /\ x IN t /\ y IN t /\
10630                          t SUBSET (s UNION outside s)`
10631   MP_TAC THENL
10632    [X_GEN_TAC `a:real^N` THEN REWRITE_TAC[IN_UNION] THEN STRIP_TAC THENL
10633      [MAP_EVERY EXISTS_TAC [`a:real^N`; `{a:real^N}`] THEN
10634       ASM_REWRITE_TAC[IN_SING; CONNECTED_SING] THEN ASM SET_TAC[];
10635       FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
10636        `~(s UNION t = UNIV) ==> ?b. ~(b IN s) /\ ~(b IN t)`)) THEN
10637       DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN
10638       MP_TAC(ISPECL [`linepath(a:real^N,b)`; `outside s:real^N->bool`]
10639         EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN
10640       ASM_SIMP_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH;
10641                    IN_UNION; OPEN_OUTSIDE; INTERIOR_OPEN] THEN
10642       DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
10643       EXISTS_TAC `pathfinish g :real^N` THEN
10644       EXISTS_TAC `path_image g :real^N->bool` THEN
10645       ASM_SIMP_TAC[PATHFINISH_IN_PATH_IMAGE; CONNECTED_PATH_IMAGE] THEN
10646       MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN
10647       REPEAT STRIP_TAC THENL
10648        [ASM_MESON_TAC[FRONTIER_OUTSIDE_SUBSET; SUBSET];
10649         ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE];
10650         ASM SET_TAC[]]];
10651     DISCH_THEN(fun th ->
10652       MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
10653       MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN
10654     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
10655     MAP_EVERY X_GEN_TAC [`a:real^N`; `t:real^N->bool`] THEN STRIP_TAC THEN
10656     MAP_EVERY X_GEN_TAC [`b:real^N`; `u:real^N->bool`] THEN STRIP_TAC THEN
10657     FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
10658     ASM_REWRITE_TAC[] THEN
10659     DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
10660     EXISTS_TAC `t UNION v UNION u:real^N->bool` THEN
10661     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
10662     REPEAT(MATCH_MP_TAC CONNECTED_UNION THEN
10663            ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC) THEN
10664     ASM SET_TAC[]]);;
10665
10666 let INSIDE_INSIDE_EQ_EMPTY = prove
10667  (`!s:real^N->bool.
10668         closed s /\ connected s ==> inside(inside s) = {}`,
10669   REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN
10670   X_GEN_TAC `x:real^N` THEN ONCE_REWRITE_TAC[inside] THEN
10671   REWRITE_TAC[IN_ELIM_THM] THEN
10672   ONCE_REWRITE_TAC[INSIDE_OUTSIDE] THEN
10673   REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN
10674   REWRITE_TAC[IN_DIFF; IN_UNIV] THEN
10675   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
10676   ASM_SIMP_TAC[CONNECTED_COMPONENT_EQ_SELF; CONNECTED_WITH_OUTSIDE] THEN
10677   REWRITE_TAC[BOUNDED_UNION] THEN MESON_TAC[UNBOUNDED_OUTSIDE]);;
10678
10679 let INSIDE_IN_COMPONENTS = prove
10680  (`!s. (inside s) IN components((:real^N) DIFF s) <=>
10681        connected(inside s) /\ ~(inside s = {})`,
10682   X_GEN_TAC `s:real^N->bool` THEN REWRITE_TAC[IN_COMPONENTS_MAXIMAL] THEN
10683   ASM_CASES_TAC `inside s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN
10684   ASM_CASES_TAC `connected(inside s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN
10685   REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN
10686   REWRITE_TAC[INSIDE_NO_OVERLAP] THEN
10687   X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN
10688   ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
10689   REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
10690   MATCH_MP_TAC INSIDE_SAME_COMPONENT THEN
10691   UNDISCH_TAC `~(inside s:real^N->bool = {})` THEN
10692   REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN
10693   X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
10694   ASM_REWRITE_TAC[connected_component] THEN
10695   EXISTS_TAC `d:real^N->bool` THEN ASM SET_TAC[]);;
10696
10697 let OUTSIDE_IN_COMPONENTS = prove
10698  (`!s. (outside s) IN components((:real^N) DIFF s) <=>
10699        connected(outside s) /\ ~(outside s = {})`,
10700   X_GEN_TAC `s:real^N->bool` THEN REWRITE_TAC[IN_COMPONENTS_MAXIMAL] THEN
10701   ASM_CASES_TAC `outside s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN
10702   ASM_CASES_TAC `connected(outside s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN
10703   REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN
10704   REWRITE_TAC[OUTSIDE_NO_OVERLAP] THEN
10705   X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN
10706   ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
10707   REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
10708   MATCH_MP_TAC OUTSIDE_SAME_COMPONENT THEN
10709   UNDISCH_TAC `~(outside s:real^N->bool = {})` THEN
10710   REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN
10711   X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
10712   ASM_REWRITE_TAC[connected_component] THEN
10713   EXISTS_TAC `d:real^N->bool` THEN ASM SET_TAC[]);;
10714
10715 let BOUNDED_UNIQUE_OUTSIDE = prove
10716  (`!c s. 2 <= dimindex(:N) /\ bounded s
10717          ==> (c IN components ((:real^N) DIFF s) /\ ~bounded c <=>
10718               c = outside s)`,
10719   REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL
10720    [MATCH_MP_TAC COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS THEN
10721     EXISTS_TAC `(:real^N) DIFF s` THEN
10722     ASM_REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN
10723     ASM_REWRITE_TAC[OUTSIDE_IN_COMPONENTS];
10724     ASM_REWRITE_TAC[OUTSIDE_IN_COMPONENTS]] THEN
10725   ASM_SIMP_TAC[UNBOUNDED_OUTSIDE; OUTSIDE_BOUNDED_NONEMPTY;
10726                CONNECTED_OUTSIDE]);;
10727
10728 (* ------------------------------------------------------------------------- *)
10729 (* Homotopy of maps p,q : X->Y with property P of all intermediate maps.     *)
10730 (* We often just want to require that it fixes some subset, but to take in   *)
10731 (* the case of loop homotopy it's convenient to have a general property P.   *)
10732 (* ------------------------------------------------------------------------- *)
10733
10734 let homotopic_with = new_definition
10735  `homotopic_with P (X,Y) p q <=>
10736    ?h:real^(1,M)finite_sum->real^N.
10737      h continuous_on (interval[vec 0,vec 1] PCROSS X) /\
10738      IMAGE h (interval[vec 0,vec 1] PCROSS X) SUBSET Y /\
10739      (!x. h(pastecart (vec 0) x) = p x) /\
10740      (!x. h(pastecart (vec 1) x) = q x) /\
10741      (!t. t IN interval[vec 0,vec 1] ==> P(\x. h(pastecart t x)))`;;
10742
10743 (* ------------------------------------------------------------------------- *)
10744 (* We often want to just localize the ending function equality or whatever.  *)
10745 (* ------------------------------------------------------------------------- *)
10746
10747 let HOMOTOPIC_WITH = prove
10748  (`(!h k. (!x. x IN X ==> h x = k x) ==> (P h <=> P k))
10749    ==> (homotopic_with P (X,Y) p q <=>
10750         ?h:real^(1,M)finite_sum->real^N.
10751           h continuous_on (interval[vec 0,vec 1] PCROSS X) /\
10752           IMAGE h (interval[vec 0,vec 1] PCROSS X) SUBSET Y /\
10753           (!x. x IN X ==> h(pastecart (vec 0) x) = p x) /\
10754           (!x. x IN X ==> h(pastecart (vec 1) x) = q x) /\
10755           (!t. t IN interval[vec 0,vec 1] ==> P(\x. h(pastecart t x))))`,
10756   REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL
10757    [REWRITE_TAC[homotopic_with; PCROSS] THEN
10758     MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[];
10759     REWRITE_TAC[homotopic_with; PCROSS] THEN
10760      DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N`
10761       (fun th -> EXISTS_TAC
10762         `\y. if sndcart(y) IN X then (h:real^(1,M)finite_sum->real^N) y
10763              else if fstcart(y) = vec 0 then p(sndcart y)
10764              else q(sndcart y)` THEN
10765       MP_TAC th)) THEN
10766      REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; VEC_EQ; ARITH_EQ] THEN
10767      REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL
10768       [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_EQ) THEN
10769        SIMP_TAC[FORALL_IN_GSPEC; SNDCART_PASTECART];
10770        SIMP_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC; SUBSET] THEN
10771        SIMP_TAC[FORALL_IN_GSPEC; SNDCART_PASTECART];
10772        ASM_MESON_TAC[];
10773        ASM_MESON_TAC[];
10774        MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `t:real^1` THEN
10775        MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
10776        MATCH_MP_TAC EQ_IMP THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
10777        SIMP_TAC[]]]);;
10778
10779 let HOMOTOPIC_WITH_EQ = prove
10780  (`!P X Y f g f' g':real^M->real^N.
10781         homotopic_with P (X,Y) f g /\
10782         (!x. x IN X ==> f' x = f x /\ g' x = g x) /\
10783         (!h k. (!x. x IN X ==> h x = k x) ==> (P h <=> P k))
10784         ==>  homotopic_with P (X,Y) f' g'`,
10785   REPEAT GEN_TAC THEN
10786   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
10787   REWRITE_TAC[homotopic_with] THEN
10788   DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N`
10789    (fun th -> EXISTS_TAC
10790      `\y. if sndcart(y) IN X then (h:real^(1,M)finite_sum->real^N) y
10791           else if fstcart(y) = vec 0 then f'(sndcart y)
10792           else g'(sndcart y)` THEN
10793    MP_TAC th)) THEN
10794   REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; VEC_EQ; ARITH_EQ] THEN
10795   REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL
10796    [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_EQ) THEN
10797     SIMP_TAC[FORALL_IN_PCROSS; SNDCART_PASTECART];
10798     SIMP_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS; SUBSET] THEN
10799     SIMP_TAC[FORALL_IN_PCROSS; SNDCART_PASTECART];
10800     ASM_MESON_TAC[];
10801     ASM_MESON_TAC[];
10802     MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `t:real^1` THEN
10803     MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
10804     MATCH_MP_TAC EQ_IMP THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
10805     SIMP_TAC[]]);;
10806
10807 let HOMOTOPIC_WITH_EQUAL = prove
10808  (`!P f:real^M->real^N g s t.
10809         P f /\ P g /\
10810         f continuous_on s /\ IMAGE f s SUBSET t /\
10811         (!x. x IN s ==> g x = f x)
10812         ==> homotopic_with P (s,t) f g`,
10813   REPEAT STRIP_TAC THEN REWRITE_TAC[homotopic_with] THEN
10814   EXISTS_TAC `\z:real^(1,M)finite_sum.
10815     if fstcart z = vec 1 then g(sndcart z):real^N else f(sndcart z)` THEN
10816   REWRITE_TAC[VEC_EQ; ARITH_EQ; SNDCART_PASTECART; FSTCART_PASTECART] THEN
10817   CONJ_TAC THENL
10818    [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
10819     EXISTS_TAC `\z:real^(1,M)finite_sum. (f:real^M->real^N)(sndcart z)` THEN
10820     ASM_SIMP_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN
10821     REWRITE_TAC[COND_ID] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN
10822     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
10823     SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; IMAGE_SNDCART_PCROSS] THEN
10824     ASM_REWRITE_TAC[UNIT_INTERVAL_NONEMPTY];
10825     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
10826     REWRITE_TAC[ FSTCART_PASTECART; SNDCART_PASTECART] THEN
10827     CONJ_TAC THEN X_GEN_TAC `t:real^1` THEN REPEAT STRIP_TAC THEN
10828     ASM_CASES_TAC `t:real^1 = vec 1` THEN ASM_REWRITE_TAC[ETA_AX] THEN
10829     ASM SET_TAC[]]);;
10830
10831 let HOMOTOPIC_CONSTANT_MAPS = prove
10832  (`!s:real^M->bool t:real^N->bool a b.
10833         homotopic_with (\x. T) (s,t) (\x. a) (\x. b) <=>
10834         s = {} \/ path_component t a b`,
10835   REPEAT GEN_TAC THEN SIMP_TAC[HOMOTOPIC_WITH; path_component] THEN
10836   ASM_CASES_TAC `s:real^M->bool = {}` THEN
10837   ASM_REWRITE_TAC[NOT_IN_EMPTY; PCROSS_EMPTY; IMAGE_CLAUSES] THEN
10838   REWRITE_TAC[EMPTY_SUBSET; CONTINUOUS_ON_EMPTY] THEN
10839   ASM_CASES_TAC `t:real^N->bool = {}` THEN
10840   ASM_REWRITE_TAC[PATH_IMAGE_NONEMPTY; SUBSET_EMPTY; PCROSS_EQ_EMPTY;
10841                   IMAGE_EQ_EMPTY; UNIT_INTERVAL_NONEMPTY] THEN
10842   EQ_TAC THENL
10843    [DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N`
10844         STRIP_ASSUME_TAC) THEN
10845     SUBGOAL_THEN `?c:real^M. c IN s` STRIP_ASSUME_TAC THENL
10846      [ASM SET_TAC[]; ALL_TAC] THEN
10847     EXISTS_TAC `(h:real^(1,M)finite_sum->real^N) o (\t. pastecart t c)` THEN
10848     ASM_SIMP_TAC[pathstart; pathfinish; o_THM; PATH_IMAGE_COMPOSE] THEN
10849     CONJ_TAC THENL
10850      [REWRITE_TAC[path] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
10851       SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID;
10852                CONTINUOUS_ON_CONST] THEN
10853       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10854         CONTINUOUS_ON_SUBSET));
10855       REWRITE_TAC[path_image]] THEN
10856     ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN
10857     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
10858     ASM_SIMP_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS];
10859     REWRITE_TAC[path; pathstart; path_image; pathfinish] THEN
10860     DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
10861     EXISTS_TAC
10862      `(g:real^1->real^N) o (fstcart:real^(1,M)finite_sum->real^1)` THEN
10863     ASM_SIMP_TAC[FSTCART_PASTECART; o_THM; IMAGE_o; IMAGE_FSTCART_PCROSS] THEN
10864     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
10865     ASM_SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_ON;
10866                  IMAGE_FSTCART_PCROSS]]);;
10867
10868 (* ------------------------------------------------------------------------- *)
10869 (* Trivial properties.                                                       *)
10870 (* ------------------------------------------------------------------------- *)
10871
10872 let HOMOTOPIC_WITH_IMP_PROPERTY = prove
10873  (`!P X Y (f:real^M->real^N) g. homotopic_with P (X,Y) f g ==> P f /\ P g`,
10874   REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with] THEN
10875   DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` MP_TAC) THEN
10876   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN
10877    (fun th -> MP_TAC(SPEC `vec 0:real^1` th) THEN
10878               MP_TAC(SPEC `vec 1:real^1` th)) THEN
10879   ASM_SIMP_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL; ETA_AX]);;
10880
10881 let HOMOTOPIC_WITH_IMP_CONTINUOUS = prove
10882  (`!P X Y (f:real^M->real^N) g.
10883       homotopic_with P (X,Y) f g ==> f continuous_on X /\ g continuous_on X`,
10884   REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with] THEN
10885   DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` MP_TAC) THEN
10886   STRIP_TAC THEN
10887   SUBGOAL_THEN
10888    `((h:real^(1,M)finite_sum->real^N) o (\x. pastecart (vec 0) x))
10889     continuous_on X /\
10890     ((h:real^(1,M)finite_sum->real^N) o (\x. pastecart (vec 1) x))
10891     continuous_on X`
10892   MP_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[o_DEF; ETA_AX]] THEN
10893   CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
10894   SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
10895   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10896         CONTINUOUS_ON_SUBSET)) THEN
10897   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN
10898   ONCE_REWRITE_TAC[CONJ_SYM] THEN
10899   REWRITE_TAC[GSYM CONJ_ASSOC; FSTCART_PASTECART; SNDCART_PASTECART] THEN
10900   SIMP_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1; IN_INTERVAL_1] THEN
10901   REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL]);;
10902
10903 let HOMOTOPIC_WITH_IMP_SUBSET = prove
10904  (`!P X Y (f:real^M->real^N) g.
10905       homotopic_with P (X,Y) f g ==> IMAGE f X SUBSET Y /\ IMAGE g X SUBSET Y`,
10906   REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with] THEN
10907   DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` MP_TAC) THEN
10908   STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
10909   REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS; SUBSET] THEN DISCH_THEN
10910    (fun th -> MP_TAC(SPEC `vec 0:real^1` th) THEN
10911               MP_TAC(SPEC `vec 1:real^1` th)) THEN
10912   ASM_SIMP_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL]);;
10913
10914 let HOMOTOPIC_WITH_MONO = prove
10915  (`!P Q X Y f g:real^M->real^N.
10916         homotopic_with P (X,Y) f g /\
10917         (!h. h continuous_on X /\ IMAGE h X SUBSET Y /\ P h ==> Q h)
10918         ==> homotopic_with Q (X,Y) f g`,
10919   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
10920   REWRITE_TAC[homotopic_with; PCROSS] THEN
10921   MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
10922   FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL
10923    [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
10924     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
10925     SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID;
10926              CONTINUOUS_ON_CONST] THEN
10927     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10928         CONTINUOUS_ON_SUBSET)) THEN
10929     ASM SET_TAC[];
10930     ASM SET_TAC[]]);;
10931
10932 let HOMOTOPIC_WITH_SUBSET_LEFT = prove
10933  (`!P X Y Z f g.
10934         homotopic_with P (X,Y) f g /\ Z SUBSET X
10935         ==> homotopic_with P (Z,Y) f g`,
10936   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
10937   REWRITE_TAC[homotopic_with; PCROSS] THEN
10938   MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
10939   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
10940    [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10941         CONTINUOUS_ON_SUBSET)) THEN
10942     ASM SET_TAC[];
10943     ASM SET_TAC[]]);;
10944
10945 let HOMOTOPIC_WITH_SUBSET_RIGHT = prove
10946  (`!P X Y Z (f:real^M->real^N) g h.
10947         homotopic_with P (X,Y) f g /\ Y SUBSET Z
10948         ==> homotopic_with P (X,Z) f g`,
10949   REPEAT GEN_TAC THEN
10950   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
10951   REWRITE_TAC[homotopic_with] THEN
10952   MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN
10953   ASM_MESON_TAC[SUBSET_TRANS]);;
10954
10955 let HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT = prove
10956  (`!p f:real^N->real^P g h:real^M->real^N W X Y.
10957         homotopic_with (\f. p(f o h)) (X,Y) f g /\
10958         h continuous_on W /\ IMAGE h W SUBSET X
10959         ==> homotopic_with p (W,Y) (f o h) (g o h)`,
10960   REPEAT GEN_TAC THEN
10961   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
10962   REWRITE_TAC[homotopic_with; o_DEF; PCROSS] THEN
10963   DISCH_THEN(X_CHOOSE_THEN `k:real^(1,N)finite_sum->real^P`
10964     STRIP_ASSUME_TAC) THEN
10965   EXISTS_TAC `\y:real^(1,M)finite_sum.
10966                 (k:real^(1,N)finite_sum->real^P)
10967                 (pastecart (fstcart y) (h(sndcart y)))` THEN
10968   ASM_REWRITE_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
10969   CONJ_TAC THENL
10970    [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
10971     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
10972      [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
10973       SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
10974       GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
10975       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
10976       SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART];
10977       ALL_TAC] THEN
10978     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE [IMP_CONJ]
10979       CONTINUOUS_ON_SUBSET));
10980     ALL_TAC] THEN
10981   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
10982   SIMP_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
10983   ASM SET_TAC[]);;
10984
10985 let HOMOTOPIC_COMPOSE_CONTINUOUS_RIGHT = prove
10986  (`!f:real^N->real^P g h:real^M->real^N W X Y.
10987         homotopic_with (\f. T) (X,Y) f g /\
10988         h continuous_on W /\ IMAGE h W SUBSET X
10989         ==> homotopic_with (\f. T) (W,Y) (f o h) (g o h)`,
10990   REPEAT STRIP_TAC THEN
10991   MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
10992   EXISTS_TAC `X:real^N->bool` THEN ASM_REWRITE_TAC[]);;
10993
10994 let HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT = prove
10995  (`!p f:real^M->real^N g h:real^N->real^P X Y Z.
10996         homotopic_with (\f. p(h o f)) (X,Y) f g /\
10997         h continuous_on Y /\ IMAGE h Y SUBSET Z
10998         ==> homotopic_with p (X,Z) (h o f) (h o g)`,
10999   REPEAT GEN_TAC THEN
11000   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
11001   REWRITE_TAC[homotopic_with; o_DEF] THEN
11002   DISCH_THEN(X_CHOOSE_THEN `k:real^(1,M)finite_sum->real^N`
11003     STRIP_ASSUME_TAC) THEN
11004   EXISTS_TAC `(h:real^N->real^P) o (k:real^(1,M)finite_sum->real^N)` THEN
11005   ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL
11006    [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
11007     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE [IMP_CONJ]
11008       CONTINUOUS_ON_SUBSET));
11009     ALL_TAC] THEN
11010   REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]);;
11011
11012 let HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT = prove
11013  (`!f:real^M->real^N g h:real^N->real^P X Y Z.
11014         homotopic_with (\f. T) (X,Y) f g /\
11015         h continuous_on Y /\ IMAGE h Y SUBSET Z
11016         ==> homotopic_with (\f. T) (X,Z) (h o f) (h o g)`,
11017   REPEAT STRIP_TAC THEN
11018   MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
11019   EXISTS_TAC `Y:real^N->bool` THEN ASM_REWRITE_TAC[]);;
11020
11021 let HOMOTOPIC_WITH_PCROSS = prove
11022  (`!f:real^M->real^N f':real^P->real^Q g g' p p' q s s' t t'.
11023      homotopic_with p (s,t) f g /\
11024      homotopic_with p' (s',t') f' g' /\
11025      (!f g. p f /\ p' g ==> q(\x. pastecart (f(fstcart x)) (g(sndcart x))))
11026      ==> homotopic_with q (s PCROSS s',t PCROSS t')
11027           (\z. pastecart (f(fstcart z)) (f'(sndcart z)))
11028           (\z. pastecart (g(fstcart z)) (g'(sndcart z)))`,
11029   REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with] THEN
11030   REWRITE_TAC[CONJ_ASSOC] THEN
11031   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
11032   REWRITE_TAC[GSYM CONJ_ASSOC] THEN
11033   DISCH_THEN(CONJUNCTS_THEN2
11034    (X_CHOOSE_THEN `k:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC)
11035    (X_CHOOSE_THEN `k':real^(1,P)finite_sum->real^Q` STRIP_ASSUME_TAC)) THEN
11036   EXISTS_TAC
11037    `\z:real^(1,(M,P)finite_sum)finite_sum.
11038         pastecart (k(pastecart (fstcart z) (fstcart(sndcart z))):real^N)
11039                   (k'(pastecart (fstcart z) (sndcart(sndcart z))):real^Q)` THEN
11040   ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
11041   RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS]) THEN
11042   ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS;
11043                FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS;
11044                IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
11045   MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN CONJ_TAC THEN
11046   GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
11047   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11048   (CONJ_TAC THENL
11049     [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
11050      SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
11051      GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
11052      MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11053      SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART];
11054      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11055       CONTINUOUS_ON_SUBSET)) THEN
11056      REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS;
11057                  IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
11058      ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART;
11059                   PASTECART_IN_PCROSS]]));;
11060
11061 let HOMOTOPIC_ON_EMPTY = prove
11062  (`!t f g. homotopic_with (\x. T) ({},t) f g`,
11063   SIMP_TAC[HOMOTOPIC_WITH; NOT_IN_EMPTY; PCROSS_EMPTY] THEN
11064   REWRITE_TAC[CONTINUOUS_ON_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET]);;
11065
11066 (* ------------------------------------------------------------------------- *)
11067 (* Homotopy with P is an equivalence relation (on continuous functions       *)
11068 (* mapping X into Y that satisfy P, though this only affects reflexivity).   *)
11069 (* ------------------------------------------------------------------------- *)
11070
11071 let HOMOTOPIC_WITH_REFL = prove
11072  (`!P X Y (f:real^M->real^N).
11073       homotopic_with P (X,Y) f f <=>
11074       f continuous_on X /\ IMAGE f X SUBSET Y /\ P f`,
11075   REPEAT GEN_TAC THEN EQ_TAC THENL
11076    [MESON_TAC[HOMOTOPIC_WITH_IMP_PROPERTY; HOMOTOPIC_WITH_IMP_CONTINUOUS;
11077               HOMOTOPIC_WITH_IMP_SUBSET];
11078     STRIP_TAC THEN REWRITE_TAC[homotopic_with; PCROSS]] THEN
11079   EXISTS_TAC `\y:real^(1,M)finite_sum. (f:real^M->real^N) (sndcart y)` THEN
11080   RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN
11081   ASM_SIMP_TAC[SNDCART_PASTECART; ETA_AX; SUBSET; FORALL_IN_IMAGE;
11082                FORALL_IN_GSPEC] THEN
11083   GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
11084   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11085   SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
11086   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11087         CONTINUOUS_ON_SUBSET)) THEN
11088   ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; SNDCART_PASTECART]);;
11089
11090 let HOMOTOPIC_WITH_SYM = prove
11091  (`!P X Y (f:real^M->real^N) g.
11092       homotopic_with P (X,Y) f g <=> homotopic_with P (X,Y) g f`,
11093   REPLICATE_TAC 3 GEN_TAC THEN MATCH_MP_TAC(MESON[]
11094    `(!x y. P x y ==> P y x) ==> (!x y. P x y <=> P y x)`) THEN
11095   REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with; PCROSS] THEN
11096   DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N`
11097     STRIP_ASSUME_TAC) THEN
11098   EXISTS_TAC `\y:real^(1,M)finite_sum.
11099         (h:real^(1,M)finite_sum->real^N)
11100         (pastecart (vec 1 - fstcart y) (sndcart y))` THEN
11101   REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
11102   ASM_REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_SUB_RZERO] THEN REPEAT CONJ_TAC THENL
11103    [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
11104     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11105     SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST;
11106              LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN
11107     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11108           CONTINUOUS_ON_SUBSET));
11109     GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
11110     REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
11111      `IMAGE h s SUBSET t ==> IMAGE g s SUBSET s
11112       ==> IMAGE h (IMAGE g s) SUBSET t`)) THEN
11113     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC];
11114     REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN REPEAT STRIP_TAC THEN
11115     FIRST_X_ASSUM MATCH_MP_TAC] THEN
11116   SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
11117   REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_ELIM_THM] THEN
11118   ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[PASTECART_EQ] THEN
11119   REWRITE_TAC[GSYM CONJ_ASSOC; FSTCART_PASTECART; SNDCART_PASTECART] THEN
11120   SIMP_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1; IN_INTERVAL_1] THEN
11121   REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL; DROP_SUB] THEN
11122   ASM_REAL_ARITH_TAC);;
11123
11124 let HOMOTOPIC_WITH_TRANS = prove
11125  (`!P X Y (f:real^M->real^N) g h.
11126       homotopic_with P (X,Y) f g /\ homotopic_with P (X,Y) g h
11127       ==> homotopic_with P (X,Y) f h`,
11128   REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with; PCROSS] THEN
11129   DISCH_THEN(CONJUNCTS_THEN2
11130    (X_CHOOSE_THEN `k1:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC)
11131    (X_CHOOSE_THEN `k2:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC)) THEN
11132   EXISTS_TAC `\y:real^(1,M)finite_sum.
11133         if drop(fstcart y) <= &1 / &2
11134         then (k1:real^(1,M)finite_sum->real^N)
11135              (pastecart (&2 % fstcart y) (sndcart y))
11136         else (k2:real^(1,M)finite_sum->real^N)
11137              (pastecart (&2 % fstcart y - vec 1) (sndcart y))` THEN
11138   REWRITE_TAC[FSTCART_PASTECART; DROP_VEC] THEN
11139   CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN
11140   ASM_REWRITE_TAC[VECTOR_ARITH `&2 % x - x:real^N = x`; SNDCART_PASTECART] THEN
11141   REPEAT CONJ_TAC THENL
11142    [SUBGOAL_THEN
11143      `interval[vec 0:real^1,vec 1] =
11144       interval[vec 0,lift(&1 / &2)] UNION interval[lift(&1 / &2),vec 1]`
11145     SUBST1_TAC THENL
11146      [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
11147       REAL_ARITH_TAC;
11148       ALL_TAC] THEN
11149     REWRITE_TAC[SET_RULE `{f x y | x IN s UNION t /\ y IN u} =
11150                           {f x y | x IN s /\ y IN u} UNION
11151                           {f x y | x IN t /\ y IN u}`] THEN
11152     MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
11153     ONCE_REWRITE_TAC[TAUT
11154      `a /\ b /\ c /\ d /\ e <=> (a /\ b) /\ (c /\ d) /\ e`] THEN
11155     CONJ_TAC THENL
11156      [REWRITE_TAC[CLOSED_IN_CLOSED] THEN CONJ_TAC THENL
11157        [EXISTS_TAC `{ pastecart (t:real^1) (x:real^M) |
11158                       t IN interval[vec 0,lift(&1 / &2)] /\ x IN UNIV }`;
11159         EXISTS_TAC `{ pastecart (t:real^1) (x:real^M) |
11160                       t IN interval[lift(&1 / &2),vec 1] /\ x IN UNIV}`] THEN
11161       SIMP_TAC[REWRITE_RULE[PCROSS] CLOSED_PCROSS;
11162                CLOSED_INTERVAL; CLOSED_UNIV] THEN
11163       MATCH_MP_TAC SUBSET_ANTISYM THEN
11164       REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_INTER; TAUT
11165        `(x IN (s UNION t) /\ x IN u ==> x IN v) <=>
11166         (x IN u ==> x IN (s UNION t) ==> x IN v)`] THEN
11167       REWRITE_TAC[PASTECART_EQ; IN_ELIM_THM; IN_UNION] THEN
11168       REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_UNIV] THEN
11169       MESON_TAC[];
11170       ALL_TAC] THEN
11171     CONJ_TAC THENL
11172      [CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
11173       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11174       (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5)
11175        [CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB;
11176         CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART;
11177         LINEAR_SNDCART] THEN
11178       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11179         CONTINUOUS_ON_SUBSET)) THEN
11180       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
11181       REWRITE_TAC[IN_ELIM_THM; PASTECART_EQ; FSTCART_PASTECART;
11182                   SNDCART_PASTECART] THEN
11183       REWRITE_TAC[MESON[] `(?t x. P t x /\ a = t /\ b = x) <=> P a b`] THEN
11184       SIMP_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; DROP_CMUL; LIFT_DROP] THEN
11185       REAL_ARITH_TAC;
11186       REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN
11187       REWRITE_TAC[FORALL_AND_THM; IMP_CONJ; FORALL_IN_GSPEC] THEN
11188       REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1] THEN
11189       SIMP_TAC[LIFT_DROP; DROP_VEC; REAL_ARITH
11190        `&1 / &2 <= t ==> (t <= &1 / &2 <=> t = &1 / &2)`] THEN
11191       SIMP_TAC[GSYM LIFT_EQ; LIFT_DROP; GSYM LIFT_CMUL; GSYM LIFT_NUM] THEN
11192       REWRITE_TAC[GSYM LIFT_SUB] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
11193       ASM_REWRITE_TAC[LIFT_NUM]];
11194     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
11195     REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
11196     REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
11197     REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
11198     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
11199      `IMAGE k s SUBSET t ==> x IN s ==> k x IN t`)) THEN
11200     ASM_REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_INTERVAL_1; DROP_VEC;
11201                     DROP_CMUL; DROP_SUB] THEN
11202     ASM_REAL_ARITH_TAC;
11203     X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
11204     STRIP_TAC THEN ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_SIMP_TAC[] THEN
11205     FIRST_X_ASSUM MATCH_MP_TAC THEN
11206     REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN
11207     ASM_REAL_ARITH_TAC]);;
11208
11209 let HOMOTOPIC_COMPOSE = prove
11210  (`!f f':real^M->real^N g g':real^N->real^P s t u.
11211         homotopic_with (\x. T) (s,t) f f' /\
11212         homotopic_with (\x. T) (t,u) g g'
11213         ==> homotopic_with (\x. T) (s,u) (g o f) (g' o f')`,
11214   REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_TRANS THEN
11215   EXISTS_TAC `(g:real^N->real^P) o (f':real^M->real^N)` THEN
11216   CONJ_TAC THENL
11217    [MATCH_MP_TAC HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT;
11218     MATCH_MP_TAC HOMOTOPIC_COMPOSE_CONTINUOUS_RIGHT] THEN
11219   EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
11220   REPEAT(FIRST_X_ASSUM(fun th ->
11221     ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS th) THEN
11222     ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET th))) THEN
11223   ASM_REWRITE_TAC[]);;
11224
11225 (* ------------------------------------------------------------------------- *)
11226 (* Two characterizations of homotopic triviality, one of which               *)
11227 (* implicitly incorporates path-connectedness.                               *)
11228 (* ------------------------------------------------------------------------- *)
11229
11230 let HOMOTOPIC_TRIVIALITY = prove
11231  (`!s:real^M->bool t:real^N->bool.
11232         (!f g. f continuous_on s /\ IMAGE f s SUBSET t /\
11233                g continuous_on s /\ IMAGE g s SUBSET t
11234                ==> homotopic_with (\x. T) (s,t) f g) <=>
11235         (s = {} \/ path_connected t) /\
11236         (!f. f continuous_on s /\ IMAGE f s SUBSET t
11237              ==> ?c. homotopic_with (\x. T) (s,t) f (\x. c))`,
11238   REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL
11239    [ASM_SIMP_TAC[CONTINUOUS_ON_EMPTY; HOMOTOPIC_WITH; NOT_IN_EMPTY;
11240                  PCROSS_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET];
11241     ASM_CASES_TAC `t:real^N->bool = {}` THEN
11242     ASM_REWRITE_TAC[SUBSET_EMPTY; IMAGE_EQ_EMPTY; PATH_CONNECTED_EMPTY]] THEN
11243   EQ_TAC THEN REPEAT STRIP_TAC THENL
11244    [REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
11245     REPEAT STRIP_TAC THEN
11246     W(MP_TAC o PART_MATCH (rand o rand) HOMOTOPIC_CONSTANT_MAPS o snd) THEN
11247     ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
11248     FIRST_X_ASSUM MATCH_MP_TAC THEN
11249     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; CONTINUOUS_ON_CONST] THEN
11250     ASM SET_TAC[];
11251     SUBGOAL_THEN `?c:real^N. c IN t` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
11252     MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN
11253     FIRST_X_ASSUM MATCH_MP_TAC THEN
11254     ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; CONTINUOUS_ON_CONST];
11255     FIRST_X_ASSUM(fun th ->
11256       MP_TAC(ISPEC `g:real^M->real^N` th) THEN
11257       MP_TAC(ISPEC `f:real^M->real^N` th)) THEN
11258     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
11259     X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN
11260     X_GEN_TAC `d:real^N` THEN DISCH_TAC THEN
11261     TRANS_TAC HOMOTOPIC_WITH_TRANS `(\x. c):real^M->real^N` THEN
11262     ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN
11263     TRANS_TAC HOMOTOPIC_WITH_TRANS `(\x. d):real^M->real^N` THEN
11264     ASM_REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN
11265     FIRST_X_ASSUM(MATCH_MP_TAC o
11266       REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]) THEN
11267     REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET)) THEN
11268     ASM SET_TAC[]]);;
11269
11270 (* ------------------------------------------------------------------------- *)
11271 (* Homotopy on a union of closed-open sets.                                  *)
11272 (* ------------------------------------------------------------------------- *)
11273
11274 let HOMOTOPIC_ON_CLOPEN_UNIONS = prove
11275  (`!f:real^M->real^N g t u.
11276         (!s. s IN u
11277              ==> closed_in (subtopology euclidean (UNIONS u)) s /\
11278                  open_in (subtopology euclidean (UNIONS u)) s /\
11279                  homotopic_with (\x. T) (s,t) f g)
11280         ==> homotopic_with (\x. T) (UNIONS u,t) f g`,
11281   REPEAT STRIP_TAC THEN
11282   SUBGOAL_THEN
11283    `?v. v SUBSET u /\ COUNTABLE v /\ UNIONS v :real^M->bool = UNIONS u`
11284   STRIP_ASSUME_TAC THENL
11285    [MATCH_MP_TAC LINDELOF_OPEN_IN THEN ASM_MESON_TAC[];
11286     FIRST_X_ASSUM(SUBST_ALL_TAC o SYM)] THEN
11287   ASM_CASES_TAC `v:(real^M->bool)->bool = {}` THEN
11288   ASM_REWRITE_TAC[HOMOTOPIC_ON_EMPTY; UNIONS_0] THEN
11289   MP_TAC(ISPEC `v:(real^M->bool)->bool` COUNTABLE_AS_IMAGE) THEN
11290   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
11291   X_GEN_TAC `f:num->real^M->bool` THEN DISCH_THEN SUBST_ALL_TAC THEN
11292   FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `(f:num->real^M->bool) n`) THEN
11293   DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN
11294   ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[FORALL_AND_THM]] THEN
11295   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
11296   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [homotopic_with] THEN
11297   SIMP_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; HOMOTOPIC_WITH] THEN
11298   X_GEN_TAC `h:num->real^(1,M)finite_sum->real^N` THEN
11299   REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN
11300   MP_TAC(ISPECL
11301    [`h:num->real^(1,M)finite_sum->real^N`;
11302     `(\n. interval[vec 0,vec 1] PCROSS (f n DIFF UNIONS {f m | m < n}))
11303      :num->real^(1,M)finite_sum->bool`;
11304     `(interval[vec 0,vec 1] PCROSS UNIONS(IMAGE f (:num)))
11305      :real^(1,M)finite_sum->bool`;
11306     `(:num)`] PASTING_LEMMA_EXISTS) THEN
11307   REWRITE_TAC[IN_UNIV; FORALL_AND_THM; INTER_PCROSS] THEN ANTS_TAC THENL
11308    [REPEAT CONJ_TAC THENL
11309      [REWRITE_TAC[UNIONS_GSPEC; SUBSET; IN_ELIM_THM; FORALL_PASTECART] THEN
11310       REWRITE_TAC[PASTECART_IN_PCROSS; IMP_CONJ; RIGHT_FORALL_IMP_THM;
11311                   FORALL_IN_UNIONS; FORALL_IN_IMAGE; IN_UNIV; IMP_CONJ] THEN
11312       X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
11313       ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN X_GEN_TAC `y:real^M` THEN
11314       REWRITE_TAC[LEFT_FORALL_IMP_THM; IN_DIFF; IN_ELIM_THM] THEN
11315       GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN MESON_TAC[];
11316       X_GEN_TAC `n:num` THEN MATCH_MP_TAC OPEN_IN_PCROSS THEN
11317       REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN
11318       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IN_UNIONS THEN
11319       ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
11320       SIMP_TAC[FINITE_NUMSEG_LT; FINITE_IMAGE] THEN ASM SET_TAC[];
11321       X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(fun th ->
11322         MATCH_MP_TAC(MATCH_MP(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)
11323         (SPEC `n:num` th))) THEN
11324       REWRITE_TAC[SUBSET_PCROSS; SUBSET_REFL; SUBSET_DIFF];
11325       MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL
11326        [REWRITE_TAC[INTER_ACI] THEN MESON_TAC[];
11327         REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN SET_TAC[]]];
11328     MATCH_MP_TAC MONO_EXISTS THEN
11329     X_GEN_TAC `g:real^(1,M)finite_sum->real^N` THEN
11330     REWRITE_TAC[INTER_ACI; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
11331     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
11332     REWRITE_TAC[FORALL_IN_UNIONS; FORALL_IN_IMAGE; IMP_CONJ; SUBSET;
11333                 RIGHT_FORALL_IMP_THM; IN_UNIV; FORALL_IN_PCROSS] THEN
11334     CONJ_TAC THENL
11335      [X_GEN_TAC `t:real^1` THEN DISCH_TAC; CONJ_TAC] THEN
11336     ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN X_GEN_TAC `y:real^M` THEN
11337     REWRITE_TAC[LEFT_FORALL_IMP_THM] THEN
11338     GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN
11339     DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THENL
11340      [FIRST_X_ASSUM(MP_TAC o SPECL [`t:real^1`; `y:real^M`; `n:num`]);
11341       FIRST_X_ASSUM(MP_TAC o SPECL [`vec 0:real^1`; `y:real^M`; `n:num`]);
11342       FIRST_X_ASSUM(MP_TAC o SPECL [`vec 1:real^1`; `y:real^M`; `n:num`])] THEN
11343     ASM_REWRITE_TAC[IN_INTER; UNIONS_IMAGE; IN_UNIV; IN_DIFF;
11344                     UNIONS_GSPEC; IN_ELIM_THM; ENDS_IN_UNIT_INTERVAL] THEN
11345     (ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC]) THEN
11346     REWRITE_TAC[] THEN
11347     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [SUBSET]) THEN
11348     REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN ASM SET_TAC[]]);;
11349
11350 let INESSENTIAL_ON_CLOPEN_UNIONS = prove
11351  (`!f:real^M->real^N t u.
11352         path_connected t /\
11353         (!s. s IN u
11354              ==> closed_in (subtopology euclidean (UNIONS u)) s /\
11355                  open_in (subtopology euclidean (UNIONS u)) s /\
11356                  ?a. homotopic_with (\x. T) (s,t) f (\x. a))
11357         ==> ?a. homotopic_with (\x. T) (UNIONS u,t) f (\x. a)`,
11358   REPEAT GEN_TAC THEN ASM_CASES_TAC `UNIONS u:real^M->bool = {}` THEN
11359   ASM_REWRITE_TAC[UNIONS_0; HOMOTOPIC_ON_EMPTY] THEN STRIP_TAC THEN
11360   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [EMPTY_UNIONS]) THEN
11361   REWRITE_TAC[NOT_FORALL_THM; LEFT_IMP_EXISTS_THM; NOT_IMP] THEN
11362   X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
11363   FIRST_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN
11364   ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN
11365   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
11366   DISCH_THEN(X_CHOOSE_THEN `a:real^N` MP_TAC) THEN
11367   DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
11368   STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
11369    `IMAGE (\x. a) s SUBSET t ==> ~(s = {}) ==> a IN t`)) THEN
11370   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN EXISTS_TAC `a:real^N` THEN
11371   MATCH_MP_TAC HOMOTOPIC_ON_CLOPEN_UNIONS THEN
11372   X_GEN_TAC `s:real^M->bool` THEN STRIP_TAC THEN
11373   FIRST_X_ASSUM(MP_TAC o SPEC `s:real^M->bool`) THEN
11374   ASM_REWRITE_TAC[] THEN
11375   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
11376   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
11377   ASM_CASES_TAC `s:real^M->bool = {}` THEN
11378   ASM_REWRITE_TAC[HOMOTOPIC_ON_EMPTY] THEN X_GEN_TAC `b:real^N` THEN
11379   DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
11380   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN
11381   REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN DISJ2_TAC THEN
11382   FIRST_X_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
11383   FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
11384    `IMAGE (\x. a) s SUBSET t ==> ~(s = {}) ==> a IN t`)) THEN
11385   ASM_MESON_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT]);;
11386
11387 (* ------------------------------------------------------------------------- *)
11388 (* Homotopy of paths, maintaining the same endpoints.                        *)
11389 (* ------------------------------------------------------------------------- *)
11390
11391 let homotopic_paths = new_definition
11392  `homotopic_paths s p q =
11393      homotopic_with
11394        (\r. pathstart r = pathstart p /\ pathfinish r = pathfinish p)
11395        (interval[vec 0:real^1,vec 1],s)
11396        p q`;;
11397
11398 let HOMOTOPIC_PATHS = prove
11399  (`!s p q:real^1->real^N.
11400       homotopic_paths s p q <=>
11401       ?h. h continuous_on
11402           interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1] /\
11403           IMAGE h (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1])
11404           SUBSET s /\
11405           (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 0) x) = p x) /\
11406           (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 1) x) = q x) /\
11407           (!t. t IN interval[vec 0:real^1,vec 1]
11408                ==> pathstart(h o pastecart t) = pathstart p /\
11409                    pathfinish(h o pastecart t) = pathfinish p)`,
11410   REPEAT GEN_TAC THEN
11411   REWRITE_TAC[homotopic_paths] THEN
11412   W(MP_TAC o PART_MATCH (lhand o rand) HOMOTOPIC_WITH o lhand o snd) THEN
11413   ANTS_TAC THENL
11414    [SIMP_TAC[pathstart; pathfinish; ENDS_IN_UNIT_INTERVAL];
11415     DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF]]);;
11416
11417 let HOMOTOPIC_PATHS_IMP_PATHSTART = prove
11418  (`!s p q. homotopic_paths s p q ==> pathstart p = pathstart q`,
11419   REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN
11420   DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN
11421   SIMP_TAC[]);;
11422
11423 let HOMOTOPIC_PATHS_IMP_PATHFINISH = prove
11424  (`!s p q. homotopic_paths s p q ==> pathfinish p = pathfinish q`,
11425   REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN
11426   DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN
11427   SIMP_TAC[]);;
11428
11429 let HOMOTOPIC_PATHS_IMP_PATH = prove
11430  (`!s p q. homotopic_paths s p q ==> path p /\ path q`,
11431   REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN
11432   DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN
11433   SIMP_TAC[path]);;
11434
11435 let HOMOTOPIC_PATHS_IMP_SUBSET = prove
11436  (`!s p q.
11437      homotopic_paths s p q ==> path_image p SUBSET s /\ path_image q SUBSET s`,
11438   REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN
11439   DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
11440   SIMP_TAC[path_image]);;
11441
11442 let HOMOTOPIC_PATHS_REFL = prove
11443  (`!s p. homotopic_paths s p p <=>
11444            path p /\ path_image p SUBSET s`,
11445   REWRITE_TAC[homotopic_paths; HOMOTOPIC_WITH_REFL; path; path_image]);;
11446
11447 let HOMOTOPIC_PATHS_SYM = prove
11448  (`!s p q. homotopic_paths s p q <=> homotopic_paths s q p`,
11449   REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN
11450   FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN
11451   FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN
11452   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_paths]) THEN
11453   ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN ASM_SIMP_TAC[homotopic_paths]);;
11454
11455 let HOMOTOPIC_PATHS_TRANS = prove
11456  (`!s p q r.
11457         homotopic_paths s p q /\ homotopic_paths s q r
11458         ==> homotopic_paths s p r`,
11459   REPEAT GEN_TAC THEN DISCH_TAC THEN
11460   FIRST_ASSUM(CONJUNCTS_THEN
11461    (fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART th) THEN
11462               ASSUME_TAC(MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH th))) THEN
11463   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE BINOP_CONV [homotopic_paths]) THEN
11464   ASM_REWRITE_TAC[HOMOTOPIC_WITH_TRANS; homotopic_paths]);;
11465
11466 let HOMOTOPIC_PATHS_EQ = prove
11467  (`!p:real^1->real^N q s.
11468         path p /\ path_image p SUBSET s /\
11469         (!t. t IN interval[vec 0,vec 1] ==> p(t) = q(t))
11470         ==> homotopic_paths s p q`,
11471   REPEAT STRIP_TAC THEN REWRITE_TAC[homotopic_paths] THEN
11472   MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN
11473   REPEAT(EXISTS_TAC `p:real^1->real^N`) THEN
11474   ASM_SIMP_TAC[HOMOTOPIC_WITH_REFL] THEN
11475   ASM_REWRITE_TAC[GSYM path; GSYM path_image] THEN
11476   REWRITE_TAC[pathstart; pathfinish] THEN
11477   MESON_TAC[ENDS_IN_UNIT_INTERVAL]);;
11478
11479 let HOMOTOPIC_PATHS_REPARAMETRIZE = prove
11480  (`!p:real^1->real^N q f:real^1->real^1.
11481         path p /\ path_image p SUBSET s /\
11482         (?f. f continuous_on interval[vec 0,vec 1] /\
11483              IMAGE f (interval[vec 0,vec 1]) SUBSET interval[vec 0,vec 1] /\
11484              f(vec 0) = vec 0 /\ f(vec 1) = vec 1 /\
11485              !t. t IN interval[vec 0,vec 1] ==> q(t) = p(f t))
11486         ==> homotopic_paths s p q`,
11487   REWRITE_TAC[path; path_image] THEN REPEAT STRIP_TAC THEN
11488   ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
11489   MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
11490   EXISTS_TAC `(p:real^1->real^N) o (f:real^1->real^1)` THEN CONJ_TAC THENL
11491    [MATCH_MP_TAC HOMOTOPIC_PATHS_EQ THEN
11492     ASM_SIMP_TAC[o_THM; pathstart; pathfinish; o_THM;
11493                  IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN
11494     REWRITE_TAC[path; path_image] THEN CONJ_TAC THENL
11495      [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
11496       EXISTS_TAC `(p:real^1->real^N) o (f:real^1->real^1)` THEN
11497       ASM_SIMP_TAC[o_THM] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11498       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
11499       ASM SET_TAC[]];
11500     REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS] THEN
11501     EXISTS_TAC `(p:real^1->real^N) o
11502                 (\y. (&1 - drop(fstcart y)) % f(sndcart y) +
11503                      drop(fstcart y) % sndcart y)` THEN
11504     ASM_REWRITE_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC;
11505                     pathstart; pathfinish] THEN
11506     CONV_TAC REAL_RAT_REDUCE_CONV THEN
11507     REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_RZERO; VECTOR_ADD_LID;
11508                 VECTOR_MUL_LID; VECTOR_ADD_RID] THEN
11509     REWRITE_TAC[VECTOR_ARITH `(&1 - u) % x + u % x:real^N = x`] THEN
11510     CONJ_TAC THENL
11511      [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
11512        [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
11513         MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
11514         REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX; LIFT_SUB] THEN
11515         SIMP_TAC[LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_CONST; LINEAR_FSTCART;
11516                  LINEAR_SNDCART; CONTINUOUS_ON_SUB] THEN
11517         MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN
11518         SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
11519         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11520           CONTINUOUS_ON_SUBSET)) THEN
11521         SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; SNDCART_PASTECART];
11522         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11523           CONTINUOUS_ON_SUBSET))];
11524       ONCE_REWRITE_TAC[IMAGE_o] THEN
11525       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
11526        `IMAGE p i SUBSET s
11527         ==> IMAGE f x SUBSET i
11528             ==> IMAGE p (IMAGE f x) SUBSET s`))] THEN
11529     SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; SNDCART_PASTECART;
11530              FSTCART_PASTECART] THEN
11531     REPEAT STRIP_TAC THEN
11532     MATCH_MP_TAC(REWRITE_RULE[CONVEX_ALT] (CONJUNCT1(SPEC_ALL
11533       CONVEX_INTERVAL))) THEN
11534     ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC; SUBSET; IN_IMAGE]]);;
11535
11536 let HOMOTOPIC_PATHS_SUBSET = prove
11537  (`!s p q.
11538         homotopic_paths s p q /\ s SUBSET t
11539         ==> homotopic_paths t p q`,
11540   REWRITE_TAC[homotopic_paths; HOMOTOPIC_WITH_SUBSET_RIGHT]);;
11541
11542 (* ------------------------------------------------------------------------- *)
11543 (* A slightly ad-hoc but useful lemma in constructing homotopies.            *)
11544 (* ------------------------------------------------------------------------- *)
11545
11546 let HOMOTOPIC_JOIN_LEMMA = prove
11547  (`!p q:real^1->real^1->real^N.
11548   (\y. p (fstcart y) (sndcart y)) continuous_on
11549   (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1]) /\
11550   (\y. q (fstcart y) (sndcart y)) continuous_on
11551   (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1]) /\
11552   (!t. t IN interval[vec 0,vec 1] ==> pathfinish(p t) = pathstart(q t))
11553   ==> (\y. (p(fstcart y) ++ q(fstcart y)) (sndcart y)) continuous_on
11554       (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1])`,
11555   REWRITE_TAC[joinpaths; PCROSS] THEN REPEAT STRIP_TAC THEN
11556   MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN REPEAT CONJ_TAC THENL
11557    [SUBGOAL_THEN
11558     `(\y. p (fstcart y) (&2 % sndcart y)):real^(1,1)finite_sum->real^N =
11559      (\y. p (fstcart y) (sndcart y)) o
11560      (\y. pastecart (fstcart y) (&2 % sndcart y))`
11561     SUBST1_TAC THENL
11562      [REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]; ALL_TAC];
11563     SUBGOAL_THEN
11564     `(\y. q (fstcart y) (&2 % sndcart y - vec 1)):real^(1,1)finite_sum->real^N =
11565      (\y. q (fstcart y) (sndcart y)) o
11566      (\y. pastecart (fstcart y) (&2 % sndcart y - vec 1))`
11567     SUBST1_TAC THENL
11568      [REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]; ALL_TAC];
11569     SIMP_TAC[o_DEF; LIFT_DROP; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; ETA_AX];
11570     SIMP_TAC[IMP_CONJ; FORALL_IN_GSPEC; FSTCART_PASTECART; SNDCART_PASTECART;
11571              GSYM LIFT_EQ; LIFT_DROP; GSYM LIFT_CMUL] THEN
11572     CONV_TAC REAL_RAT_REDUCE_CONV THEN
11573     RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
11574     ASM_SIMP_TAC[LIFT_NUM; VECTOR_SUB_REFL]] THEN
11575   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11576   (CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_PASTECART; ALL_TAC]) THEN
11577   SIMP_TAC[CONTINUOUS_ON_CMUL; LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_SUB;
11578            CONTINUOUS_ON_CONST; LINEAR_FSTCART; LINEAR_SNDCART] THEN
11579   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11580     CONTINUOUS_ON_SUBSET)) THEN
11581   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; IMP_CONJ] THEN
11582   SIMP_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
11583   REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_SUB; DROP_VEC] THEN
11584   REAL_ARITH_TAC);;
11585
11586 (* ------------------------------------------------------------------------- *)
11587 (* Congruence properties of homotopy w.r.t. path-combining operations.       *)
11588 (* ------------------------------------------------------------------------- *)
11589
11590 let HOMOTOPIC_PATHS_REVERSEPATH = prove
11591  (`!s p q:real^1->real^N.
11592      homotopic_paths s (reversepath p) (reversepath q) <=>
11593      homotopic_paths s p q`,
11594   GEN_TAC THEN MATCH_MP_TAC(MESON[]
11595    `(!p. f(f p) = p) /\
11596     (!a b. homotopic_paths s a b ==> homotopic_paths s (f a) (f b))
11597     ==> !a b. homotopic_paths s (f a) (f b) <=>
11598               homotopic_paths s a b`) THEN
11599   REWRITE_TAC[REVERSEPATH_REVERSEPATH] THEN REPEAT GEN_TAC THEN
11600   REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS; o_DEF] THEN DISCH_THEN
11601    (X_CHOOSE_THEN `h:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC) THEN
11602   EXISTS_TAC `\y:real^(1,1)finite_sum.
11603                  (h:real^(1,1)finite_sum->real^N)
11604                  (pastecart(fstcart y) (vec 1 - sndcart y))` THEN
11605   ASM_REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART] THEN
11606   RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
11607   ASM_SIMP_TAC[reversepath; pathstart; pathfinish; VECTOR_SUB_REFL;
11608                VECTOR_SUB_RZERO] THEN
11609   CONJ_TAC THENL
11610    [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
11611     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
11612      [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
11613       SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
11614                CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST];
11615       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11616         CONTINUOUS_ON_SUBSET)) THEN
11617       SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC;
11618         IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
11619       REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC];
11620      GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
11621      REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
11622      `IMAGE h s SUBSET t ==> IMAGE g s SUBSET s
11623       ==> IMAGE h (IMAGE g s) SUBSET t`)) THEN
11624      SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC;
11625         IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
11626      REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC]);;
11627
11628 let HOMOTOPIC_PATHS_JOIN = prove
11629  (`!s p q p' q':real^1->real^N.
11630      homotopic_paths s p p' /\ homotopic_paths s q q' /\
11631      pathfinish p = pathstart q
11632      ==> homotopic_paths s (p ++ q) (p' ++ q')`,
11633   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN
11634   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
11635   REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS] THEN
11636   DISCH_THEN(CONJUNCTS_THEN2
11637    (X_CHOOSE_THEN `k1:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC)
11638    (X_CHOOSE_THEN `k2:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC)) THEN
11639   EXISTS_TAC `(\y. ((k1 o pastecart (fstcart y)) ++
11640                     (k2 o pastecart (fstcart y))) (sndcart y))
11641               :real^(1,1)finite_sum->real^N` THEN
11642   REPEAT CONJ_TAC THENL
11643    [MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN
11644     ASM_REWRITE_TAC[o_DEF; PASTECART_FST_SND; ETA_AX] THEN
11645     RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
11646     ASM_REWRITE_TAC[pathstart; pathfinish] THEN ASM_MESON_TAC[];
11647     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
11648     REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
11649     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
11650     REWRITE_TAC[ETA_AX; GSYM path_image; SET_RULE
11651       `(!x. x IN i ==> f x IN s) <=> IMAGE f i SUBSET s`] THEN
11652     REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN
11653     REWRITE_TAC[path_image; SUBSET; FORALL_IN_IMAGE; o_DEF] THEN ASM SET_TAC[];
11654     ALL_TAC; ALL_TAC; ALL_TAC] THEN
11655   REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
11656   ASM_REWRITE_TAC[joinpaths; o_DEF] THEN
11657   RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
11658   REWRITE_TAC[pathstart; pathfinish; DROP_VEC] THEN
11659   CONV_TAC REAL_RAT_REDUCE_CONV THEN
11660   ASM_SIMP_TAC[VECTOR_ARITH `&2 % x - x:real^N = x`; VECTOR_MUL_RZERO]);;
11661
11662 let HOMOTOPIC_PATHS_CONTINUOUS_IMAGE = prove
11663  (`!f:real^1->real^M g h:real^M->real^N s t.
11664         homotopic_paths s f g /\
11665         h continuous_on s /\ IMAGE h s SUBSET t
11666         ==> homotopic_paths t (h o f) (h o g)`,
11667   REWRITE_TAC[homotopic_paths] THEN REPEAT STRIP_TAC THEN
11668   MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
11669   EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
11670   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11671         HOMOTOPIC_WITH_MONO)) THEN
11672   SIMP_TAC[pathstart; pathfinish; o_THM]);;
11673
11674 (* ------------------------------------------------------------------------- *)
11675 (* Group properties for homotopy of paths (so taking equivalence classes     *)
11676 (* under homotopy would give the fundamental group).                         *)
11677 (* ------------------------------------------------------------------------- *)
11678
11679 let HOMOTOPIC_PATHS_RID = prove
11680  (`!s p. path p /\ path_image p SUBSET s
11681          ==> homotopic_paths s (p ++ linepath(pathfinish p,pathfinish p)) p`,
11682   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
11683   MATCH_MP_TAC HOMOTOPIC_PATHS_REPARAMETRIZE THEN
11684   ASM_REWRITE_TAC[joinpaths] THEN
11685   EXISTS_TAC `\t. if drop t <= &1 / &2 then &2 % t else vec 1` THEN
11686   ASM_REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
11687   REWRITE_TAC[VECTOR_MUL_RZERO; linepath; pathfinish;
11688               VECTOR_ARITH `(&1 - t) % x + t % x:real^N = x`] THEN
11689   REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
11690   CONJ_TAC THENL
11691    [SUBGOAL_THEN
11692      `interval[vec 0:real^1,vec 1] =
11693       interval[vec 0,lift(&1 / &2)] UNION interval[lift(&1 / &2),vec 1]`
11694     SUBST1_TAC THENL
11695      [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
11696       REAL_ARITH_TAC;
11697       MATCH_MP_TAC CONTINUOUS_ON_CASES THEN
11698       SIMP_TAC[CLOSED_INTERVAL; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID;
11699                CONTINUOUS_ON_CONST; IN_INTERVAL_1; DROP_VEC; LIFT_DROP;
11700                GSYM DROP_EQ; DROP_CMUL] THEN
11701       REAL_ARITH_TAC];
11702     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_VEC] THEN
11703     GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[DROP_CMUL; DROP_VEC] THEN
11704     ASM_REAL_ARITH_TAC]);;
11705
11706 let HOMOTOPIC_PATHS_LID = prove
11707  (`!s p:real^1->real^N.
11708         path p /\ path_image p SUBSET s
11709         ==> homotopic_paths s (linepath(pathstart p,pathstart p) ++ p) p`,
11710   REPEAT STRIP_TAC THEN
11711   ONCE_REWRITE_TAC[GSYM HOMOTOPIC_PATHS_REVERSEPATH] THEN
11712   REWRITE_TAC[o_DEF; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH] THEN
11713   SIMP_TAC[REVERSEPATH_JOINPATHS; REVERSEPATH_LINEPATH;
11714            PATHFINISH_LINEPATH] THEN
11715   ONCE_REWRITE_TAC[CONJ_SYM] THEN
11716   MP_TAC(ISPECL [`s:real^N->bool`; `reversepath p :real^1->real^N`]
11717     HOMOTOPIC_PATHS_RID) THEN
11718   ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH;
11719                PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH]);;
11720
11721 let HOMOTOPIC_PATHS_ASSOC = prove
11722  (`!s p q r:real^1->real^N.
11723         path p /\ path_image p SUBSET s /\
11724         path q /\ path_image q SUBSET s /\
11725         path r /\ path_image r SUBSET s /\
11726         pathfinish p = pathstart q /\ pathfinish q = pathstart r
11727         ==> homotopic_paths s (p ++ (q ++ r)) ((p ++ q) ++ r)`,
11728   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
11729   MATCH_MP_TAC HOMOTOPIC_PATHS_REPARAMETRIZE THEN
11730   ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET;
11731                PATHSTART_JOIN; PATHFINISH_JOIN] THEN
11732   REWRITE_TAC[joinpaths] THEN
11733   EXISTS_TAC `\t. if drop t <= &1 / &2 then inv(&2) % t
11734                   else if drop t <= &3 / &4 then t - lift(&1 / &4)
11735                   else &2 % t - vec 1` THEN
11736   REPEAT CONJ_TAC THENL
11737    [MATCH_MP_TAC CONTINUOUS_ON_CASES_1 THEN
11738     SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; LIFT_DROP] THEN
11739     REWRITE_TAC[GSYM LIFT_SUB; GSYM LIFT_CMUL] THEN
11740     CONV_TAC REAL_RAT_REDUCE_CONV THEN
11741     MATCH_MP_TAC CONTINUOUS_ON_CASES_1 THEN
11742     SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID;
11743              CONTINUOUS_ON_CONST] THEN
11744     REWRITE_TAC[GSYM LIFT_SUB; GSYM LIFT_CMUL; GSYM LIFT_NUM] THEN
11745     CONV_TAC REAL_RAT_REDUCE_CONV;
11746     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_VEC] THEN
11747     REPEAT STRIP_TAC THEN
11748     REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
11749     REWRITE_TAC[DROP_CMUL; DROP_VEC; LIFT_DROP; DROP_SUB] THEN
11750     ASM_REAL_ARITH_TAC;
11751     REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
11752     REWRITE_TAC[VECTOR_MUL_RZERO];
11753     REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
11754     VECTOR_ARITH_TAC;
11755     X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
11756     STRIP_TAC THEN
11757     ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_REWRITE_TAC[DROP_CMUL] THEN
11758     ASM_REWRITE_TAC[REAL_ARITH `inv(&2) * t <= &1 / &2 <=> t <= &1`] THEN
11759     REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_ASSOC] THEN
11760     CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[REAL_MUL_LID] THEN
11761     ASM_CASES_TAC `drop t <= &3 / &4` THEN
11762     ASM_REWRITE_TAC[DROP_SUB; DROP_VEC; DROP_CMUL; LIFT_DROP;
11763                     REAL_ARITH `&2 * (t - &1 / &4) <= &1 / &2 <=> t <= &1 / &2`;
11764                     REAL_ARITH `&2 * t - &1 <= &1 / &2 <=> t <= &3 / &4`;
11765                     REAL_ARITH `t - &1 / &4 <= &1 / &2 <=> t <= &3 / &4`] THEN
11766     REWRITE_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC; GSYM LIFT_CMUL] THEN
11767     CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM] THEN
11768     REWRITE_TAC[VECTOR_ARITH `a - b - b:real^N = a - &2 % b`]]);;
11769
11770 let HOMOTOPIC_PATHS_RINV = prove
11771  (`!s p:real^1->real^N.
11772         path p /\ path_image p SUBSET s
11773         ==> homotopic_paths s
11774               (p ++ reversepath p) (linepath(pathstart p,pathstart p))`,
11775   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
11776   REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS] THEN
11777   EXISTS_TAC `(\y. (subpath (vec 0) (fstcart y) p ++
11778                     reversepath(subpath (vec 0) (fstcart y) p)) (sndcart y))
11779               : real^(1,1)finite_sum->real^N` THEN
11780   REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SUBPATH_TRIVIAL] THEN
11781   REWRITE_TAC[ETA_AX; PATHSTART_JOIN; PATHFINISH_JOIN] THEN
11782   REWRITE_TAC[REVERSEPATH_SUBPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
11783   REPEAT CONJ_TAC THENL
11784    [REWRITE_TAC[joinpaths] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN
11785     RULE_ASSUM_TAC(REWRITE_RULE[path; path_image]) THEN REPEAT CONJ_TAC THENL
11786      [REWRITE_TAC[subpath; VECTOR_ADD_LID; VECTOR_SUB_RZERO] THEN
11787       GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
11788       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
11789        [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
11790         REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN
11791         SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
11792                  CONTINUOUS_ON_CMUL];
11793         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11794           CONTINUOUS_ON_SUBSET)) THEN
11795         REWRITE_TAC[FORALL_IN_IMAGE; SUBSET; FORALL_IN_GSPEC; IMP_CONJ] THEN
11796         REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
11797         REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC] THEN
11798         REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS] THEN
11799         MATCH_MP_TAC REAL_LE_TRANS THEN
11800         EXISTS_TAC `drop x * &2 * &1 / &2` THEN CONJ_TAC THEN
11801         REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC) THEN
11802         ASM_REAL_ARITH_TAC];
11803       REWRITE_TAC[subpath; VECTOR_ADD_LID; VECTOR_SUB_RZERO] THEN
11804       GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
11805       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
11806        [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
11807         SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
11808         MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
11809         REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN
11810         SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
11811                  CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST];
11812         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11813           CONTINUOUS_ON_SUBSET)) THEN
11814         REWRITE_TAC[FORALL_IN_IMAGE; SUBSET; FORALL_IN_GSPEC; IMP_CONJ] THEN
11815         REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
11816         REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_CMUL; DROP_VEC; DROP_ADD;
11817          REAL_ARITH `t + (&0 - t) * (&2 * x - &1) =
11818                      t * &2 * (&1 - x)`] THEN
11819         REPEAT STRIP_TAC THEN
11820         ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_SUB_LE] THEN
11821         MATCH_MP_TAC REAL_LE_TRANS THEN
11822         EXISTS_TAC `drop x * &2 * &1 / &2` THEN CONJ_TAC THEN
11823         REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC) THEN
11824         ASM_REAL_ARITH_TAC];
11825       SIMP_TAC[o_DEF; LIFT_DROP; ETA_AX; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART];
11826       REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN
11827       REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[subpath] THEN AP_TERM_TAC THEN
11828       REWRITE_TAC[GSYM DROP_EQ; DROP_SUB; DROP_VEC; DROP_ADD; DROP_CMUL;
11829                   LIFT_DROP] THEN
11830       REAL_ARITH_TAC];
11831     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
11832     REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN
11833     X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
11834     REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; ETA_AX;
11835       SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN
11836     REWRITE_TAC[GSYM path_image] THEN MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN
11837     REWRITE_TAC[PATH_IMAGE_SUBPATH_GEN] THEN
11838     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [path_image]) THEN
11839     MATCH_MP_TAC(SET_RULE
11840       `t SUBSET s /\ u SUBSET s
11841        ==> IMAGE p s SUBSET v
11842            ==> IMAGE p t SUBSET v /\ IMAGE p u SUBSET v`) THEN
11843     REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN CONJ_TAC THEN
11844     MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_INTERVAL] THEN
11845     ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN
11846     REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL];
11847     REWRITE_TAC[subpath; linepath; pathstart; joinpaths] THEN
11848     REWRITE_TAC[VECTOR_SUB_REFL; DROP_VEC; VECTOR_MUL_LZERO] THEN
11849     REWRITE_TAC[VECTOR_ADD_RID; COND_ID] THEN VECTOR_ARITH_TAC;
11850     REWRITE_TAC[pathstart; PATHFINISH_LINEPATH; PATHSTART_LINEPATH]]);;
11851
11852 let HOMOTOPIC_PATHS_LINV = prove
11853  (`!s p:real^1->real^N.
11854         path p /\ path_image p SUBSET s
11855         ==> homotopic_paths s
11856               (reversepath p ++ p) (linepath(pathfinish p,pathfinish p))`,
11857   REPEAT STRIP_TAC THEN
11858   MP_TAC(ISPECL [`s:real^N->bool`; `reversepath p:real^1->real^N`]
11859         HOMOTOPIC_PATHS_RINV) THEN
11860   ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH] THEN
11861   REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH;
11862               REVERSEPATH_REVERSEPATH]);;
11863
11864 (* ------------------------------------------------------------------------- *)
11865 (* Homotopy of loops without requiring preservation of endpoints.            *)
11866 (* ------------------------------------------------------------------------- *)
11867
11868 let homotopic_loops = new_definition
11869  `homotopic_loops s p q =
11870      homotopic_with
11871        (\r. pathfinish r = pathstart r)
11872        (interval[vec 0:real^1,vec 1],s)
11873        p q`;;
11874
11875 let HOMOTOPIC_LOOPS = prove
11876  (`!s p q:real^1->real^N.
11877       homotopic_loops s p q <=>
11878       ?h. h continuous_on
11879           interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1] /\
11880           IMAGE h (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1])
11881           SUBSET s /\
11882           (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 0) x) = p x) /\
11883           (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 1) x) = q x) /\
11884           (!t. t IN interval[vec 0:real^1,vec 1]
11885                ==> pathfinish(h o pastecart t) = pathstart(h o pastecart t))`,
11886   REPEAT GEN_TAC THEN
11887   REWRITE_TAC[homotopic_loops] THEN
11888   W(MP_TAC o PART_MATCH (lhand o rand) HOMOTOPIC_WITH o lhand o snd) THEN
11889   ANTS_TAC THENL
11890    [SIMP_TAC[pathstart; pathfinish; ENDS_IN_UNIT_INTERVAL];
11891     DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF]]);;
11892
11893 let HOMOTOPIC_LOOPS_IMP_LOOP = prove
11894  (`!s p q. homotopic_loops s p q
11895            ==> pathfinish p = pathstart p /\
11896                pathfinish q = pathstart q`,
11897   REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops] THEN
11898   DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN
11899   SIMP_TAC[]);;
11900
11901 let HOMOTOPIC_LOOPS_IMP_PATH = prove
11902  (`!s p q. homotopic_loops s p q ==> path p /\ path q`,
11903   REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops] THEN
11904   DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN
11905   SIMP_TAC[path]);;
11906
11907 let HOMOTOPIC_LOOPS_IMP_SUBSET = prove
11908  (`!s p q.
11909      homotopic_loops s p q ==> path_image p SUBSET s /\ path_image q SUBSET s`,
11910   REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops] THEN
11911   DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
11912   SIMP_TAC[path_image]);;
11913
11914 let HOMOTOPIC_LOOPS_REFL = prove
11915  (`!s p. homotopic_loops s p p <=>
11916            path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p`,
11917   REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_REFL; path; path_image]);;
11918
11919 let HOMOTOPIC_LOOPS_SYM = prove
11920  (`!s p q. homotopic_loops s p q <=> homotopic_loops s q p`,
11921   REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_SYM]);;
11922
11923 let HOMOTOPIC_LOOPS_TRANS = prove
11924  (`!s p q r.
11925         homotopic_loops s p q /\ homotopic_loops s q r
11926         ==> homotopic_loops s p r`,
11927   REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_TRANS]);;
11928
11929 let HOMOTOPIC_LOOPS_SUBSET = prove
11930  (`!s p q.
11931         homotopic_loops s p q /\ s SUBSET t
11932         ==> homotopic_loops t p q`,
11933   REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_SUBSET_RIGHT]);;
11934
11935 let HOMOTOPIC_LOOPS_EQ = prove
11936  (`!p:real^1->real^N q s.
11937         path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p /\
11938         (!t. t IN interval[vec 0,vec 1] ==> p(t) = q(t))
11939         ==> homotopic_loops s p q`,
11940   REPEAT STRIP_TAC THEN REWRITE_TAC[homotopic_loops] THEN
11941   MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN
11942   REPEAT(EXISTS_TAC `p:real^1->real^N`) THEN
11943   ASM_SIMP_TAC[HOMOTOPIC_WITH_REFL] THEN
11944   ASM_REWRITE_TAC[GSYM path; GSYM path_image] THEN
11945   REWRITE_TAC[pathstart; pathfinish] THEN
11946   MESON_TAC[ENDS_IN_UNIT_INTERVAL]);;
11947
11948 let HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE = prove
11949  (`!f:real^1->real^M g h:real^M->real^N s t.
11950         homotopic_loops s f g /\
11951         h continuous_on s /\ IMAGE h s SUBSET t
11952         ==> homotopic_loops t (h o f) (h o g)`,
11953   REWRITE_TAC[homotopic_loops] THEN REPEAT STRIP_TAC THEN
11954   MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
11955   EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
11956   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11957         HOMOTOPIC_WITH_MONO)) THEN
11958   SIMP_TAC[pathstart; pathfinish; o_THM]);;
11959
11960 let HOMOTOPIC_LOOPS_SHIFTPATH_SELF = prove
11961  (`!p:real^1->real^N t s.
11962         path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p /\
11963         t IN interval[vec 0,vec 1]
11964         ==> homotopic_loops s p (shiftpath t p)`,
11965   REPEAT STRIP_TAC THEN REWRITE_TAC[HOMOTOPIC_LOOPS] THEN EXISTS_TAC
11966    `\z. shiftpath (drop t % fstcart z) (p:real^1->real^N) (sndcart z)` THEN
11967   REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; o_DEF] THEN
11968   REWRITE_TAC[GSYM LIFT_EQ_CMUL; VECTOR_MUL_RZERO; ETA_AX] THEN
11969   REPEAT CONJ_TAC THENL
11970    [ALL_TAC;
11971     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
11972     REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
11973     MATCH_MP_TAC(SET_RULE
11974      `IMAGE p t SUBSET u /\
11975       (!x. x IN s ==> IMAGE(shiftpath (f x) p) t = IMAGE p t)
11976       ==> (!x y. x IN s /\ y IN t ==> shiftpath (f x) p y  IN u)`) THEN
11977     ASM_REWRITE_TAC[GSYM path_image] THEN REPEAT STRIP_TAC THEN
11978     MATCH_MP_TAC PATH_IMAGE_SHIFTPATH THEN
11979     ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC] THEN
11980     RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
11981     ASM_SIMP_TAC[REAL_LE_MUL] THEN
11982     GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
11983     MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[];
11984     SIMP_TAC[shiftpath; VECTOR_ADD_LID; IN_INTERVAL_1; DROP_VEC];
11985     REWRITE_TAC[LIFT_DROP];
11986     X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN MATCH_MP_TAC CLOSED_SHIFTPATH THEN
11987     ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC] THEN
11988     RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
11989     ASM_SIMP_TAC[REAL_LE_MUL] THEN
11990     GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
11991     MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[]] THEN
11992   REWRITE_TAC[shiftpath; DROP_ADD; DROP_CMUL] THEN
11993   MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN REPEAT CONJ_TAC THENL
11994    [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
11995     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11996     SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_MUL; o_DEF; LIFT_DROP;
11997              LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
11998              CONTINUOUS_ON_CONST] THEN
11999     RULE_ASSUM_TAC(REWRITE_RULE[path]) THEN
12000     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12001         CONTINUOUS_ON_SUBSET)) THEN
12002     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN
12003     REWRITE_TAC[IN_ELIM_THM; PASTECART_IN_PCROSS] THEN
12004     RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
12005     ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1;
12006                  DROP_ADD; DROP_CMUL; DROP_VEC; REAL_LE_ADD; REAL_LE_MUL];
12007     GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
12008     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
12009     SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_MUL; o_DEF; LIFT_DROP;
12010              LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
12011              CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB] THEN
12012     RULE_ASSUM_TAC(REWRITE_RULE[path]) THEN
12013     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12014         CONTINUOUS_ON_SUBSET)) THEN
12015     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN
12016     REWRITE_TAC[IN_ELIM_THM; PASTECART_IN_PCROSS] THEN
12017     RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
12018     ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1; DROP_SUB;
12019                  DROP_ADD; DROP_CMUL; DROP_VEC; REAL_LE_ADD; REAL_LE_MUL] THEN
12020     SIMP_TAC[REAL_ARITH `&0 <= x + y - &1 <=> &1 <= x + y`] THEN
12021     REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
12022      `t * x <= &1 * &1 /\ y <= &1 ==> t * x + y - &1 <= &1`) THEN
12023     ASM_SIMP_TAC[REAL_LE_MUL2; REAL_POS];
12024     REWRITE_TAC[o_DEF; LIFT_ADD; LIFT_CMUL; LIFT_DROP] THEN
12025     SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CMUL; LINEAR_CONTINUOUS_ON;
12026              LINEAR_FSTCART; LINEAR_SNDCART];
12027     SIMP_TAC[GSYM LIFT_EQ; LIFT_ADD; LIFT_CMUL; LIFT_DROP; LIFT_NUM;
12028              VECTOR_ARITH `a + b - c:real^1 = (a + b) - c`] THEN
12029     ASM_MESON_TAC[VECTOR_SUB_REFL; pathstart; pathfinish]]);;
12030
12031 (* ------------------------------------------------------------------------- *)
12032 (* Relations between the two variants of homotopy.                           *)
12033 (* ------------------------------------------------------------------------- *)
12034
12035 let HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS = prove
12036  (`!s p q. homotopic_paths s p q /\
12037            pathfinish p = pathstart p /\
12038            pathfinish q = pathstart p
12039            ==> homotopic_loops s p q`,
12040   REPEAT GEN_TAC THEN
12041   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
12042   REWRITE_TAC[homotopic_paths; homotopic_loops] THEN
12043   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_MONO) THEN
12044   ASM_SIMP_TAC[]);;
12045
12046 let HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL = prove
12047  (`!s p a:real^N.
12048         homotopic_loops s p (linepath(a,a))
12049         ==> homotopic_paths s p (linepath(pathstart p,pathstart p))`,
12050   REPEAT STRIP_TAC THEN
12051   FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o MATCH_MP HOMOTOPIC_LOOPS_IMP_LOOP) THEN
12052   FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_PATH) THEN
12053   FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_SUBSET) THEN
12054   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_loops]) THEN
12055   REWRITE_TAC[homotopic_with; PCROSS; LEFT_IMP_EXISTS_THM] THEN
12056   X_GEN_TAC `h:real^(1,1)finite_sum->real^N` THEN STRIP_TAC THEN
12057   MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC
12058    `(p:real^1->real^N) ++ linepath(pathfinish p,pathfinish p)` THEN
12059   CONJ_TAC THENL
12060    [ASM_MESON_TAC[HOMOTOPIC_PATHS_RID; HOMOTOPIC_PATHS_SYM]; ALL_TAC] THEN
12061   MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC
12062    `linepath(pathstart p,pathstart p) ++ (p:real^1->real^N) ++
12063     linepath(pathfinish p,pathfinish p)` THEN
12064   CONJ_TAC THENL
12065    [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
12066     MP_TAC(ISPECL [`s:real^N->bool`;
12067        `(p:real^1->real^N) ++ linepath(pathfinish p,pathfinish p)`]
12068      HOMOTOPIC_PATHS_LID) THEN
12069     REWRITE_TAC[PATHSTART_JOIN] THEN DISCH_THEN MATCH_MP_TAC THEN
12070     ASM_SIMP_TAC[PATH_JOIN; PATH_LINEPATH; PATHSTART_LINEPATH] THEN
12071     MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN
12072     ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
12073     REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN
12074     ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET];
12075     ALL_TAC] THEN
12076   MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC
12077    `((\u. (h:real^(1,1)finite_sum->real^N) (pastecart u (vec 0))) ++
12078      linepath(a,a) ++
12079      reversepath(\u. h (pastecart u (vec 0))))` THEN
12080   CONJ_TAC THENL
12081    [ALL_TAC;
12082     MATCH_MP_TAC(MESON[HOMOTOPIC_PATHS_LID; HOMOTOPIC_PATHS_JOIN;
12083                        HOMOTOPIC_PATHS_TRANS; HOMOTOPIC_PATHS_SYM;
12084                        HOMOTOPIC_PATHS_RINV]
12085        `(path p /\ path(reversepath p)) /\
12086         (path_image p SUBSET s /\ path_image(reversepath p) SUBSET s) /\
12087         (pathfinish p = pathstart(linepath(b,b) ++ reversepath p) /\
12088          pathstart(reversepath p) = b) /\
12089         pathstart p = a
12090         ==> homotopic_paths s (p ++ linepath(b,b) ++ reversepath p)
12091                               (linepath(a,a))`) THEN
12092     REWRITE_TAC[PATHSTART_REVERSEPATH; PATHSTART_JOIN; PATH_REVERSEPATH;
12093                 PATH_IMAGE_REVERSEPATH; PATHSTART_LINEPATH] THEN
12094     ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish;
12095                     LINEPATH_REFL] THEN
12096     CONJ_TAC THENL
12097      [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
12098       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
12099       SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID;
12100                CONTINUOUS_ON_CONST] THEN
12101       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12102         CONTINUOUS_ON_SUBSET)) THEN
12103       SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM;
12104                ENDS_IN_UNIT_INTERVAL];
12105       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
12106           SUBSET_TRANS)) THEN
12107       GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
12108       REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
12109       SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM;
12110                ENDS_IN_UNIT_INTERVAL]]] THEN
12111   REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS] THEN
12112   EXISTS_TAC
12113    `\y:real^(1,1)finite_sum.
12114         (subpath (vec 0) (fstcart y) (\u. h(pastecart u (vec 0))) ++
12115          (\u. (h:real^(1,1)finite_sum->real^N) (pastecart (fstcart y) u)) ++
12116          subpath (fstcart y) (vec 0) (\u. h(pastecart u (vec 0))))
12117         (sndcart y)` THEN
12118   ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SUBPATH_TRIVIAL;
12119                   SUBPATH_REFL; SUBPATH_REVERSEPATH; ETA_AX;
12120                   PATHSTART_JOIN; PATHFINISH_JOIN;
12121                   PATHSTART_SUBPATH; PATHFINISH_SUBPATH;
12122                   PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
12123   ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
12124    [ALL_TAC; REWRITE_TAC[pathstart]] THEN
12125   CONJ_TAC THENL
12126    [MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN
12127     REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
12128      [ALL_TAC;
12129       MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN
12130       ASM_REWRITE_TAC[PASTECART_FST_SND; ETA_AX] THEN CONJ_TAC THENL
12131        [ALL_TAC;
12132         RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
12133         REWRITE_TAC[PATHSTART_SUBPATH] THEN
12134         ASM_SIMP_TAC[pathstart; pathfinish]];
12135       RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
12136       REWRITE_TAC[PATHFINISH_SUBPATH; PATHSTART_JOIN] THEN
12137       ASM_SIMP_TAC[pathstart]] THEN
12138     REWRITE_TAC[subpath] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
12139     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
12140     REWRITE_TAC[VECTOR_SUB_RZERO; VECTOR_SUB_LZERO; VECTOR_ADD_LID] THEN
12141     (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5)
12142        [CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ADD; CONTINUOUS_ON_MUL;
12143         LIFT_DROP; CONTINUOUS_ON_NEG; DROP_NEG; CONTINUOUS_ON_CONST;
12144         CONTINUOUS_ON_ID; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
12145         LIFT_NEG; o_DEF; ETA_AX] THEN
12146     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12147        CONTINUOUS_ON_SUBSET)) THEN
12148     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12149     REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN
12150     REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1] THEN
12151     REWRITE_TAC[DROP_ADD; DROP_NEG; DROP_VEC; DROP_CMUL; REAL_POS] THEN
12152     SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_ARITH
12153      `t + --t * x = t * (&1 - x)`] THEN REPEAT STRIP_TAC THEN
12154     MATCH_MP_TAC(REAL_ARITH
12155      `t * x <= t * &1 /\ &1 * t <= &1 * &1 ==> t * x <= &1`) THEN
12156     CONJ_TAC THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC;
12157
12158     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; IMP_CONJ;
12159       RIGHT_FORALL_IMP_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
12160     X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN
12161     REWRITE_TAC[SET_RULE
12162      `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN
12163     REWRITE_TAC[GSYM path_image; ETA_AX] THEN
12164     REPEAT(MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN CONJ_TAC) THEN
12165     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
12166       SUBSET_TRANS)) THEN
12167     REWRITE_TAC[path_image; subpath] THEN
12168     GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
12169     REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
12170     ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM] THEN
12171     SIMP_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; DROP_CMUL; DROP_ADD] THEN
12172     REWRITE_TAC[REAL_ADD_LID; REAL_SUB_RZERO; REAL_POS] THEN
12173     REWRITE_TAC[REAL_ARITH `t + (&0 - t) * x = t * (&1 - x)`] THEN
12174     RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
12175     ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE] THEN
12176     REPEAT STRIP_TAC THEN
12177     GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
12178     MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REAL_ARITH_TAC]);;
12179
12180 let HOMOTOPIC_LOOPS_CONJUGATE = prove
12181  (`!p q s:real^N->bool.
12182         path p /\ path_image p SUBSET s /\
12183         path q /\ path_image q SUBSET s /\
12184         pathfinish p = pathstart q /\ pathfinish q = pathstart q
12185         ==> homotopic_loops s (p ++ q ++ reversepath p) q`,
12186   REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN EXISTS_TAC
12187    `linepath(pathstart q,pathstart q) ++ (q:real^1->real^N) ++
12188     linepath(pathstart q,pathstart q)` THEN
12189   CONJ_TAC THENL
12190    [ALL_TAC;
12191     MATCH_MP_TAC HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS THEN
12192     MP_TAC(ISPECL [`s:real^N->bool`;
12193        `(q:real^1->real^N) ++ linepath(pathfinish q,pathfinish q)`]
12194      HOMOTOPIC_PATHS_LID) THEN
12195     ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; UNION_SUBSET; SING_SUBSET;
12196                  PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH;
12197                  PATH_JOIN; PATH_IMAGE_JOIN; PATH_LINEPATH; SEGMENT_REFL] THEN
12198     ANTS_TAC THENL
12199      [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]; ALL_TAC] THEN
12200     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_PATHS_TRANS) THEN
12201     ASM_MESON_TAC[HOMOTOPIC_PATHS_RID]] THEN
12202   REWRITE_TAC[homotopic_loops; homotopic_with; PCROSS] THEN
12203   EXISTS_TAC
12204    `(\y. (subpath (fstcart y) (vec 1) p ++ q ++ subpath (vec 1) (fstcart y) p)
12205          (sndcart y)):real^(1,1)finite_sum->real^N` THEN
12206   ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SUBPATH_TRIVIAL;
12207                   SUBPATH_REFL; SUBPATH_REVERSEPATH; ETA_AX;
12208                  PATHSTART_JOIN; PATHFINISH_JOIN;
12209                   PATHSTART_SUBPATH; PATHFINISH_SUBPATH;
12210                   PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
12211   RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
12212   ASM_REWRITE_TAC[pathstart; pathfinish] THEN CONJ_TAC THENL
12213    [RULE_ASSUM_TAC(REWRITE_RULE[path; path_image]) THEN
12214     MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN
12215     REPEAT CONJ_TAC THENL
12216      [ALL_TAC;
12217       MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN
12218       REPEAT CONJ_TAC THENL
12219        [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
12220         MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
12221         SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
12222         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12223           CONTINUOUS_ON_SUBSET)) THEN
12224         REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12225         SIMP_TAC[SNDCART_PASTECART];
12226         ALL_TAC;
12227         REWRITE_TAC[PATHSTART_SUBPATH] THEN ASM_REWRITE_TAC[pathfinish]];
12228       REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_SUBPATH] THEN
12229       ASM_REWRITE_TAC[pathstart]] THEN
12230     REWRITE_TAC[subpath] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
12231     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
12232     (CONJ_TAC THENL
12233       [REWRITE_TAC[DROP_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
12234        SIMP_TAC[LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_CONST; LINEAR_FSTCART] THEN
12235        MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
12236        SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
12237        REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP] THEN
12238        SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON;
12239                 LINEAR_FSTCART];
12240        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12241           CONTINUOUS_ON_SUBSET)) THEN
12242        REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12243        REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1] THEN
12244        REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC; DROP_CMUL]])
12245     THENL
12246      [REPEAT STRIP_TAC THENL
12247        [MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THEN
12248         TRY(MATCH_MP_TAC REAL_LE_MUL) THEN ASM_REAL_ARITH_TAC;
12249         REWRITE_TAC[REAL_ARITH `t + (&1 - t) * x <= &1 <=>
12250                                 (&1 - t) * x <= (&1 - t) * &1`] THEN
12251         MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC];
12252       REPEAT STRIP_TAC THENL
12253        [MATCH_MP_TAC(REAL_ARITH
12254          `x * (&1 - t) <= x * &1 /\ x <= &1
12255           ==> &0 <= &1 + (t - &1) * x`) THEN
12256         ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN
12257         ASM_REAL_ARITH_TAC;
12258         REWRITE_TAC[REAL_ARITH
12259          `a + (t - &1) * x <= a <=> &0 <= (&1 - t) * x`] THEN
12260         MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC]];
12261     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12262     REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
12263     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
12264     REWRITE_TAC[ETA_AX; GSYM path_image; SET_RULE
12265       `(!x. x IN i ==> f x IN s) <=> IMAGE f i SUBSET s`] THEN
12266     REPEAT STRIP_TAC THEN
12267     REPEAT(MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN CONJ_TAC) THEN
12268     ASM_REWRITE_TAC[] THEN
12269     MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `path_image p:real^N->bool` THEN
12270     ASM_REWRITE_TAC[] THEN
12271     MATCH_MP_TAC PATH_IMAGE_SUBPATH_SUBSET THEN
12272     ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]]);;
12273
12274 (* ------------------------------------------------------------------------- *)
12275 (* Relating homotopy of trivial loops to path-connectedness.                 *)
12276 (* ------------------------------------------------------------------------- *)
12277
12278 let PATH_COMPONENT_IMP_HOMOTOPIC_POINTS = prove
12279  (`!s a b:real^N.
12280         path_component s a b
12281         ==> homotopic_loops s (linepath(a,a)) (linepath(b,b))`,
12282   REWRITE_TAC[path_component; homotopic_loops; homotopic_with; PCROSS] THEN
12283   REPEAT GEN_TAC THEN REWRITE_TAC[pathstart; pathfinish; path_image; path] THEN
12284   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12285   DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
12286   EXISTS_TAC `\y:real^(1,1)finite_sum. (g(fstcart y):real^N)` THEN
12287   ASM_SIMP_TAC[FSTCART_PASTECART; linepath] THEN
12288   REWRITE_TAC[VECTOR_ARITH `(&1 - x) % a + x % a:real^N = a`] THEN
12289   MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN
12290   SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
12291   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12292         CONTINUOUS_ON_SUBSET)) THEN
12293   SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; FSTCART_PASTECART]);;
12294
12295 let HOMOTOPIC_LOOPS_IMP_PATH_COMPONENT_VALUE = prove
12296  (`!s p q:real^1->real^N t.
12297         homotopic_loops s p q /\ t IN interval[vec 0,vec 1]
12298         ==> path_component s (p t) (q t)`,
12299   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
12300   REWRITE_TAC[path_component; homotopic_loops; homotopic_with; PCROSS] THEN
12301   DISCH_THEN(X_CHOOSE_THEN `h:real^(1,1)finite_sum->real^N` MP_TAC) THEN
12302   STRIP_TAC THEN
12303   EXISTS_TAC `\u. (h:real^(1,1)finite_sum->real^N) (pastecart u t)` THEN
12304   ASM_REWRITE_TAC[pathstart; pathfinish] THEN CONJ_TAC THENL
12305    [REWRITE_TAC[path] THEN
12306     MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN
12307     CONJ_TAC THENL
12308      [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
12309       REWRITE_TAC[CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID];
12310       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12311         CONTINUOUS_ON_SUBSET)) THEN
12312       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12313       ASM SET_TAC[]];
12314     REWRITE_TAC[path_image] THEN ASM SET_TAC[]]);;
12315
12316 let HOMOTOPIC_POINTS_EQ_PATH_COMPONENT = prove
12317  (`!s a b:real^N.
12318         homotopic_loops s (linepath(a,a)) (linepath(b,b)) <=>
12319         path_component s a b`,
12320   REPEAT GEN_TAC THEN EQ_TAC THEN
12321   REWRITE_TAC[PATH_COMPONENT_IMP_HOMOTOPIC_POINTS] THEN
12322   DISCH_THEN(MP_TAC o SPEC `vec 0:real^1` o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12323     HOMOTOPIC_LOOPS_IMP_PATH_COMPONENT_VALUE)) THEN
12324   REWRITE_TAC[linepath; IN_INTERVAL_1; DROP_VEC; REAL_POS] THEN
12325   REWRITE_TAC[VECTOR_ARITH `(&1 - &0) % a + &0 % b:real^N = a`]);;
12326
12327 let PATH_CONNECTED_EQ_HOMOTOPIC_POINTS = prove
12328  (`!s:real^N->bool.
12329         path_connected s <=>
12330         !a b. a IN s /\ b IN s
12331               ==> homotopic_loops s (linepath(a,a)) (linepath(b,b))`,
12332   GEN_TAC THEN REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN
12333   REWRITE_TAC[path_connected; path_component]);;
12334
12335 (* ------------------------------------------------------------------------- *)
12336 (* Homotopy of "nearby" function, paths and loops.                           *)
12337 (* ------------------------------------------------------------------------- *)
12338
12339 let HOMOTOPIC_WITH_LINEAR = prove
12340  (`!f g:real^M->real^N s t.
12341         f continuous_on s /\ g continuous_on s /\
12342         (!x. x IN s ==> segment[f x,g x] SUBSET t)
12343         ==> homotopic_with (\z. T) (s,t) f g`,
12344   REPEAT STRIP_TAC THEN REWRITE_TAC[homotopic_with] THEN
12345   EXISTS_TAC
12346     `\y. ((&1 - drop(fstcart y)) % (f:real^M->real^N)(sndcart y) +
12347          drop(fstcart y) % g(sndcart y):real^N)` THEN
12348   REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC] THEN
12349   ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_SUB_RZERO] THEN
12350   REWRITE_TAC[VECTOR_ARITH `(&1 - t) % a + t % a:real^N = a`] THEN
12351   REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID] THEN
12352   REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID] THEN CONJ_TAC THENL
12353    [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
12354     MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
12355     REWRITE_TAC[o_DEF; LIFT_DROP; LIFT_SUB] THEN
12356     SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON;
12357              LINEAR_FSTCART; ETA_AX] THEN
12358     GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
12359     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
12360     SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
12361     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12362         CONTINUOUS_ON_SUBSET)) THEN
12363     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12364     SIMP_TAC[SNDCART_PASTECART; FORALL_IN_PCROSS];
12365     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
12366     MAP_EVERY X_GEN_TAC [`t:real^1`; `u:real^M`] THEN STRIP_TAC THEN
12367     SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
12368     RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; RIGHT_IMP_FORALL_THM; IMP_IMP]) THEN
12369     FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `u:real^M` THEN
12370     ASM_REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `drop t` THEN
12371     ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC]]);;
12372
12373 let HOMOTOPIC_PATHS_LINEAR,HOMOTOPIC_LOOPS_LINEAR = (CONJ_PAIR o prove)
12374  (`(!g s:real^N->bool h.
12375         path g /\ path h /\
12376         pathstart h = pathstart g /\ pathfinish h = pathfinish g /\
12377         (!t x. t IN interval[vec 0,vec 1] ==> segment[g t,h t] SUBSET s)
12378         ==> homotopic_paths s g h) /\
12379    (!g s:real^N->bool h.
12380         path g /\ path h /\
12381         pathfinish g = pathstart g /\ pathfinish h = pathstart h /\
12382         (!t x. t IN interval[vec 0,vec 1] ==> segment[g t,h t] SUBSET s)
12383         ==> homotopic_loops s g h)`,
12384   CONJ_TAC THEN
12385  (REWRITE_TAC[pathstart; pathfinish] THEN
12386   REWRITE_TAC[SUBSET; RIGHT_IMP_FORALL_THM; IMP_IMP] THEN REPEAT STRIP_TAC THEN
12387   REWRITE_TAC[homotopic_paths; homotopic_loops; homotopic_with; PCROSS] THEN
12388   EXISTS_TAC
12389    `\y:real^(1,1)finite_sum.
12390       ((&1 - drop(fstcart y)) % g(sndcart y) +
12391        drop(fstcart y) % h(sndcart y):real^N)` THEN
12392   REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC] THEN
12393   ASM_REWRITE_TAC[pathstart; pathfinish; REAL_SUB_REFL; REAL_SUB_RZERO] THEN
12394   REWRITE_TAC[VECTOR_ARITH `(&1 - t) % a + t % a:real^N = a`] THEN
12395   REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID] THEN
12396   REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID] THEN CONJ_TAC THENL
12397    [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
12398     MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
12399     REWRITE_TAC[o_DEF; LIFT_DROP; LIFT_SUB] THEN
12400     SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON;
12401              LINEAR_FSTCART; ETA_AX] THEN
12402     GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
12403     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
12404     SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
12405     RULE_ASSUM_TAC(REWRITE_RULE[path]) THEN
12406     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12407         CONTINUOUS_ON_SUBSET)) THEN
12408     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12409     SIMP_TAC[SNDCART_PASTECART];
12410     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12411     MAP_EVERY X_GEN_TAC [`t:real^1`; `u:real^1`] THEN STRIP_TAC THEN
12412     SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
12413     FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `u:real^1` THEN
12414     ASM_REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `drop t` THEN
12415     ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC]]));;
12416
12417 let HOMOTOPIC_PATHS_NEARBY_EXPLICIT,
12418     HOMOTOPIC_LOOPS_NEARBY_EXPLICIT = (CONJ_PAIR o prove)
12419  (`(!g s:real^N->bool h.
12420         path g /\ path h /\
12421         pathstart h = pathstart g /\ pathfinish h = pathfinish g /\
12422         (!t x. t IN interval[vec 0,vec 1] /\ ~(x IN s)
12423                ==> norm(h t - g t) < norm(g t - x))
12424         ==> homotopic_paths s g h) /\
12425    (!g s:real^N->bool h.
12426         path g /\ path h /\
12427         pathfinish g = pathstart g /\ pathfinish h = pathstart h /\
12428         (!t x. t IN interval[vec 0,vec 1] /\ ~(x IN s)
12429                ==> norm(h t - g t) < norm(g t - x))
12430         ==> homotopic_loops s g h)`,
12431   ONCE_REWRITE_TAC[TAUT `p /\ ~q ==> r <=> p /\ ~r ==> q`] THEN
12432   REPEAT STRIP_TAC THENL
12433    [MATCH_MP_TAC HOMOTOPIC_PATHS_LINEAR;
12434     MATCH_MP_TAC HOMOTOPIC_LOOPS_LINEAR] THEN
12435   ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; segment; FORALL_IN_GSPEC] THEN
12436   X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN
12437   X_GEN_TAC `u:real` THEN STRIP_TAC THEN
12438   FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `t:real^1` THEN
12439   ASM_REWRITE_TAC[REAL_NOT_LT] THEN
12440   MP_TAC(ISPECL [`(g:real^1->real^N) t`; `(h:real^1->real^N) t`]
12441       DIST_IN_CLOSED_SEGMENT) THEN
12442   RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
12443   REWRITE_TAC[segment; FORALL_IN_GSPEC;
12444               ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
12445   ASM_MESON_TAC[]);;
12446
12447 let HOMOTOPIC_NEARBY_PATHS,HOMOTOPIC_NEARBY_LOOPS = (CONJ_PAIR o prove)
12448  (`(!g s:real^N->bool.
12449         path g /\ open s /\ path_image g SUBSET s
12450         ==> ?e. &0 < e /\
12451                 !h. path h /\
12452                     pathstart h = pathstart g /\
12453                     pathfinish h = pathfinish g /\
12454                     (!t. t IN interval[vec 0,vec 1] ==> norm(h t - g t) < e)
12455                     ==> homotopic_paths s g h) /\
12456    (!g s:real^N->bool.
12457         path g /\ pathfinish g = pathstart g /\ open s /\ path_image g SUBSET s
12458         ==> ?e. &0 < e /\
12459                 !h. path h /\
12460                     pathfinish h = pathstart h /\
12461                     (!t. t IN interval[vec 0,vec 1] ==> norm(h t - g t) < e)
12462                     ==> homotopic_loops s g h)`,
12463   CONJ_TAC THEN
12464   REPEAT STRIP_TAC THEN
12465   MP_TAC(ISPECL [`path_image g:real^N->bool`; `(:real^N) DIFF s`]
12466         SEPARATE_COMPACT_CLOSED) THEN
12467   ASM_SIMP_TAC[COMPACT_PATH_IMAGE; GSYM OPEN_CLOSED] THEN
12468   (ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_DIFF; IN_UNIV; dist]]) THEN
12469   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN
12470   REWRITE_TAC[REAL_NOT_LE] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
12471   X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THENL
12472    [MATCH_MP_TAC HOMOTOPIC_PATHS_NEARBY_EXPLICIT;
12473     MATCH_MP_TAC HOMOTOPIC_LOOPS_NEARBY_EXPLICIT] THEN
12474   ASM_REWRITE_TAC[] THEN
12475   MAP_EVERY X_GEN_TAC [`t:real^1`; `x:real^N`] THEN STRIP_TAC THEN
12476   MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `e:real` THEN
12477   ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
12478   ASM_REWRITE_TAC[path_image] THEN ASM SET_TAC[]);;
12479
12480 (* ------------------------------------------------------------------------- *)
12481 (* Homotopy of non-antipodal sphere maps.                                    *)
12482 (* ------------------------------------------------------------------------- *)
12483
12484 let HOMOTOPIC_NON_MIDPOINT_SPHEREMAPS = prove
12485  (`!f g:real^M->real^N s a r.
12486         f continuous_on s /\ IMAGE f s SUBSET sphere(a,r) /\
12487         g continuous_on s /\ IMAGE g s SUBSET sphere(a,r) /\
12488         (!x. x IN s ==> ~(midpoint(f x,g x) = a))
12489     ==> homotopic_with (\x. T) (s,sphere(a,r)) f g`,
12490   REPEAT GEN_TAC THEN ASM_CASES_TAC `r <= &0` THENL
12491    [REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN
12492     REPEAT(EXISTS_TAC `g:real^M->real^N`) THEN
12493     ASM_REWRITE_TAC[HOMOTOPIC_WITH_REFL] THEN
12494     SUBGOAL_THEN `?c:real^N. sphere(a,r) SUBSET {c}` MP_TAC THENL
12495      [ALL_TAC; ASM SET_TAC[]] THEN
12496     ASM_CASES_TAC `r = &0` THEN
12497     ASM_SIMP_TAC[SPHERE_SING; SPHERE_EMPTY; REAL_LT_LE] THEN
12498     MESON_TAC[SUBSET_REFL; EMPTY_SUBSET];
12499     RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN STRIP_TAC] THEN
12500   SUBGOAL_THEN
12501    `homotopic_with (\z. T) (s:real^M->bool,(:real^N) DELETE a) f g`
12502   MP_TAC THENL
12503    [MATCH_MP_TAC HOMOTOPIC_WITH_LINEAR THEN
12504     ASM_REWRITE_TAC[SET_RULE `s SUBSET UNIV DELETE a <=> ~(a IN s)`] THEN
12505     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
12506     REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET])) THEN
12507     REWRITE_TAC[FORALL_IN_IMAGE; IN_SPHERE; IMP_IMP] THEN
12508     REWRITE_TAC[AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
12509     FIRST_X_ASSUM(MP_TAC o GSYM o SPEC `x:real^M`) THEN
12510     ASM_REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; MIDPOINT_BETWEEN] THEN
12511     MESON_TAC[DIST_SYM];
12512     ALL_TAC] THEN
12513   DISCH_THEN(MP_TAC o
12514     ISPECL [`\y:real^N. a + r / norm(y - a) % (y - a)`;
12515             `sphere(a:real^N,r)`] o
12516     MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
12517     HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN
12518   REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL
12519    [CONJ_TAC THENL
12520      [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
12521       MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
12522       SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
12523       REWRITE_TAC[real_div; o_DEF; LIFT_CMUL] THEN
12524       MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
12525       MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
12526       SIMP_TAC[IN_DELETE; NORM_EQ_0; VECTOR_SUB_EQ] THEN
12527       MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN
12528       SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID];
12529       SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; IN_DELETE; IN_SPHERE] THEN
12530       REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + b) = norm b`] THEN
12531       SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
12532       ASM_SIMP_TAC[real_abs; REAL_LE_RMUL; REAL_DIV_RMUL;
12533                    NORM_EQ_0; VECTOR_SUB_EQ; REAL_LT_IMP_LE]];
12534       MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN
12535       RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; IN_SPHERE]) THEN
12536       ASM_SIMP_TAC[NORM_ARITH `norm(a - b:real^N) = dist(b,a)`] THEN
12537       ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ] THEN REPEAT STRIP_TAC THEN
12538       VECTOR_ARITH_TAC]);;
12539
12540 let HOMOTOPIC_NON_ANTIPODAL_SPHEREMAPS = prove
12541  (`!f g:real^M->real^N s r.
12542         f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0,r) /\
12543         g continuous_on s /\ IMAGE g s SUBSET sphere(vec 0,r) /\
12544         (!x. x IN s ==> ~(f x = --g x))
12545     ==> homotopic_with (\x. T) (s,sphere(vec 0,r)) f g`,
12546   REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_NON_MIDPOINT_SPHEREMAPS THEN
12547   ASM_REWRITE_TAC[midpoint; VECTOR_ARITH
12548    `inv(&2) % (a + b):real^N = vec 0 <=> a = --b`]);;
12549
12550 (* ------------------------------------------------------------------------- *)
12551 (* Retracts, in a general sense, preserve (co)homotopic triviality.          *)
12552 (* ------------------------------------------------------------------------- *)
12553
12554 let HOMOTOPICALLY_TRIVIAL_RETRACTION_GEN = prove
12555  (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k.
12556         (h continuous_on s /\ IMAGE h s = t /\
12557          k continuous_on t /\ IMAGE k t SUBSET s /\
12558          (!y. y IN t ==> h(k y) = y) /\
12559          (!f. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f ==> P(k o f)) /\
12560          (!f. f continuous_on u /\ IMAGE f u SUBSET s /\ P f ==> Q(h o f)) /\
12561          (!h k. (!x. x IN u ==> h x = k x) ==> (Q h <=> Q k))) /\
12562         (!f g. f continuous_on u /\ IMAGE f u SUBSET s /\ P f /\
12563                g continuous_on u /\ IMAGE g u SUBSET s /\ P g
12564                ==> homotopic_with P (u,s)  f g)
12565         ==> (!f g. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f /\
12566                    g continuous_on u /\ IMAGE g u SUBSET t /\ Q g
12567                    ==> homotopic_with Q (u,t) f g)`,
12568   REPEAT GEN_TAC THEN STRIP_TAC THEN
12569   MAP_EVERY X_GEN_TAC [`p:real^P->real^N`; `q:real^P->real^N`] THEN
12570   STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
12571    [`(k:real^N->real^M) o (p:real^P->real^N)`;
12572     `(k:real^N->real^M) o (q:real^P->real^N)`]) THEN
12573   ANTS_TAC THENL
12574    [ASM_SIMP_TAC[IMAGE_o] THEN REPEAT CONJ_TAC THEN
12575     TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN
12576     TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12577         CONTINUOUS_ON_SUBSET))) THEN
12578     ASM SET_TAC[];
12579     DISCH_TAC] THEN
12580   MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN MAP_EVERY EXISTS_TAC
12581    [`(h:real^M->real^N) o (k:real^N->real^M) o (p:real^P->real^N)`;
12582     `(h:real^M->real^N) o (k:real^N->real^M) o (q:real^P->real^N)`] THEN
12583   ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
12584   MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
12585   EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
12586   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
12587         HOMOTOPIC_WITH_MONO)) THEN
12588   ASM_SIMP_TAC[]);;
12589
12590 let HOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN = prove
12591  (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k.
12592         (h continuous_on s /\ IMAGE h s = t /\
12593          k continuous_on t /\ IMAGE k t SUBSET s /\
12594          (!y. y IN t ==> h(k y) = y) /\
12595          (!f. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f ==> P(k o f)) /\
12596          (!f. f continuous_on u /\ IMAGE f u SUBSET s /\ P f ==> Q(h o f)) /\
12597          (!h k. (!x. x IN u ==> h x = k x) ==> (Q h <=> Q k))) /\
12598         (!f. f continuous_on u /\ IMAGE f u SUBSET s /\ P f
12599              ==> ?c. homotopic_with P (u,s) f (\x. c))
12600         ==> (!f. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f
12601                  ==> ?c. homotopic_with Q (u,t) f (\x. c))`,
12602   REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `p:real^P->real^N` THEN
12603   STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC
12604     `(k:real^N->real^M) o (p:real^P->real^N)`) THEN
12605   ANTS_TAC THENL
12606    [ASM_SIMP_TAC[IMAGE_o] THEN CONJ_TAC THEN
12607     TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN
12608     TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12609         CONTINUOUS_ON_SUBSET))) THEN
12610     ASM SET_TAC[];
12611     DISCH_THEN(X_CHOOSE_TAC `c:real^M`)] THEN
12612   EXISTS_TAC `(h:real^M->real^N) c` THEN
12613   MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN MAP_EVERY EXISTS_TAC
12614    [`(h:real^M->real^N) o (k:real^N->real^M) o (p:real^P->real^N)`;
12615     `(h:real^M->real^N) o ((\x. c):real^P->real^M)`] THEN
12616   ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
12617   MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
12618   EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
12619   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
12620         HOMOTOPIC_WITH_MONO)) THEN
12621   ASM_SIMP_TAC[]);;
12622
12623 let COHOMOTOPICALLY_TRIVIAL_RETRACTION_GEN = prove
12624  (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k.
12625         (h continuous_on s /\ IMAGE h s = t /\
12626          k continuous_on t /\ IMAGE k t SUBSET s /\
12627          (!y. y IN t ==> h(k y) = y) /\
12628          (!f. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f ==> P(f o h)) /\
12629          (!f. f continuous_on s /\ IMAGE f s SUBSET u /\ P f ==> Q(f o k)) /\
12630          (!h k. (!x. x IN t ==> h x = k x) ==> (Q h <=> Q k))) /\
12631         (!f g. f continuous_on s /\ IMAGE f s SUBSET u /\ P f /\
12632                g continuous_on s /\ IMAGE g s SUBSET u /\ P g
12633                ==> homotopic_with P (s,u) f g)
12634         ==> (!f g. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f /\
12635                    g continuous_on t /\ IMAGE g t SUBSET u /\ Q g
12636                    ==> homotopic_with Q (t,u) f g)`,
12637   REPEAT GEN_TAC THEN STRIP_TAC THEN
12638   MAP_EVERY X_GEN_TAC [`p:real^N->real^P`; `q:real^N->real^P`] THEN
12639   STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
12640    [`(p:real^N->real^P) o (h:real^M->real^N)`;
12641     `(q:real^N->real^P) o (h:real^M->real^N)`]) THEN
12642   ANTS_TAC THENL
12643    [ASM_SIMP_TAC[IMAGE_o] THEN REPEAT CONJ_TAC THEN
12644     TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN
12645     TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12646         CONTINUOUS_ON_SUBSET))) THEN
12647     ASM SET_TAC[];
12648     DISCH_TAC] THEN
12649   MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN MAP_EVERY EXISTS_TAC
12650    [`((p:real^N->real^P) o (h:real^M->real^N)) o (k:real^N->real^M)`;
12651     `((q:real^N->real^P) o (h:real^M->real^N)) o (k:real^N->real^M)`] THEN
12652   ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
12653   MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
12654   EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
12655   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
12656         HOMOTOPIC_WITH_MONO)) THEN
12657   ASM_SIMP_TAC[]);;
12658
12659 let COHOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN = prove
12660  (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k.
12661         (h continuous_on s /\ IMAGE h s = t /\
12662          k continuous_on t /\ IMAGE k t SUBSET s /\
12663          (!y. y IN t ==> h(k y) = y) /\
12664          (!f. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f ==> P(f o h)) /\
12665          (!f. f continuous_on s /\ IMAGE f s SUBSET u /\ P f ==> Q(f o k)) /\
12666          (!h k. (!x. x IN t ==> h x = k x) ==> (Q h <=> Q k))) /\
12667         (!f. f continuous_on s /\ IMAGE f s SUBSET u /\ P f
12668              ==> ?c. homotopic_with P (s,u) f (\x. c))
12669         ==> (!f. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f
12670                  ==> ?c. homotopic_with Q (t,u) f (\x. c))`,
12671   REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `p:real^N->real^P` THEN
12672   STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC
12673     `(p:real^N->real^P) o (h:real^M->real^N)`) THEN
12674   ANTS_TAC THENL
12675    [ASM_SIMP_TAC[IMAGE_o] THEN
12676     TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN
12677     TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12678         CONTINUOUS_ON_SUBSET))) THEN
12679     ASM SET_TAC[];
12680     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^P` THEN DISCH_TAC] THEN
12681   MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN MAP_EVERY EXISTS_TAC
12682    [`((p:real^N->real^P) o (h:real^M->real^N)) o (k:real^N->real^M)`;
12683     `((\x. c):real^M->real^P) o (k:real^N->real^M)`] THEN
12684   ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
12685   MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
12686   EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
12687   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
12688         HOMOTOPIC_WITH_MONO)) THEN
12689   ASM_SIMP_TAC[]);;
12690
12691 (* ------------------------------------------------------------------------- *)
12692 (* Another useful lemma.                                                     *)
12693 (* ------------------------------------------------------------------------- *)
12694
12695 let HOMOTOPIC_JOIN_SUBPATHS = prove
12696  (`!g:real^1->real^N s.
12697        path g /\ path_image g SUBSET s /\
12698        u IN interval[vec 0,vec 1] /\
12699        v IN interval[vec 0,vec 1] /\
12700        w IN interval[vec 0,vec 1]
12701        ==> homotopic_paths s (subpath u v g ++ subpath v w g) (subpath u w g)`,
12702   let lemma1 = prove
12703    (`!g:real^1->real^N s.
12704          drop u <= drop v /\ drop v <= drop w
12705          ==> path g /\ path_image g SUBSET s /\
12706              u IN interval[vec 0,vec 1] /\
12707              v IN interval[vec 0,vec 1] /\
12708              w IN interval[vec 0,vec 1] /\
12709              drop u <= drop v /\ drop v <= drop w
12710              ==> homotopic_paths s
12711                  (subpath u v g ++ subpath v w g) (subpath u w g)`,
12712     REPEAT STRIP_TAC THEN
12713     MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN
12714     EXISTS_TAC `path_image g:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
12715     ASM_CASES_TAC `w:real^1 = u` THENL
12716      [MP_TAC(ISPECL
12717       [`path_image g:real^N->bool`;
12718        `subpath u v (g:real^1->real^N)`] HOMOTOPIC_PATHS_RINV) THEN
12719       ASM_REWRITE_TAC[REVERSEPATH_SUBPATH; SUBPATH_REFL] THEN
12720       REWRITE_TAC[LINEPATH_REFL; PATHSTART_SUBPATH] THEN
12721       ASM_SIMP_TAC[PATH_SUBPATH; PATH_IMAGE_SUBPATH_SUBSET];
12722       ALL_TAC] THEN
12723     ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
12724     MATCH_MP_TAC HOMOTOPIC_PATHS_REPARAMETRIZE THEN
12725     ASM_SIMP_TAC[PATH_SUBPATH; PATH_IMAGE_SUBPATH_SUBSET] THEN
12726     EXISTS_TAC
12727     `\t. if drop t <= &1 / &2
12728          then inv(drop(w - u)) % (&2 * drop(v - u)) % t
12729          else inv(drop(w - u)) %
12730               ((v - u) + drop(w - v) % (&2 % t - vec 1))` THEN
12731     REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
12732     REWRITE_TAC[VECTOR_MUL_RZERO] THEN REPEAT CONJ_TAC THENL
12733      [MATCH_MP_TAC CONTINUOUS_ON_CASES_1 THEN
12734       REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; LIFT_DROP; GSYM LIFT_NUM;
12735                   DROP_ADD; DROP_SUB] THEN
12736       (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5)
12737         [CONTINUOUS_ON_MUL; o_DEF; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID;
12738          CONTINUOUS_ON_SUB; CONTINUOUS_ON_ADD] THEN
12739       REPEAT STRIP_TAC THEN REAL_ARITH_TAC;
12740       SUBGOAL_THEN `drop u < drop w` ASSUME_TAC THENL
12741        [ASM_SIMP_TAC[REAL_LT_LE; DROP_EQ] THEN ASM_REAL_ARITH_TAC;
12742         ALL_TAC] THEN
12743       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
12744       X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN COND_CASES_TAC THEN
12745       REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC; DROP_ADD; DROP_SUB] THEN
12746       ONCE_REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
12747       ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN
12748       REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN
12749       RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
12750       (CONJ_TAC THENL
12751         [REPEAT(MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC) THEN
12752          REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN
12753          ASM_REAL_ARITH_TAC;
12754          ALL_TAC]) THEN
12755       REWRITE_TAC[REAL_ARITH `v - u + x * t <= w - u <=> x * t <= w - v`;
12756                   REAL_ARITH `(&2 * x) * t = x * &2 * t`] THEN
12757       MATCH_MP_TAC(REAL_ARITH `a * t <= a * &1 /\ a <= b ==> a * t <= b`) THEN
12758       (CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL; ALL_TAC]) THEN
12759       ASM_REAL_ARITH_TAC;
12760       REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; DROP_ADD; DROP_CMUL; DROP_SUB] THEN
12761       CONV_TAC REAL_RAT_REDUCE_CONV THEN
12762       REWRITE_TAC[REAL_ARITH `(v - u) + (w - v) * &1 = w - u`] THEN
12763       ASM_SIMP_TAC[REAL_SUB_0; DROP_EQ; REAL_MUL_LINV];
12764       X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
12765       REWRITE_TAC[subpath; joinpaths] THEN COND_CASES_TAC THEN
12766       ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_ASSOC] THEN
12767       ASM_SIMP_TAC[REAL_MUL_RINV; DROP_EQ_0; VECTOR_SUB_EQ] THEN
12768       AP_TERM_TAC THEN
12769       REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; DROP_ADD; DROP_CMUL; DROP_SUB] THEN
12770       REAL_ARITH_TAC]) in
12771   let lemma2 = prove
12772    (`path g /\ path_image g SUBSET s /\
12773      u IN interval[vec 0,vec 1] /\
12774      v IN interval[vec 0,vec 1] /\
12775      w IN interval[vec 0,vec 1] /\
12776      homotopic_paths s (subpath u v g ++ subpath v w g) (subpath u w g)
12777      ==> homotopic_paths s (subpath w v g ++ subpath v u g) (subpath w u g)`,
12778     REPEAT STRIP_TAC THEN
12779     ONCE_REWRITE_TAC[GSYM HOMOTOPIC_PATHS_REVERSEPATH] THEN
12780     SIMP_TAC[REVERSEPATH_JOINPATHS; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
12781     ASM_REWRITE_TAC[REVERSEPATH_SUBPATH]) in
12782   let lemma3 = prove
12783    (`path (g:real^1->real^N) /\ path_image g SUBSET s /\
12784      u IN interval[vec 0,vec 1] /\
12785      v IN interval[vec 0,vec 1] /\
12786      w IN interval[vec 0,vec 1] /\
12787      homotopic_paths s (subpath u v g ++ subpath v w g) (subpath u w g)
12788      ==> homotopic_paths s (subpath v w g ++ subpath w u g) (subpath v u g)`,
12789     let tac =
12790       ASM_MESON_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH; PATH_SUBPATH;
12791                  HOMOTOPIC_PATHS_REFL; PATH_IMAGE_SUBPATH_SUBSET; SUBSET_TRANS;
12792                  PATHSTART_JOIN; PATHFINISH_JOIN] in
12793     REPEAT STRIP_TAC THEN
12794     ONCE_REWRITE_TAC[GSYM HOMOTOPIC_PATHS_REVERSEPATH] THEN
12795     SIMP_TAC[REVERSEPATH_JOINPATHS; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
12796     ASM_REWRITE_TAC[REVERSEPATH_SUBPATH] THEN
12797     MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
12798     EXISTS_TAC
12799      `(subpath u v g ++ subpath v w g) ++ subpath w v g:real^1->real^N` THEN
12800     CONJ_TAC THENL
12801      [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
12802       ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
12803       ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN tac;
12804       ALL_TAC] THEN
12805     MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
12806     EXISTS_TAC
12807      `subpath u v g ++ (subpath v w g ++ subpath w v g):real^1->real^N` THEN
12808     CONJ_TAC THENL
12809      [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
12810       MATCH_MP_TAC HOMOTOPIC_PATHS_ASSOC THEN tac;
12811       ALL_TAC] THEN
12812     MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
12813     EXISTS_TAC
12814      `(subpath u v g :real^1->real^N) ++
12815       linepath(pathfinish(subpath u v g),pathfinish(subpath u v g))` THEN
12816     CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HOMOTOPIC_PATHS_RID THEN tac] THEN
12817     MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
12818     REPEAT CONJ_TAC THENL [tac; ALL_TAC; tac] THEN
12819     MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
12820     EXISTS_TAC
12821      `linepath(pathstart(subpath v w g):real^N,pathstart(subpath v w g))` THEN
12822     CONJ_TAC THENL
12823      [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REVERSEPATH_SUBPATH] THEN
12824       MATCH_MP_TAC HOMOTOPIC_PATHS_RINV THEN tac;
12825       ALL_TAC] THEN
12826     REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH; HOMOTOPIC_PATHS_REFL;
12827                 PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL;
12828                 INSERT_SUBSET; EMPTY_SUBSET] THEN
12829     ASM_MESON_TAC[path_image; IN_IMAGE; SUBSET]) in
12830   REPEAT STRIP_TAC THEN
12831   REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
12832      (REAL_ARITH `(drop u <= drop v /\ drop v <= drop w \/
12833                    drop w <= drop v /\ drop v <= drop u) \/
12834                   (drop u <= drop w /\ drop w <= drop v \/
12835                    drop v <= drop w /\ drop w <= drop u) \/
12836                   (drop v <= drop u /\ drop u <= drop w \/
12837                    drop w <= drop u /\ drop u <= drop v)`) THEN
12838   FIRST_ASSUM(MP_TAC o SPECL [`g:real^1->real^N`; `s:real^N->bool`] o
12839     MATCH_MP lemma1) THEN
12840   ASM_MESON_TAC[lemma2; lemma3]);;
12841
12842 let HOMOTOPIC_LOOPS_SHIFTPATH = prove
12843  (`!s:real^N->bool p q u.
12844         homotopic_loops s p q /\ u IN interval[vec 0,vec 1]
12845         ==> homotopic_loops s (shiftpath u p) (shiftpath u q)`,
12846   REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops; homotopic_with; PCROSS] THEN
12847   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(
12848    (X_CHOOSE_THEN `h:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC)) THEN
12849   EXISTS_TAC
12850    `\z. shiftpath u (\t. (h:real^(1,1)finite_sum->real^N)
12851                          (pastecart (fstcart z) t)) (sndcart z)` THEN
12852   ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; ETA_AX] THEN
12853   ASM_SIMP_TAC[CLOSED_SHIFTPATH] THEN CONJ_TAC THENL
12854    [REWRITE_TAC[shiftpath; DROP_ADD; REAL_ARITH
12855      `u + z <= &1 <=> z <= &1 - u`] THEN
12856     SUBGOAL_THEN
12857      `{ pastecart (t:real^1) (x:real^1) |
12858         t IN interval[vec 0,vec 1] /\ x IN interval[vec 0,vec 1]} =
12859       { pastecart (t:real^1) (x:real^1) |
12860         t IN interval[vec 0,vec 1] /\ x IN interval[vec 0,vec 1 - u]} UNION
12861       { pastecart (t:real^1) (x:real^1) |
12862         t IN interval[vec 0,vec 1] /\ x IN interval[vec 1 - u,vec 1]}`
12863     SUBST1_TAC THENL
12864      [MATCH_MP_TAC(SET_RULE `s UNION s' = u
12865         ==> {f t x | t IN i /\ x IN u} =
12866             {f t x | t IN i /\ x IN s} UNION
12867             {f t x | t IN i /\ x IN s'}`) THEN
12868       UNDISCH_TAC `(u:real^1) IN interval[vec 0,vec 1]` THEN
12869       REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_UNION; DROP_SUB; DROP_VEC] THEN
12870       REAL_ARITH_TAC;
12871       ALL_TAC] THEN
12872     MATCH_MP_TAC CONTINUOUS_ON_CASES THEN
12873     SIMP_TAC[REWRITE_RULE[PCROSS] CLOSED_PCROSS; CLOSED_INTERVAL] THEN
12874     REWRITE_TAC[FORALL_AND_THM; FORALL_IN_GSPEC; TAUT
12875      `p /\ q \/ r /\ s ==> t <=> (p ==> q ==> t) /\ (r ==> s ==> t)`] THEN
12876     SIMP_TAC[SNDCART_PASTECART; IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN
12877     SIMP_TAC[REAL_ARITH `&1 - u <= x ==> (x <= &1 - u <=> x = &1 - u)`] THEN
12878     SIMP_TAC[GSYM LIFT_EQ; LIFT_SUB; LIFT_DROP; LIFT_NUM] THEN
12879     REWRITE_TAC[FSTCART_PASTECART; VECTOR_ARITH `u + v - u:real^N = v`;
12880                 VECTOR_ARITH `u + v - u - v:real^N = vec 0`] THEN
12881     RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
12882     ASM_SIMP_TAC[GSYM IN_INTERVAL_1; GSYM DROP_VEC] THEN CONJ_TAC THEN
12883     GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
12884     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
12885     SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST;
12886              LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
12887              VECTOR_ARITH `u + z - v:real^N = (u - v) + z`] THEN
12888     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12889       CONTINUOUS_ON_SUBSET)) THEN
12890     UNDISCH_TAC `(u:real^1) IN interval[vec 0,vec 1]` THEN
12891     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12892     REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1;
12893                 IN_ELIM_PASTECART_THM; DROP_ADD; DROP_SUB; DROP_VEC] THEN
12894     REAL_ARITH_TAC;
12895     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
12896     REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SET_RULE
12897      `(!t x. t IN i /\ x IN i ==> f t x IN s) <=>
12898       (!t. t IN i ==> IMAGE (f t) i SUBSET s)`] THEN
12899     X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN REWRITE_TAC[GSYM path_image] THEN
12900     ASM_SIMP_TAC[PATH_IMAGE_SHIFTPATH; ETA_AX] THEN
12901     REWRITE_TAC[path_image] THEN ASM SET_TAC[]]);;
12902
12903 let HOMOTOPIC_PATHS_LOOP_PARTS = prove
12904  (`!s p q a:real^N.
12905         homotopic_loops s (p ++ reversepath q) (linepath(a,a)) /\ path q
12906         ==> homotopic_paths s p q`,
12907   REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o
12908     MATCH_MP HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL) THEN
12909   REWRITE_TAC[PATHSTART_JOIN] THEN STRIP_TAC THEN
12910   FIRST_ASSUM(MP_TAC o CONJUNCT1 o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN
12911   ASM_CASES_TAC `pathfinish p:real^N = pathstart(reversepath q)` THENL
12912    [ASM_SIMP_TAC[PATH_JOIN; PATH_REVERSEPATH] THEN STRIP_TAC;
12913     ASM_MESON_TAC[PATH_JOIN_PATH_ENDS; PATH_REVERSEPATH]] THEN
12914   RULE_ASSUM_TAC(REWRITE_RULE[PATHSTART_REVERSEPATH]) THEN
12915   FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN
12916   ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN;
12917     PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; UNION_SUBSET; SING_SUBSET;
12918     PATH_IMAGE_REVERSEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
12919   STRIP_TAC THEN
12920   MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
12921   EXISTS_TAC `p ++ (linepath(pathfinish p:real^N,pathfinish p))` THEN
12922   CONJ_TAC THENL
12923    [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
12924     MATCH_MP_TAC HOMOTOPIC_PATHS_RID THEN ASM_REWRITE_TAC[];
12925     ALL_TAC] THEN
12926   MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
12927   EXISTS_TAC `p ++ (reversepath q ++ q):real^1->real^N` THEN CONJ_TAC THENL
12928    [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
12929     MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
12930     ASM_SIMP_TAC[HOMOTOPIC_PATHS_LINV; PATHSTART_JOIN; PATHSTART_REVERSEPATH;
12931                  HOMOTOPIC_PATHS_REFL];
12932     ALL_TAC] THEN
12933   MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
12934   EXISTS_TAC `(p ++ reversepath q) ++ q:real^1->real^N` THEN CONJ_TAC THENL
12935    [MATCH_MP_TAC HOMOTOPIC_PATHS_ASSOC THEN
12936     ASM_REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH;
12937                     PATH_IMAGE_REVERSEPATH; PATH_REVERSEPATH];
12938     ALL_TAC] THEN
12939   MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
12940   EXISTS_TAC `linepath(pathstart p:real^N,pathstart p) ++ q` THEN
12941   CONJ_TAC THENL
12942    [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
12943     ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN
12944     REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_REVERSEPATH];
12945     FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN
12946     REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_LINEPATH;
12947                 PATHFINISH_REVERSEPATH] THEN
12948     DISCH_THEN(SUBST1_TAC o SYM) THEN
12949     MATCH_MP_TAC HOMOTOPIC_PATHS_LID THEN ASM_REWRITE_TAC[]]);;
12950
12951 let HOMOTOPIC_LOOPS_ADD_SYM = prove
12952  (`!p q:real^1->real^N.
12953         path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p /\
12954         path q /\ path_image q SUBSET s /\ pathfinish q = pathstart q /\
12955         pathstart q = pathstart p
12956         ==> homotopic_loops s (p ++ q) (q ++ p)`,
12957   REPEAT STRIP_TAC THEN
12958   MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
12959   SUBGOAL_THEN `lift(&1 / &2) IN interval[vec 0,vec 1]` ASSUME_TAC THENL
12960    [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
12961     CONV_TAC REAL_RAT_REDUCE_CONV;
12962     ALL_TAC] THEN
12963   EXISTS_TAC `shiftpath (lift(&1 / &2)) (p ++ q:real^1->real^N)` THEN
12964   CONJ_TAC THENL
12965    [MATCH_MP_TAC HOMOTOPIC_LOOPS_SHIFTPATH_SELF;
12966     MATCH_MP_TAC HOMOTOPIC_LOOPS_EQ] THEN
12967   ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN;
12968                UNION_SUBSET; IN_INTERVAL_1; DROP_VEC; LIFT_DROP;
12969                PATH_SHIFTPATH; PATH_IMAGE_SHIFTPATH; CLOSED_SHIFTPATH] THEN
12970   SIMP_TAC[shiftpath; joinpaths; LIFT_DROP; DROP_ADD; DROP_SUB; DROP_VEC;
12971            REAL_ARITH `&0 <= t ==> (a + t <= a <=> t = &0)`;
12972            REAL_ARITH `t <= &1 ==> &1 / &2 + t - &1 <= &1 / &2`;
12973            REAL_ARITH `&1 / &2 + t <= &1 <=> t <= &1 / &2`] THEN
12974   X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN
12975   ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_REWRITE_TAC[] THENL
12976    [REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN
12977     COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_RID] THENL
12978      [REWRITE_TAC[GSYM LIFT_CMUL; VECTOR_MUL_RZERO] THEN
12979       CONV_TAC REAL_RAT_REDUCE_CONV THEN
12980       ASM_MESON_TAC[LIFT_NUM; pathstart; pathfinish];
12981       ALL_TAC];
12982     ALL_TAC] THEN
12983   AP_TERM_TAC THEN
12984   REWRITE_TAC[GSYM DROP_EQ; DROP_SUB; DROP_ADD; DROP_VEC; DROP_CMUL;
12985               LIFT_DROP] THEN REAL_ARITH_TAC);;
12986
12987 (* ------------------------------------------------------------------------- *)
12988 (* Simply connected sets defined as "all loops are homotopic (as loops)".    *)
12989 (* ------------------------------------------------------------------------- *)
12990
12991 let simply_connected = new_definition
12992  `simply_connected(s:real^N->bool) <=>
12993         !p q. path p /\ pathfinish p = pathstart p /\ path_image p SUBSET s /\
12994               path q /\ pathfinish q = pathstart q /\ path_image q SUBSET s
12995               ==> homotopic_loops s p q`;;
12996
12997 let SIMPLY_CONNECTED_EMPTY = prove
12998  (`simply_connected {}`,
12999   REWRITE_TAC[simply_connected; SUBSET_EMPTY] THEN
13000   MESON_TAC[PATH_IMAGE_NONEMPTY]);;
13001
13002 let SIMPLY_CONNECTED_IMP_PATH_CONNECTED = prove
13003  (`!s:real^N->bool. simply_connected s ==> path_connected s`,
13004   REWRITE_TAC[simply_connected; PATH_CONNECTED_EQ_HOMOTOPIC_POINTS] THEN
13005   REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
13006   ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH;
13007                   PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
13008   ASM SET_TAC[]);;
13009
13010 let SIMPLY_CONNECTED_IMP_CONNECTED = prove
13011  (`!s:real^N->bool. simply_connected s ==> connected s`,
13012   SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED;
13013            PATH_CONNECTED_IMP_CONNECTED]);;
13014
13015 let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY = prove
13016  (`!s:real^N->bool.
13017         simply_connected s <=>
13018         !p a. path p /\ path_image p SUBSET s /\
13019               pathfinish p = pathstart p /\ a IN s
13020               ==> homotopic_loops s p (linepath(a,a))`,
13021   GEN_TAC THEN REWRITE_TAC[simply_connected] THEN EQ_TAC THEN DISCH_TAC THENL
13022    [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
13023     ASM_SIMP_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
13024     ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET];
13025     MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `q:real^1->real^N`] THEN
13026     STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
13027     EXISTS_TAC `linepath(pathstart p:real^N,pathstart p)` THEN
13028     CONJ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[HOMOTOPIC_LOOPS_SYM]] THEN
13029     FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
13030     ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]]);;
13031
13032 let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_SOME = prove
13033  (`!s:real^N->bool.
13034         simply_connected s <=>
13035         path_connected s /\
13036         !p. path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p
13037             ==> ?a. a IN s /\ homotopic_loops s p (linepath(a,a))`,
13038   GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
13039   ASM_SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED] THENL
13040    [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
13041      [SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN
13042     MESON_TAC[SUBSET; PATHSTART_IN_PATH_IMAGE];
13043     REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN
13044     MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `a:real^N`] THEN STRIP_TAC THEN
13045     FIRST_X_ASSUM(MP_TAC o SPEC `p:real^1->real^N`) THEN
13046     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN
13047     STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
13048     EXISTS_TAC `linepath(b:real^N,b)` THEN
13049     ASM_REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN
13050     ASM_MESON_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT]]);;
13051
13052 let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ALL = prove
13053  (`!s:real^N->bool.
13054         simply_connected s <=>
13055         s = {} \/
13056         ?a. a IN s /\
13057             !p. path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p
13058                 ==> homotopic_loops s p (linepath(a,a))`,
13059   GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
13060   ASM_REWRITE_TAC[SIMPLY_CONNECTED_EMPTY] THEN
13061   REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_SOME] THEN
13062   EQ_TAC THENL
13063    [STRIP_TAC THEN
13064     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
13065     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN
13066     ASM_REWRITE_TAC[] THEN X_GEN_TAC `p:real^1->real^N` THEN STRIP_TAC THEN
13067     FIRST_X_ASSUM(MP_TAC o SPEC `p:real^1->real^N`) THEN
13068     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN
13069     STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
13070     EXISTS_TAC `linepath(b:real^N,b)` THEN
13071     ASM_REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN
13072     ASM_MESON_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT];
13073     DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
13074     CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
13075     REWRITE_TAC[PATH_CONNECTED_EQ_HOMOTOPIC_POINTS] THEN
13076     MAP_EVERY X_GEN_TAC [`b:real^N`; `c:real^N`] THEN STRIP_TAC THEN
13077     MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
13078     EXISTS_TAC `linepath(a:real^N,a)` THEN
13079     GEN_REWRITE_TAC RAND_CONV [HOMOTOPIC_LOOPS_SYM] THEN
13080     CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
13081     REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL;
13082                 PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
13083     ASM SET_TAC[]]);;
13084
13085 let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH = prove
13086  (`!s:real^N->bool.
13087         simply_connected s <=>
13088         path_connected s /\
13089         !p. path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p
13090             ==> homotopic_paths s p (linepath(pathstart p,pathstart p))`,
13091   GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL
13092    [ASM_SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED] THEN
13093     REPEAT STRIP_TAC THEN
13094     MATCH_MP_TAC HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL THEN
13095     EXISTS_TAC `pathstart p :real^N` THEN
13096     FIRST_X_ASSUM(MATCH_MP_TAC o
13097       REWRITE_RULE[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN
13098     ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET];
13099     REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN
13100     MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `a:real^N`] THEN
13101     STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
13102     EXISTS_TAC `linepath(pathstart p:real^N,pathfinish p)` THEN
13103     CONJ_TAC THENL
13104      [MATCH_MP_TAC HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS THEN
13105       ASM_SIMP_TAC[PATHFINISH_LINEPATH];
13106       ASM_REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN
13107       RULE_ASSUM_TAC(REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]) THEN
13108       FIRST_X_ASSUM MATCH_MP_TAC THEN
13109       ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]]]);;
13110
13111 let SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS = prove
13112  (`!s:real^N->bool.
13113         simply_connected s <=>
13114         path_connected s /\
13115         !p q. path p /\ path_image p SUBSET s /\
13116               path q /\ path_image q SUBSET s /\
13117               pathstart q = pathstart p /\ pathfinish q = pathfinish p
13118               ==> homotopic_paths s p q`,
13119   REPEAT GEN_TAC THEN REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH] THEN
13120   EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
13121   X_GEN_TAC `p:real^1->real^N` THENL
13122    [X_GEN_TAC `q:real^1->real^N` THEN STRIP_TAC THEN
13123     FIRST_X_ASSUM(MP_TAC o SPEC `p ++ reversepath q :real^1->real^N`) THEN
13124     ASM_SIMP_TAC[PATH_JOIN; PATHSTART_REVERSEPATH; PATH_REVERSEPATH;
13125                  PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH;
13126                  PATH_IMAGE_JOIN; UNION_SUBSET; PATH_IMAGE_REVERSEPATH] THEN
13127     DISCH_TAC THEN
13128     MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
13129     EXISTS_TAC `p ++ linepath(pathfinish p,pathfinish p):real^1->real^N` THEN
13130     GEN_REWRITE_TAC LAND_CONV [HOMOTOPIC_PATHS_SYM] THEN
13131     ASM_SIMP_TAC[HOMOTOPIC_PATHS_RID] THEN
13132     MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
13133     EXISTS_TAC `p ++ (reversepath q ++ q):real^1->real^N` THEN
13134     CONJ_TAC THENL
13135      [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
13136       ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL; PATHSTART_LINEPATH] THEN
13137       ASM_MESON_TAC[HOMOTOPIC_PATHS_LINV; HOMOTOPIC_PATHS_SYM];
13138       ALL_TAC] THEN
13139     MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
13140     EXISTS_TAC `(p ++ reversepath q) ++ q:real^1->real^N` THEN
13141     CONJ_TAC THENL
13142      [MATCH_MP_TAC HOMOTOPIC_PATHS_ASSOC THEN
13143       ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH] THEN
13144       ASM_REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH];
13145       ALL_TAC] THEN
13146     MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
13147     EXISTS_TAC `linepath(pathstart q,pathstart q) ++ q:real^1->real^N` THEN
13148     CONJ_TAC THENL
13149      [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
13150       ASM_SIMP_TAC[HOMOTOPIC_PATHS_RINV; HOMOTOPIC_PATHS_REFL] THEN
13151       ASM_REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_REVERSEPATH];
13152       ASM_MESON_TAC[HOMOTOPIC_PATHS_LID]];
13153     STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
13154     ASM_SIMP_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_LINEPATH] THEN
13155     REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN
13156     ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]]);;
13157
13158 let SIMPLY_CONNECTED_RETRACTION_GEN = prove
13159  (`!s:real^M->bool t:real^N->bool h k.
13160         h continuous_on s /\ IMAGE h s = t /\
13161         k continuous_on t /\ IMAGE k t SUBSET s /\
13162         (!y. y IN t ==> h(k y) = y) /\
13163         simply_connected s
13164         ==> simply_connected t`,
13165   REPEAT GEN_TAC THEN
13166   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
13167   REWRITE_TAC[simply_connected; path; path_image; homotopic_loops] THEN
13168   ONCE_REWRITE_TAC[TAUT
13169    `a /\ b /\ c /\ a' /\ b' /\ c' <=> a /\ c /\ b /\ a' /\ c' /\ b'`] THEN
13170   MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
13171     HOMOTOPICALLY_TRIVIAL_RETRACTION_GEN) THEN
13172   MAP_EVERY EXISTS_TAC [`h:real^M->real^N`; `k:real^N->real^M`] THEN
13173   ASM_SIMP_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN
13174   REWRITE_TAC[pathfinish; pathstart] THEN MESON_TAC[ENDS_IN_UNIT_INTERVAL]);;
13175
13176 let HOMEOMORPHIC_SIMPLY_CONNECTED = prove
13177  (`!s:real^M->bool t:real^N->bool.
13178         s homeomorphic t /\ simply_connected s
13179         ==> simply_connected t`,
13180   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
13181   MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
13182    (REWRITE_RULE[CONJ_ASSOC] SIMPLY_CONNECTED_RETRACTION_GEN)) THEN
13183   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
13184   REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
13185   SIMP_TAC[homeomorphism; SUBSET_REFL]);;
13186
13187 let HOMEOMORPHIC_SIMPLY_CONNECTED_EQ = prove
13188  (`!s:real^M->bool t:real^N->bool.
13189         s homeomorphic t
13190         ==> (simply_connected s <=> simply_connected t)`,
13191   REPEAT STRIP_TAC THEN EQ_TAC THEN
13192   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_SIMPLY_CONNECTED) THEN
13193   ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
13194   ASM_REWRITE_TAC[]);;
13195
13196 let SIMPLY_CONNECTED_TRANSLATION = prove
13197  (`!a:real^N s. simply_connected (IMAGE (\x. a + x) s) <=> simply_connected s`,
13198   REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_SIMPLY_CONNECTED_EQ THEN
13199   ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
13200   REWRITE_TAC[HOMEOMORPHIC_TRANSLATION]);;
13201
13202 add_translation_invariants [SIMPLY_CONNECTED_TRANSLATION];;
13203
13204 let SIMPLY_CONNECTED_INJECTIVE_LINEAR_IMAGE = prove
13205  (`!f:real^M->real^N s.
13206         linear f /\ (!x y. f x = f y ==> x = y)
13207         ==> (simply_connected (IMAGE f s) <=> simply_connected s)`,
13208   REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_SIMPLY_CONNECTED_EQ THEN
13209   ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ;
13210                 HOMEOMORPHIC_REFL]);;
13211
13212 add_linear_invariants [SIMPLY_CONNECTED_INJECTIVE_LINEAR_IMAGE];;
13213
13214 let SIMPLY_CONNECTED_PCROSS = prove
13215  (`!s:real^M->bool t:real^N->bool.
13216         simply_connected s /\ simply_connected t
13217         ==> simply_connected(s PCROSS t)`,
13218   REPEAT GEN_TAC THEN
13219   REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN
13220   REWRITE_TAC[path; path_image; pathstart; pathfinish; FORALL_PASTECART] THEN
13221   DISCH_TAC THEN
13222   MAP_EVERY X_GEN_TAC
13223    [`p:real^1->real^(M,N)finite_sum`; `a:real^M`; `b:real^N`] THEN
13224   REWRITE_TAC[PASTECART_IN_PCROSS; FORALL_IN_IMAGE; SUBSET] THEN STRIP_TAC THEN
13225   FIRST_X_ASSUM(CONJUNCTS_THEN2
13226    (MP_TAC o SPECL [`fstcart o (p:real^1->real^(M,N)finite_sum)`; `a:real^M`])
13227    (MP_TAC o SPECL [`sndcart o (p:real^1->real^(M,N)finite_sum)`;
13228                     `b:real^N`])) THEN
13229   ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_FSTCART; LINEAR_SNDCART;
13230                LINEAR_CONTINUOUS_ON; homotopic_loops; homotopic_with;
13231                pathfinish; pathstart; IMAGE_o; o_THM] THEN
13232   ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN ANTS_TAC THENL
13233    [RULE_ASSUM_TAC(REWRITE_RULE[PCROSS; IN_ELIM_THM]) THEN
13234     ASM_MESON_TAC[SNDCART_PASTECART];
13235     DISCH_THEN(X_CHOOSE_THEN
13236       `k:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC)] THEN
13237   ANTS_TAC THENL
13238    [RULE_ASSUM_TAC(REWRITE_RULE[PCROSS; IN_ELIM_THM]) THEN
13239     ASM_MESON_TAC[FSTCART_PASTECART];
13240     DISCH_THEN(X_CHOOSE_THEN
13241       `h:real^(1,1)finite_sum->real^M` STRIP_ASSUME_TAC)] THEN
13242   EXISTS_TAC
13243    `(\z. pastecart (h z) (k z))
13244     :real^(1,1)finite_sum->real^(M,N)finite_sum` THEN
13245   ASM_SIMP_TAC[CONTINUOUS_ON_PASTECART; ETA_AX] THEN
13246   REWRITE_TAC[LINEPATH_REFL; PASTECART_FST_SND] THEN
13247   ASM_SIMP_TAC[PASTECART_IN_PCROSS]);;
13248
13249 let SIMPLY_CONNECTED_PCROSS_EQ = prove
13250  (`!s:real^M->bool t:real^N->bool.
13251         simply_connected(s PCROSS t) <=>
13252         s = {} \/ t = {} \/ simply_connected s /\ simply_connected t`,
13253   REPEAT GEN_TAC THEN
13254   ASM_CASES_TAC `s:real^M->bool = {}` THEN
13255   ASM_REWRITE_TAC[PCROSS_EMPTY; SIMPLY_CONNECTED_EMPTY] THEN
13256   ASM_CASES_TAC `t:real^N->bool = {}` THEN
13257   ASM_REWRITE_TAC[PCROSS_EMPTY; SIMPLY_CONNECTED_EMPTY] THEN
13258   EQ_TAC THEN REWRITE_TAC[SIMPLY_CONNECTED_PCROSS] THEN REPEAT STRIP_TAC THENL
13259    [REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN
13260     MAP_EVERY X_GEN_TAC [`p:real^1->real^M`; `a:real^M`] THEN
13261     REWRITE_TAC[path; path_image; pathstart; pathfinish; SUBSET;
13262                 FORALL_IN_IMAGE] THEN
13263     STRIP_TAC THEN UNDISCH_TAC `~(t:real^N->bool = {})` THEN
13264     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
13265     DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN
13266     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
13267      [SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN
13268     DISCH_THEN(MP_TAC o SPECL
13269      [`(\t. pastecart (p t) (b)):real^1->real^(M,N)finite_sum`;
13270       `pastecart (a:real^M) (b:real^N)`]) THEN
13271     ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN
13272     ASM_SIMP_TAC[path; path_image; pathstart; pathfinish; SUBSET;
13273                  FORALL_IN_IMAGE; PASTECART_IN_PCROSS; PASTECART_INJ;
13274                  CONTINUOUS_ON_PASTECART; ETA_AX; CONTINUOUS_ON_CONST] THEN
13275     STRIP_TAC THEN
13276     MP_TAC(ISPECL
13277      [`(\t. pastecart (p t) b):real^1->real^(M,N)finite_sum`;
13278       `linepath (pastecart (a:real^M) (b:real^N),pastecart a b)`;
13279       `fstcart:real^(M,N)finite_sum->real^M`;
13280       `(s:real^M->bool) PCROSS (t:real^N->bool)`; `s:real^M->bool`]
13281         HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE) THEN
13282     ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
13283     SIMP_TAC[o_DEF; LINEPATH_REFL; FSTCART_PASTECART; ETA_AX;
13284              SUBSET; FORALL_IN_PCROSS; FORALL_IN_IMAGE];
13285     REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN
13286     MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `b:real^N`] THEN
13287     REWRITE_TAC[path; path_image; pathstart; pathfinish; SUBSET;
13288                 FORALL_IN_IMAGE] THEN
13289     STRIP_TAC THEN UNDISCH_TAC `~(s:real^M->bool = {})` THEN
13290     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
13291     DISCH_THEN(X_CHOOSE_THEN `a:real^M` STRIP_ASSUME_TAC) THEN
13292     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
13293      [SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN
13294     DISCH_THEN(MP_TAC o SPECL
13295      [`(\t. pastecart a (p t)):real^1->real^(M,N)finite_sum`;
13296       `pastecart (a:real^M) (b:real^N)`]) THEN
13297     ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN
13298     ASM_SIMP_TAC[path; path_image; pathstart; pathfinish; SUBSET;
13299                  FORALL_IN_IMAGE; PASTECART_IN_PCROSS; PASTECART_INJ;
13300                  CONTINUOUS_ON_PASTECART; ETA_AX; CONTINUOUS_ON_CONST] THEN
13301     STRIP_TAC THEN
13302     MP_TAC(ISPECL
13303      [`(\t. pastecart a (p t)):real^1->real^(M,N)finite_sum`;
13304       `linepath (pastecart (a:real^M) (b:real^N),pastecart a b)`;
13305       `sndcart:real^(M,N)finite_sum->real^N`;
13306       `(s:real^M->bool) PCROSS (t:real^N->bool)`; `t:real^N->bool`]
13307         HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE) THEN
13308     ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
13309     SIMP_TAC[o_DEF; LINEPATH_REFL; SNDCART_PASTECART; ETA_AX;
13310              SUBSET; FORALL_IN_PCROSS; FORALL_IN_IMAGE]]);;
13311
13312 (* ------------------------------------------------------------------------- *)
13313 (* A mapping out of a sphere is nullhomotopic iff it extends to the ball.    *)
13314 (* This even works out in the degenerate cases when the radius is <= 0, and  *)
13315 (* we also don't need to explicitly assume continuity since it's already     *)
13316 (* implicit in both sides of the equivalence.                                *)
13317 (* ------------------------------------------------------------------------- *)
13318
13319 let NULLHOMOTOPIC_FROM_SPHERE_EXTENSION = prove
13320  (`!f:real^M->real^N s a r.
13321         (?c. homotopic_with (\x. T) (sphere(a,r),s) f (\x. c)) <=>
13322         (?g. g continuous_on cball(a,r) /\ IMAGE g (cball(a,r)) SUBSET s /\
13323              !x. x IN sphere(a,r) ==> g x = f x)`,
13324   let lemma = prove
13325    (`!f:real^M->real^N g a r.
13326         (!e. &0 < e
13327              ==> ?d. &0 < d /\
13328                      !x. ~(x = a) /\ norm(x - a) < d ==> norm(g x - f a) < e) /\
13329         g continuous_on (cball(a,r) DELETE a) /\
13330         (!x. x IN cball(a,r) /\ ~(x = a) ==> f x = g x)
13331         ==> f continuous_on cball(a,r)`,
13332     REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
13333     X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_CBALL; dist] THEN STRIP_TAC THEN
13334     ASM_CASES_TAC `x:real^M = a` THENL
13335      [ASM_REWRITE_TAC[continuous_within; IN_CBALL; dist] THEN
13336       RULE_ASSUM_TAC(REWRITE_RULE[IN_CBALL; dist]) THEN
13337       X_GEN_TAC `e:real` THEN DISCH_TAC THEN
13338       FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN
13339       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
13340       GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
13341       X_GEN_TAC `y:real^M` THEN ASM_CASES_TAC `y:real^M = a` THEN
13342       ASM_MESON_TAC[VECTOR_SUB_REFL; NORM_0];
13343       MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN THEN
13344       EXISTS_TAC `g:real^M->real^N` THEN EXISTS_TAC `norm(x - a:real^M)` THEN
13345       ASM_SIMP_TAC[NORM_POS_LT; VECTOR_SUB_EQ; IN_CBALL; dist] THEN
13346       CONJ_TAC THENL
13347        [RULE_ASSUM_TAC(REWRITE_RULE[IN_CBALL; dist]);
13348         UNDISCH_TAC
13349          `(g:real^M->real^N) continuous_on (cball(a,r) DELETE a)` THEN
13350         REWRITE_TAC[continuous_on; continuous_within] THEN
13351         DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
13352         ASM_REWRITE_TAC[IN_DELETE; IN_CBALL; dist] THEN
13353         MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
13354         ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
13355         DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
13356         EXISTS_TAC `min d (norm(x - a:real^M))` THEN
13357         ASM_REWRITE_TAC[REAL_LT_MIN; NORM_POS_LT; VECTOR_SUB_EQ]] THEN
13358        ASM_MESON_TAC[NORM_SUB; NORM_ARITH
13359         `norm(y - x:real^N) < norm(x - a) ==> ~(y = a)`]]) in
13360   REWRITE_TAC[sphere; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
13361   REPEAT GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
13362    (REAL_ARITH `r < &0 \/ r = &0 \/ &0 < r`)
13363   THENL
13364    [ASM_SIMP_TAC[NORM_ARITH `r < &0 ==> ~(norm x = r)`] THEN
13365     FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [GSYM CBALL_EQ_EMPTY]) THEN
13366     ASM_SIMP_TAC[HOMOTOPIC_WITH; IMAGE_CLAUSES; EMPTY_GSPEC; NOT_IN_EMPTY;
13367        PCROSS; SET_RULE `{f t x |x,t| F} = {}`; EMPTY_SUBSET] THEN
13368     REWRITE_TAC[CONTINUOUS_ON_EMPTY];
13369     ASM_SIMP_TAC[NORM_EQ_0; VECTOR_SUB_EQ; CBALL_SING] THEN
13370     SIMP_TAC[HOMOTOPIC_WITH; PCROSS; FORALL_IN_GSPEC; FORALL_UNWIND_THM2] THEN
13371     ASM_CASES_TAC `(f:real^M->real^N) a IN s` THENL
13372      [MATCH_MP_TAC(TAUT `p /\ q ==> (p <=> q)`) THEN CONJ_TAC THENL
13373        [EXISTS_TAC `(f:real^M->real^N) a` THEN
13374         EXISTS_TAC `\y:real^(1,M)finite_sum. (f:real^M->real^N) a` THEN
13375         ASM_REWRITE_TAC[CONTINUOUS_ON_CONST; SUBSET; FORALL_IN_IMAGE];
13376         EXISTS_TAC `f:real^M->real^N` THEN REWRITE_TAC[CONTINUOUS_ON_SING] THEN
13377         ASM SET_TAC[]];
13378       MATCH_MP_TAC(TAUT `~q /\ ~p ==> (p <=> q)`) THEN CONJ_TAC THENL
13379        [ASM SET_TAC[]; STRIP_TAC] THEN
13380       UNDISCH_TAC `~((f:real^M->real^N) a IN s)` THEN REWRITE_TAC[] THEN
13381       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
13382        `IMAGE h t SUBSET s ==> (?y. y IN t /\ z = h y) ==> z IN s`)) THEN
13383       REWRITE_TAC[EXISTS_IN_GSPEC] THEN
13384       EXISTS_TAC `vec 0:real^1` THEN ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL] THEN
13385       ASM_REWRITE_TAC[EXISTS_IN_GSPEC; UNWIND_THM2]];
13386     ALL_TAC] THEN
13387   MATCH_MP_TAC(TAUT
13388    `!p. (q ==> p) /\ (r ==> p) /\ (p ==> (q <=> r)) ==> (q <=> r)`) THEN
13389   EXISTS_TAC
13390    `(f:real^M->real^N) continuous_on {x | norm(x - a) = r} /\
13391     IMAGE f {x | norm(x - a) = r} SUBSET s` THEN
13392   REPEAT CONJ_TAC THENL
13393    [STRIP_TAC THEN
13394     FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
13395     FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN
13396     ASM_REWRITE_TAC[];
13397     DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
13398     CONJ_TAC THENL
13399      [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `g:real^M->real^N` THEN
13400       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
13401       EXISTS_TAC `cball(a:real^M,r)`;
13402       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
13403         `IMAGE g t SUBSET s
13404          ==> u SUBSET t /\ (!x. x IN u ==> f x = g x)
13405              ==> IMAGE f u SUBSET s`)) THEN
13406       ASM_SIMP_TAC[]] THEN
13407     ASM_SIMP_TAC[SUBSET; IN_CBALL; dist; IN_ELIM_THM] THEN
13408     MESON_TAC[REAL_LE_REFL; NORM_SUB];
13409     STRIP_TAC] THEN
13410   ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN EQ_TAC THENL
13411    [REWRITE_TAC[homotopic_with; PCROSS; LEFT_IMP_EXISTS_THM] THEN
13412     MAP_EVERY X_GEN_TAC [`c:real^N`; `h:real^(1,M)finite_sum->real^N`] THEN
13413     STRIP_TAC THEN
13414     EXISTS_TAC `\x. (h:real^(1,M)finite_sum->real^N)
13415                     (pastecart (lift(inv(r) * norm(x - a)))
13416                                (a + (if x = a then r % basis 1
13417                                      else r / norm(x - a) % (x - a))))` THEN
13418     ASM_SIMP_TAC[IN_ELIM_THM; REAL_MUL_LINV; REAL_DIV_REFL; REAL_LT_IMP_NZ;
13419                  LIFT_NUM; VECTOR_ARITH `a + &1 % (x - a):real^N = x`] THEN
13420     REPEAT CONJ_TAC THENL
13421      [MATCH_MP_TAC lemma THEN
13422       EXISTS_TAC `\x. (h:real^(1,M)finite_sum->real^N)
13423                     (pastecart (lift(inv(r) * norm(x - a)))
13424                                (a + r / norm(x - a) % (x - a)))` THEN
13425       SIMP_TAC[] THEN CONJ_TAC THENL
13426        [X_GEN_TAC `e:real` THEN DISCH_TAC THEN
13427         ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_MUL_RZERO; LIFT_NUM] THEN
13428         FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
13429           COMPACT_UNIFORMLY_CONTINUOUS)) THEN
13430         SIMP_TAC[REWRITE_RULE[PCROSS] COMPACT_PCROSS;
13431             REWRITE_RULE[REWRITE_RULE[ONCE_REWRITE_RULE[DIST_SYM] dist] sphere]
13432                  COMPACT_SPHERE; COMPACT_INTERVAL] THEN
13433         REWRITE_TAC[uniformly_continuous_on] THEN
13434         DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
13435         REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN
13436         DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
13437         EXISTS_TAC `min r (d * r):real` THEN
13438         ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_MIN] THEN
13439         X_GEN_TAC `x:real^M` THEN REPEAT STRIP_TAC THEN
13440         FIRST_X_ASSUM(MP_TAC o SPEC `vec 0:real^1`) THEN
13441         REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; RIGHT_IMP_FORALL_THM] THEN
13442         ASM_REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN
13443         DISCH_THEN(MP_TAC o MATCH_MP (MESON[]
13444          `(!x t y. P x t y) ==> (!t x. P x t x)`)) THEN
13445         REWRITE_TAC[dist] THEN DISCH_THEN MATCH_MP_TAC THEN
13446         REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
13447         REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
13448         ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN
13449         ASM_SIMP_TAC[REAL_MUL_LID; REAL_MUL_LZERO; NORM_POS_LE] THEN
13450         ASM_SIMP_TAC[REAL_LT_IMP_LE; CONJ_ASSOC] THEN
13451         REWRITE_TAC[VECTOR_ADD_SUB; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
13452         ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
13453         ASM_SIMP_TAC[REAL_ARITH `&0 < r ==> abs r = r`] THEN
13454         REWRITE_TAC[PASTECART_SUB; VECTOR_SUB_REFL; NORM_PASTECART] THEN
13455         REWRITE_TAC[NORM_0; VECTOR_SUB_RZERO] THEN
13456         CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ADD_RID] THEN
13457         REWRITE_TAC[POW_2_SQRT_ABS; REAL_ABS_NORM; NORM_LIFT] THEN
13458         ASM_SIMP_TAC[REAL_ABS_DIV; REAL_LT_LDIV_EQ; REAL_ABS_NORM;
13459                      REAL_ARITH `&0 < r ==> abs r = r`];
13460         GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
13461         MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
13462          [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
13463           SIMP_TAC[CONTINUOUS_ON_CMUL; LIFT_CMUL; CONTINUOUS_ON_SUB;
13464                    CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST;
13465                    CONTINUOUS_ON_LIFT_NORM_COMPOSE] THEN
13466           MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
13467           REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
13468           MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
13469           SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST;
13470                    o_DEF; real_div; LIFT_CMUL] THEN
13471           MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
13472           REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
13473           GEN_TAC THEN REWRITE_TAC[IN_DELETE] THEN DISCH_TAC THEN
13474           MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN
13475           MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_INV) THEN
13476           ASM_SIMP_TAC[NETLIMIT_AT; NORM_EQ_0; VECTOR_SUB_EQ] THEN
13477           MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE THEN
13478           SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_AT_ID; CONTINUOUS_CONST];
13479           FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
13480             CONTINUOUS_ON_SUBSET)) THEN
13481           REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC; SUBSET] THEN
13482           REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_DELETE; IN_ELIM_THM] THEN
13483           SIMP_TAC[IN_CBALL; NORM_ARITH `dist(a:real^M,a + x) = norm x`] THEN
13484           REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
13485           REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
13486           REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
13487           ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN
13488           ASM_SIMP_TAC[REAL_MUL_LID; REAL_MUL_LZERO; NORM_POS_LE] THEN
13489           SIMP_TAC[VECTOR_ADD_SUB; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM;
13490                    REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
13491           ASM_REAL_ARITH_TAC]];
13492       GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
13493       REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
13494        `IMAGE g s SUBSET u ==> t SUBSET s ==> IMAGE g t SUBSET u`)) THEN
13495       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
13496       REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_CBALL; IN_ELIM_THM] THEN
13497       X_GEN_TAC `x:real^M` THEN
13498       REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN REPEAT STRIP_TAC THENL
13499        [REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
13500         REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
13501         ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN
13502         ASM_REWRITE_TAC[REAL_MUL_LID; REAL_MUL_LZERO; NORM_POS_LE];
13503         REWRITE_TAC[VECTOR_ADD_SUB] THEN COND_CASES_TAC THEN
13504         ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL;
13505                      REAL_ABS_DIV; REAL_ABS_NORM;
13506                      REAL_MUL_RID; REAL_ARITH `&0 < r ==> abs r = r`] THEN
13507         ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ]];
13508       GEN_TAC THEN COND_CASES_TAC THEN
13509       ASM_SIMP_TAC[VECTOR_SUB_REFL; NORM_0; REAL_LT_IMP_NZ] THEN
13510       REWRITE_TAC[VECTOR_ARITH `a + &1 % (x - a):real^N = x`]];
13511     DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
13512     EXISTS_TAC `(g:real^M->real^N) a` THEN
13513     ASM_SIMP_TAC[HOMOTOPIC_WITH; PCROSS] THEN
13514     EXISTS_TAC `\y:real^(1,M)finite_sum.
13515                    (g:real^M->real^N)
13516                    (a + drop(fstcart y) % (sndcart y - a))` THEN
13517     REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC] THEN
13518     REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_RID; VECTOR_MUL_LID] THEN
13519     ASM_SIMP_TAC[VECTOR_SUB_ADD2] THEN CONJ_TAC THENL
13520      [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
13521       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
13522        [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN SIMP_TAC[CONTINUOUS_ON_CONST] THEN
13523         MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
13524         SIMP_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST;
13525                  LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; LINEAR_FSTCART; ETA_AX];
13526         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
13527           CONTINUOUS_ON_SUBSET))];
13528       GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
13529       REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
13530        `IMAGE g s SUBSET u ==> t SUBSET s ==> IMAGE g t SUBSET u`))] THEN
13531     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
13532     REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_ELIM_THM] THEN
13533     REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(a:real^M,a + x) = norm x`] THEN
13534     ASM_SIMP_TAC[NORM_MUL; IN_INTERVAL_1; DROP_VEC; REAL_LE_RMUL_EQ;
13535                  REAL_ARITH `x * r <= r <=> x * r <= &1 * r`] THEN
13536     REAL_ARITH_TAC]);;
13537
13538 (* ------------------------------------------------------------------------- *)
13539 (* Homotopy equivalence.                                                     *)
13540 (* ------------------------------------------------------------------------- *)
13541
13542 parse_as_infix("homotopy_equivalent",(12,"right"));;
13543
13544 let homotopy_equivalent = new_definition
13545  `(s:real^M->bool) homotopy_equivalent (t:real^N->bool) <=>
13546         ?f g. f continuous_on s /\ IMAGE f s SUBSET t /\
13547               g continuous_on t /\ IMAGE g t SUBSET s /\
13548               homotopic_with (\x. T) (s,s) (g o f) I /\
13549               homotopic_with (\x. T) (t,t) (f o g) I`;;
13550
13551 let HOMOTOPY_EQUIVALENT = prove
13552  (`!s:real^M->bool t:real^N->bool.
13553         s homotopy_equivalent t <=>
13554         ?f g h. f continuous_on s /\ IMAGE f s SUBSET t /\
13555                 g continuous_on t /\ IMAGE g t SUBSET s /\
13556                 h continuous_on t /\ IMAGE h t SUBSET s /\
13557                 homotopic_with (\x. T) (s,s) (g o f) I /\
13558                 homotopic_with (\x. T) (t,t) (f o h) I`,
13559   REPEAT GEN_TAC THEN REWRITE_TAC[homotopy_equivalent] THEN
13560   MATCH_MP_TAC(MESON[] `(!x. P x <=> Q x) ==> ((?x. P x) <=> (?x. Q x))`) THEN
13561   X_GEN_TAC `f:real^M->real^N` THEN
13562   EQ_TAC THENL [MESON_TAC[]; STRIP_TAC] THEN
13563   EXISTS_TAC `(g:real^N->real^M) o f o (h:real^N->real^M)` THEN
13564   ASM_REWRITE_TAC[IMAGE_o] THEN REPEAT CONJ_TAC THENL
13565    [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN
13566     REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
13567      (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[];
13568     ASM SET_TAC[];
13569     TRANS_TAC HOMOTOPIC_WITH_TRANS
13570       `((g:real^N->real^M) o I) o (f:real^M->real^N)` THEN
13571     CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[I_O_ID]] THEN
13572     MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
13573     EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
13574     MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
13575     EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[];
13576     TRANS_TAC HOMOTOPIC_WITH_TRANS
13577       `(f:real^M->real^N) o I o (h:real^N->real^M)` THEN
13578     CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[I_O_ID]] THEN
13579     MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
13580     EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
13581     REWRITE_TAC[o_ASSOC] THEN
13582     MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
13583     EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[]]);;
13584
13585 let HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT = prove
13586  (`!s:real^M->bool t:real^N->bool.
13587         s homeomorphic t ==> s homotopy_equivalent t`,
13588   REPEAT GEN_TAC THEN
13589   REWRITE_TAC[homeomorphic; homotopy_equivalent; homeomorphism] THEN
13590   REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
13591   STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
13592   CONJ_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQUAL THEN
13593   ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; IMAGE_o; o_THM; I_THM; SUBSET_REFL]);;
13594
13595 let HOMOTOPY_EQUIVALENT_REFL = prove
13596  (`!s:real^N->bool. s homotopy_equivalent s`,
13597   SIMP_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT; HOMEOMORPHIC_REFL]);;
13598
13599 let HOMOTOPY_EQUIVALENT_SYM = prove
13600  (`!s:real^M->bool t:real^N->bool.
13601         s homotopy_equivalent t <=> t homotopy_equivalent s`,
13602   REPEAT GEN_TAC THEN REWRITE_TAC[homotopy_equivalent] THEN
13603   GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN
13604   REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN CONV_TAC TAUT);;
13605
13606 let HOMOTOPY_EQUIVALENT_TRANS = prove
13607  (`!s:real^M->bool t:real^N->bool u:real^P->bool.
13608         s homotopy_equivalent t /\ t homotopy_equivalent u
13609         ==> s homotopy_equivalent u`,
13610   REPEAT GEN_TAC THEN
13611   SIMP_TAC[homotopy_equivalent; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
13612   SIMP_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
13613   MAP_EVERY X_GEN_TAC
13614    [`f1:real^M->real^N`; `g1:real^N->real^M`;
13615     `f2:real^N->real^P`; `g2:real^P->real^N`] THEN
13616   STRIP_TAC THEN
13617   MAP_EVERY EXISTS_TAC
13618    [`(f2:real^N->real^P) o (f1:real^M->real^N)`;
13619     `(g1:real^N->real^M) o (g2:real^P->real^N)`] THEN
13620   REWRITE_TAC[IMAGE_o] THEN
13621   REPLICATE_TAC 2
13622    (CONJ_TAC THENL
13623     [ASM_MESON_TAC[CONTINUOUS_ON_COMPOSE; CONTINUOUS_ON_SUBSET];ALL_TAC] THEN
13624     CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
13625   CONJ_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_TRANS THENL
13626    [EXISTS_TAC `(g1:real^N->real^M) o I o (f1:real^M->real^N)`;
13627     EXISTS_TAC `(f2:real^N->real^P) o I o (g2:real^P->real^N)`] THEN
13628   (CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[I_O_ID]]) THEN
13629   REWRITE_TAC[GSYM o_ASSOC] THEN
13630   MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
13631   EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
13632   REWRITE_TAC[o_ASSOC] THEN
13633   MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
13634   EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]);;
13635
13636 let HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_SELF = prove
13637  (`!f:real^M->real^N s.
13638         linear f /\ (!x y. f x = f y ==> x = y)
13639         ==> (IMAGE f s) homotopy_equivalent s`,
13640   REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT THEN
13641   MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF THEN
13642   ASM_REWRITE_TAC[]);;
13643
13644 let HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ = prove
13645  (`!f:real^M->real^N s t.
13646         linear f /\ (!x y. f x = f y ==> x = y)
13647         ==> ((IMAGE f s) homotopy_equivalent t <=> s homotopy_equivalent t)`,
13648   REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o SPEC `s:real^M->bool` o
13649     MATCH_MP HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_SELF) THEN
13650   EQ_TAC THENL
13651    [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMOTOPY_EQUIVALENT_SYM]);
13652     POP_ASSUM MP_TAC] THEN
13653   REWRITE_TAC[IMP_IMP; HOMOTOPY_EQUIVALENT_TRANS]);;
13654
13655 let HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ = prove
13656  (`!f:real^M->real^N s t.
13657         linear f /\ (!x y. f x = f y ==> x = y)
13658         ==> (s homotopy_equivalent (IMAGE f t) <=> s homotopy_equivalent t)`,
13659   ONCE_REWRITE_TAC[HOMOTOPY_EQUIVALENT_SYM] THEN
13660   REWRITE_TAC[HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ]);;
13661
13662 add_linear_invariants
13663   [HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ;
13664    HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ];;
13665
13666 let HOMOTOPY_EQUIVALENT_TRANSLATION_SELF = prove
13667  (`!a:real^N s. (IMAGE (\x. a + x) s) homotopy_equivalent s`,
13668   REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT THEN
13669   REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);;
13670
13671 let HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ = prove
13672  (`!a:real^N s t.
13673       (IMAGE (\x. a + x) s) homotopy_equivalent t <=> s homotopy_equivalent t`,
13674   MESON_TAC[HOMOTOPY_EQUIVALENT_TRANSLATION_SELF;
13675             HOMOTOPY_EQUIVALENT_SYM; HOMOTOPY_EQUIVALENT_TRANS]);;
13676
13677 let HOMOTOPY_EQUIVALENT_TRANSLATION_RIGHT_EQ = prove
13678  (`!a:real^N s t.
13679       s homotopy_equivalent (IMAGE (\x. a + x) t) <=> s homotopy_equivalent t`,
13680   ONCE_REWRITE_TAC[HOMOTOPY_EQUIVALENT_SYM] THEN
13681   REWRITE_TAC[HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ]);;
13682
13683 add_translation_invariants
13684   [HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ;
13685    HOMOTOPY_EQUIVALENT_TRANSLATION_RIGHT_EQ];;
13686
13687 let HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY = prove
13688   (`!s:real^M->bool t:real^N->bool u:real^P->bool.
13689         s homotopy_equivalent t
13690         ==> ((!f g. f continuous_on u /\ IMAGE f u SUBSET s /\
13691                     g continuous_on u /\ IMAGE g u SUBSET s
13692                     ==> homotopic_with (\x. T) (u,s) f g) <=>
13693              (!f g. f continuous_on u /\ IMAGE f u SUBSET t /\
13694                     g continuous_on u /\ IMAGE g u SUBSET t
13695                     ==> homotopic_with (\x. T) (u,t) f g))`,
13696   let lemma = prove
13697    (`!s:real^M->bool t:real^N->bool u:real^P->bool.
13698           s homotopy_equivalent t /\
13699           (!f g. f continuous_on u /\ IMAGE f u SUBSET s /\
13700                  g continuous_on u /\ IMAGE g u SUBSET s
13701                  ==> homotopic_with (\x. T) (u,s) f g)
13702           ==> (!f g. f continuous_on u /\ IMAGE f u SUBSET t /\
13703                      g continuous_on u /\ IMAGE g u SUBSET t
13704                      ==> homotopic_with (\x. T) (u,t) f g)`,
13705     REPEAT STRIP_TAC THEN
13706     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN
13707     DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N`
13708      (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN
13709     SUBGOAL_THEN
13710      `homotopic_with (\x. T) (u,t)
13711           ((h:real^M->real^N) o (k:real^N->real^M) o (f:real^P->real^N))
13712           (h o k o g)`
13713     MP_TAC THENL
13714      [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
13715       EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
13716       FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IMAGE_o] THEN
13717       REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN
13718       ASM_REWRITE_TAC[] THEN
13719       TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
13720         CONTINUOUS_ON_SUBSET))) THEN
13721       ASM SET_TAC[];
13722       MATCH_MP_TAC(MESON[HOMOTOPIC_WITH_TRANS; HOMOTOPIC_WITH_SYM]
13723        `homotopic_with P (u,t) f f' /\ homotopic_with P (u,t) g g'
13724         ==> homotopic_with P (u,t) f g ==> homotopic_with P (u,t) f' g'`) THEN
13725       CONJ_TAC THEN
13726       GEN_REWRITE_TAC RAND_CONV [GSYM(CONJUNCT1(SPEC_ALL I_O_ID))] THEN
13727       REWRITE_TAC[o_ASSOC] THEN
13728       MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
13729       EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]]) in
13730   REPEAT STRIP_TAC THEN EQ_TAC THEN
13731   MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN
13732   ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);;
13733
13734 let HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY = prove
13735  (`!s:real^M->bool t:real^N->bool u:real^P->bool.
13736         s homotopy_equivalent t
13737         ==> ((!f g. f continuous_on s /\ IMAGE f s SUBSET u /\
13738                     g continuous_on s /\ IMAGE g s SUBSET u
13739                     ==> homotopic_with (\x. T) (s,u) f g) <=>
13740              (!f g. f continuous_on t /\ IMAGE f t SUBSET u /\
13741                     g continuous_on t /\ IMAGE g t SUBSET u
13742                     ==> homotopic_with (\x. T) (t,u) f g))`,
13743   let lemma = prove
13744    (`!s:real^M->bool t:real^N->bool u:real^P->bool.
13745           s homotopy_equivalent t /\
13746           (!f g. f continuous_on s /\ IMAGE f s SUBSET u /\
13747                  g continuous_on s /\ IMAGE g s SUBSET u
13748                  ==> homotopic_with (\x. T) (s,u) f g)
13749            ==> (!f g. f continuous_on t /\ IMAGE f t SUBSET u /\
13750                       g continuous_on t /\ IMAGE g t SUBSET u
13751                       ==> homotopic_with (\x. T) (t,u) f g)`,
13752     REPEAT STRIP_TAC THEN
13753     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN
13754     DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N`
13755      (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN
13756     SUBGOAL_THEN
13757      `homotopic_with (\x. T) (t,u)
13758           (((f:real^N->real^P) o h) o (k:real^N->real^M)) ((g o h) o k)`
13759     MP_TAC THENL
13760      [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
13761       EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
13762       FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IMAGE_o] THEN
13763       REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN
13764       ASM_REWRITE_TAC[] THEN
13765       TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
13766         CONTINUOUS_ON_SUBSET))) THEN
13767       ASM SET_TAC[];
13768       MATCH_MP_TAC(MESON[HOMOTOPIC_WITH_TRANS; HOMOTOPIC_WITH_SYM]
13769        `homotopic_with P (u,t) f f' /\ homotopic_with P (u,t) g g'
13770         ==> homotopic_with P (u,t) f g ==> homotopic_with P (u,t) f' g'`) THEN
13771       CONJ_TAC THEN
13772       GEN_REWRITE_TAC RAND_CONV [GSYM(CONJUNCT2(SPEC_ALL I_O_ID))] THEN
13773       REWRITE_TAC[GSYM o_ASSOC] THEN
13774       MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
13775       EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]]) in
13776   REPEAT STRIP_TAC THEN EQ_TAC THEN
13777   MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN
13778   ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);;
13779
13780 let HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY_NULL = prove
13781   (`!s:real^M->bool t:real^N->bool u:real^P->bool.
13782         s homotopy_equivalent t
13783         ==> ((!f. f continuous_on u /\ IMAGE f u SUBSET s
13784                   ==> ?c. homotopic_with (\x. T) (u,s) f (\x. c)) <=>
13785              (!f. f continuous_on u /\ IMAGE f u SUBSET t
13786                   ==> ?c. homotopic_with (\x. T) (u,t) f (\x. c)))`,
13787   let lemma = prove
13788    (`!s:real^M->bool t:real^N->bool u:real^P->bool.
13789           s homotopy_equivalent t /\
13790           (!f. f continuous_on u /\ IMAGE f u SUBSET s
13791                ==> ?c. homotopic_with (\x. T) (u,s) f (\x. c))
13792           ==> (!f. f continuous_on u /\ IMAGE f u SUBSET t
13793                    ==> ?c. homotopic_with (\x. T) (u,t) f (\x. c))`,
13794     REPEAT STRIP_TAC THEN
13795     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN
13796     DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N`
13797      (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN
13798     FIRST_X_ASSUM(MP_TAC o SPEC `(k:real^N->real^M) o (f:real^P->real^N)`) THEN
13799     REWRITE_TAC[IMAGE_o] THEN ANTS_TAC THENL
13800      [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE; ASM SET_TAC[]] THEN
13801       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
13802       DISCH_THEN(X_CHOOSE_TAC `c:real^M`) THEN
13803       EXISTS_TAC `(h:real^M->real^N) c`] THEN
13804     SUBGOAL_THEN
13805      `homotopic_with (\x. T) (u,t)
13806           ((h:real^M->real^N) o (k:real^N->real^M) o (f:real^P->real^N))
13807           (h o (\x. c))`
13808     MP_TAC THENL
13809      [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
13810       EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[];
13811       GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [o_DEF] THEN
13812       REWRITE_TAC[] THEN
13813       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_TRANS) THEN
13814       GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT1(SPEC_ALL I_O_ID))] THEN
13815       REWRITE_TAC[o_ASSOC] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN
13816       MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
13817       EXISTS_TAC `t:real^N->bool` THEN
13818       ASM_REWRITE_TAC[]]) in
13819   REPEAT STRIP_TAC THEN EQ_TAC THEN
13820   MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN
13821   ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);;
13822
13823 let HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL = prove
13824  (`!s:real^M->bool t:real^N->bool u:real^P->bool.
13825         s homotopy_equivalent t
13826         ==> ((!f. f continuous_on s /\ IMAGE f s SUBSET u
13827                   ==> ?c. homotopic_with (\x. T) (s,u) f (\x. c)) <=>
13828              (!f. f continuous_on t /\ IMAGE f t SUBSET u
13829                   ==> ?c. homotopic_with (\x. T) (t,u) f (\x. c)))`,
13830   let lemma = prove
13831    (`!s:real^M->bool t:real^N->bool u:real^P->bool.
13832           s homotopy_equivalent t /\
13833           (!f. f continuous_on s /\ IMAGE f s SUBSET u
13834                ==> ?c. homotopic_with (\x. T) (s,u) f (\x. c))
13835           ==> (!f. f continuous_on t /\ IMAGE f t SUBSET u
13836                    ==> ?c. homotopic_with (\x. T) (t,u) f (\x. c))`,
13837     REPEAT STRIP_TAC THEN
13838     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN
13839     DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N`
13840      (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN
13841     FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^N->real^P) o (h:real^M->real^N)`) THEN
13842     REWRITE_TAC[IMAGE_o] THEN ANTS_TAC THENL
13843      [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE; ASM SET_TAC[]] THEN
13844       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
13845       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^P` THEN DISCH_TAC] THEN
13846     SUBGOAL_THEN
13847      `homotopic_with (\x. T) (t,u)
13848           (((f:real^N->real^P) o h) o (k:real^N->real^M)) ((\x. c) o k)`
13849     MP_TAC THENL
13850      [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
13851       EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[];
13852       GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [o_DEF] THEN
13853       REWRITE_TAC[] THEN
13854       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_TRANS) THEN
13855       GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT2(SPEC_ALL I_O_ID))] THEN
13856       REWRITE_TAC[GSYM o_ASSOC] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN
13857       MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
13858       EXISTS_TAC `t:real^N->bool` THEN
13859       ASM_REWRITE_TAC[]]) in
13860   REPEAT STRIP_TAC THEN EQ_TAC THEN
13861   MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN
13862   ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);;
13863
13864 let HOMOTOPY_INVARIANT_CONNECTEDNESS = prove
13865  (`!f:real^M->real^N g s t.
13866         f continuous_on s /\ IMAGE f s SUBSET t /\
13867         g continuous_on t /\ IMAGE g t SUBSET s /\
13868         homotopic_with (\x. T) (t,t) (f o g) I /\
13869         connected s
13870         ==> connected t`,
13871   REPEAT STRIP_TAC THEN
13872   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN
13873   REWRITE_TAC[o_THM; I_THM] THEN
13874   DISCH_THEN(X_CHOOSE_THEN `h:real^(1,N)finite_sum->real^N`
13875         STRIP_ASSUME_TAC) THEN
13876   SUBGOAL_THEN
13877   `t = IMAGE (h:real^(1,N)finite_sum->real^N) (interval[vec 0,vec 1] PCROSS t)`
13878   SUBST1_TAC THENL
13879    [MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN
13880     REWRITE_TAC[SUBSET; IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN
13881     DISCH_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
13882     REWRITE_TAC[EXISTS_IN_PCROSS] THEN
13883     ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL];
13884     ALL_TAC] THEN
13885   REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT; IMP_CONJ] THEN
13886   REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
13887   MAP_EVERY X_GEN_TAC [`t1:real^1`; `x1:real^N`] THEN STRIP_TAC THEN
13888   MAP_EVERY X_GEN_TAC [`t2:real^1`; `x2:real^N`] THEN STRIP_TAC THEN
13889   MATCH_MP_TAC(MESON[CONNECTED_COMPONENT_TRANS; CONNECTED_COMPONENT_SYM]
13890     `!a b. (connected_component t a a' /\ connected_component t b b') /\
13891            connected_component t a b
13892            ==> connected_component t a' b'`) THEN
13893   MAP_EVERY EXISTS_TAC
13894    [`(h:real^(1,N)finite_sum->real^N) (pastecart (vec 0) x1)`;
13895     `(h:real^(1,N)finite_sum->real^N) (pastecart (vec 0) x2)`] THEN
13896   CONJ_TAC THENL
13897    [REWRITE_TAC[connected_component] THEN CONJ_TAC THENL
13898      [EXISTS_TAC
13899        `IMAGE ((h:real^(1,N)finite_sum->real^N) o (\s. pastecart s x1))
13900               (interval[vec 0,vec 1])`;
13901       EXISTS_TAC
13902        `IMAGE ((h:real^(1,N)finite_sum->real^N) o (\s. pastecart s x2))
13903               (interval[vec 0,vec 1])`] THEN
13904     (CONJ_TAC THENL
13905      [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
13906       REWRITE_TAC[CONNECTED_INTERVAL] THEN
13907       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
13908       SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID;
13909                CONTINUOUS_ON_CONST] THEN
13910       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
13911         CONTINUOUS_ON_SUBSET)) THEN
13912       ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS];
13913       REWRITE_TAC[IMAGE_o] THEN CONJ_TAC THENL
13914        [MATCH_MP_TAC IMAGE_SUBSET THEN
13915         ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS];
13916         CONJ_TAC THEN MATCH_MP_TAC FUN_IN_IMAGE] THEN
13917       REWRITE_TAC[IN_IMAGE] THEN ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL]]);
13918     ASM_REWRITE_TAC[connected_component] THEN
13919     EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN
13920     ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE] THEN
13921     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
13922     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_IMAGE] THEN
13923     REWRITE_TAC[EXISTS_PASTECART; PASTECART_IN_PCROSS] THEN
13924     X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN
13925     MAP_EVERY EXISTS_TAC [`vec 1:real^1`; `(f:real^M->real^N) y`] THEN
13926     ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM SET_TAC[]]);;
13927
13928 let HOMOTOPY_INVARIANT_PATH_CONNECTEDNESS = prove
13929  (`!f:real^M->real^N g s t.
13930         f continuous_on s /\ IMAGE f s SUBSET t /\
13931         g continuous_on t /\ IMAGE g t SUBSET s /\
13932         homotopic_with (\x. T) (t,t) (f o g) I /\
13933         path_connected s
13934         ==> path_connected t`,
13935   REPEAT STRIP_TAC THEN
13936   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN
13937   REWRITE_TAC[o_THM; I_THM] THEN
13938   DISCH_THEN(X_CHOOSE_THEN `h:real^(1,N)finite_sum->real^N`
13939         STRIP_ASSUME_TAC) THEN
13940   SUBGOAL_THEN
13941   `t = IMAGE (h:real^(1,N)finite_sum->real^N) (interval[vec 0,vec 1] PCROSS t)`
13942   SUBST1_TAC THENL
13943    [MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN
13944     REWRITE_TAC[SUBSET; IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN
13945     DISCH_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
13946     REWRITE_TAC[EXISTS_IN_PCROSS] THEN
13947     ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL];
13948     ALL_TAC] THEN
13949   REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT; IMP_CONJ] THEN
13950   REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
13951   MAP_EVERY X_GEN_TAC [`t1:real^1`; `x1:real^N`] THEN STRIP_TAC THEN
13952   MAP_EVERY X_GEN_TAC [`t2:real^1`; `x2:real^N`] THEN STRIP_TAC THEN
13953   MATCH_MP_TAC(MESON[PATH_COMPONENT_TRANS; PATH_COMPONENT_SYM]
13954     `!a b. (path_component t a a' /\ path_component t b b') /\
13955            path_component t a b
13956            ==> path_component t a' b'`) THEN
13957   MAP_EVERY EXISTS_TAC
13958    [`(h:real^(1,N)finite_sum->real^N) (pastecart (vec 0) x1)`;
13959     `(h:real^(1,N)finite_sum->real^N) (pastecart (vec 0) x2)`] THEN
13960   CONJ_TAC THENL
13961    [REWRITE_TAC[PATH_COMPONENT] THEN CONJ_TAC THENL
13962      [EXISTS_TAC
13963        `IMAGE ((h:real^(1,N)finite_sum->real^N) o (\s. pastecart s x1))
13964               (interval[vec 0,vec 1])`;
13965       EXISTS_TAC
13966        `IMAGE ((h:real^(1,N)finite_sum->real^N) o (\s. pastecart s x2))
13967               (interval[vec 0,vec 1])`] THEN
13968     (CONJ_TAC THENL
13969      [MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN
13970       REWRITE_TAC[PATH_CONNECTED_INTERVAL] THEN
13971       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
13972       SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID;
13973                CONTINUOUS_ON_CONST] THEN
13974       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
13975         CONTINUOUS_ON_SUBSET)) THEN
13976       ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS];
13977       REWRITE_TAC[IMAGE_o] THEN CONJ_TAC THENL
13978        [MATCH_MP_TAC IMAGE_SUBSET THEN
13979         ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS];
13980         CONJ_TAC THEN MATCH_MP_TAC FUN_IN_IMAGE] THEN
13981       REWRITE_TAC[IN_IMAGE] THEN ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL]]);
13982     ASM_REWRITE_TAC[PATH_COMPONENT] THEN
13983     EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN
13984     ASM_SIMP_TAC[PATH_CONNECTED_CONTINUOUS_IMAGE] THEN
13985     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
13986     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_IMAGE] THEN
13987     REWRITE_TAC[EXISTS_PASTECART; PASTECART_IN_PCROSS] THEN
13988     X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN
13989     MAP_EVERY EXISTS_TAC [`vec 1:real^1`; `(f:real^M->real^N) y`] THEN
13990     ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM SET_TAC[]]);;
13991
13992 let HOMOTOPY_EQUIVALENT_CONNECTEDNESS = prove
13993  (`!s:real^M->bool t:real^N->bool.
13994         s homotopy_equivalent t ==> (connected s <=> connected t)`,
13995   REWRITE_TAC[homotopy_equivalent] THEN REPEAT STRIP_TAC THEN
13996   EQ_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
13997    (REWRITE_RULE[CONJ_ASSOC] HOMOTOPY_INVARIANT_CONNECTEDNESS)) THEN
13998   ASM_MESON_TAC[]);;
13999
14000 let HOMOTOPY_EQUIVALENT_PATH_CONNECTEDNESS = prove
14001  (`!s:real^M->bool t:real^N->bool.
14002         s homotopy_equivalent t ==> (path_connected s <=> path_connected t)`,
14003   REWRITE_TAC[homotopy_equivalent] THEN REPEAT STRIP_TAC THEN
14004   EQ_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
14005    (REWRITE_RULE[CONJ_ASSOC] HOMOTOPY_INVARIANT_PATH_CONNECTEDNESS)) THEN
14006   ASM_MESON_TAC[]);;
14007
14008 (* ------------------------------------------------------------------------- *)
14009 (* Contractible sets.                                                        *)
14010 (* ------------------------------------------------------------------------- *)
14011
14012 let contractible = new_definition
14013  `contractible s <=> ?a. homotopic_with (\x. T) (s,s) (\x. x) (\x. a)`;;
14014
14015 let CONTRACTIBLE_IMP_SIMPLY_CONNECTED = prove
14016  (`!s:real^N->bool. contractible s ==> simply_connected s`,
14017   GEN_TAC THEN REWRITE_TAC[contractible] THEN
14018   ASM_CASES_TAC `s:real^N->bool = {}` THEN
14019   ASM_REWRITE_TAC[SIMPLY_CONNECTED_EMPTY] THEN
14020   ASM_REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ALL] THEN
14021   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN
14022   DISCH_TAC THEN REWRITE_TAC[homotopic_loops; PCROSS] THEN
14023   FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
14024   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN
14025   CONJ_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN
14026   X_GEN_TAC `p:real^1->real^N` THEN
14027   REWRITE_TAC[path; path_image; pathfinish; pathstart] THEN
14028   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN STRIP_TAC THEN
14029   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN
14030   REWRITE_TAC[homotopic_with; SUBSET; FORALL_IN_IMAGE; PCROSS] THEN
14031   REWRITE_TAC[FORALL_IN_GSPEC] THEN
14032   DISCH_THEN(X_CHOOSE_THEN `h:real^(1,N)finite_sum->real^N`
14033     STRIP_ASSUME_TAC) THEN
14034   EXISTS_TAC `(h o (\y. pastecart (fstcart y) (p(sndcart y):real^N)))
14035               :real^(1,1)finite_sum->real^N` THEN
14036   ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; linepath; o_THM] THEN
14037   CONJ_TAC THENL [ALL_TAC; CONV_TAC VECTOR_ARITH] THEN
14038   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
14039    [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
14040     SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
14041     GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
14042     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
14043     SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART];
14044     ALL_TAC] THEN
14045   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE [IMP_CONJ]
14046      CONTINUOUS_ON_SUBSET)) THEN
14047   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
14048   ASM_SIMP_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART]);;
14049
14050 let CONTRACTIBLE_IMP_CONNECTED = prove
14051  (`!s:real^N->bool. contractible s ==> connected s`,
14052   SIMP_TAC[CONTRACTIBLE_IMP_SIMPLY_CONNECTED;
14053            SIMPLY_CONNECTED_IMP_CONNECTED]);;
14054
14055 let CONTRACTIBLE_IMP_PATH_CONNECTED = prove
14056  (`!s:real^N->bool. contractible s ==> path_connected s`,
14057   SIMP_TAC[CONTRACTIBLE_IMP_SIMPLY_CONNECTED;
14058            SIMPLY_CONNECTED_IMP_PATH_CONNECTED]);;
14059
14060 let NULLHOMOTOPIC_THROUGH_CONTRACTIBLE = prove
14061  (`!f:real^M->real^N g:real^N->real^P s t u.
14062         f continuous_on s /\ IMAGE f s SUBSET t /\
14063         g continuous_on t /\ IMAGE g t SUBSET u /\
14064         contractible t
14065         ==> ?c. homotopic_with (\h. T) (s,u) (g o f) (\x. c)`,
14066   REPEAT STRIP_TAC THEN
14067   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [contractible]) THEN
14068   DISCH_THEN(X_CHOOSE_THEN `b:real^N` MP_TAC) THEN
14069   DISCH_THEN(MP_TAC o ISPECL [`g:real^N->real^P`; `u:real^P->bool`] o MATCH_MP
14070    (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN
14071   ASM_REWRITE_TAC[] THEN
14072   DISCH_THEN(MP_TAC o ISPECL [`f:real^M->real^N`; `s:real^M->bool`] o MATCH_MP
14073    (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_COMPOSE_CONTINUOUS_RIGHT)) THEN
14074   ASM_REWRITE_TAC[o_DEF] THEN DISCH_TAC THEN
14075   EXISTS_TAC `(g:real^N->real^P) b` THEN ASM_REWRITE_TAC[]);;
14076
14077 let NULLHOMOTOPIC_INTO_CONTRACTIBLE = prove
14078  (`!f:real^M->real^N s t.
14079         f continuous_on s /\ IMAGE f s SUBSET t /\ contractible t
14080         ==> ?c. homotopic_with (\h. T) (s,t) f (\x. c)`,
14081   REPEAT STRIP_TAC THEN
14082   SUBGOAL_THEN `(f:real^M->real^N) = (\x. x) o f` SUBST1_TAC THENL
14083    [REWRITE_TAC[o_THM; FUN_EQ_THM];
14084     MATCH_MP_TAC NULLHOMOTOPIC_THROUGH_CONTRACTIBLE THEN
14085     EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN
14086     SET_TAC[]]);;
14087
14088 let NULLHOMOTOPIC_FROM_CONTRACTIBLE = prove
14089  (`!f:real^M->real^N s t.
14090         f continuous_on s /\ IMAGE f s SUBSET t /\ contractible s
14091         ==> ?c. homotopic_with (\h. T) (s,t) f (\x. c)`,
14092   REPEAT STRIP_TAC THEN
14093   SUBGOAL_THEN `(f:real^M->real^N) = f o (\x. x)` SUBST1_TAC THENL
14094    [REWRITE_TAC[o_THM; FUN_EQ_THM];
14095     MATCH_MP_TAC NULLHOMOTOPIC_THROUGH_CONTRACTIBLE THEN
14096     EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN
14097     SET_TAC[]]);;
14098
14099 let HOMOTOPIC_THROUGH_CONTRACTIBLE = prove
14100  (`!f1:real^M->real^N g1:real^N->real^P f2 g2 s t u.
14101         f1 continuous_on s /\ IMAGE f1 s SUBSET t /\
14102         g1 continuous_on t /\ IMAGE g1 t SUBSET u /\
14103         f2 continuous_on s /\ IMAGE f2 s SUBSET t /\
14104         g2 continuous_on t /\ IMAGE g2 t SUBSET u /\
14105         contractible t /\ path_connected u
14106         ==> homotopic_with (\h. T) (s,u) (g1 o f1) (g2 o f2)`,
14107   REPEAT STRIP_TAC THEN MP_TAC(ISPECL
14108    [`f1:real^M->real^N`; `g1:real^N->real^P`; `s:real^M->bool`;
14109     `t:real^N->bool`; `u:real^P->bool`]
14110     NULLHOMOTOPIC_THROUGH_CONTRACTIBLE) THEN
14111   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c1:real^P` THEN
14112   DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET th) THEN
14113                        MP_TAC th) THEN
14114   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN
14115   ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN MP_TAC(ISPECL
14116    [`f2:real^M->real^N`; `g2:real^N->real^P`; `s:real^M->bool`;
14117     `t:real^N->bool`; `u:real^P->bool`]
14118    NULLHOMOTOPIC_THROUGH_CONTRACTIBLE) THEN
14119   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c2:real^P` THEN
14120   DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET th) THEN
14121                        MP_TAC th) THEN
14122   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN
14123   REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN FIRST_X_ASSUM
14124    (MP_TAC o GEN_REWRITE_RULE I [PATH_CONNECTED_IFF_PATH_COMPONENT]) THEN
14125   ASM SET_TAC[]);;
14126
14127 let HOMOTOPIC_INTO_CONTRACTIBLE = prove
14128  (`!f:real^M->real^N g s t.
14129         f continuous_on s /\ IMAGE f s SUBSET t /\
14130         g continuous_on s /\ IMAGE g s SUBSET t /\
14131         contractible t
14132         ==> homotopic_with (\h. T) (s,t) f g`,
14133   REPEAT STRIP_TAC THEN SUBGOAL_THEN
14134    `(f:real^M->real^N) = (\x. x) o f /\ (g:real^M->real^N) = (\x. x) o g`
14135    (CONJUNCTS_THEN SUBST1_TAC)
14136   THENL [REWRITE_TAC[o_THM; FUN_EQ_THM]; ALL_TAC] THEN
14137   MATCH_MP_TAC HOMOTOPIC_THROUGH_CONTRACTIBLE THEN
14138   EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN
14139   ASM_SIMP_TAC[IMAGE_ID; SUBSET_REFL; CONTRACTIBLE_IMP_PATH_CONNECTED]);;
14140
14141 let HOMOTOPIC_FROM_CONTRACTIBLE = prove
14142  (`!f:real^M->real^N g s t.
14143         f continuous_on s /\ IMAGE f s SUBSET t /\
14144         g continuous_on s /\ IMAGE g s SUBSET t /\
14145         contractible s /\ path_connected t
14146         ==> homotopic_with (\h. T) (s,t) f g`,
14147   REPEAT STRIP_TAC THEN
14148   REPEAT STRIP_TAC THEN SUBGOAL_THEN
14149    `(f:real^M->real^N) = f o (\x. x) /\ (g:real^M->real^N) = g o (\x. x)`
14150    (CONJUNCTS_THEN SUBST1_TAC)
14151   THENL [REWRITE_TAC[o_THM; FUN_EQ_THM]; ALL_TAC] THEN
14152   MATCH_MP_TAC HOMOTOPIC_THROUGH_CONTRACTIBLE THEN
14153   EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN
14154   ASM_REWRITE_TAC[IMAGE_ID; SUBSET_REFL]);;
14155
14156 let HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS = prove
14157  (`!s:real^M->bool t:real^N->bool.
14158         contractible s /\ contractible t /\ (s = {} <=> t = {})
14159         ==> s homotopy_equivalent t`,
14160   REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN
14161   ASM_SIMP_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT; HOMEOMORPHIC_EMPTY] THEN
14162   FIRST_X_ASSUM(X_CHOOSE_TAC `b:real^N` o
14163     GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
14164   STRIP_TAC THEN REWRITE_TAC[homotopy_equivalent] THEN
14165   FIRST_X_ASSUM(X_CHOOSE_TAC `a:real^M` o
14166     GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
14167   EXISTS_TAC `(\x. b):real^M->real^N` THEN
14168   EXISTS_TAC `(\y. a):real^N->real^M` THEN
14169   REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
14170   REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
14171   CONJ_TAC THEN MATCH_MP_TAC HOMOTOPIC_INTO_CONTRACTIBLE THEN
14172   ASM_REWRITE_TAC[o_DEF; IMAGE_ID; I_DEF; SUBSET_REFL; CONTINUOUS_ON_ID;
14173                   CONTINUOUS_ON_CONST] THEN
14174   ASM SET_TAC[]);;
14175
14176 let STARLIKE_IMP_CONTRACTIBLE_GEN = prove
14177  (`!P s.
14178         (!a t. a IN s /\ &0 <= t /\ t <= &1 ==> P(\x. (&1 - t) % x + t % a)) /\
14179         starlike s
14180         ==> ?a:real^N. homotopic_with P (s,s) (\x. x) (\x. a)`,
14181   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
14182   REWRITE_TAC[starlike] THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN
14183   REWRITE_TAC[segment; SUBSET; FORALL_IN_GSPEC] THEN
14184   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN
14185   REWRITE_TAC[homotopic_with; PCROSS] THEN
14186   EXISTS_TAC `\y:real^(1,N)finite_sum.
14187              (&1 - drop(fstcart y)) % sndcart y +
14188              drop(fstcart y) % a` THEN
14189   ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC; IN_INTERVAL_1;
14190     SUBSET; FORALL_IN_IMAGE; REAL_SUB_RZERO; REAL_SUB_REFL; FORALL_IN_GSPEC;
14191     VECTOR_MUL_LZERO; VECTOR_MUL_LID; VECTOR_ADD_LID; VECTOR_ADD_RID] THEN
14192   MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
14193   MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
14194   SIMP_TAC[o_DEF; LIFT_DROP; ETA_AX; LIFT_SUB; CONTINUOUS_ON_SUB;
14195            CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; ETA_AX;
14196            LINEAR_FSTCART; LINEAR_SNDCART]);;
14197
14198 let STARLIKE_IMP_CONTRACTIBLE = prove
14199  (`!s:real^N->bool. starlike s ==> contractible s`,
14200   SIMP_TAC[contractible; STARLIKE_IMP_CONTRACTIBLE_GEN]);;
14201
14202 let CONTRACTIBLE_UNIV = prove
14203  (`contractible(:real^N)`,
14204   SIMP_TAC[STARLIKE_IMP_CONTRACTIBLE; STARLIKE_UNIV]);;
14205
14206 let STARLIKE_IMP_SIMPLY_CONNECTED = prove
14207  (`!s:real^N->bool. starlike s ==> simply_connected s`,
14208   REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTRACTIBLE_IMP_SIMPLY_CONNECTED THEN
14209   MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN ASM_REWRITE_TAC[]);;
14210
14211 let CONVEX_IMP_SIMPLY_CONNECTED = prove
14212  (`!s:real^N->bool. convex s ==> simply_connected s`,
14213   MESON_TAC[CONVEX_IMP_STARLIKE; STARLIKE_IMP_SIMPLY_CONNECTED;
14214             SIMPLY_CONNECTED_EMPTY]);;
14215
14216 let STARLIKE_IMP_PATH_CONNECTED = prove
14217  (`!s:real^N->bool. starlike s ==> path_connected s`,
14218   MESON_TAC[STARLIKE_IMP_SIMPLY_CONNECTED;
14219             SIMPLY_CONNECTED_IMP_PATH_CONNECTED]);;
14220
14221 let STARLIKE_IMP_CONNECTED = prove
14222  (`!s:real^N->bool. starlike s ==> connected s`,
14223   MESON_TAC[STARLIKE_IMP_PATH_CONNECTED; PATH_CONNECTED_IMP_CONNECTED]);;
14224
14225 let IS_INTERVAL_SIMPLY_CONNECTED_1 = prove
14226  (`!s:real^1->bool. is_interval s <=> simply_connected s`,
14227   MESON_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED; IS_INTERVAL_PATH_CONNECTED_1;
14228             CONVEX_IMP_SIMPLY_CONNECTED; IS_INTERVAL_CONVEX_1]);;
14229
14230 let CONTRACTIBLE_EMPTY = prove
14231  (`contractible {}`,
14232   SIMP_TAC[contractible; HOMOTOPIC_WITH; PCROSS_EMPTY; NOT_IN_EMPTY] THEN
14233   REWRITE_TAC[CONTINUOUS_ON_EMPTY] THEN SET_TAC[]);;
14234
14235 let CONTRACTIBLE_CONVEX_TWEAK_BOUNDARY_POINTS = prove
14236  (`!s t:real^N->bool.
14237         convex s /\ relative_interior s SUBSET t /\ t SUBSET closure s
14238         ==> contractible t`,
14239   REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
14240   ASM_SIMP_TAC[SUBSET_EMPTY; CLOSURE_EMPTY; CONTRACTIBLE_EMPTY] THEN
14241   STRIP_TAC THEN MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN
14242   MATCH_MP_TAC STARLIKE_CONVEX_TWEAK_BOUNDARY_POINTS THEN ASM_MESON_TAC[]);;
14243
14244 let CONVEX_IMP_CONTRACTIBLE = prove
14245  (`!s:real^N->bool. convex s ==> contractible s`,
14246   MESON_TAC[CONVEX_IMP_STARLIKE; CONTRACTIBLE_EMPTY;
14247             STARLIKE_IMP_CONTRACTIBLE]);;
14248
14249 let CONTRACTIBLE_SING = prove
14250  (`!a:real^N. contractible {a}`,
14251   SIMP_TAC[CONVEX_IMP_CONTRACTIBLE; CONVEX_SING]);;
14252
14253 let IS_INTERVAL_CONTRACTIBLE_1 = prove
14254  (`!s:real^1->bool. is_interval s <=> contractible s`,
14255   MESON_TAC[CONTRACTIBLE_IMP_PATH_CONNECTED; IS_INTERVAL_PATH_CONNECTED_1;
14256             CONVEX_IMP_CONTRACTIBLE; IS_INTERVAL_CONVEX_1]);;
14257
14258 let CONTRACTIBLE_PCROSS = prove
14259  (`!s:real^M->bool t:real^N->bool.
14260         contractible s /\ contractible t ==> contractible(s PCROSS t)`,
14261   REPEAT GEN_TAC THEN REWRITE_TAC[contractible; homotopic_with] THEN
14262   REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN
14263   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
14264   MAP_EVERY X_GEN_TAC [`a:real^M`; `h:real^(1,M)finite_sum->real^M`] THEN
14265   REPEAT DISCH_TAC THEN
14266   MAP_EVERY X_GEN_TAC [`b:real^N`; `k:real^(1,N)finite_sum->real^N`] THEN
14267   REPEAT DISCH_TAC THEN
14268   EXISTS_TAC `pastecart (a:real^M) (b:real^N)` THEN
14269   EXISTS_TAC `\z. pastecart
14270                    ((h:real^(1,M)finite_sum->real^M)
14271                     (pastecart (fstcart z) (fstcart(sndcart z))))
14272                    ((k:real^(1,N)finite_sum->real^N)
14273                     (pastecart (fstcart z) (sndcart(sndcart z))))` THEN
14274   ASM_SIMP_TAC[FORALL_IN_IMAGE; FORALL_PASTECART; PASTECART_IN_PCROSS;
14275                FSTCART_PASTECART; SNDCART_PASTECART] THEN
14276   MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN CONJ_TAC THEN
14277   GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
14278   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
14279   SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON;
14280            LINEAR_FSTCART; LINEAR_SNDCART; CONTINUOUS_ON_ID;
14281            GSYM o_DEF; CONTINUOUS_ON_COMPOSE] THEN
14282   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14283           CONTINUOUS_ON_SUBSET)) THEN
14284   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN
14285   SIMP_TAC[PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART]);;
14286
14287 let CONTRACTIBLE_PCROSS_EQ = prove
14288  (`!s:real^M->bool t:real^N->bool.
14289         contractible(s PCROSS t) <=>
14290         s = {} \/ t = {} \/ contractible s /\ contractible t`,
14291   REPEAT GEN_TAC THEN
14292   ASM_CASES_TAC `s:real^M->bool = {}` THEN
14293   ASM_REWRITE_TAC[PCROSS_EMPTY; CONTRACTIBLE_EMPTY] THEN
14294   ASM_CASES_TAC `t:real^N->bool = {}` THEN
14295   ASM_REWRITE_TAC[PCROSS_EMPTY; CONTRACTIBLE_EMPTY] THEN
14296   EQ_TAC THEN REWRITE_TAC[CONTRACTIBLE_PCROSS] THEN
14297   REWRITE_TAC[contractible; homotopic_with; LEFT_IMP_EXISTS_THM] THEN
14298   SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
14299   MAP_EVERY X_GEN_TAC
14300    [`a:real^M`; `b:real^N`;
14301     `h:real^(1,(M,N)finite_sum)finite_sum->real^(M,N)finite_sum`] THEN
14302   STRIP_TAC THEN
14303   SUBGOAL_THEN `(a:real^M) IN s /\ (b:real^N) IN t` STRIP_ASSUME_TAC THENL
14304    [REWRITE_TAC[GSYM PASTECART_IN_PCROSS] THEN
14305     RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN
14306     ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL];
14307     ALL_TAC] THEN
14308   CONJ_TAC THENL
14309    [EXISTS_TAC `a:real^M` THEN
14310     EXISTS_TAC
14311      `fstcart o
14312       (h:real^(1,(M,N)finite_sum)finite_sum->real^(M,N)finite_sum) o
14313       (\z. pastecart (fstcart z) (pastecart (sndcart z) b))`;
14314     EXISTS_TAC `b:real^N` THEN
14315     EXISTS_TAC
14316      `sndcart o
14317       (h:real^(1,(M,N)finite_sum)finite_sum->real^(M,N)finite_sum) o
14318       (\z. pastecart (fstcart z) (pastecart a (sndcart z)))`] THEN
14319   ASM_REWRITE_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART;
14320                   SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS; o_THM] THEN
14321   (CONJ_TAC THENL
14322     [ALL_TAC;  ASM_MESON_TAC[PASTECART_FST_SND; PASTECART_IN_PCROSS]]) THEN
14323   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
14324   SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN
14325   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
14326   SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST;
14327            LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN
14328   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14329         CONTINUOUS_ON_SUBSET)) THEN
14330   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
14331   ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS]);;
14332
14333 let HOMOTOPY_EQUIVALENT_EMPTY = prove
14334  (`(!s. (s:real^M->bool) homotopy_equivalent ({}:real^N->bool) <=> s = {}) /\
14335    (!t. ({}:real^M->bool) homotopy_equivalent (t:real^N->bool) <=> t = {})`,
14336   REPEAT STRIP_TAC THEN EQ_TAC THEN
14337   SIMP_TAC[HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS; CONTRACTIBLE_EMPTY] THEN
14338   REWRITE_TAC[homotopy_equivalent] THEN SET_TAC[]);;
14339
14340 let HOMOTOPY_DOMINATED_CONTRACTIBILITY = prove
14341  (`!f:real^M->real^N g s t.
14342         f continuous_on s /\
14343         IMAGE f s SUBSET t /\
14344         g continuous_on t /\
14345         IMAGE g t SUBSET s /\
14346         homotopic_with (\x. T) (t,t) (f o g) I /\
14347         contractible s
14348         ==> contractible t`,
14349   REPEAT GEN_TAC THEN SIMP_TAC[contractible; I_DEF] THEN STRIP_TAC THEN
14350   MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^N->bool`]
14351         NULLHOMOTOPIC_FROM_CONTRACTIBLE) THEN
14352   ASM_REWRITE_TAC[contractible; I_DEF] THEN
14353   ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
14354   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN
14355   ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN DISCH_TAC THEN
14356   MATCH_MP_TAC HOMOTOPIC_WITH_TRANS THEN
14357   EXISTS_TAC `(f:real^M->real^N) o (g:real^N->real^M)` THEN
14358   ASM_REWRITE_TAC[] THEN
14359   SUBGOAL_THEN `(\x. (b:real^N)) = (\x. b) o (g:real^N->real^M)`
14360   SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN
14361   MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
14362   EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[]);;
14363
14364 let HOMOTOPY_EQUIVALENT_CONTRACTIBILITY = prove
14365  (`!s:real^M->bool t:real^N->bool.
14366         s homotopy_equivalent t ==> (contractible s <=> contractible t)`,
14367   REWRITE_TAC[homotopy_equivalent] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN
14368   MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
14369    (REWRITE_RULE[CONJ_ASSOC] HOMOTOPY_DOMINATED_CONTRACTIBILITY)) THEN
14370   ASM_MESON_TAC[]);;
14371
14372 let HOMOTOPY_EQUIVALENT_SING = prove
14373  (`!s:real^M->bool a:real^N.
14374         s homotopy_equivalent {a} <=> ~(s = {}) /\ contractible s`,
14375   REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN
14376   ASM_REWRITE_TAC[HOMOTOPY_EQUIVALENT_EMPTY; NOT_INSERT_EMPTY] THEN
14377   EQ_TAC THENL
14378    [DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPY_EQUIVALENT_CONTRACTIBILITY) THEN
14379     REWRITE_TAC[CONTRACTIBLE_SING];
14380     DISCH_TAC THEN MATCH_MP_TAC HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS THEN
14381     ASM_REWRITE_TAC[CONTRACTIBLE_SING; NOT_INSERT_EMPTY]]);;
14382
14383 let HOMEOMORPHIC_CONTRACTIBLE_EQ = prove
14384  (`!s:real^M->bool t:real^N->bool.
14385         s homeomorphic t ==> (contractible s <=> contractible t)`,
14386   REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPY_EQUIVALENT_CONTRACTIBILITY THEN
14387   ASM_SIMP_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT]);;
14388
14389 let HOMEOMORPHIC_CONTRACTIBLE = prove
14390  (`!s:real^M->bool t:real^N->bool.
14391         s homeomorphic t /\ contractible s ==> contractible t`,
14392   MESON_TAC[HOMEOMORPHIC_CONTRACTIBLE_EQ]);;
14393
14394 let CONTRACTIBLE_TRANSLATION = prove
14395  (`!a:real^N s. contractible (IMAGE (\x. a + x) s) <=> contractible s`,
14396   REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_CONTRACTIBLE_EQ THEN
14397   ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
14398   REWRITE_TAC[HOMEOMORPHIC_TRANSLATION]);;
14399
14400 add_translation_invariants [CONTRACTIBLE_TRANSLATION];;
14401
14402 let CONTRACTIBLE_INJECTIVE_LINEAR_IMAGE = prove
14403  (`!f:real^M->real^N s.
14404         linear f /\ (!x y. f x = f y ==> x = y)
14405         ==> (contractible (IMAGE f s) <=> contractible s)`,
14406   REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_CONTRACTIBLE_EQ THEN
14407   ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ;
14408                 HOMEOMORPHIC_REFL]);;
14409
14410 add_linear_invariants [CONTRACTIBLE_INJECTIVE_LINEAR_IMAGE];;
14411
14412 (* ------------------------------------------------------------------------- *)
14413 (* Homeomorphisms between punctured spheres and affine sets.                 *)
14414 (* ------------------------------------------------------------------------- *)
14415
14416 let HOMEOMORPHIC_PUNCTURED_AFFINE_SPHERE_AFFINE = prove
14417  (`!a r b t:real^N->bool p:real^M->bool.
14418         &0 < r /\ b IN sphere(a,r) /\ affine t /\ a IN t /\ b IN t /\
14419         affine p /\ aff_dim t = aff_dim p + &1
14420         ==> ((sphere(a:real^N,r) INTER t) DELETE b) homeomorphic p`,
14421   GEOM_ORIGIN_TAC `a:real^N` THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN
14422   REWRITE_TAC[sphere; DIST_0; IN_ELIM_THM] THEN
14423   SIMP_TAC[CONJ_ASSOC; NORM_ARITH
14424    `&0 < r /\ norm(b:real^N) = r <=> norm(b) = r /\ ~(b = vec 0)`] THEN
14425   GEOM_NORMALIZE_TAC `b:real^N` THEN REWRITE_TAC[] THEN
14426   GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN
14427   SIMP_TAC[NORM_MUL; real_abs; NORM_BASIS; LE_REFL; DIMINDEX_GE_1] THEN
14428   X_GEN_TAC `b:real` THEN REWRITE_TAC[REAL_MUL_RID; VECTOR_MUL_EQ_0] THEN
14429   DISCH_THEN(K ALL_TAC) THEN DISCH_THEN SUBST1_TAC THEN
14430   REPEAT GEN_TAC THEN REWRITE_TAC[VECTOR_MUL_LID] THEN
14431   ASM_CASES_TAC `r = &1` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(K ALL_TAC) THEN
14432   CONV_TAC REAL_RAT_REDUCE_CONV THEN
14433   SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN STRIP_TAC THEN
14434   SUBGOAL_THEN `subspace(t:real^N->bool)` ASSUME_TAC THENL
14435    [ASM_MESON_TAC[AFFINE_EQ_SUBSPACE]; ALL_TAC] THEN
14436   TRANS_TAC HOMEOMORPHIC_TRANS `{x:real^N | x$1 = &0} INTER t` THEN
14437   CONJ_TAC THENL
14438    [ALL_TAC;
14439     MATCH_MP_TAC HOMEOMORPHIC_AFFINE_SETS THEN
14440     ASM_SIMP_TAC[AFFINE_INTER; AFFINE_STANDARD_HYPERPLANE] THEN
14441     ONCE_REWRITE_TAC[INTER_COMM] THEN
14442     MP_TAC(ISPECL [`basis 1:real^N`; `&0`; `t:real^N->bool`]
14443         AFF_DIM_AFFINE_INTER_HYPERPLANE) THEN
14444     ASM_SIMP_TAC[DOT_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
14445     DISCH_THEN SUBST1_TAC THEN
14446     SUBGOAL_THEN `~(t INTER {x:real^N | x$1 = &0} = {})` ASSUME_TAC THENL
14447      [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_ELIM_THM] THEN
14448       EXISTS_TAC `vec 0:real^N` THEN ASM_REWRITE_TAC[VEC_COMPONENT];
14449       ALL_TAC] THEN
14450     SUBGOAL_THEN `~(t SUBSET {v:real^N | v$1 = &0})` ASSUME_TAC THENL
14451      [REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `basis 1:real^N`) THEN
14452       ASM_SIMP_TAC[IN_ELIM_THM; BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN
14453       REAL_ARITH_TAC;
14454       ASM_REWRITE_TAC[] THEN INT_ARITH_TAC]] THEN
14455   SUBGOAL_THEN
14456    `({x:real^N | norm x = &1} INTER t) DELETE (basis 1) =
14457     {x | norm x = &1 /\ ~(x$1 = &1)} INTER t`
14458   SUBST1_TAC THENL
14459    [MATCH_MP_TAC(SET_RULE
14460      `s DELETE a = s' ==> (s INTER t) DELETE a = s' INTER t`) THEN
14461     MATCH_MP_TAC(SET_RULE
14462      `Q a /\ (!x. P x /\ Q x ==> x = a)
14463       ==> {x | P x} DELETE a = {x | P x /\ ~Q x}`) THEN
14464     SIMP_TAC[BASIS_COMPONENT; CART_EQ; DIMINDEX_GE_1; LE_REFL] THEN
14465     REWRITE_TAC[NORM_EQ_SQUARE; REAL_POS; REAL_POW_ONE] THEN
14466     X_GEN_TAC `x:real^N` THEN
14467     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
14468     ASM_SIMP_TAC[dot; SUM_CLAUSES_LEFT; DIMINDEX_GE_1] THEN
14469     REWRITE_TAC[REAL_ARITH `&1 * &1 + s = &1 <=> s = &0`] THEN
14470     DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
14471       SUM_POS_EQ_0_NUMSEG)) THEN
14472     REWRITE_TAC[REAL_LE_SQUARE; REAL_ENTIRE] THEN
14473     REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
14474     FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
14475     ALL_TAC] THEN
14476   REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN MAP_EVERY ABBREV_TAC
14477    [`f = \x:real^N. &2 % basis 1 + &2 / (&1 - x$1) % (x - basis 1)`;
14478     `g = \y:real^N.
14479            basis 1 + &4 / (norm y pow 2 + &4) % (y - &2 % basis 1)`] THEN
14480   MAP_EVERY EXISTS_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN
14481   REPEAT CONJ_TAC THENL
14482    [MATCH_MP_TAC(MESON[CONTINUOUS_ON_SUBSET; INTER_SUBSET]
14483      `f continuous_on s ==> f continuous_on (s INTER t)`) THEN
14484     EXPAND_TAC "f" THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
14485     REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
14486     MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
14487     SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
14488     REWRITE_TAC[o_DEF; real_div; LIFT_CMUL] THEN
14489     MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
14490     MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
14491     SIMP_TAC[REAL_SUB_0; IN_ELIM_THM] THEN
14492     REWRITE_TAC[LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
14493     REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
14494     MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT THEN
14495     REWRITE_TAC[LE_REFL; DIMINDEX_GE_1];
14496     MATCH_MP_TAC(SET_RULE
14497      `IMAGE f s SUBSET s' /\ IMAGE f t SUBSET t
14498       ==> IMAGE f (s INTER t) SUBSET (s' INTER t)`) THEN
14499     EXPAND_TAC "f" THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
14500     ASM_SIMP_TAC[SUBSPACE_ADD; SUBSPACE_MUL; SUBSPACE_SUB] THEN
14501     REWRITE_TAC[IN_ELIM_THM; IN_DELETE] THEN
14502     SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT;
14503              LE_REFL; DIMINDEX_GE_1; VECTOR_SUB_COMPONENT] THEN
14504     CONV_TAC REAL_FIELD;
14505     MATCH_MP_TAC(MESON[CONTINUOUS_ON_SUBSET; INTER_SUBSET]
14506      `f continuous_on s ==> f continuous_on (s INTER t)`) THEN
14507     EXPAND_TAC "g" THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
14508     REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
14509     MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
14510     SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
14511     REWRITE_TAC[o_DEF; real_div; LIFT_CMUL] THEN
14512     MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
14513     MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
14514     SIMP_TAC[LIFT_ADD; REAL_POW_LE; NORM_POS_LE; REAL_ARITH
14515      `&0 <= x ==> ~(x + &4 = &0)`] THEN
14516     MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
14517     REWRITE_TAC[REAL_POW_2; LIFT_CMUL; CONTINUOUS_ON_CONST] THEN
14518     MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
14519     REWRITE_TAC[CONTINUOUS_ON_LIFT_NORM; GSYM o_DEF];
14520     MATCH_MP_TAC(SET_RULE
14521      `IMAGE f s SUBSET s' /\ IMAGE f t SUBSET t
14522       ==> IMAGE f (s INTER t) SUBSET (s' INTER t)`) THEN
14523     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
14524     REWRITE_TAC[NORM_EQ_SQUARE; REAL_POS] THEN EXPAND_TAC "g" THEN
14525     CONJ_TAC THENL
14526      [ALL_TAC; ASM_MESON_TAC[SUBSPACE_ADD; SUBSPACE_MUL; SUBSPACE_SUB]] THEN
14527     X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
14528     REWRITE_TAC[VECTOR_ARITH
14529      `b + a % (y - &2 % b):real^N = (&1 - &2 * a) % b + a % y`] THEN
14530     REWRITE_TAC[NORM_POW_2; VECTOR_ARITH
14531      `(a + b:real^N) dot (a + b) = (a dot a + b dot b) + &2 * a dot b`] THEN
14532     ASM_SIMP_TAC[DOT_LMUL; DOT_RMUL; DOT_BASIS; BASIS_COMPONENT; LE_REFL;
14533                 VECTOR_ADD_COMPONENT; DIMINDEX_GE_1; VECTOR_MUL_COMPONENT] THEN
14534     REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID; GSYM REAL_POW_2] THEN
14535     SUBGOAL_THEN `~((y:real^N) dot y + &4 = &0)` MP_TAC THENL
14536      [MESON_TAC[DOT_POS_LE; REAL_ARITH `&0 <= x ==> ~(x + &4 = &0)`];
14537       CONV_TAC REAL_FIELD];
14538     SUBGOAL_THEN
14539      `!x. norm x = &1 /\ ~(x$1 = &1)
14540           ==> norm((f:real^N->real^N) x) pow 2 = &4 * (&1 + x$1) / (&1 - x$1)`
14541     ASSUME_TAC THENL
14542      [REPEAT STRIP_TAC THEN EXPAND_TAC "f" THEN
14543       REWRITE_TAC[VECTOR_ARITH
14544        `a % b + m % (x - b):real^N = (a - m) % b + m % x`] THEN
14545       REWRITE_TAC[NORM_POW_2; VECTOR_ARITH
14546        `(a + b:real^N) dot (a + b) = (a dot a + b dot b) + &2 * a dot b`] THEN
14547       SIMP_TAC[DOT_LMUL; DOT_RMUL; DOT_BASIS; BASIS_COMPONENT;
14548                DIMINDEX_GE_1; LE_REFL; VECTOR_MUL_COMPONENT] THEN
14549       ASM_REWRITE_TAC[GSYM NORM_POW_2; GSYM REAL_POW_2; REAL_MUL_RID;
14550                       REAL_POW_ONE] THEN
14551       UNDISCH_TAC `~((x:real^N)$1 = &1)` THEN CONV_TAC REAL_FIELD;
14552       ALL_TAC] THEN
14553     EXPAND_TAC "g" THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN
14554     ASM_SIMP_TAC[] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
14555     ASM_SIMP_TAC[REAL_FIELD
14556      `~(x = &1)
14557       ==> &4 * (&1 + x) / (&1 - x) + &4 = &8 / (&1 - x)`] THEN
14558     REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN
14559     REWRITE_TAC[REAL_ARITH `&4 * inv(&8) * x = x / &2`] THEN
14560     EXPAND_TAC "f" THEN
14561     REWRITE_TAC[VECTOR_ARITH `(a + x) - a:real^N = x`] THEN
14562     REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH
14563      `b + a % (x - b):real^N = x <=> (&1 - a) % (x - b) = vec 0`] THEN
14564     REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ1_TAC THEN
14565     UNDISCH_TAC `~((x:real^N)$1 = &1)` THEN CONV_TAC REAL_FIELD;
14566     X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN
14567     DISCH_TAC THEN
14568     SUBGOAL_THEN `~((y:real^N) dot y + &4 = &0)` ASSUME_TAC THENL
14569      [MESON_TAC[DOT_POS_LE; REAL_ARITH `&0 <= x ==> ~(x + &4 = &0)`];
14570       ALL_TAC] THEN
14571     SUBGOAL_THEN `((g:real^N->real^N) y)$1 =
14572                   (y dot y - &4) / (y dot y + &4)` ASSUME_TAC THENL
14573      [EXPAND_TAC "g" THEN REWRITE_TAC[VECTOR_ADD_COMPONENT] THEN
14574       REWRITE_TAC[VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT] THEN
14575       ASM_SIMP_TAC[BASIS_COMPONENT; LE_REFL; NORM_POW_2; DIMINDEX_GE_1] THEN
14576       UNDISCH_TAC `~((y:real^N) dot y + &4 = &0)` THEN
14577       CONV_TAC REAL_FIELD;
14578       ALL_TAC] THEN
14579     EXPAND_TAC "f" THEN REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN
14580     EXPAND_TAC "g" THEN SIMP_TAC[VECTOR_ARITH `(a + x) - a:real^N = x`] THEN
14581     REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH
14582      `b + a % (x - b):real^N = x <=> (&1 - a) % (x - b) = vec 0`] THEN
14583     REWRITE_TAC[VECTOR_MUL_EQ_0; NORM_POW_2] THEN DISJ1_TAC THEN
14584     UNDISCH_TAC `~((y:real^N) dot y + &4 = &0)` THEN CONV_TAC REAL_FIELD]);;
14585
14586 let HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN = prove
14587  (`!s:real^N->bool t:real^M->bool a.
14588         convex s /\ bounded s /\ a IN relative_frontier s /\
14589         affine t /\ aff_dim s = aff_dim t + &1
14590         ==> (relative_frontier s DELETE a) homeomorphic t`,
14591   REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
14592   ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_GE; INT_ARITH
14593    `--(&1):int <= s ==> ~(--(&1) = s + &1)`] THEN
14594   MP_TAC(ISPECL [`(:real^N)`; `aff_dim(s:real^N->bool)`]
14595     CHOOSE_AFFINE_SUBSET) THEN REWRITE_TAC[SUBSET_UNIV] THEN
14596   REWRITE_TAC[AFF_DIM_GE; AFF_DIM_LE_UNIV; AFF_DIM_UNIV; AFFINE_UNIV] THEN
14597   DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
14598   SUBGOAL_THEN `~(t:real^N->bool = {})` MP_TAC THENL
14599    [ASM_MESON_TAC[AFF_DIM_EQ_MINUS1]; ALL_TAC] THEN
14600   GEN_REWRITE_TAC LAND_CONV [GSYM MEMBER_NOT_EMPTY] THEN
14601   DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN STRIP_TAC THEN
14602   MP_TAC(ISPECL
14603    [`s:real^N->bool`; `ball(z:real^N,&1) INTER t`]
14604         HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS) THEN
14605   MP_TAC(ISPECL [`t:real^N->bool`; `ball(z:real^N,&1)`]
14606         (ONCE_REWRITE_RULE[INTER_COMM] AFF_DIM_CONVEX_INTER_OPEN)) THEN
14607   MP_TAC(ISPECL [`ball(z:real^N,&1)`; `t:real^N->bool`]
14608         RELATIVE_FRONTIER_CONVEX_INTER_AFFINE) THEN
14609   ASM_SIMP_TAC[CONVEX_INTER; BOUNDED_INTER; BOUNDED_BALL; CONVEX_BALL;
14610                AFFINE_IMP_CONVEX; INTERIOR_OPEN; OPEN_BALL;
14611                FRONTIER_BALL; REAL_LT_01] THEN
14612   SUBGOAL_THEN `~(ball(z:real^N,&1) INTER t = {})` ASSUME_TAC THENL
14613    [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
14614     EXISTS_TAC `z:real^N` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_01];
14615     ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN SUBST1_TAC) THEN SIMP_TAC[]] THEN
14616   REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM] THEN
14617   MAP_EVERY X_GEN_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN
14618   STRIP_TAC THEN REWRITE_TAC[GSYM homeomorphic] THEN
14619   TRANS_TAC HOMEOMORPHIC_TRANS
14620     `(sphere(z,&1) INTER t) DELETE (h:real^N->real^N) a` THEN
14621   CONJ_TAC THENL
14622    [REWRITE_TAC[homeomorphic] THEN
14623     MAP_EVERY EXISTS_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN
14624     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN
14625     REWRITE_TAC[HOMEOMORPHISM] THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL
14626      [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; DELETE_SUBSET];
14627       ASM SET_TAC[];
14628       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; DELETE_SUBSET];
14629       ASM SET_TAC[];
14630       ASM SET_TAC[];
14631       ASM SET_TAC[]];
14632     MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_AFFINE_SPHERE_AFFINE THEN
14633     ASM_REWRITE_TAC[REAL_LT_01; GSYM IN_INTER] THEN
14634     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN
14635     ASM SET_TAC[]]);;
14636
14637 let HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE = prove
14638  (`!a r b:real^N t:real^M->bool.
14639     &0 < r /\ b IN sphere(a,r) /\ affine t /\ aff_dim(t) + &1 = &(dimindex(:N))
14640     ==> (sphere(a:real^N,r) DELETE b) homeomorphic t`,
14641   REPEAT STRIP_TAC THEN
14642   MP_TAC(ISPECL [`cball(a:real^N,r)`; `t:real^M->bool`; `b:real^N`]
14643         HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN) THEN
14644   ASM_SIMP_TAC[RELATIVE_FRONTIER_CBALL; REAL_LT_IMP_NZ; AFF_DIM_CBALL;
14645                CONVEX_CBALL; BOUNDED_CBALL]);;
14646
14647 let HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE = prove
14648  (`!a r b c d.
14649         &0 < r /\ b IN sphere(a,r) /\ ~(c = vec 0)
14650         ==> (sphere(a:real^N,r) DELETE b) homeomorphic
14651              {x:real^N | c dot x = d}`,
14652   REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE THEN
14653   ASM_SIMP_TAC[AFFINE_HYPERPLANE; AFF_DIM_HYPERPLANE] THEN INT_ARITH_TAC);;
14654
14655 let HOMEOMORPHIC_PUNCTURED_SPHERE_UNIV = prove
14656  (`!a r b.
14657         &0 < r /\ b IN sphere(a,r) /\ dimindex(:N) = dimindex(:M) + 1
14658         ==> (sphere(a:real^N,r) DELETE b) homeomorphic (:real^M)`,
14659   REPEAT STRIP_TAC THEN
14660   TRANS_TAC HOMEOMORPHIC_TRANS `{x:real^N | basis 1 dot x = &0}` THEN
14661   ASM_SIMP_TAC[HOMEOMORPHIC_HYPERPLANE_UNIV; BASIS_NONZERO; LE_REFL;
14662                DIMINDEX_GE_1; HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE]);;
14663
14664 let CONTRACTIBLE_PUNCTURED_SPHERE = prove
14665  (`!a r b:real^N.
14666         &0 < r /\ b IN sphere(a,r) ==> contractible(sphere(a,r) DELETE b)`,
14667   REPEAT STRIP_TAC THEN
14668   SUBGOAL_THEN `contractible {x:real^N | basis 1 dot x = &0}` MP_TAC THENL
14669    [SIMP_TAC[CONVEX_IMP_CONTRACTIBLE; CONVEX_HYPERPLANE];
14670     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_CONTRACTIBLE) THEN
14671     ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
14672     MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE THEN
14673     ASM_SIMP_TAC[BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1]]);;
14674
14675 (* ------------------------------------------------------------------------- *)
14676 (* When dealing with AR, ANR and ANR later, it's useful to know that any set *)
14677 (* at all is homeomorphic to a closed subset of a convex set, and if the     *)
14678 (* set is locally compact we can take the convex set to be the universe.     *)
14679 (* ------------------------------------------------------------------------- *)
14680
14681 let HOMEOMORPHIC_CLOSED_IN_CONVEX = prove
14682  (`!s:real^M->bool.
14683         aff_dim s < &(dimindex(:N))
14684         ==> ?u t:real^N->bool.
14685                 convex u /\
14686                 ~(u = {}) /\
14687                 closed_in (subtopology euclidean u) t /\
14688                 s homeomorphic t`,
14689   GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL
14690    [REPEAT STRIP_TAC THEN
14691     MAP_EVERY EXISTS_TAC [`(:real^N)`; `{}:real^N->bool`] THEN
14692     REWRITE_TAC[CONVEX_UNIV; UNIV_NOT_EMPTY; CLOSED_IN_EMPTY] THEN
14693     ASM_REWRITE_TAC[HOMEOMORPHIC_EMPTY];
14694     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY])] THEN
14695   DISCH_THEN(X_CHOOSE_THEN `a:real^M` MP_TAC) THEN
14696   GEOM_ORIGIN_TAC `a:real^M` THEN
14697   SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; INT_OF_NUM_LT] THEN REPEAT STRIP_TAC THEN
14698   MP_TAC(ISPECL [`{x:real^N | x$1 = &0}`; `dim(s:real^M->bool)`]
14699         CHOOSE_SUBSPACE_OF_SUBSPACE) THEN
14700   SIMP_TAC[DIM_SPECIAL_HYPERPLANE; DIMINDEX_GE_1; LE_REFL; SUBSET; IN_ELIM_THM;
14701            SPAN_OF_SUBSPACE; SUBSPACE_SPECIAL_HYPERPLANE] THEN
14702   ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
14703   X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
14704   MP_TAC(ISPECL [`span s:real^M->bool`; `t:real^N->bool`]
14705     ISOMETRIES_SUBSPACES) THEN
14706   ASM_REWRITE_TAC[SUBSPACE_SPAN; DIM_SPAN; LEFT_IMP_EXISTS_THM] THEN
14707   MAP_EVERY X_GEN_TAC [`h:real^M->real^N`; `k:real^N->real^M`] THEN
14708   REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_IMAGE] THEN
14709   STRIP_TAC THEN
14710   MP_TAC(ISPECL [`vec 0:real^N`; `&1`; `basis 1:real^N`;
14711                  `{x:real^N | basis 1 dot x = &0}`]
14712         HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE) THEN
14713   SIMP_TAC[AFFINE_HYPERPLANE; AFF_DIM_HYPERPLANE; BASIS_NONZERO;
14714            DIMINDEX_GE_1; LE_REFL; REAL_LT_01; IN_SPHERE_0; NORM_BASIS] THEN
14715   ANTS_TAC THENL [INT_ARITH_TAC; ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM]] THEN
14716   SIMP_TAC[DOT_BASIS; DIMINDEX_GE_1; LE_REFL; homeomorphic] THEN
14717   REWRITE_TAC[HOMEOMORPHISM; LEFT_IMP_EXISTS_THM; IN_ELIM_THM;
14718               SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; IN_DELETE] THEN
14719   MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN
14720   STRIP_TAC THEN
14721   EXISTS_TAC `ball(vec 0,&1) UNION
14722               IMAGE ((f:real^N->real^N) o (h:real^M->real^N)) s` THEN
14723   EXISTS_TAC `IMAGE ((f:real^N->real^N) o (h:real^M->real^N)) s` THEN
14724   REPEAT CONJ_TAC THENL
14725    [MATCH_MP_TAC CONVEX_INTERMEDIATE_BALL THEN
14726     MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `&1`] THEN
14727     REWRITE_TAC[SUBSET_UNION; UNION_SUBSET; BALL_SUBSET_CBALL] THEN
14728     ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM; IN_CBALL_0] THEN
14729     ASM_MESON_TAC[SPAN_SUPERSET; REAL_LE_REFL];
14730     REWRITE_TAC[NOT_IN_EMPTY; IMAGE_o] THEN ASM SET_TAC[];
14731     REWRITE_TAC[CLOSED_IN_CLOSED] THEN
14732     EXISTS_TAC `sphere(vec 0:real^N,&1)` THEN
14733     REWRITE_TAC[CLOSED_SPHERE] THEN MATCH_MP_TAC(SET_RULE
14734      `b INTER t = {} /\ s SUBSET t ==> s = (b UNION s) INTER t`) THEN
14735     REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN
14736     CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[SUBSET]] THEN
14737     REWRITE_TAC[FORALL_IN_IMAGE; o_THM; IN_SPHERE_0] THEN
14738     ASM_MESON_TAC[SPAN_SUPERSET];
14739     MAP_EVERY EXISTS_TAC
14740      [`(k:real^N->real^M) o (g:real^N->real^N)`;
14741       `(f:real^N->real^N) o (h:real^M->real^N)`] THEN
14742     REWRITE_TAC[FORALL_IN_IMAGE; o_THM; IMAGE_o] THEN
14743     REPEAT CONJ_TAC THEN
14744     TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
14745         ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON]) THEN
14746     TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14747      CONTINUOUS_ON_SUBSET))) THEN
14748     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; IN_DELETE] THEN
14749     MP_TAC(ISPEC `s:real^M->bool` SPAN_INC) THEN ASM SET_TAC[]]);;
14750
14751 let LOCALLY_COMPACT_HOMEOMORPHIC_CLOSED = prove
14752  (`!s:real^M->bool.
14753         locally compact s /\ dimindex(:M) < dimindex(:N)
14754         ==> ?t:real^N->bool. closed t /\ s homeomorphic t`,
14755   REPEAT STRIP_TAC THEN SUBGOAL_THEN
14756    `?t:real^(M,1)finite_sum->bool h.
14757             closed t /\ homeomorphism (s,t) (h,fstcart)`
14758   STRIP_ASSUME_TAC THENL
14759    [ASM_SIMP_TAC[LOCALLY_COMPACT_HOMEOMORPHISM_PROJECTION_CLOSED];
14760     ALL_TAC] THEN
14761   ABBREV_TAC
14762    `f:real^(M,1)finite_sum->real^N =
14763         \x. lambda i. if i <= dimindex(:M) then x$i
14764                       else x$(dimindex(:M)+1)` THEN
14765   ABBREV_TAC
14766    `g:real^N->real^(M,1)finite_sum = (\x. lambda i. x$i)` THEN
14767   EXISTS_TAC `IMAGE (f:real^(M,1)finite_sum->real^N) t` THEN
14768   SUBGOAL_THEN `linear(f:real^(M,1)finite_sum->real^N)` ASSUME_TAC THENL
14769    [EXPAND_TAC "f" THEN REWRITE_TAC[linear; CART_EQ] THEN
14770     SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
14771     MESON_TAC[];
14772     ALL_TAC] THEN
14773   SUBGOAL_THEN `linear(g:real^N->real^(M,1)finite_sum)` ASSUME_TAC THENL
14774    [EXPAND_TAC "g" THEN REWRITE_TAC[linear; CART_EQ] THEN
14775     SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
14776     MESON_TAC[];
14777     ALL_TAC] THEN
14778   SUBGOAL_THEN
14779    `!x. (g:real^N->real^(M,1)finite_sum)((f:real^(M,1)finite_sum->real^N) x) =
14780         x`
14781   ASSUME_TAC THENL
14782    [MAP_EVERY EXPAND_TAC ["f"; "g"] THEN FIRST_ASSUM(MP_TAC o MATCH_MP
14783      (ARITH_RULE `m < n ==> !i. i <= m + 1 ==> i <= n`)) THEN
14784     SIMP_TAC[CART_EQ; LAMBDA_BETA; DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN
14785     REWRITE_TAC[ARITH_RULE `i <= n + 1 <=> i <= n \/ i = n + 1`] THEN
14786     MESON_TAC[];
14787     ALL_TAC] THEN
14788   CONJ_TAC THENL [ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE]; ALL_TAC] THEN
14789   TRANS_TAC HOMEOMORPHIC_TRANS `t:real^(M,1)finite_sum->bool` THEN
14790   CONJ_TAC THENL [ASM_MESON_TAC[homeomorphic]; ALL_TAC] THEN
14791   REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN MAP_EVERY EXISTS_TAC
14792    [`f:real^(M,1)finite_sum->real^N`; `g:real^N->real^(M,1)finite_sum`] THEN
14793   ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]);;
14794
14795 (* ------------------------------------------------------------------------- *)
14796 (* Simple connectedness of a union. This is essentially a stripped-down      *)
14797 (* version of the Seifert - Van Kampen theorem.                              *)
14798 (* ------------------------------------------------------------------------- *)
14799
14800 let SIMPLY_CONNECTED_UNION = prove
14801  (`!s t:real^N->bool.
14802     open_in (subtopology euclidean (s UNION t)) s /\
14803     open_in (subtopology euclidean (s UNION t)) t /\
14804     simply_connected s /\ simply_connected t /\
14805     path_connected (s INTER t) /\ ~(s INTER t = {})
14806     ==> simply_connected (s UNION t)`,
14807   REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN
14808   DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `u:real^N->bool`
14809    (STRIP_ASSUME_TAC o GSYM)) MP_TAC) THEN
14810    DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `v:real^N->bool`
14811    (STRIP_ASSUME_TAC o GSYM)) MP_TAC) THEN
14812   SIMP_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH; PATH_CONNECTED_UNION] THEN
14813   REPEAT STRIP_TAC THEN
14814   SUBGOAL_THEN `(pathstart p:real^N) IN s UNION t` MP_TAC THENL
14815    [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]; REWRITE_TAC[IN_UNION]] THEN
14816   POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
14817   ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`] THEN
14818   MAP_EVERY (fun s -> let x = mk_var(s,`:real^N->bool`) in SPEC_TAC(x,x))
14819    ["v"; "u"; "t"; "s"] THEN
14820   MATCH_MP_TAC(MESON[]
14821    `(!s t u v. x IN s ==> P x s t u v) /\
14822     (!x s t u v. P x s t u v ==> P x t s v u)
14823     ==> (!s t u v. x IN s \/ x IN t ==>  P x s t u v)`) THEN
14824   CONJ_TAC THENL
14825    [REPEAT STRIP_TAC;
14826     REPEAT GEN_TAC THEN REWRITE_TAC[UNION_COMM; INTER_COMM] THEN
14827     MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[]] THEN
14828   SUBGOAL_THEN
14829    `?e. &0 < e /\
14830         !x y. x IN interval[vec 0,vec 1] /\ y IN interval[vec 0,vec 1] /\
14831               norm(x - y) < e
14832               ==> path_image(subpath x y p) SUBSET (s:real^N->bool) \/
14833                   path_image(subpath x y p) SUBSET t`
14834   STRIP_ASSUME_TAC THENL
14835    [MP_TAC(ISPEC `path_image(p:real^1->real^N)` HEINE_BOREL_LEMMA) THEN
14836     ASM_SIMP_TAC[COMPACT_PATH_IMAGE] THEN
14837     DISCH_THEN(MP_TAC o SPEC `{u:real^N->bool,v}`) THEN
14838     SIMP_TAC[UNIONS_2; EXISTS_IN_INSERT; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN
14839     ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
14840     DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
14841     MP_TAC(ISPECL [`p:real^1->real^N`; `interval[vec 0:real^1,vec 1]`]
14842         COMPACT_UNIFORMLY_CONTINUOUS) THEN
14843     ASM_REWRITE_TAC[GSYM path; COMPACT_INTERVAL; uniformly_continuous_on] THEN
14844     DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[dist] THEN
14845     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN
14846     ASM_REWRITE_TAC[] THEN
14847     MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN
14848     FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^1->real^N) x`) THEN
14849     ANTS_TAC THENL [REWRITE_TAC[path_image] THEN ASM SET_TAC[]; ALL_TAC] THEN
14850     MATCH_MP_TAC(SET_RULE
14851      `!p'. p SUBSET b /\
14852            (s UNION t) INTER u = s /\ (s UNION t) INTER v = t /\
14853            p SUBSET p' /\ p' SUBSET s UNION t
14854            ==>  (b SUBSET u \/ b SUBSET v) ==> p SUBSET s \/ p SUBSET t`) THEN
14855     EXISTS_TAC `path_image(p:real^1->real^N)` THEN
14856     ASM_SIMP_TAC[PATH_IMAGE_SUBPATH_SUBSET] THEN
14857     REWRITE_TAC[PATH_IMAGE_SUBPATH_GEN; SUBSET; FORALL_IN_IMAGE] THEN
14858     SUBGOAL_THEN `segment[x,y] SUBSET ball(x:real^1,d)` MP_TAC THENL
14859      [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
14860       ASM_REWRITE_TAC[INSERT_SUBSET; CENTRE_IN_BALL] THEN
14861       ASM_REWRITE_TAC[IN_BALL; EMPTY_SUBSET; CONVEX_BALL; dist];
14862       REWRITE_TAC[IN_BALL; dist; SUBSET] THEN STRIP_TAC THEN
14863       X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN
14864       FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[] THEN
14865       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SEGMENT_1]) THEN
14866       REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN
14867       COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
14868       ASM_REAL_ARITH_TAC];
14869     MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN
14870     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
14871     X_GEN_TAC `N:num` THEN STRIP_TAC] THEN
14872   SUBGOAL_THEN
14873    `!n. n <= N /\ p(lift(&n / &N)) IN s
14874         ==> ?q. path(q:real^1->real^N) /\ path_image q SUBSET s /\
14875                 homotopic_paths (s UNION t)
14876                                 (subpath (vec 0) (lift(&n / &N)) p) q`
14877   MP_TAC THENL
14878    [ALL_TAC;
14879     DISCH_THEN(MP_TAC o SPEC `N:num`) THEN
14880     ASM_SIMP_TAC[REAL_DIV_REFL; REAL_OF_NUM_EQ; LE_REFL; LIFT_NUM] THEN
14881     ANTS_TAC THENL [ASM_MESON_TAC[pathfinish]; ALL_TAC] THEN
14882     DISCH_THEN(X_CHOOSE_THEN `q:real^1->real^N` MP_TAC) THEN
14883     REWRITE_TAC[SUBPATH_TRIVIAL] THEN
14884     REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
14885     DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
14886     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_PATHS_TRANS) THEN
14887     FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN
14888     FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN
14889     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN
14890     EXISTS_TAC `s:real^N->bool` THEN
14891     ASM_MESON_TAC[SUBSET_UNION]] THEN
14892   SUBGOAL_THEN
14893    `!n. n < N
14894         ==> path_image(subpath (lift(&n / &N)) (lift(&(SUC n) / &N)) p)
14895               SUBSET (s:real^N->bool) \/
14896             path_image(subpath (lift(&n / &N)) (lift(&(SUC n) / &N)) p)
14897               SUBSET t`
14898   ASSUME_TAC THENL
14899    [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
14900     REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; GSYM LIFT_SUB; DROP_VEC;
14901                 NORM_REAL; GSYM drop;
14902                 REAL_ARITH `abs(a / c - b / c) = abs((b - a) / c)`] THEN
14903     ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUC; REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ;
14904                  REAL_OF_NUM_LT; LE_1; REAL_ARITH `(x + &1) - x = &1`] THEN
14905     ASM_REWRITE_TAC[real_div; REAL_MUL_LID; REAL_MUL_LZERO; REAL_ABS_INV;
14906       REAL_ABS_NUM; REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
14907     ASM_ARITH_TAC;
14908     ALL_TAC] THEN
14909   MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN
14910   REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN STRIP_TAC THEN
14911   ASM_CASES_TAC `n = 0` THENL
14912    [ASM_REWRITE_TAC[REAL_ARITH `&0 / x = &0`; LIFT_NUM] THEN
14913     EXISTS_TAC `linepath((p:real^1->real^N)(vec 0),p(vec 0))` THEN
14914     REWRITE_TAC[SUBPATH_REFL; HOMOTOPIC_PATHS_REFL] THEN
14915     REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
14916     UNDISCH_TAC `(pathstart p:real^N) IN s` THEN REWRITE_TAC[pathstart] THEN
14917     SET_TAC[];
14918     ALL_TAC] THEN
14919   MP_TAC(ISPEC `\m. m < n /\ (p(lift(&m / &N)):real^N) IN s` num_MAX) THEN
14920   REWRITE_TAC[] THEN
14921   MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN
14922   CONJ_TAC THENL
14923    [CONJ_TAC THENL [EXISTS_TAC `0`; MESON_TAC[LT_IMP_LE]] THEN
14924     ASM_SIMP_TAC[REAL_ARITH `&0 / x = &0`; LIFT_NUM; LE_1] THEN
14925     ASM_MESON_TAC[pathstart];
14926     DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC)] THEN
14927   SUBGOAL_THEN
14928    `?q. path q /\
14929         path_image(q:real^1->real^N) SUBSET s /\
14930         homotopic_paths (s UNION t) (subpath (vec 0) (lift (&m / &N)) p) q`
14931   STRIP_ASSUME_TAC THENL
14932    [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC;
14933     ALL_TAC] THEN
14934   SUBGOAL_THEN
14935    `!i. m < i /\ i <= n
14936         ==> path_image(subpath (lift(&m / &N)) (lift(&i / &N)) p) SUBSET s \/
14937             path_image(subpath (lift(&m / &N)) (lift(&i / &N)) p) SUBSET
14938                  (t:real^N->bool)`
14939   MP_TAC THENL
14940    [MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[CONJUNCT1 LT] THEN
14941     X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
14942     ASM_CASES_TAC `i:num = m` THENL
14943      [DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[] THEN
14944       FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
14945       ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC]] THEN
14946     SUBGOAL_THEN
14947      `p(lift(&i / &N)) IN t /\ ~((p(lift(&i / &N)):real^N) IN s)`
14948     STRIP_ASSUME_TAC THENL
14949      [MATCH_MP_TAC(SET_RULE
14950        `x IN s UNION t /\ ~(x IN s) ==> x IN t /\ ~(x IN s)`) THEN
14951       CONJ_TAC THENL
14952        [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
14953          `s SUBSET t ==> x IN s ==> x IN t`)) THEN
14954         REWRITE_TAC[path_image] THEN MATCH_MP_TAC FUN_IN_IMAGE THEN
14955         REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
14956         ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
14957                      LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
14958         ASM_ARITH_TAC;
14959         SUBGOAL_THEN `i < n /\ ~(i:num <= m)` MP_TAC THENL
14960          [ASM_ARITH_TAC; ASM_MESON_TAC[]]];
14961       ALL_TAC] THEN
14962     SUBGOAL_THEN
14963      `path_image(subpath (lift(&i / &N)) (lift (&(SUC i) / &N)) p) SUBSET s \/
14964       path_image(subpath (lift(&i / &N)) (lift (&(SUC i) / &N)) p) SUBSET
14965         (t:real^N->bool)`
14966     MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN
14967     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
14968      `~(x IN s)
14969       ==> (x IN p /\ x IN q) /\ (q UNION p = r)
14970           ==> p SUBSET s \/ p SUBSET t
14971               ==> q SUBSET s \/ q SUBSET t
14972                   ==> r SUBSET s \/ r SUBSET t`)) THEN
14973     SIMP_TAC[PATH_IMAGE_SUBPATH_GEN; FUN_IN_IMAGE; ENDS_IN_SEGMENT] THEN
14974     REWRITE_TAC[GSYM IMAGE_UNION] THEN AP_TERM_TAC THEN
14975     MATCH_MP_TAC UNION_SEGMENT THEN
14976     ASM_SIMP_TAC[SEGMENT_1; LIFT_DROP; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT;
14977                  LE_1; REAL_OF_NUM_LE; LT_IMP_LE; IN_INTERVAL_1] THEN
14978     ASM_ARITH_TAC;
14979     DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[LE_REFL]] THEN
14980   STRIP_TAC THENL
14981    [EXISTS_TAC `(q:real^1->real^N) ++
14982                 subpath (lift(&m / &N)) (lift (&n / &N)) p` THEN
14983     REPEAT CONJ_TAC THENL
14984      [MATCH_MP_TAC PATH_JOIN_IMP THEN
14985       FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN
14986       ASM_SIMP_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
14987       DISCH_TAC THEN MATCH_MP_TAC PATH_SUBPATH THEN
14988       ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
14989       ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
14990                    LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
14991       ASM_ARITH_TAC;
14992       MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN ASM_REWRITE_TAC[];
14993       MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
14994       EXISTS_TAC `subpath (vec 0) (lift(&m / &N)) (p:real^1->real^N) ++
14995                   subpath (lift(&m / &N)) (lift(&n / &N)) p` THEN
14996       CONJ_TAC THENL
14997        [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
14998         MATCH_MP_TAC HOMOTOPIC_JOIN_SUBPATHS THEN
14999         ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL];
15000         MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
15001         ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
15002         MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN
15003         EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_UNION] THEN
15004         ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN
15005         MATCH_MP_TAC PATH_SUBPATH] THEN
15006       ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
15007       ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
15008                    LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
15009       ASM_ARITH_TAC];
15010     SUBGOAL_THEN
15011      `(p(lift(&m / &N)):real^N) IN t /\ (p(lift(&n / &N)):real^N) IN t`
15012     STRIP_ASSUME_TAC THENL
15013      [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE;
15014                     PATHSTART_SUBPATH; PATHFINISH_SUBPATH; SUBSET];
15015       ALL_TAC] THEN
15016     UNDISCH_TAC `path_connected(s INTER t:real^N->bool)` THEN
15017     REWRITE_TAC[path_connected] THEN DISCH_THEN(MP_TAC o SPECL
15018      [`p(lift(&m / &N)):real^N`; `p(lift(&n / &N)):real^N`]) THEN
15019     ASM_REWRITE_TAC[IN_INTER; SUBSET_INTER] THEN
15020     DISCH_THEN(X_CHOOSE_THEN `r:real^1->real^N` STRIP_ASSUME_TAC) THEN
15021     UNDISCH_THEN
15022      `!p. path p /\ path_image p SUBSET t /\ pathfinish p:real^N = pathstart p
15023           ==> homotopic_paths t p (linepath (pathstart p,pathstart p))`
15024      (MP_TAC o SPEC `subpath (lift(&m / &N)) (lift(&n / &N)) p ++
15025                      reversepath(r:real^1->real^N)`) THEN
15026     ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH;
15027                 PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH] THEN
15028     ANTS_TAC THENL
15029      [ASM_SIMP_TAC[SUBSET_PATH_IMAGE_JOIN; PATH_IMAGE_REVERSEPATH] THEN
15030       MATCH_MP_TAC PATH_JOIN_IMP THEN
15031       ASM_SIMP_TAC[PATH_REVERSEPATH; PATHFINISH_SUBPATH;
15032                    PATHSTART_REVERSEPATH] THEN
15033       MATCH_MP_TAC PATH_SUBPATH THEN
15034       ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
15035       ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
15036                    LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
15037       ASM_ARITH_TAC;
15038       ALL_TAC] THEN
15039      DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15040         HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS)) THEN
15041      ASM_REWRITE_TAC[PATHFINISH_LINEPATH; PATHSTART_SUBPATH;
15042        PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH] THEN
15043      DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15044         HOMOTOPIC_PATHS_LOOP_PARTS)) THEN
15045      FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN
15046      FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN
15047      REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
15048      REPLICATE_TAC 2 (DISCH_THEN(ASSUME_TAC o SYM)) THEN
15049      ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
15050      EXISTS_TAC `(q:real^1->real^N) ++ r` THEN
15051      ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET] THEN
15052      MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
15053      EXISTS_TAC `subpath (vec 0) (lift(&m / &N)) (p:real^1->real^N) ++
15054                  subpath (lift(&m / &N)) (lift(&n / &N)) p` THEN
15055      CONJ_TAC THENL
15056       [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
15057        MATCH_MP_TAC HOMOTOPIC_JOIN_SUBPATHS THEN
15058        ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
15059        ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
15060        ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
15061                     LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
15062        ASM_ARITH_TAC;
15063        MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
15064        ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
15065        MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN
15066        EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_UNION]]]);;
15067
15068 (* ------------------------------------------------------------------------- *)
15069 (* Covering spaces and lifting results for them.                             *)
15070 (* ------------------------------------------------------------------------- *)
15071
15072 let covering_space = new_definition
15073  `covering_space(c,(p:real^M->real^N)) s <=>
15074         p continuous_on c /\ IMAGE p c = s /\
15075         !x. x IN s
15076             ==> ?t. x IN t /\ open_in (subtopology euclidean s) t /\
15077                     ?v. UNIONS v = {x | x IN c /\ p(x) IN t} /\
15078                         (!u. u IN v ==> open_in (subtopology euclidean c) u) /\
15079                         pairwise DISJOINT v /\
15080                         (!u. u IN v ==> ?q. homeomorphism (u,t) (p,q))`;;
15081
15082 let COVERING_SPACE_IMP_CONTINUOUS = prove
15083  (`!p:real^M->real^N c s. covering_space (c,p) s ==> p continuous_on c`,
15084   SIMP_TAC[covering_space]);;
15085
15086 let COVERING_SPACE_IMP_SURJECTIVE = prove
15087  (`!p:real^M->real^N c s. covering_space (c,p) s ==> IMAGE p c = s`,
15088   SIMP_TAC[covering_space]);;
15089
15090 let HOMEOMORPHISM_IMP_COVERING_SPACE = prove
15091  (`!f:real^M->real^N g s t.
15092         homeomorphism (s,t) (f,g) ==> covering_space (s,f) t`,
15093   REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN
15094   ASM_REWRITE_TAC[covering_space] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
15095   EXISTS_TAC `t:real^N->bool` THEN
15096   ASM_SIMP_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN
15097   EXISTS_TAC `{s:real^M->bool}` THEN
15098   REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; UNIONS_1; PAIRWISE_SING] THEN
15099   ASM_SIMP_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN
15100   CONJ_TAC THENL [ASM SET_TAC[]; EXISTS_TAC `g:real^N->real^M`] THEN
15101   ASM_REWRITE_TAC[homeomorphism]);;
15102
15103 let COVERING_SPACE_LOCAL_HOMEOMORPHISM = prove
15104  (`!p:real^M->real^N c s.
15105         covering_space (c,p) s
15106         ==> !x. x IN c
15107                 ==> ?t u. x IN t /\ open_in (subtopology euclidean c) t /\
15108                           p(x) IN u /\ open_in (subtopology euclidean s) u /\
15109                           ?q. homeomorphism (t,u) (p,q)`,
15110   REWRITE_TAC[covering_space] THEN REPEAT STRIP_TAC THEN
15111   FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^M->real^N) x`) THEN
15112   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
15113   DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` MP_TAC) THEN
15114   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
15115   DISCH_THEN(X_CHOOSE_THEN `v:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
15116   SUBGOAL_THEN `(x:real^M) IN UNIONS v` MP_TAC THENL
15117    [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN
15118   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^M->bool` THEN
15119   STRIP_TAC THEN EXISTS_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[]);;
15120
15121 let COVERING_SPACE_LOCAL_HOMEOMORPHISM_ALT = prove
15122  (`!p:real^M->real^N c s.
15123         covering_space (c,p) s
15124         ==> !y. y IN s
15125                 ==> ?x t u. p(x) = y /\
15126                             x IN t /\ open_in (subtopology euclidean c) t /\
15127                             y IN u /\ open_in (subtopology euclidean s) u /\
15128                             ?q. homeomorphism (t,u) (p,q)`,
15129   REPEAT STRIP_TAC THEN
15130   SUBGOAL_THEN `?x. x IN c /\ (p:real^M->real^N) x = y` MP_TAC THENL
15131    [FIRST_X_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
15132     ASM SET_TAC[];
15133     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
15134     FIRST_ASSUM(MP_TAC o SPEC `x:real^M` o MATCH_MP
15135      COVERING_SPACE_LOCAL_HOMEOMORPHISM) THEN
15136     ASM_MESON_TAC[]]);;
15137
15138 let COVERING_SPACE_OPEN_MAP = prove
15139  (`!p:real^M->real^N c s t.
15140         covering_space (c,p) s /\
15141         open_in (subtopology euclidean c) t
15142         ==> open_in (subtopology euclidean s) (IMAGE p t)`,
15143   REWRITE_TAC[covering_space] THEN REPEAT STRIP_TAC THEN
15144   FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
15145   ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `y:real^N` THEN
15146   DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN
15147   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
15148   DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` MP_TAC) THEN
15149   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
15150   DISCH_THEN(X_CHOOSE_THEN `vs:(real^M->bool)->bool`
15151    (STRIP_ASSUME_TAC o GSYM)) THEN
15152   SUBGOAL_THEN
15153    `?x. x IN {x | x IN c /\ (p:real^M->real^N) x IN u} /\ x IN t /\ p x = y`
15154   MP_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN
15155   DISCH_THEN(X_CHOOSE_THEN `x:real^M` STRIP_ASSUME_TAC) THEN
15156   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNIONS]) THEN
15157   DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN
15158   REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `v:real^M->bool`)) THEN
15159   ASM_REWRITE_TAC[homeomorphism] THEN REPEAT DISCH_TAC THEN
15160   FIRST_X_ASSUM(X_CHOOSE_THEN `q:real^N->real^M` STRIP_ASSUME_TAC) THEN
15161   EXISTS_TAC `IMAGE (p:real^M->real^N) (t INTER v)` THEN CONJ_TAC THENL
15162    [ALL_TAC; ASM SET_TAC[]] THEN
15163   SUBGOAL_THEN
15164    `IMAGE (p:real^M->real^N) (t INTER v) =
15165     {z | z IN u /\ q z IN (t INTER v)}`
15166   SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
15167   MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN
15168   ASM_REWRITE_TAC[] THEN
15169   FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN
15170   ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN
15171   MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN
15172   EXISTS_TAC `c:real^M->bool` THEN
15173   CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_INTER; ASM_MESON_TAC[open_in]] THEN
15174   ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV]);;
15175
15176 let COVERING_SPACE_QUOTIENT_MAP = prove
15177  (`!p:real^M->real^N c s.
15178     covering_space (c,p) s
15179     ==> !u. u SUBSET s
15180             ==> (open_in (subtopology euclidean c) {x | x IN c /\ p x IN u} <=>
15181                  open_in (subtopology euclidean s) u)`,
15182   REPEAT GEN_TAC THEN DISCH_TAC THEN
15183   FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
15184   MATCH_MP_TAC OPEN_MAP_IMP_QUOTIENT_MAP THEN
15185   CONJ_TAC THENL [ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS]; ALL_TAC] THEN
15186   FIRST_ASSUM(SUBST1_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
15187   ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP]);;
15188
15189 let COVERING_SPACE_LOCALLY = prove
15190  (`!P Q p:real^M->real^N c s.
15191         covering_space (c,p) s /\ (!t. t SUBSET c /\ P t ==> Q(IMAGE p t)) /\
15192         locally P c
15193         ==> locally Q s`,
15194   REPEAT STRIP_TAC THEN
15195   FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
15196   MATCH_MP_TAC LOCALLY_OPEN_MAP_IMAGE THEN
15197   EXISTS_TAC `P:(real^M->bool)->bool` THEN
15198   CONJ_TAC THENL [ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS]; ALL_TAC] THEN
15199   ASM_SIMP_TAC[] THEN
15200   FIRST_ASSUM(SUBST1_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
15201   ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP]);;
15202
15203 let COVERING_SPACE_LOCALLY_EQ = prove
15204  (`!P Q p:real^M->real^N c s.
15205         covering_space (c,p) s /\
15206         (!t. t SUBSET c /\ P t ==> Q(IMAGE p t)) /\
15207         (!q u. u SUBSET s /\ q continuous_on u /\ Q u ==> P(IMAGE q u))
15208
15209         ==> (locally Q s <=> locally P c)`,
15210   REPEAT STRIP_TAC THEN EQ_TAC THENL
15211    [ALL_TAC; ASM_MESON_TAC[COVERING_SPACE_LOCALLY]] THEN
15212   REWRITE_TAC[locally] THEN STRIP_TAC THEN
15213   MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `x:real^M`] THEN STRIP_TAC THEN
15214   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [covering_space]) THEN
15215   DISCH_THEN(MP_TAC o SPEC `(p:real^M->real^N) x` o last o CONJUNCTS) THEN
15216   ANTS_TAC THENL
15217    [ASM_MESON_TAC[covering_space; FUN_IN_IMAGE; OPEN_IN_IMP_SUBSET; SUBSET];
15218     DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` MP_TAC)] THEN
15219   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
15220   DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
15221   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN
15222   DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN
15223   MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN
15224   CONJ_TAC THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET]; ALL_TAC] THEN
15225   REWRITE_TAC[IN_UNIONS; LEFT_IMP_EXISTS_THM] THEN
15226   X_GEN_TAC `u:real^M->bool` THEN STRIP_TAC THEN
15227   REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`)) THEN
15228   ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN
15229   FIRST_X_ASSUM(MP_TAC o SPECL
15230     [`IMAGE (p:real^M->real^N) (u INTER v)`; `(p:real^M->real^N) x`]) THEN
15231   ASM_SIMP_TAC[FUN_IN_IMAGE; IN_INTER] THEN ANTS_TAC THENL
15232    [ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP; OPEN_IN_INTER]; ALL_TAC] THEN
15233   DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool`
15234    (X_CHOOSE_THEN `w':real^N->bool` STRIP_ASSUME_TAC)) THEN
15235   FIRST_X_ASSUM(X_CHOOSE_THEN `q:real^N->real^M` MP_TAC) THEN
15236   REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN
15237   EXISTS_TAC `IMAGE (q:real^N->real^M) w` THEN
15238   EXISTS_TAC `IMAGE (q:real^N->real^M) w'` THEN REPEAT CONJ_TAC THENL
15239    [MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `u:real^M->bool` THEN
15240     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
15241     MAP_EVERY EXISTS_TAC [`p:real^M->real^N`; `t:real^N->bool`] THEN
15242     ASM_REWRITE_TAC[homeomorphism] THEN
15243
15244     MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN
15245     EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
15246     REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
15247     ASM SET_TAC[];
15248     FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
15249      [REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
15250       ASM SET_TAC[];
15251       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15252         CONTINUOUS_ON_SUBSET)) THEN
15253       ASM SET_TAC[]];
15254     ASM SET_TAC[];
15255     ASM SET_TAC[];
15256     ASM SET_TAC[]]);;
15257
15258 let COVERING_SPACE_LOCALLY_COMPACT_EQ = prove
15259  (`!p:real^M->real^N c s.
15260         covering_space (c,p) s
15261         ==> (locally compact s <=> locally compact c)`,
15262   REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_LOCALLY_EQ THEN
15263   EXISTS_TAC `p:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN
15264   RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN
15265   ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; COMPACT_CONTINUOUS_IMAGE]);;
15266
15267 let COVERING_SPACE_LOCALLY_CONNECTED_EQ = prove
15268  (`!p:real^M->real^N c s.
15269         covering_space (c,p) s
15270         ==> (locally connected s <=> locally connected c)`,
15271   REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_LOCALLY_EQ THEN
15272   EXISTS_TAC `p:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN
15273   RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN
15274   ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; CONNECTED_CONTINUOUS_IMAGE]);;
15275
15276 let COVERING_SPACE_LOCALLY_PATH_CONNECTED_EQ = prove
15277  (`!p:real^M->real^N c s.
15278         covering_space (c,p) s
15279         ==> (locally path_connected s <=> locally path_connected c)`,
15280   REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_LOCALLY_EQ THEN
15281   EXISTS_TAC `p:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN
15282   RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN
15283   ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; PATH_CONNECTED_CONTINUOUS_IMAGE]);;
15284
15285 let COVERING_SPACE_LOCALLY_COMPACT = prove
15286  (`!p:real^M->real^N c s.
15287         covering_space (c,p) s /\ locally compact c
15288         ==> locally compact s`,
15289   MESON_TAC[COVERING_SPACE_LOCALLY_COMPACT_EQ]);;
15290
15291 let COVERING_SPACE_LOCALLY_CONNECTED = prove
15292  (`!p:real^M->real^N c s.
15293         covering_space (c,p) s /\ locally connected c ==> locally connected s`,
15294   MESON_TAC[COVERING_SPACE_LOCALLY_CONNECTED_EQ]);;
15295
15296 let COVERING_SPACE_LOCALLY_PATH_CONNECTED = prove
15297  (`!p:real^M->real^N c s.
15298         covering_space (c,p) s /\ locally path_connected c
15299         ==> locally path_connected s`,
15300   MESON_TAC[COVERING_SPACE_LOCALLY_PATH_CONNECTED_EQ]);;
15301
15302 let COVERING_SPACE_LIFT_UNIQUE_GEN = prove
15303  (`!p:real^M->real^N f:real^P->real^N g1 g2 c s t u a x.
15304         covering_space (c,p) s /\
15305         f continuous_on t /\ IMAGE f t SUBSET s /\
15306         g1 continuous_on t /\ IMAGE g1 t SUBSET c /\
15307         (!x. x IN t ==> f(x) = p(g1 x)) /\
15308         g2 continuous_on t /\ IMAGE g2 t SUBSET c /\
15309         (!x. x IN t ==> f(x) = p(g2 x)) /\
15310         u IN components t /\ a IN u /\ g1(a) = g2(a) /\ x IN u
15311         ==> g1(x) = g2(x)`,
15312   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
15313   UNDISCH_TAC `(x:real^P) IN u` THEN SPEC_TAC(`x:real^P`,`x:real^P`) THEN
15314   MATCH_MP_TAC(SET_RULE
15315    `(?a. a IN u /\ g a = z) /\
15316     ({x | x IN u /\ g x = z} = {} \/ {x | x IN u /\ g x = z} = u)
15317     ==> !x. x IN u ==> g x = z`) THEN
15318   CONJ_TAC THENL [ASM_MESON_TAC[VECTOR_SUB_EQ]; ALL_TAC] THEN
15319   FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN
15320   REWRITE_TAC[CONNECTED_CLOPEN] THEN DISCH_THEN MATCH_MP_TAC THEN
15321   FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN CONJ_TAC THENL
15322    [ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN REWRITE_TAC[IN_ELIM_THM] THEN
15323     X_GEN_TAC `x:real^P` THEN STRIP_TAC THEN
15324     FIRST_ASSUM(MP_TAC o SPEC `(g1:real^P->real^M) x` o
15325         MATCH_MP COVERING_SPACE_LOCAL_HOMEOMORPHISM) THEN
15326     ANTS_TAC THENL [ASM SET_TAC[]; SIMP_TAC[LEFT_IMP_EXISTS_THM]] THEN
15327     MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `w:real^N->bool`] THEN
15328     RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_SUB_EQ]) THEN
15329     REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
15330     REWRITE_TAC[homeomorphism] THEN
15331     DISCH_THEN(X_CHOOSE_THEN `q:real^N->real^M` STRIP_ASSUME_TAC) THEN
15332     EXISTS_TAC `{x | x IN u /\ (g1:real^P->real^M) x IN v} INTER
15333                 {x | x IN u /\ (g2:real^P->real^M) x IN v}` THEN
15334     CONJ_TAC THENL
15335      [MATCH_MP_TAC OPEN_IN_INTER THEN ONCE_REWRITE_TAC[SET_RULE
15336        `{x | x IN u /\ g x IN v} =
15337         {x | x IN u /\ g x IN (v INTER IMAGE g u)}`] THEN
15338       CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN
15339       (CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC]) THEN
15340       UNDISCH_TAC `open_in (subtopology euclidean c) (v:real^M->bool)` THEN
15341       REWRITE_TAC[OPEN_IN_OPEN] THEN
15342       MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN ASM SET_TAC[];
15343       REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTER; VECTOR_SUB_EQ] THEN
15344       ASM SET_TAC[]];
15345     MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT THEN
15346     MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
15347     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]);;
15348
15349 let COVERING_SPACE_LIFT_UNIQUE = prove
15350  (`!p:real^M->real^N f:real^P->real^N g1 g2 c s t a x.
15351         covering_space (c,p) s /\
15352         f continuous_on t /\ IMAGE f t SUBSET s /\
15353         g1 continuous_on t /\ IMAGE g1 t SUBSET c /\
15354         (!x. x IN t ==> f(x) = p(g1 x)) /\
15355         g2 continuous_on t /\ IMAGE g2 t SUBSET c /\
15356         (!x. x IN t ==> f(x) = p(g2 x)) /\
15357         connected t /\ a IN t /\ g1(a) = g2(a) /\ x IN t
15358         ==> g1(x) = g2(x)`,
15359   REPEAT STRIP_TAC THEN MP_TAC(ISPECL
15360    [`p:real^M->real^N`; `f:real^P->real^N`;
15361     `g1:real^P->real^M`; `g2:real^P->real^M`;
15362     `c:real^M->bool`; `s:real^N->bool`; `t:real^P->bool`; `t:real^P->bool`;
15363     `a:real^P`; `x:real^P`] COVERING_SPACE_LIFT_UNIQUE_GEN) THEN
15364   ASM_REWRITE_TAC[IN_COMPONENTS_SELF] THEN ASM SET_TAC[]);;
15365
15366 let COVERING_SPACE_LIFT_UNIQUE_IDENTITY = prove
15367  (`!p:real^M->real^N c f s a.
15368      covering_space (c,p) s /\
15369      path_connected c /\
15370      f continuous_on c /\ IMAGE f c SUBSET c /\
15371      (!x. x IN c ==> p(f x) = p x) /\
15372      a IN c /\ f(a) = a
15373      ==> !x. x IN c ==> f x = x`,
15374   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN
15375   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
15376   DISCH_THEN(MP_TAC o SPECL [`a:real^M`; `x:real^M`]) THEN
15377   ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish] THEN
15378   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
15379   DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC) THEN
15380   MP_TAC(ISPECL
15381    [`p:real^M->real^N`; `(p:real^M->real^N) o (g:real^1->real^M)`;
15382     `(f:real^M->real^M) o (g:real^1->real^M)`; `g:real^1->real^M`;
15383     `c:real^M->bool`; `s:real^N->bool`;
15384     `interval[vec 0:real^1,vec 1]`;
15385     `vec 0:real^1`; `vec 1:real^1`]
15386    COVERING_SPACE_LIFT_UNIQUE) THEN
15387   ASM_REWRITE_TAC[o_THM; IMAGE_o] THEN DISCH_THEN MATCH_MP_TAC THEN
15388   ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; CONNECTED_INTERVAL] THEN
15389   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [covering_space]) THEN
15390   STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE
15391    `IMAGE p c = s ==> !x. x IN c ==> p(x) IN s`)) THEN
15392   ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN
15393   CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
15394   ASM_REWRITE_TAC[] THEN
15395   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15396           CONTINUOUS_ON_SUBSET)) THEN
15397   ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE]);;
15398
15399 let COVERING_SPACE_LIFT_HOMOTOPY = prove
15400  (`!p:real^M->real^N c s (h:real^(1,P)finite_sum->real^N) f u.
15401         covering_space (c,p) s /\
15402         h continuous_on (interval[vec 0,vec 1] PCROSS u) /\
15403         IMAGE h (interval[vec 0,vec 1] PCROSS u) SUBSET s /\
15404         (!y. y IN u ==> h (pastecart (vec 0) y) = p(f y)) /\
15405         f continuous_on u /\ IMAGE f u SUBSET c
15406         ==> ?k. k continuous_on (interval[vec 0,vec 1] PCROSS u) /\
15407                 IMAGE k (interval[vec 0,vec 1] PCROSS u) SUBSET c /\
15408                 (!y. y IN u ==> k(pastecart (vec 0) y) = f y) /\
15409                 (!z. z IN interval[vec 0,vec 1] PCROSS u ==> h z = p(k z))`,
15410   REPEAT STRIP_TAC THEN
15411   SUBGOAL_THEN
15412    `!y. y IN u
15413         ==> ?v. open_in (subtopology euclidean u) v /\ y IN v /\
15414                 ?k:real^(1,P)finite_sum->real^M.
15415                     k continuous_on (interval[vec 0,vec 1] PCROSS v) /\
15416                     IMAGE k (interval[vec 0,vec 1] PCROSS v) SUBSET c /\
15417                     (!y. y IN v ==> k(pastecart (vec 0) y) = f y) /\
15418                     (!z. z IN interval[vec 0,vec 1] PCROSS v
15419                          ==> h z :real^N = p(k z))`
15420   MP_TAC THENL
15421    [ALL_TAC;
15422     GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV)
15423      [RIGHT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN
15424     REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
15425     MAP_EVERY X_GEN_TAC
15426      [`v:real^P->real^P->bool`; `fs:real^P->real^(1,P)finite_sum->real^M`] THEN
15427     DISCH_THEN(LABEL_TAC "*") THEN
15428     MP_TAC(ISPECL
15429      [`fs:real^P->real^(1,P)finite_sum->real^M`;
15430       `(\x. interval[vec 0,vec 1] PCROSS (v x))
15431         :real^P->real^(1,P)finite_sum->bool`;
15432       `(interval[vec 0,vec 1] PCROSS u):real^(1,P)finite_sum->bool`;
15433       `u:real^P->bool`]
15434       PASTING_LEMMA_EXISTS) THEN
15435     ASM_SIMP_TAC[] THEN ANTS_TAC THENL
15436      [ALL_TAC;
15437       MATCH_MP_TAC MONO_EXISTS THEN
15438       X_GEN_TAC `k:real^(1,P)finite_sum->real^M` THEN STRIP_TAC THEN
15439       ASM_REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS; SUBSET] THEN
15440       REPEAT CONJ_TAC THEN TRY(X_GEN_TAC `t:real^1`) THEN
15441       X_GEN_TAC `y:real^P` THEN STRIP_TAC THENL
15442        [FIRST_X_ASSUM(MP_TAC o SPECL
15443          [`pastecart (t:real^1) (y:real^P)`; `y:real^P`]);
15444         FIRST_X_ASSUM(MP_TAC o SPECL
15445          [`pastecart (vec 0:real^1) (y:real^P)`; `y:real^P`]);
15446         FIRST_X_ASSUM(MP_TAC o SPECL
15447          [`pastecart (t:real^1) (y:real^P)`; `y:real^P`])] THEN
15448       ASM_SIMP_TAC[PASTECART_IN_PCROSS; IN_INTER; ENDS_IN_UNIT_INTERVAL] THEN
15449       DISCH_THEN SUBST1_TAC THEN
15450       REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
15451       ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
15452       REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
15453       ASM_REWRITE_TAC[PASTECART_IN_PCROSS]] THEN
15454     REPEAT CONJ_TAC THENL
15455      [REWRITE_TAC[SUBSET; FORALL_IN_PCROSS; UNIONS_GSPEC; IN_ELIM_THM] THEN
15456       MAP_EVERY X_GEN_TAC [`t:real^1`; `y:real^P`] THEN STRIP_TAC THEN
15457       EXISTS_TAC `y:real^P` THEN ASM_SIMP_TAC[PASTECART_IN_PCROSS];
15458       X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
15459       REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
15460       ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN
15461       REWRITE_TAC[OPEN_IN_OPEN] THEN
15462       DISCH_THEN(X_CHOOSE_THEN `t:real^P->bool` STRIP_ASSUME_TAC) THEN
15463       EXISTS_TAC `(:real^1) PCROSS (t:real^P->bool)` THEN
15464       ASM_SIMP_TAC[REWRITE_RULE[GSYM PCROSS] OPEN_PCROSS; OPEN_UNIV] THEN
15465       REWRITE_TAC[EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS;
15466                     IN_INTER; IN_UNIV] THEN
15467       REPEAT GEN_TAC THEN CONV_TAC TAUT;
15468       REWRITE_TAC[FORALL_PASTECART; IN_INTER; PASTECART_IN_PCROSS] THEN
15469       MAP_EVERY X_GEN_TAC
15470        [`x:real^P`; `z:real^P`; `t:real^1`; `y:real^P`] THEN
15471       REWRITE_TAC[CONJ_ACI] THEN STRIP_TAC THEN
15472       FIRST_ASSUM(MP_TAC o
15473         ISPECL [`h:real^(1,P)finite_sum->real^N`;
15474                 `(fs:real^P->real^(1,P)finite_sum->real^M) x`;
15475                 `(fs:real^P->real^(1,P)finite_sum->real^M) z`;
15476                 `interval[vec 0:real^1,vec 1] PCROSS {y:real^P}`;
15477                 `pastecart (vec 0:real^1) (y:real^P)`;
15478                 `pastecart (t:real^1) (y:real^P)`] o
15479         MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN
15480       DISCH_THEN MATCH_MP_TAC THEN
15481       ASM_SIMP_TAC[PASTECART_IN_PCROSS; IN_SING; ENDS_IN_UNIT_INTERVAL] THEN
15482       SIMP_TAC[REWRITE_RULE[GSYM PCROSS] CONNECTED_PCROSS;
15483                CONNECTED_INTERVAL; CONNECTED_SING] THEN
15484       CONJ_TAC THENL
15485        [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15486           CONTINUOUS_ON_SUBSET)) THEN
15487         REWRITE_TAC[FORALL_PASTECART; SUBSET; PASTECART_IN_PCROSS] THEN
15488         ASM_SIMP_TAC[IN_SING];
15489         ALL_TAC] THEN
15490       CONJ_TAC THENL
15491        [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
15492          (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN
15493         MATCH_MP_TAC IMAGE_SUBSET THEN
15494         REWRITE_TAC[FORALL_PASTECART; SUBSET; PASTECART_IN_PCROSS] THEN
15495         ASM_SIMP_TAC[IN_SING];
15496         ALL_TAC] THEN
15497       ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (p /\ q /\ r) /\ s`] THEN
15498       CONJ_TAC THENL
15499        [REMOVE_THEN "*" (MP_TAC o SPEC `x:real^P`);
15500         REMOVE_THEN "*" (MP_TAC o SPEC `z:real^P`)] THEN
15501       ASM_REWRITE_TAC[FORALL_IN_GSPEC; SUBSET; FORALL_IN_IMAGE] THEN
15502       ASM_SIMP_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS; IN_SING] THEN
15503       STRIP_TAC THEN
15504       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15505           CONTINUOUS_ON_SUBSET)) THEN
15506       REWRITE_TAC[FORALL_PASTECART; SUBSET; PASTECART_IN_PCROSS] THEN
15507       ASM_SIMP_TAC[IN_SING]]] THEN
15508   X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
15509   FIRST_ASSUM(MP_TAC o last o CONJUNCTS o
15510     GEN_REWRITE_RULE I [covering_space]) THEN
15511   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
15512   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
15513   X_GEN_TAC `uu:real^N->real^N->bool` THEN DISCH_TAC THEN
15514   SUBGOAL_THEN
15515    `!t. t IN interval[vec 0,vec 1]
15516         ==> ?k n i:real^N.
15517                 open_in (subtopology euclidean (interval[vec 0,vec 1])) k /\
15518                 open_in (subtopology euclidean u) n /\
15519                 t IN k /\ y IN n /\ i IN s /\
15520                 IMAGE (h:real^(1,P)finite_sum->real^N) (k PCROSS n) SUBSET uu i`
15521   MP_TAC THENL
15522    [X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
15523     SUBGOAL_THEN `(h:real^(1,P)finite_sum->real^N) (pastecart t y) IN s`
15524     ASSUME_TAC THENL
15525      [FIRST_X_ASSUM(MATCH_MP_TAC o ONCE_REWRITE_RULE[FORALL_IN_IMAGE] o
15526         GEN_REWRITE_RULE I [SUBSET]) THEN
15527       ASM_REWRITE_TAC[PASTECART_IN_PCROSS];
15528       ALL_TAC] THEN
15529     SUBGOAL_THEN
15530      `open_in (subtopology euclidean (interval[vec 0,vec 1] PCROSS u))
15531               {z | z IN (interval[vec 0,vec 1] PCROSS u) /\
15532                    (h:real^(1,P)finite_sum->real^N) z IN
15533                    uu(h(pastecart t y))}`
15534     MP_TAC THENL
15535      [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
15536       EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[];
15537       ALL_TAC] THEN
15538     DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
15539         PASTECART_IN_INTERIOR_SUBTOPOLOGY)) THEN
15540     DISCH_THEN(MP_TAC o SPECL [`t:real^1`; `y:real^P`]) THEN
15541     ASM_SIMP_TAC[IN_ELIM_THM; PASTECART_IN_PCROSS] THEN
15542     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^1->bool` THEN
15543     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:real^P->bool` THEN
15544     STRIP_TAC THEN
15545     EXISTS_TAC `(h:real^(1,P)finite_sum->real^N) (pastecart t y)` THEN
15546     ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
15547     ALL_TAC] THEN
15548   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [OPEN_IN_OPEN] THEN
15549   REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
15550   REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
15551   REWRITE_TAC[MESON[]
15552    `(?x y. (P y /\ x = f y) /\ Q x) <=> ?y. P y /\ Q(f y)`] THEN
15553   REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
15554   GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
15555   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
15556   MAP_EVERY X_GEN_TAC
15557    [`kk:real^1->real^1->bool`; `nn:real^1->real^P->bool`;
15558     `xx:real^1->real^N`] THEN
15559   DISCH_THEN(LABEL_TAC "+") THEN
15560   MP_TAC(ISPEC `interval[vec 0:real^1,vec 1] PCROSS {y:real^P}`
15561     COMPACT_IMP_HEINE_BOREL) THEN
15562   SIMP_TAC[COMPACT_PCROSS; COMPACT_INTERVAL; COMPACT_SING] THEN
15563   DISCH_THEN(MP_TAC o SPEC
15564    `IMAGE ((\i. kk i PCROSS nn i):real^1->real^(1,P)finite_sum->bool)
15565           (interval[vec 0,vec 1])`) THEN
15566   ASM_SIMP_TAC[FORALL_IN_IMAGE; OPEN_PCROSS] THEN ANTS_TAC THENL
15567    [REWRITE_TAC[SUBSET; FORALL_IN_PCROSS; IN_SING] THEN
15568     MAP_EVERY X_GEN_TAC [`t:real^1`; `z:real^P`] THEN STRIP_TAC THEN
15569     ASM_REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; PASTECART_IN_PCROSS] THEN
15570     ASM_MESON_TAC[IN_INTER];
15571     GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
15572      [TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
15573     REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN
15574     DISCH_THEN(X_CHOOSE_THEN `tk:real^1->bool` STRIP_ASSUME_TAC)] THEN
15575   ABBREV_TAC `n = INTERS (IMAGE (nn:real^1->real^P->bool) tk)` THEN
15576   SUBGOAL_THEN `(y:real^P) IN n /\ open n` STRIP_ASSUME_TAC THENL
15577    [EXPAND_TAC "n" THEN CONJ_TAC THENL
15578      [REWRITE_TAC[INTERS_IMAGE; IN_ELIM_THM];
15579       MATCH_MP_TAC OPEN_INTERS THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN
15580       ASM_SIMP_TAC[FINITE_IMAGE]] THEN
15581     X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
15582     REMOVE_THEN "+" (MP_TAC o SPEC `t:real^1`) THEN
15583     (ANTS_TAC THENL [ASM SET_TAC[]; SIMP_TAC[IN_INTER]]);
15584     ALL_TAC] THEN
15585   MP_TAC(ISPECL
15586    [`interval[vec 0:real^1,vec 1]`; `IMAGE (kk:real^1->real^1->bool) tk`]
15587    LEBESGUE_COVERING_LEMMA) THEN
15588   REWRITE_TAC[COMPACT_INTERVAL; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN
15589   MATCH_MP_TAC(TAUT
15590    `q /\ (p ==> ~q) /\ (q ==> (r ==> s) ==> t)
15591     ==> (~p /\ q /\ r ==> s) ==> t`) THEN
15592   SIMP_TAC[UNIONS_0; IMAGE_CLAUSES; SUBSET_EMPTY; UNIT_INTERVAL_NONEMPTY] THEN
15593   CONJ_TAC THENL
15594    [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [UNIONS_IMAGE]) THEN
15595     REWRITE_TAC[SUBSET; FORALL_IN_PCROSS; IMP_CONJ; IN_SING] THEN
15596     REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN
15597     REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; PASTECART_IN_PCROSS] THEN
15598     MESON_TAC[];
15599     DISCH_TAC] THEN
15600   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
15601   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
15602   MP_TAC(ISPEC `d:real` REAL_ARCH_INV) THEN
15603   ASM_REWRITE_TAC[] THEN
15604   DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN
15605   SUBGOAL_THEN
15606    `!n. n <= N
15607         ==> ?v k:real^(1,P)finite_sum->real^M.
15608                 open_in (subtopology euclidean u) v /\
15609                 y IN v /\
15610                 k continuous_on interval[vec 0,lift(&n / &N)] PCROSS v /\
15611                 IMAGE k (interval[vec 0,lift(&n / &N)] PCROSS v) SUBSET c /\
15612                 (!y. y IN v ==> k (pastecart (vec 0) y) = f y) /\
15613                 (!z. z IN interval[vec 0,lift(&n / &N)] PCROSS v
15614                      ==> h z:real^N = p (k z))`
15615   MP_TAC THENL
15616    [ALL_TAC;
15617     DISCH_THEN(MP_TAC o SPEC `N:num`) THEN REWRITE_TAC[LE_REFL] THEN
15618     ASM_SIMP_TAC[REAL_DIV_REFL; REAL_OF_NUM_EQ; LIFT_NUM]] THEN
15619   MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
15620    [DISCH_TAC THEN REWRITE_TAC[real_div; REAL_MUL_LZERO; LIFT_NUM] THEN
15621     EXISTS_TAC `u:real^P->bool` THEN
15622     EXISTS_TAC `(f o sndcart):real^(1,P)finite_sum->real^M` THEN
15623     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS; INTERVAL_SING] THEN
15624     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_SING; o_THM] THEN
15625     ASM_REWRITE_TAC[FORALL_UNWIND_THM2; SNDCART_PASTECART] THEN
15626     REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN
15627     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
15628     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
15629     SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
15630     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15631           CONTINUOUS_ON_SUBSET)) THEN
15632     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
15633     SIMP_TAC[SNDCART_PASTECART];
15634     ALL_TAC] THEN
15635   X_GEN_TAC `m:num` THEN ASM_CASES_TAC `SUC m <= N` THEN
15636   ASM_SIMP_TAC[ARITH_RULE `SUC m <= N ==> m <= N`; LEFT_IMP_EXISTS_THM] THEN
15637   MAP_EVERY X_GEN_TAC
15638    [`v:real^P->bool`; `k:real^(1,P)finite_sum->real^M`] THEN
15639   STRIP_TAC THEN FIRST_X_ASSUM
15640    (MP_TAC o SPEC `interval[lift(&m / &N),lift(&(SUC m) / &N)]`) THEN
15641   ANTS_TAC THENL
15642    [REWRITE_TAC[DIAMETER_INTERVAL; SUBSET_INTERVAL_1] THEN
15643     REWRITE_TAC[LIFT_DROP; DROP_VEC; INTERVAL_EQ_EMPTY_1;
15644                 GSYM LIFT_SUB; NORM_LIFT] THEN
15645     ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; LE_1;
15646                  REAL_FIELD `&0 < x ==> a / x - b / x = (a - b) / x`] THEN
15647     SIMP_TAC[GSYM NOT_LE; ARITH_RULE `m <= SUC m`; REAL_OF_NUM_SUB] THEN
15648     ASM_SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_LE_DIV; REAL_POS;
15649                  REAL_ABS_NUM; ARITH_RULE `SUC m - m = 1`] THEN
15650     ASM_SIMP_TAC[REAL_ARITH `&1 / n = inv(n)`; REAL_LT_IMP_LE] THEN
15651     ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN
15652     ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE] THEN ARITH_TAC;
15653     ALL_TAC] THEN
15654   REWRITE_TAC[EXISTS_IN_IMAGE] THEN
15655   DISCH_THEN(X_CHOOSE_THEN `t:real^1` STRIP_ASSUME_TAC) THEN
15656   REMOVE_THEN "+" (MP_TAC o SPEC `t:real^1`) THEN
15657   ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN
15658   FIRST_X_ASSUM(MP_TAC o SPEC `(xx:real^1->real^N) t`) THEN
15659   ASM_REWRITE_TAC[] THEN
15660   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
15661   DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` MP_TAC) THEN
15662   ONCE_REWRITE_TAC[IMP_CONJ] THEN
15663   GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN
15664   DISCH_THEN(MP_TAC o SPEC
15665    `(k:real^(1,P)finite_sum->real^M) (pastecart (lift(&m / &N)) y)`) THEN
15666   REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC(TAUT
15667    `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN
15668   REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [IN_INTER])) THEN
15669   SUBGOAL_THEN
15670    `lift(&m / &N) IN interval[vec 0,lift (&m / &N)] /\
15671     lift(&m / &N) IN interval[lift(&m / &N),lift(&(SUC m) / &N)]`
15672   STRIP_ASSUME_TAC THENL
15673    [REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
15674     SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LE_REFL] THEN
15675     ASM_SIMP_TAC[REAL_LE_DIV2_EQ; LE_1; REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN
15676     ARITH_TAC;
15677     ALL_TAC] THEN
15678   REPEAT CONJ_TAC THENL
15679    [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
15680     MATCH_MP_TAC FUN_IN_IMAGE THEN
15681     ASM_REWRITE_TAC[PASTECART_IN_PCROSS];
15682     FIRST_X_ASSUM(MP_TAC o SPEC `pastecart(lift(&m / &N)) (y:real^P)`) THEN
15683     ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN
15684     DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
15685      (SET_RULE `IMAGE h s SUBSET t ==> x IN s ==> h x IN t`)) THEN
15686     ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_INTER] THEN
15687     ASM_SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; REAL_LE_DIV; REAL_LE_LDIV_EQ;
15688                  REAL_POS; REAL_OF_NUM_LT; LE_1; DROP_VEC] THEN
15689     REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE] THEN
15690     CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
15691     FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
15692     ASM_REWRITE_TAC[];
15693     GEN_REWRITE_TAC LAND_CONV [IN_UNIONS] THEN
15694     DISCH_THEN(X_CHOOSE_THEN `w:real^M->bool` STRIP_ASSUME_TAC) THEN
15695     DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `w:real^M->bool`) MP_TAC) THEN
15696     DISCH_THEN(MP_TAC o SPEC `w:real^M->bool` o CONJUNCT2) THEN
15697     ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `p':real^N->real^M`) THEN
15698     DISCH_TAC THEN UNDISCH_THEN `(w:real^M->bool) IN vv` (K ALL_TAC)] THEN
15699   ABBREV_TAC `w' = (uu:real^N->real^N->bool)(xx(t:real^1))` THEN
15700   SUBGOAL_THEN
15701    `?n'. open_in (subtopology euclidean u) n' /\ y IN n' /\
15702          IMAGE (k:real^(1,P)finite_sum->real^M) ({lift(&m / &N)} PCROSS n')
15703          SUBSET w`
15704   STRIP_ASSUME_TAC THENL
15705    [EXISTS_TAC
15706      `{z | z IN v /\ ((k:real^(1,P)finite_sum->real^M) o
15707                      pastecart (lift(&m / &N))) z IN w}` THEN
15708     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
15709     ASM_SIMP_TAC[IN_ELIM_THM; IN_SING; o_THM] THEN
15710     MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `v:real^P->bool` THEN
15711     ASM_REWRITE_TAC[] THEN
15712     MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
15713     EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
15714     ONCE_REWRITE_TAC[GSYM o_DEF] THEN CONJ_TAC THENL
15715      [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
15716       SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST;
15717                CONTINUOUS_ON_ID] THEN
15718       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15719           CONTINUOUS_ON_SUBSET));
15720       REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
15721        `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`))] THEN
15722     ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS];
15723     ALL_TAC] THEN
15724   SUBGOAL_THEN
15725    `?q q':real^P->bool.
15726         open_in (subtopology euclidean u) q /\
15727         closed_in (subtopology euclidean u) q' /\
15728         y IN q /\ y IN q' /\ q SUBSET q' /\
15729         q SUBSET (u INTER nn(t:real^1)) INTER n' INTER v /\
15730         q' SUBSET (u INTER nn(t:real^1)) INTER n' INTER v`
15731   STRIP_ASSUME_TAC THENL
15732    [REWRITE_TAC[SET_RULE
15733      `y IN q /\ y IN q' /\ q SUBSET q' /\ q SUBSET s /\ q' SUBSET s <=>
15734       y IN q /\ q SUBSET q' /\ q' SUBSET s`] THEN
15735     UNDISCH_TAC `open_in (subtopology euclidean u) (v:real^P->bool)` THEN
15736     UNDISCH_TAC `open_in (subtopology euclidean u) (n':real^P->bool)` THEN
15737     REWRITE_TAC[OPEN_IN_OPEN] THEN
15738     DISCH_THEN(X_CHOOSE_THEN `vo:real^P->bool` STRIP_ASSUME_TAC) THEN
15739     DISCH_THEN(X_CHOOSE_THEN `vx:real^P->bool` STRIP_ASSUME_TAC) THEN
15740     MP_TAC(ISPEC `nn(t:real^1) INTER vo INTER vx:real^P->bool`
15741       OPEN_CONTAINS_CBALL) THEN
15742     ASM_SIMP_TAC[OPEN_INTER] THEN DISCH_THEN(MP_TAC o SPEC `y:real^P`) THEN
15743     ASM_REWRITE_TAC[IN_INTER] THEN
15744     ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
15745     DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
15746     EXISTS_TAC `u INTER ball(y:real^P,e)` THEN
15747     EXISTS_TAC `u INTER cball(y:real^P,e)` THEN
15748     REWRITE_TAC[CLOSED_IN_CLOSED] THEN
15749     CONJ_TAC THENL [MESON_TAC[OPEN_BALL]; ALL_TAC] THEN
15750     CONJ_TAC THENL [MESON_TAC[CLOSED_CBALL]; ALL_TAC] THEN
15751     ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL] THEN
15752     MP_TAC(ISPECL [`y:real^P`; `e:real`] BALL_SUBSET_CBALL) THEN
15753     ASM SET_TAC[];
15754     ALL_TAC] THEN
15755   FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN
15756   EXISTS_TAC `q:real^P->bool` THEN ASM_REWRITE_TAC[] THEN
15757   MP_TAC(ISPECL
15758    [`\x:real^(1,P)finite_sum.
15759        x IN interval[vec 0,lift(&m / &N)] PCROSS (q':real^P->bool)`;
15760     `k:real^(1,P)finite_sum->real^M`;
15761     `(p':real^N->real^M) o (h:real^(1,P)finite_sum->real^N)`;
15762     `interval[vec 0,lift(&m / &N)] PCROSS (q':real^P->bool)`;
15763     `interval[lift(&m / &N),lift(&(SUC m) / &N)] PCROSS (q':real^P->bool)`]
15764    CONTINUOUS_ON_CASES_LOCAL) THEN
15765   REWRITE_TAC[TAUT `~(p /\ ~p)`] THEN ANTS_TAC THENL
15766    [REPEAT CONJ_TAC THENL
15767      [REWRITE_TAC[CLOSED_IN_CLOSED] THEN
15768       EXISTS_TAC `interval[vec 0,lift(&m / &N)] PCROSS (:real^P)` THEN
15769       SIMP_TAC[CLOSED_PCROSS; CLOSED_INTERVAL; CLOSED_UNIV] THEN
15770       REWRITE_TAC[EXTENSION; IN_INTER; IN_UNION; FORALL_PASTECART] THEN
15771       REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV] THEN CONV_TAC TAUT;
15772       REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC
15773        `interval[lift(&m / &N),lift(&(SUC m) / &N)] PCROSS (:real^P)` THEN
15774       SIMP_TAC[CLOSED_PCROSS; CLOSED_INTERVAL; CLOSED_UNIV] THEN
15775       REWRITE_TAC[EXTENSION; IN_INTER; IN_UNION; FORALL_PASTECART] THEN
15776       REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV] THEN CONV_TAC TAUT;
15777       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15778           CONTINUOUS_ON_SUBSET)) THEN
15779       REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
15780       ASM SET_TAC[];
15781       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
15782       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15783           CONTINUOUS_ON_SUBSET))
15784       THENL
15785        [ALL_TAC;
15786         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
15787          `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`))] THEN
15788       MATCH_MP_TAC PCROSS_MONO THEN
15789       (CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN
15790       ASM_REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC;
15791                       SUBSET_INTER] THEN
15792       REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
15793       ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT;
15794                    LE_1] THEN
15795       ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1;
15796                    REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
15797       DISJ2_TAC THEN ARITH_TAC;
15798       REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
15799       MAP_EVERY X_GEN_TAC [`r:real^1`; `z:real^P`] THEN
15800       ASM_CASES_TAC `(z:real^P) IN q'` THEN ASM_REWRITE_TAC[] THEN
15801       REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN DISCH_THEN(MP_TAC o MATCH_MP
15802        (REAL_ARITH `(b <= x /\ x <= c) /\ (a <= x /\ x <= b) ==> x = b`)) THEN
15803       REWRITE_TAC[DROP_EQ; o_THM] THEN DISCH_THEN SUBST1_TAC THEN
15804       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
15805        `(!x. x IN w ==> p' (p x) = x)
15806         ==> h z = p(k z) /\ k z IN w
15807             ==> k z = p' (h z)`)) THEN
15808       CONJ_TAC THENL
15809        [FIRST_X_ASSUM MATCH_MP_TAC THEN
15810         ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM SET_TAC[];
15811         FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
15812         MATCH_MP_TAC FUN_IN_IMAGE THEN
15813         REWRITE_TAC[PASTECART_IN_PCROSS; IN_SING] THEN ASM SET_TAC[]]];
15814     SUBGOAL_THEN
15815      `interval[vec 0,lift(&m / &N)] UNION
15816       interval [lift(&m / &N),lift(&(SUC m) / &N)] =
15817       interval[vec 0,lift(&(SUC m) / &N)]`
15818     ASSUME_TAC THENL
15819      [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN GEN_TAC THEN
15820       MATCH_MP_TAC(REAL_ARITH `a <= b /\ b <= c ==>
15821        (a <= x /\ x <= b \/ b <= x /\ x <= c <=> a <= x /\ x <= c)`) THEN
15822       SIMP_TAC[LIFT_DROP; DROP_VEC; REAL_LE_DIV; REAL_POS] THEN
15823       ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; REAL_OF_NUM_LE; LE_1] THEN
15824       ARITH_TAC;
15825       ALL_TAC] THEN
15826     SUBGOAL_THEN
15827      `interval[vec 0,lift(&m / &N)] PCROSS (q':real^P->bool) UNION
15828       interval [lift(&m / &N),lift(&(SUC m) / &N)] PCROSS q' =
15829       interval[vec 0,lift(&(SUC m) / &N)] PCROSS q'`
15830     SUBST1_TAC THENL
15831      [SIMP_TAC[EXTENSION; IN_UNION; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
15832       ASM SET_TAC[];
15833       ALL_TAC] THEN
15834     MATCH_MP_TAC(MESON[CONTINUOUS_ON_SUBSET]
15835      `t SUBSET s /\ (f continuous_on s ==> P f)
15836       ==> f continuous_on s ==> ?g. g continuous_on t /\ P g`) THEN
15837     ASM_SIMP_TAC[PCROSS_MONO; SUBSET_REFL] THEN DISCH_TAC THEN
15838     REPEAT CONJ_TAC THENL
15839      [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
15840       MAP_EVERY X_GEN_TAC [`r:real^1`; `z:real^P`] THEN STRIP_TAC THEN
15841       SUBGOAL_THEN `(z:real^P) IN q'` ASSUME_TAC THENL
15842        [ASM SET_TAC[]; ASM_REWRITE_TAC[PASTECART_IN_PCROSS]] THEN
15843       COND_CASES_TAC THEN REWRITE_TAC[o_THM] THENL
15844        [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
15845         MATCH_MP_TAC FUN_IN_IMAGE THEN
15846         REWRITE_TAC[PASTECART_IN_PCROSS; IN_SING] THEN ASM SET_TAC[];
15847         FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET] o
15848           CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
15849         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
15850          `IMAGE p w' = w ==> x IN w' ==> p x IN w`))];
15851       X_GEN_TAC `z:real^P` THEN REWRITE_TAC[PASTECART_IN_PCROSS] THEN
15852       DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN
15853       SUBGOAL_THEN `(z:real^P) IN q'` ASSUME_TAC THENL
15854        [ASM SET_TAC[]; ASM_REWRITE_TAC[LIFT_DROP; DROP_VEC]] THEN
15855       SIMP_TAC[REAL_LE_DIV; REAL_POS] THEN ASM SET_TAC[];
15856       REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
15857       MAP_EVERY X_GEN_TAC [`r:real^1`; `z:real^P`] THEN STRIP_TAC THEN
15858       SUBGOAL_THEN `(z:real^P) IN q'` ASSUME_TAC THENL
15859        [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN
15860       COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
15861        [FIRST_X_ASSUM MATCH_MP_TAC THEN
15862         ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM SET_TAC[];
15863         REWRITE_TAC[o_THM] THEN CONV_TAC SYM_CONV THEN
15864         FIRST_X_ASSUM MATCH_MP_TAC]] THEN
15865     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
15866       (SET_RULE `IMAGE h s SUBSET t ==> x IN s ==> h x IN t`)) THEN
15867     ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_INTER] THEN
15868     REPEAT(CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN
15869     RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
15870     REWRITE_TAC[IN_INTERVAL_1] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
15871      (REAL_ARITH `a <= x /\ x <= b ==> b <= c ==> a <= x /\ x <= c`)) THEN
15872     ASM_SIMP_TAC[LIFT_DROP; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN
15873     ASM_REWRITE_TAC[DROP_VEC; REAL_MUL_LID; REAL_OF_NUM_LE]]);;
15874
15875 let COVERING_SPACE_LIFT_HOMOTOPIC_FUNCTION = prove
15876  (`!p:real^M->real^N c s f f' g u:real^P->bool.
15877         covering_space (c,p) s /\
15878         g continuous_on u /\ IMAGE g u SUBSET c /\
15879         (!y. y IN u ==> p(g y) = f y) /\
15880         homotopic_with (\x. T) (u,s) f f'
15881         ==> ?g'. g' continuous_on u /\ IMAGE g' u SUBSET c /\
15882                  (!y. y IN u ==> p(g' y) = f' y)`,
15883   REPEAT STRIP_TAC THEN
15884   FIRST_X_ASSUM(X_CHOOSE_THEN `h:real^(1,P)finite_sum->real^N`
15885     STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN
15886   FIRST_ASSUM(MP_TAC o
15887     ISPECL [`h:real^(1,P)finite_sum->real^N`;
15888             `g:real^P->real^M`; `u:real^P->bool`] o
15889     MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY)) THEN
15890   ASM_SIMP_TAC[] THEN
15891   DISCH_THEN(X_CHOOSE_THEN `k:real^(1,P)finite_sum->real^M`
15892         STRIP_ASSUME_TAC) THEN
15893   EXISTS_TAC `(k:real^(1,P)finite_sum->real^M) o
15894               (\x. pastecart (vec 1) x)` THEN
15895   ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN REPEAT CONJ_TAC THENL
15896    [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
15897     SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST;
15898              CONTINUOUS_ON_ID] THEN
15899     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15900           CONTINUOUS_ON_SUBSET)) THEN
15901     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS;
15902                 ENDS_IN_UNIT_INTERVAL];
15903     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
15904      `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`)) THEN
15905     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS;
15906                 ENDS_IN_UNIT_INTERVAL];
15907     ASM_MESON_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL]]);;
15908
15909 let COVERING_SPACE_LIFT_INESSENTIAL_FUNCTION = prove
15910  (`!p:real^M->real^N c s f a u:real^P->bool.
15911         covering_space (c,p) s /\ homotopic_with (\x. T) (u,s) f (\x. a)
15912         ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\
15913                 (!y. y IN u ==> p(g y) = f y)`,
15914   ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN
15915   ASM_CASES_TAC `u:real^P->bool = {}` THEN
15916   ASM_REWRITE_TAC[NOT_IN_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET;
15917                   CONTINUOUS_ON_EMPTY] THEN
15918   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE
15919      [TAUT `a /\ b /\ c /\ d /\ e ==> f <=> a /\ e ==> b /\ c /\ d ==> f`]
15920      COVERING_SPACE_LIFT_HOMOTOPIC_FUNCTION)) THEN
15921   FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC) THEN
15922   FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
15923   FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
15924   SUBGOAL_THEN `?b. b IN c /\ (p:real^M->real^N) b = a` CHOOSE_TAC THENL
15925    [ASM SET_TAC[];
15926     EXISTS_TAC `(\x. b):real^P->real^M`] THEN
15927   REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]);;
15928
15929 let COVERING_SPACE_LIFT_HOMOTOPY_ALT = prove
15930  (`!p:real^M->real^N c s (h:real^(P,1)finite_sum->real^N) f u.
15931         covering_space (c,p) s /\
15932         h continuous_on (u PCROSS interval[vec 0,vec 1]) /\
15933         IMAGE h (u PCROSS interval[vec 0,vec 1]) SUBSET s /\
15934         (!y. y IN u ==> h (pastecart y (vec 0)) = p(f y)) /\
15935         f continuous_on u /\ IMAGE f u SUBSET c
15936         ==> ?k. k continuous_on (u PCROSS interval[vec 0,vec 1]) /\
15937                 IMAGE k (u PCROSS interval[vec 0,vec 1]) SUBSET c /\
15938                 (!y. y IN u ==> k(pastecart y (vec 0)) = f y) /\
15939                 (!z. z IN u PCROSS interval[vec 0,vec 1] ==> h z = p(k z))`,
15940   REPEAT STRIP_TAC THEN
15941   FIRST_ASSUM(MP_TAC o ISPECL
15942    [`(h:real^(P,1)finite_sum->real^N) o
15943      (\z. pastecart (sndcart z) (fstcart z))`;
15944     `f:real^P->real^M`; `u:real^P->bool`] o
15945       MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY)) THEN
15946   ASM_SIMP_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN ANTS_TAC THENL
15947    [CONJ_TAC THENL
15948      [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
15949       SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON;
15950                LINEAR_FSTCART; LINEAR_SNDCART] THEN
15951       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15952           CONTINUOUS_ON_SUBSET));
15953       REWRITE_TAC[IMAGE_o] THEN
15954       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
15955        `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`))] THEN
15956     SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; FORALL_IN_PCROSS;
15957              FSTCART_PASTECART; SNDCART_PASTECART];
15958     DISCH_THEN(X_CHOOSE_THEN `k:real^(1,P)finite_sum->real^M`
15959         STRIP_ASSUME_TAC) THEN
15960     EXISTS_TAC `(k:real^(1,P)finite_sum->real^M) o
15961                 (\z. pastecart (sndcart z) (fstcart z))` THEN
15962     ASM_SIMP_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART;
15963                  FORALL_IN_PCROSS; PASTECART_IN_PCROSS] THEN
15964     REPEAT CONJ_TAC THENL
15965      [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
15966       SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON;
15967                LINEAR_FSTCART; LINEAR_SNDCART] THEN
15968       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15969           CONTINUOUS_ON_SUBSET));
15970       REWRITE_TAC[IMAGE_o] THEN
15971       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
15972        `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`));
15973       MAP_EVERY X_GEN_TAC [`x:real^P`; `t:real^1`] THEN STRIP_TAC THEN
15974       FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (t:real^1) (x:real^P)`)] THEN
15975     ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS;
15976                  FSTCART_PASTECART; SNDCART_PASTECART; FORALL_IN_PCROSS]]);;
15977
15978 let COVERING_SPACE_LIFT_PATH_STRONG = prove
15979  (`!p:real^M->real^N c s g a.
15980      covering_space (c,p) s /\
15981      path g /\ path_image g SUBSET s /\ pathstart g = p(a) /\ a IN c
15982      ==> ?h. path h /\ path_image h SUBSET c /\ pathstart h = a /\
15983              !t. t IN interval[vec 0,vec 1] ==> p(h t) = g t`,
15984   REWRITE_TAC[path_image; path; pathstart] THEN
15985   REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o
15986     ISPECL [`(g:real^1->real^N) o (fstcart:real^(1,P)finite_sum->real^1)`;
15987             `(\y. a):real^P->real^M`; `{arb:real^P}`] o
15988     MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY)) THEN
15989   REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; o_THM; FSTCART_PASTECART] THEN
15990   ANTS_TAC THENL
15991    [ASM_REWRITE_TAC[IMAGE_o; CONTINUOUS_ON_CONST] THEN
15992     ASM_REWRITE_TAC[SET_RULE `IMAGE (\y. a) {b} SUBSET s <=> a IN s`] THEN
15993     CONJ_TAC THENL
15994      [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
15995       SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_ON] THEN
15996       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15997           CONTINUOUS_ON_SUBSET));
15998       ALL_TAC] THEN
15999     ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
16000     SIMP_TAC[FSTCART_PASTECART] THEN ASM SET_TAC[];
16001     DISCH_THEN(X_CHOOSE_THEN `k:real^(1,P)finite_sum->real^M`
16002         STRIP_ASSUME_TAC) THEN
16003     EXISTS_TAC `(k:real^(1,P)finite_sum->real^M) o (\t. pastecart t arb)` THEN
16004     ASM_REWRITE_TAC[o_THM; IMAGE_o] THEN REPEAT CONJ_TAC THENL
16005      [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
16006       SIMP_TAC[CONTINUOUS_ON_PASTECART;
16007                CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
16008       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
16009           CONTINUOUS_ON_SUBSET)) THEN
16010       SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; IN_SING];
16011       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
16012        `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`)) THEN
16013       SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; IN_SING];
16014       X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
16015       FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (t:real^1) (arb:real^P)`) THEN
16016       ASM_SIMP_TAC[PASTECART_IN_PCROSS; FSTCART_PASTECART; IN_SING]]]);;
16017
16018 let COVERING_SPACE_LIFT_PATH = prove
16019  (`!p:real^M->real^N c s g.
16020      covering_space (c,p) s /\ path g /\ path_image g SUBSET s
16021      ==> ?h. path h /\ path_image h SUBSET c /\
16022              !t. t IN interval[vec 0,vec 1] ==> p(h t) = g t`,
16023   REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE
16024    `IMAGE g i SUBSET s ==> vec 0 IN i ==> g(vec 0) IN s`) o
16025    GEN_REWRITE_RULE LAND_CONV [path_image]) THEN
16026   REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
16027   FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
16028   REWRITE_TAC[IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN
16029   X_GEN_TAC `a:real^M` THEN STRIP_TAC THEN
16030   MP_TAC(ISPECL [`p:real^M->real^N`; `c:real^M->bool`; `s:real^N->bool`;
16031                 `g:real^1->real^N`; `a:real^M`]
16032     COVERING_SPACE_LIFT_PATH_STRONG) THEN
16033   ASM_REWRITE_TAC[pathstart] THEN MATCH_MP_TAC MONO_EXISTS THEN
16034   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]);;
16035
16036 let COVERING_SPACE_LIFT_HOMOTOPIC_PATHS = prove
16037  (`!p:real^M->real^N c s g1 g2 h1 h2.
16038      covering_space (c,p) s /\
16039      path g1 /\ path_image g1 SUBSET s /\
16040      path g2 /\ path_image g2 SUBSET s /\
16041      homotopic_paths s g1 g2 /\
16042      path h1 /\ path_image h1 SUBSET c /\
16043      (!t. t IN interval[vec 0,vec 1] ==> p(h1 t) = g1 t) /\
16044      path h2 /\ path_image h2 SUBSET c /\
16045      (!t. t IN interval[vec 0,vec 1] ==> p(h2 t) = g2 t) /\
16046      pathstart h1 = pathstart h2
16047      ==> homotopic_paths c h1 h2`,
16048   REPEAT STRIP_TAC THEN REWRITE_TAC[HOMOTOPIC_PATHS] THEN
16049   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_paths]) THEN
16050   REWRITE_TAC[homotopic_with; pathstart; pathfinish] THEN
16051   DISCH_THEN(X_CHOOSE_THEN
16052    `h:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC) THEN
16053   FIRST_ASSUM(MP_TAC o ISPECL
16054    [`h:real^(1,1)finite_sum->real^N`; `(\x. pathstart h2):real^1->real^M`;
16055     `interval[vec 0:real^1,vec 1]`] o
16056    MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY_ALT)) THEN
16057   ASM_SIMP_TAC[] THEN ANTS_TAC THENL
16058    [REWRITE_TAC[CONTINUOUS_ON_CONST; SUBSET; FORALL_IN_IMAGE] THEN
16059     ASM_MESON_TAC[pathstart; ENDS_IN_UNIT_INTERVAL; PATHSTART_IN_PATH_IMAGE;
16060                   SUBSET];
16061     ALL_TAC] THEN
16062   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^(1,1)finite_sum->real^M` THEN
16063   STRIP_TAC THEN ASM_SIMP_TAC[o_DEF] THEN
16064   MATCH_MP_TAC(TAUT `(p /\ q) /\ (p /\ q ==> r) ==> p /\ q /\ r`) THEN
16065   CONJ_TAC THENL
16066    [CONJ_TAC THEN
16067     FIRST_ASSUM(MATCH_MP_TAC o
16068       REWRITE_RULE[RIGHT_FORALL_IMP_THM] o
16069       ONCE_REWRITE_RULE[IMP_CONJ] o
16070       REWRITE_RULE[CONJ_ASSOC] o MATCH_MP
16071        (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN
16072     REWRITE_TAC[GSYM CONJ_ASSOC] THENL
16073      [MAP_EVERY EXISTS_TAC [`g1:real^1->real^N`; `vec 0:real^1`];
16074       MAP_EVERY EXISTS_TAC [`g2:real^1->real^N`; `vec 0:real^1`]] THEN
16075     ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN
16076     RULE_ASSUM_TAC(REWRITE_RULE[path_image; pathstart; pathfinish; path]) THEN
16077     ASM_REWRITE_TAC[CONNECTED_INTERVAL; pathstart; pathfinish] THEN
16078     REWRITE_TAC[CONJ_ASSOC] THEN
16079     (REPEAT CONJ_TAC THENL
16080      [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
16081       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
16082       SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST;
16083                CONTINUOUS_ON_ID] THEN
16084       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
16085           CONTINUOUS_ON_SUBSET));
16086       GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
16087       REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
16088        `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`));
16089       ASM_MESON_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL]] THEN
16090      SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; FORALL_IN_PCROSS;
16091               FSTCART_PASTECART; SNDCART_PASTECART; ENDS_IN_UNIT_INTERVAL]);
16092      STRIP_TAC THEN
16093      REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN
16094      REWRITE_TAC[FORALL_AND_THM] THEN CONJ_TAC THENL
16095       [ASM_MESON_TAC[pathstart; ENDS_IN_UNIT_INTERVAL]; ALL_TAC] THEN
16096      FIRST_ASSUM(MATCH_MP_TAC o
16097       REWRITE_RULE[RIGHT_FORALL_IMP_THM] o
16098       ONCE_REWRITE_RULE[IMP_CONJ] o
16099       REWRITE_RULE[CONJ_ASSOC] o MATCH_MP
16100        (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN
16101      MAP_EVERY EXISTS_TAC
16102       [`(\x. pathfinish g1):real^1->real^N`; `vec 0:real^1`] THEN
16103      ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL; CONNECTED_INTERVAL] THEN
16104      REWRITE_TAC[CONTINUOUS_ON_CONST; pathfinish] THEN
16105      REPEAT CONJ_TAC THENL
16106       [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
16107        ASM_MESON_TAC[SUBSET; pathfinish; PATHFINISH_IN_PATH_IMAGE];
16108        GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
16109        MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
16110        SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST;
16111                 CONTINUOUS_ON_ID] THEN
16112        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
16113            CONTINUOUS_ON_SUBSET)) THEN
16114        SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; FORALL_IN_PCROSS;
16115                 FSTCART_PASTECART; SNDCART_PASTECART; ENDS_IN_UNIT_INTERVAL];
16116        REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
16117        X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
16118        FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (t:real^1) (vec 1:real^1)` o
16119          REWRITE_RULE[FORALL_IN_IMAGE] o GEN_REWRITE_RULE I [SUBSET]) THEN
16120        ASM_REWRITE_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL];
16121        ASM_MESON_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL];
16122        REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
16123        ASM_MESON_TAC[SUBSET; pathfinish; PATHFINISH_IN_PATH_IMAGE]]]);;
16124
16125 let COVERING_SPACE_MONODROMY = prove
16126  (`!p:real^M->real^N c s g1 g2 h1 h2.
16127      covering_space (c,p) s /\
16128      path g1 /\ path_image g1 SUBSET s /\
16129      path g2 /\ path_image g2 SUBSET s /\
16130      homotopic_paths s g1 g2 /\
16131      path h1 /\ path_image h1 SUBSET c /\
16132      (!t. t IN interval[vec 0,vec 1] ==> p(h1 t) = g1 t) /\
16133      path h2 /\ path_image h2 SUBSET c /\
16134      (!t. t IN interval[vec 0,vec 1] ==> p(h2 t) = g2 t) /\
16135      pathstart h1 = pathstart h2
16136      ==> pathfinish h1 = pathfinish h2`,
16137   REPEAT GEN_TAC THEN
16138   DISCH_THEN(MP_TAC o MATCH_MP COVERING_SPACE_LIFT_HOMOTOPIC_PATHS) THEN
16139   REWRITE_TAC[HOMOTOPIC_PATHS_IMP_PATHFINISH]);;
16140
16141 let COVERING_SPACE_LIFT_HOMOTOPIC_PATH = prove
16142  (`!p:real^M->real^N c s f f' g a b.
16143         covering_space (c,p) s /\
16144         homotopic_paths s f f' /\
16145         path g /\ path_image g SUBSET c /\
16146         pathstart g = a /\ pathfinish g = b /\
16147         (!t. t IN interval[vec 0,vec 1] ==> p(g t) = f t)
16148         ==> ?g'. path g' /\ path_image g' SUBSET c /\
16149                  pathstart g' = a /\ pathfinish g' = b /\
16150                  (!t. t IN interval[vec 0,vec 1] ==> p(g' t) = f' t)`,
16151   ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN REPEAT STRIP_TAC THEN
16152   FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN
16153   FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN
16154   FIRST_ASSUM(MP_TAC o ISPECL [`f':real^1->real^N`; `a:real^M`] o
16155    MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_PATH_STRONG)) THEN
16156   ANTS_TAC THENL
16157    [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
16158      [ASM_MESON_TAC[pathstart; ENDS_IN_UNIT_INTERVAL;
16159                     HOMOTOPIC_PATHS_IMP_PATHSTART];
16160       ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]];
16161     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g':real^1->real^M` THEN
16162     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
16163     SUBST1_TAC(SYM(ASSUME `pathfinish g:real^M = b`)) THEN
16164     FIRST_ASSUM(MATCH_MP_TAC o
16165      MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_MONODROMY)) THEN
16166     MAP_EVERY EXISTS_TAC [`f':real^1->real^N`; `f:real^1->real^N`] THEN
16167     ASM_REWRITE_TAC[]]);;
16168
16169 let COVERING_SPACE_INESSENTIAL_LOOP_LIFT_IS_LOOP = prove
16170  (`!p:real^M->real^N c s g h a.
16171         covering_space (c,p) s /\
16172         path g /\ path_image g SUBSET s /\ pathfinish g = pathstart g /\
16173         homotopic_paths s g (linepath(a,a)) /\
16174         path h /\ path_image h SUBSET c /\
16175         (!t. t IN interval[vec 0,vec 1] ==> p(h t) = g t)
16176         ==> pathfinish h = pathstart h`,
16177   REPEAT STRIP_TAC THEN
16178   FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN
16179   REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN
16180   FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
16181   FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN
16182   REWRITE_TAC[PATHSTART_LINEPATH] THEN REPEAT STRIP_TAC THEN
16183   FIRST_X_ASSUM(MP_TAC o
16184     ISPECL [`g:real^1->real^N`; `linepath(a:real^N,a)`;
16185             `h:real^1->real^M`; `linepath(pathstart h:real^M,pathstart h)`] o
16186     MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
16187         COVERING_SPACE_MONODROMY)) THEN
16188   ASM_REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
16189   ASM_REWRITE_TAC[SING_SUBSET; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
16190   DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[LINEPATH_REFL] THEN CONJ_TAC THENL
16191    [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET];
16192     REPEAT STRIP_TAC THEN
16193     FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
16194     REWRITE_TAC[pathstart] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
16195     REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]]);;
16196
16197 let COVERING_SPACE_SIMPLY_CONNECTED_LOOP_LIFT_IS_LOOP = prove
16198  (`!p:real^M->real^N c s g h.
16199         covering_space (c,p) s /\ simply_connected s /\
16200         path g /\ path_image g SUBSET s /\ pathfinish g = pathstart g /\
16201         path h /\ path_image h SUBSET c /\
16202         (!t. t IN interval[vec 0,vec 1] ==> p(h t) = g t)
16203         ==> pathfinish h = pathstart h`,
16204   REPEAT STRIP_TAC THEN
16205   FIRST_X_ASSUM(MATCH_MP_TAC o
16206     MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
16207         COVERING_SPACE_INESSENTIAL_LOOP_LIFT_IS_LOOP)) THEN
16208   EXISTS_TAC `g:real^1->real^N` THEN ASM_REWRITE_TAC[] THEN
16209   ASM_MESON_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH]);;
16210
16211 (* ------------------------------------------------------------------------- *)
16212 (* Lifting of general functions to covering space                            *)
16213 (* ------------------------------------------------------------------------- *)
16214
16215 let COVERING_SPACE_LIFT_GENERAL = prove
16216  (`!p:real^M->real^N c s f:real^P->real^N u a z.
16217         covering_space (c,p) s /\ a IN c /\ z IN u /\
16218         path_connected u /\ locally path_connected u /\
16219         f continuous_on u /\ IMAGE f u SUBSET s /\ f z = p a /\
16220         (!r. path r /\ path_image r SUBSET u /\
16221              pathstart r = z /\ pathfinish r = z
16222              ==> ?q. path q /\ path_image q SUBSET c /\
16223                      pathstart q = a /\ pathfinish q = a /\
16224                      homotopic_paths s (f o r) (p o q))
16225         ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ g z = a /\
16226                 (!y. y IN u ==> p(g y) = f y)`,
16227   REPEAT STRIP_TAC THEN
16228   SUBGOAL_THEN
16229    `!y. y IN u
16230         ==> ?g h. path g /\ path_image g SUBSET u /\
16231                   pathstart g = z /\ pathfinish g = y /\
16232                   path h /\ path_image h SUBSET c /\ pathstart h = a /\
16233                   (!t. t IN interval[vec 0,vec 1]
16234                        ==> (p:real^M->real^N)(h t) = (f:real^P->real^N)(g t))`
16235    (LABEL_TAC "*")
16236   THENL
16237    [X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
16238     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
16239     DISCH_THEN(MP_TAC o SPECL [`z:real^P`; `y:real^P`]) THEN
16240     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
16241     X_GEN_TAC `g:real^1->real^P` THEN STRIP_TAC THEN
16242     ASM_REWRITE_TAC[] THEN
16243     MATCH_MP_TAC  COVERING_SPACE_LIFT_PATH_STRONG THEN
16244     EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[GSYM o_DEF] THEN
16245     ASM_REWRITE_TAC[PATH_IMAGE_COMPOSE; PATHSTART_COMPOSE] THEN
16246     CONJ_TAC THENL
16247      [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN
16248       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
16249       ASM SET_TAC[]];
16250     ALL_TAC] THEN
16251   SUBGOAL_THEN
16252    `?l. !y g h. path g /\ path_image g SUBSET u /\
16253                 pathstart g = z /\ pathfinish g = y /\
16254                 path h /\ path_image h SUBSET c /\ pathstart h = a /\
16255                 (!t. t IN interval[vec 0,vec 1]
16256                      ==> (p:real^M->real^N)(h t) = (f:real^P->real^N)(g t))
16257                 ==> pathfinish h = l y`
16258   MP_TAC THENL
16259    [REWRITE_TAC[GSYM SKOLEM_THM] THEN X_GEN_TAC `y:real^P` THEN
16260     MATCH_MP_TAC(MESON[]
16261       `(!g h g' h'. P g h /\ P g' h' ==> f h = f h')
16262        ==> ?z. !g h. P g h ==> f h = z`) THEN
16263     REPEAT STRIP_TAC THEN
16264     FIRST_X_ASSUM(MP_TAC o SPEC `(g ++ reversepath g'):real^1->real^P`) THEN
16265     ASM_SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN;
16266       PATH_REVERSEPATH; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH;
16267       SUBSET_PATH_IMAGE_JOIN; PATH_IMAGE_REVERSEPATH] THEN
16268     DISCH_THEN(X_CHOOSE_THEN `q:real^1->real^M` STRIP_ASSUME_TAC) THEN
16269     FIRST_ASSUM(MP_TAC o
16270      ISPECL [`(p:real^M->real^N) o (q:real^1->real^M)`;
16271              `(f:real^P->real^N) o (g ++ reversepath g')`;
16272              `q:real^1->real^M`; `pathstart q:real^M`; `pathfinish q:real^M`] o
16273       MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ]
16274        (ONCE_REWRITE_RULE[HOMOTOPIC_PATHS_SYM]
16275          COVERING_SPACE_LIFT_HOMOTOPIC_PATH))) THEN
16276     ASM_REWRITE_TAC[o_THM] THEN
16277     DISCH_THEN(X_CHOOSE_THEN `q':real^1->real^M` STRIP_ASSUME_TAC) THEN
16278     SUBGOAL_THEN `path(h ++ reversepath h':real^1->real^M)` MP_TAC THENL
16279      [ALL_TAC;
16280       ASM_SIMP_TAC[PATH_JOIN_EQ; PATH_REVERSEPATH; PATHSTART_REVERSEPATH]] THEN
16281     MATCH_MP_TAC PATH_EQ THEN EXISTS_TAC `q':real^1->real^M` THEN
16282     ASM_REWRITE_TAC[] THEN
16283     X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
16284     STRIP_TAC THEN REWRITE_TAC[joinpaths] THEN COND_CASES_TAC THENL
16285      [FIRST_ASSUM(MP_TAC o
16286         ISPECL [`(f:real^P->real^N) o (g:real^1->real^P) o (\t. &2 % t)`;
16287                 `q':real^1->real^M`;
16288                 `(h:real^1->real^M) o (\t. &2 % t)`;
16289                 `interval[vec 0,lift(&1 / &2)]`;
16290                 `vec 0:real^1`; `t:real^1`] o
16291         MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN
16292       REWRITE_TAC[o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN
16293       REPEAT CONJ_TAC THENL
16294        [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
16295         EXISTS_TAC `(f:real^P->real^N) o (g ++ reversepath g')` THEN
16296         CONJ_TAC THENL
16297          [SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; joinpaths; o_THM];
16298           ALL_TAC] THEN
16299         MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
16300         EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL
16301          [ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_PATH; path];
16302           REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
16303           REAL_ARITH_TAC];
16304         MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC
16305          `path_image ((f:real^P->real^N) o (g ++ reversepath g'))` THEN
16306         CONJ_TAC THENL[ALL_TAC; ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_SUBSET]] THEN
16307         REWRITE_TAC[path_image] THEN MATCH_MP_TAC(SET_RULE
16308          `(!x. x IN s ==> f x = g x) /\ s SUBSET t
16309           ==> IMAGE f s SUBSET IMAGE g t`) THEN
16310         REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC; IN_INTERVAL_1] THEN
16311         CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[joinpaths; o_THM];
16312         MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
16313         EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
16314         ASM_REWRITE_TAC[GSYM path] THEN
16315         REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
16316         REAL_ARITH_TAC;
16317         MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC
16318          `path_image(q':real^1->real^M)` THEN
16319         ASM_REWRITE_TAC[] THEN REWRITE_TAC[path_image] THEN
16320         MATCH_MP_TAC IMAGE_SUBSET THEN
16321         REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
16322         REAL_ARITH_TAC;
16323         X_GEN_TAC `t':real^1` THEN
16324         REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN STRIP_TAC THEN
16325         FIRST_X_ASSUM(fun th ->
16326          W(MP_TAC o PART_MATCH (lhand o rand) th o rand o snd)) THEN
16327         ASM_SIMP_TAC[IN_INTERVAL_1; joinpaths; DROP_VEC] THEN
16328         ANTS_TAC THENL [ASM_REAL_ARITH_TAC; SIMP_TAC[]];
16329         MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
16330         SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN
16331         MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
16332         EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
16333         ASM_SIMP_TAC[GSYM path] THEN
16334         REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
16335         REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; LIFT_DROP] THEN
16336         REAL_ARITH_TAC;
16337         MATCH_MP_TAC SUBSET_TRANS THEN
16338         EXISTS_TAC `path_image(h:real^1->real^M)` THEN
16339         CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[]] THEN
16340         REWRITE_TAC[path_image; IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
16341         REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN
16342         REWRITE_TAC[DROP_VEC; DROP_CMUL; LIFT_DROP] THEN
16343         REAL_ARITH_TAC;
16344         X_GEN_TAC `t':real^1` THEN
16345         REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN STRIP_TAC THEN
16346         CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
16347         REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL] THEN
16348         ASM_REAL_ARITH_TAC;
16349         REWRITE_TAC[CONNECTED_INTERVAL];
16350         REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN REAL_ARITH_TAC;
16351         GEN_REWRITE_TAC LAND_CONV [GSYM pathstart] THEN
16352         ASM_REWRITE_TAC[] THEN
16353         SUBST1_TAC(SYM(ASSUME `pathstart h:real^M = a`)) THEN
16354         REWRITE_TAC[pathstart] THEN AP_TERM_TAC THEN
16355         REWRITE_TAC[VECTOR_MUL_RZERO];
16356         REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
16357         ASM_REAL_ARITH_TAC];
16358       FIRST_ASSUM(MP_TAC o
16359         ISPECL [`(f:real^P->real^N) o reversepath(g':real^1->real^P) o
16360                  (\t. &2 % t - vec 1)`;
16361                 `q':real^1->real^M`;
16362                 `reversepath(h':real^1->real^M) o (\t. &2 % t - vec 1)`;
16363                 `{t | &1 / &2 < drop t /\ drop t <= &1}`;
16364                 `vec 1:real^1`; `t:real^1`] o
16365         MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN
16366       REWRITE_TAC[o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN
16367       REPEAT CONJ_TAC THENL
16368        [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
16369         EXISTS_TAC `(f:real^P->real^N) o (g ++ reversepath g')` THEN
16370         CONJ_TAC THENL
16371          [SIMP_TAC[IN_ELIM_THM; GSYM REAL_NOT_LE; joinpaths; o_THM];
16372           ALL_TAC] THEN
16373         MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
16374         EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL
16375          [ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_PATH; path];
16376           REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
16377           REAL_ARITH_TAC];
16378         MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC
16379          `path_image ((f:real^P->real^N) o (g ++ reversepath g'))` THEN
16380         CONJ_TAC THENL[ALL_TAC; ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_SUBSET]] THEN
16381         REWRITE_TAC[path_image] THEN MATCH_MP_TAC(SET_RULE
16382          `(!x. x IN s ==> f x = g x) /\ s SUBSET t
16383           ==> IMAGE f s SUBSET IMAGE g t`) THEN
16384         SIMP_TAC[IN_ELIM_THM; GSYM REAL_NOT_LE; joinpaths; o_THM] THEN
16385         REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
16386         REAL_ARITH_TAC;
16387         MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
16388         EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
16389         ASM_REWRITE_TAC[GSYM path] THEN
16390         REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
16391         REAL_ARITH_TAC;
16392         MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC
16393          `path_image(q':real^1->real^M)` THEN
16394         ASM_REWRITE_TAC[] THEN REWRITE_TAC[path_image] THEN
16395         MATCH_MP_TAC IMAGE_SUBSET THEN
16396         REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
16397         REAL_ARITH_TAC;
16398         X_GEN_TAC `t':real^1` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
16399         FIRST_X_ASSUM(fun th ->
16400          W(MP_TAC o PART_MATCH (lhand o rand) th o rand o snd)) THEN
16401         ASM_SIMP_TAC[IN_INTERVAL_1; joinpaths; DROP_VEC; GSYM REAL_NOT_LT] THEN
16402         ANTS_TAC THENL [ASM_REAL_ARITH_TAC; SIMP_TAC[]];
16403         MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
16404         SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID;
16405                  CONTINUOUS_ON_CONST] THEN
16406         MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
16407         EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
16408         ASM_SIMP_TAC[GSYM path; PATH_REVERSEPATH] THEN
16409         REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
16410         REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN
16411         REAL_ARITH_TAC;
16412         MATCH_MP_TAC SUBSET_TRANS THEN
16413         EXISTS_TAC `path_image(reversepath h':real^1->real^M)` THEN
16414         CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[PATH_IMAGE_REVERSEPATH]] THEN
16415         REWRITE_TAC[path_image; IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
16416         REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
16417         REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN
16418         REAL_ARITH_TAC;
16419         X_GEN_TAC `t':real^1` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
16420         REWRITE_TAC[reversepath] THEN CONV_TAC SYM_CONV THEN
16421         FIRST_X_ASSUM MATCH_MP_TAC THEN
16422         REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; DROP_CMUL] THEN
16423         ASM_REAL_ARITH_TAC;
16424         REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_1] THEN
16425         REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC;
16426         REWRITE_TAC[IN_ELIM_THM; DROP_VEC] THEN REAL_ARITH_TAC;
16427         GEN_REWRITE_TAC LAND_CONV [GSYM pathfinish] THEN
16428         ASM_REWRITE_TAC[reversepath] THEN
16429         SUBST1_TAC(SYM(ASSUME `pathstart h':real^M = a`)) THEN
16430         REWRITE_TAC[pathstart] THEN AP_TERM_TAC THEN
16431         REWRITE_TAC[GSYM DROP_EQ; DROP_SUB; DROP_CMUL; DROP_VEC] THEN
16432         REAL_ARITH_TAC;
16433         REWRITE_TAC[IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC]];
16434     ALL_TAC] THEN
16435   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^P->real^M` THEN
16436   DISCH_THEN(LABEL_TAC "+") THEN
16437   MATCH_MP_TAC(TAUT `(q ==> p) /\ q ==> p /\ q`) THEN REPEAT CONJ_TAC THENL
16438    [STRIP_TAC;
16439     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
16440     X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
16441     REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
16442     ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE; SUBSET];
16443     FIRST_ASSUM(MP_TAC o SPECL
16444      [`z:real^P`; `linepath(z:real^P,z)`; `linepath(a:real^M,a)`]) THEN
16445     REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
16446     REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
16447     ASM_SIMP_TAC[LINEPATH_REFL; SING_SUBSET];
16448     X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
16449     REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
16450     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
16451     MAP_EVERY X_GEN_TAC [`g:real^1->real^P`; `h:real^1->real^M`] THEN
16452     STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
16453      [`y:real^P`; `g:real^1->real^P`; `h:real^1->real^M`]) THEN
16454     ASM_MESON_TAC[pathfinish; ENDS_IN_UNIT_INTERVAL]] THEN
16455   FIRST_ASSUM(fun th ->
16456    GEN_REWRITE_TAC I [MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) THEN
16457   X_GEN_TAC `n:real^M->bool` THEN DISCH_TAC THEN
16458   ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `y:real^P` THEN
16459   REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
16460   FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
16461   FIRST_ASSUM(MP_TAC o SPEC `(f:real^P->real^N) y` o last o CONJUNCTS o
16462         GEN_REWRITE_RULE I [covering_space]) THEN
16463   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
16464   DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool` MP_TAC) THEN
16465   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
16466   DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` MP_TAC) THEN
16467   ONCE_REWRITE_TAC[IMP_CONJ] THEN
16468   GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN
16469   DISCH_THEN(MP_TAC o SPEC `(l:real^P->real^M) y`) THEN
16470   MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN
16471   CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN
16472   DISCH_THEN(X_CHOOSE_THEN `w':real^M->bool` STRIP_ASSUME_TAC) THEN
16473   DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `w':real^M->bool`) MP_TAC) THEN
16474   DISCH_THEN(MP_TAC o SPEC `w':real^M->bool` o CONJUNCT2) THEN
16475   ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `p':real^N->real^M`) THEN
16476   DISCH_TAC THEN UNDISCH_THEN `(w':real^M->bool) IN vv` (K ALL_TAC) THEN
16477   SUBGOAL_THEN
16478    `?v. y IN v /\ y IN u /\ IMAGE (f:real^P->real^N) v SUBSET w /\
16479         v SUBSET u /\ path_connected v /\ open_in (subtopology euclidean u) v`
16480   STRIP_ASSUME_TAC THENL
16481    [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_PATH_CONNECTED]) THEN
16482     DISCH_THEN(MP_TAC o SPECL
16483      [`{x | x IN u /\ (f:real^P->real^N) x IN w}`; `y:real^P`]) THEN
16484     ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]] THEN
16485     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
16486     MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
16487     EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[];
16488     ALL_TAC] THEN
16489   FIRST_X_ASSUM(STRIP_ASSUME_TAC o
16490    GEN_REWRITE_RULE I [homeomorphism]) THEN
16491   SUBGOAL_THEN `(w':real^M->bool) SUBSET c /\ (w:real^N->bool) SUBSET s`
16492   STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[open_in]; ALL_TAC] THEN
16493   EXISTS_TAC
16494    `v INTER
16495     {x | x IN u /\ (f:real^P->real^N) x IN
16496                    {x | x IN w /\ (p':real^N->real^M) x IN w' INTER n}}` THEN
16497   REPEAT CONJ_TAC THENL
16498    [MATCH_MP_TAC OPEN_IN_INTER THEN ASM_REWRITE_TAC[] THEN
16499     MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
16500     EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
16501     MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `w:real^N->bool` THEN
16502     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
16503     EXISTS_TAC `w':real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
16504     UNDISCH_TAC `open_in (subtopology euclidean c) (n:real^M->bool)` THEN
16505     REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[];
16506     ASM SET_TAC[];
16507     ALL_TAC] THEN
16508   SIMP_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN
16509   X_GEN_TAC `y':real^P` THEN STRIP_TAC THEN
16510   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
16511   DISCH_THEN(MP_TAC o SPECL [`y:real^P`; `y':real^P`]) THEN
16512   ASM_REWRITE_TAC[] THEN
16513   DISCH_THEN(X_CHOOSE_THEN `r:real^1->real^P` STRIP_ASSUME_TAC) THEN
16514   REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
16515   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
16516   MAP_EVERY X_GEN_TAC [`pp:real^1->real^P`; `qq:real^1->real^M`] THEN
16517   STRIP_TAC THEN
16518   FIRST_ASSUM(MP_TAC o SPECL
16519    [`y':real^P`; `(pp:real^1->real^P) ++ r`;
16520     `(qq:real^1->real^M) ++ ((p':real^N->real^M) o (f:real^P->real^N) o
16521                             (r:real^1->real^P))`]) THEN
16522   FIRST_X_ASSUM(MP_TAC o SPECL
16523    [`y:real^P`; `pp:real^1->real^P`; `qq:real^1->real^M`]) THEN
16524   ASM_SIMP_TAC[o_THM; PATHSTART_JOIN; PATHFINISH_JOIN] THEN DISCH_TAC THEN
16525   SUBGOAL_THEN
16526    `path_image ((pp:real^1->real^P) ++ r) SUBSET u`
16527   ASSUME_TAC THENL
16528    [MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN ASM SET_TAC[]; ALL_TAC] THEN
16529   ANTS_TAC THENL
16530    [ALL_TAC;
16531     ASM_REWRITE_TAC[PATHFINISH_COMPOSE] THEN ASM_MESON_TAC[]] THEN
16532   REPEAT CONJ_TAC THENL
16533    [ASM_SIMP_TAC[PATH_JOIN];
16534     ASM_SIMP_TAC[SUBSET_PATH_IMAGE_JOIN];
16535     MATCH_MP_TAC PATH_JOIN_IMP THEN ASM_SIMP_TAC[PATHSTART_COMPOSE] THEN
16536     CONJ_TAC THENL
16537      [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN
16538       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
16539       CONJ_TAC THEN
16540       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
16541              CONTINUOUS_ON_SUBSET)) THEN
16542       ASM SET_TAC[];
16543       REWRITE_TAC[pathfinish] THEN ASM SET_TAC[]];
16544     MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN ASM_SIMP_TAC[] THEN
16545     REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN ASM SET_TAC[];
16546     X_GEN_TAC `tt:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
16547     STRIP_TAC THEN REWRITE_TAC[joinpaths; o_THM] THEN COND_CASES_TAC THEN
16548     ASM_REWRITE_TAC[] THENL
16549      [ABBREV_TAC `t:real^1 = &2 % tt`;
16550       ABBREV_TAC `t:real^1 = &2 % tt - vec 1`] THEN
16551     (SUBGOAL_THEN `t IN interval[vec 0:real^1,vec 1]` ASSUME_TAC THENL
16552       [EXPAND_TAC "t" THEN
16553        REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN
16554        ASM_REAL_ARITH_TAC;
16555        ALL_TAC]) THEN
16556     ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
16557     RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN ASM SET_TAC[]]);;
16558
16559 let COVERING_SPACE_LIFT_STRONGER = prove
16560  (`!p:real^M->real^N c s f:real^P->real^N u a z.
16561         covering_space (c,p) s /\ a IN c /\ z IN u /\
16562         path_connected u /\ locally path_connected u /\
16563         f continuous_on u /\ IMAGE f u SUBSET s /\ f z = p a /\
16564         (!r. path r /\ path_image r SUBSET u /\
16565              pathstart r = z /\ pathfinish r = z
16566              ==> ?b. homotopic_paths s (f o r) (linepath(b,b)))
16567         ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ g z = a /\
16568                 (!y. y IN u ==> p(g y) = f y)`,
16569   REPEAT STRIP_TAC THEN
16570   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
16571         COVERING_SPACE_LIFT_GENERAL)) THEN ASM_REWRITE_TAC[] THEN
16572   X_GEN_TAC `r:real^1->real^P` THEN STRIP_TAC THEN
16573   FIRST_X_ASSUM(MP_TAC o SPEC  `r:real^1->real^P`) THEN ASM_REWRITE_TAC[] THEN
16574   DISCH_THEN(X_CHOOSE_TAC `b:real^N`) THEN
16575   FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN
16576   ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHSTART_LINEPATH] THEN
16577   DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
16578   EXISTS_TAC `linepath(a:real^M,a)` THEN
16579   REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
16580   ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN
16581   RULE_ASSUM_TAC(REWRITE_RULE[o_DEF; LINEPATH_REFL]) THEN
16582   ASM_REWRITE_TAC[o_DEF; LINEPATH_REFL]);;
16583
16584 let COVERING_SPACE_LIFT_STRONG = prove
16585  (`!p:real^M->real^N c s f:real^P->real^N u a z.
16586         covering_space (c,p) s /\ a IN c /\ z IN u /\
16587         simply_connected u /\ locally path_connected u /\
16588         f continuous_on u /\ IMAGE f u SUBSET s /\ f z = p a
16589         ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ g z = a /\
16590                 (!y. y IN u ==> p(g y) = f y)`,
16591   REPEAT STRIP_TAC THEN
16592   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
16593         COVERING_SPACE_LIFT_STRONGER)) THEN
16594   ASM_SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED] THEN
16595   X_GEN_TAC `r:real^1->real^P` THEN STRIP_TAC THEN
16596   EXISTS_TAC `(f:real^P->real^N) z` THEN
16597   SUBGOAL_THEN
16598    `linepath(f z,f z) = (f:real^P->real^N) o linepath(z,z)`
16599   SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LINEPATH_REFL]; ALL_TAC] THEN
16600   MATCH_MP_TAC HOMOTOPIC_PATHS_CONTINUOUS_IMAGE THEN
16601   EXISTS_TAC `u:real^P->bool` THEN ASM_REWRITE_TAC[] THEN
16602   FIRST_X_ASSUM(MATCH_MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I
16603    [SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS]) THEN
16604   ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
16605   ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET]);;
16606
16607 let COVERING_SPACE_LIFT = prove
16608  (`!p:real^M->real^N c s f:real^P->real^N u.
16609         covering_space (c,p) s /\
16610         simply_connected u /\ locally path_connected u /\
16611         f continuous_on u /\ IMAGE f u SUBSET s
16612         ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\
16613                 (!y. y IN u ==> p(g y) = f y)`,
16614   MP_TAC COVERING_SPACE_LIFT_STRONG THEN
16615   REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
16616   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th THEN ASM_REWRITE_TAC[]) THEN
16617   ASM_CASES_TAC `u:real^P->bool = {}` THEN
16618   ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET;
16619                   NOT_IN_EMPTY] THEN
16620   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
16621   DISCH_THEN(X_CHOOSE_TAC `a:real^P`) THEN
16622   FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
16623   GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN
16624   DISCH_THEN(MP_TAC o SPEC `(f:real^P->real^N) a`) THEN
16625   MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN
16626   CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_IMAGE]] THEN
16627   ASM_MESON_TAC[]);;
16628
16629 (* ------------------------------------------------------------------------- *)
16630 (* Some additional lemmas about covering spaces.                             *)
16631 (* ------------------------------------------------------------------------- *)
16632
16633 let CARD_EQ_COVERING_MAP_FIBRES = prove
16634  (`!p:real^M->real^N c s a b.
16635         covering_space (c,p) s /\ path_connected s /\ a IN s /\ b IN s
16636         ==> {x | x IN c /\ p(x) = a} =_c {x | x IN c /\ p(x) = b}`,
16637   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
16638   REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN
16639   REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN
16640   REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; FORALL_AND_THM;
16641               TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN
16642   GEN_REWRITE_TAC (LAND_CONV o funpow 2 BINDER_CONV o LAND_CONV)
16643    [CONJ_SYM] THEN
16644   MATCH_MP_TAC(MESON[]
16645    `(!a b. P a b) ==> (!a b. P a b) /\ (!a b. P b a)`) THEN
16646   REPEAT STRIP_TAC THEN
16647   FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`] o
16648     GEN_REWRITE_RULE I [path_connected]) THEN
16649   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
16650   X_GEN_TAC `g:real^1->real^N` THEN STRIP_TAC THEN
16651   SUBGOAL_THEN
16652    `!z. ?h. z IN c /\ p z = a
16653             ==> path h /\ path_image h SUBSET c /\ pathstart h = z /\
16654                 !t. t IN interval[vec 0,vec 1]
16655                     ==> (p:real^M->real^N)(h t) = g t`
16656   MP_TAC THENL
16657    [REWRITE_TAC[RIGHT_EXISTS_IMP_THM] THEN
16658     REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_LIFT_PATH_STRONG THEN
16659     REWRITE_TAC[ETA_AX] THEN ASM_MESON_TAC[];
16660     REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
16661     X_GEN_TAC `h:real^M->real^1->real^M` THEN DISCH_TAC] THEN
16662   REWRITE_TAC[le_c; IN_ELIM_THM] THEN
16663   EXISTS_TAC `\z. pathfinish((h:real^M->real^1->real^M) z)` THEN
16664   ASM_REWRITE_TAC[pathfinish] THEN CONJ_TAC THENL
16665    [X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
16666     FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN
16667     ASM_REWRITE_TAC[SUBSET; path_image; pathstart; FORALL_IN_IMAGE] THEN
16668     ASM_MESON_TAC[pathfinish; ENDS_IN_UNIT_INTERVAL];
16669     MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN
16670     MP_TAC(ISPECL
16671      [`p:real^M->real^N`; `c:real^M->bool`; `s:real^N->bool`;
16672       `reversepath(g:real^1->real^N)`; `reversepath(g:real^1->real^N)`;
16673       `reversepath((h:real^M->real^1->real^M) x)`;
16674       `reversepath((h:real^M->real^1->real^M) y)`]
16675     COVERING_SPACE_MONODROMY) THEN
16676     ASM_SIMP_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH] THEN
16677     DISCH_THEN MATCH_MP_TAC THEN
16678     ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH;
16679                  HOMOTOPIC_PATHS_REFL] THEN
16680     ASM_REWRITE_TAC[pathfinish; reversepath; IN_INTERVAL_1; DROP_VEC] THEN
16681     REPEAT STRIP_TAC THENL
16682      [FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`);
16683       FIRST_X_ASSUM(MP_TAC o SPEC `y:real^M`)] THEN
16684     ASM_REWRITE_TAC[] THEN DISCH_THEN(MATCH_MP_TAC o last o CONJUNCTS) THEN
16685     REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN ASM_REAL_ARITH_TAC]);;
16686
16687 let COVERING_SPACE_INJECTIVE = prove
16688  (`!p:real^M->real^N c s.
16689         covering_space (c,p) s /\ path_connected c /\ simply_connected s
16690         ==> (!x y. x IN c /\ y IN c /\ p x = p y ==> x = y)`,
16691   REPEAT STRIP_TAC THEN
16692   FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
16693   FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_CONTINUOUS) THEN
16694   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
16695   DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `y:real^M`]) THEN
16696   ASM_REWRITE_TAC[] THEN
16697   DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC) THEN
16698   FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
16699         COVERING_SPACE_LIFT_PATH_STRONG)) THEN
16700   GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN
16701   DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
16702   DISCH_THEN(fun th ->
16703     MP_TAC(SPEC `(p:real^M->real^N) o (g:real^1->real^M)` th) THEN
16704     MP_TAC(SPEC `(p:real^M->real^N) o linepath(x:real^M,x)` th)) THEN
16705   SUBGOAL_THEN
16706    `(path ((p:real^M->real^N) o linepath(x,x)) /\
16707      path (p o g)) /\
16708     (path_image (p o linepath(x:real^M,x)) SUBSET s /\
16709      path_image (p o g) SUBSET s)`
16710   STRIP_ASSUME_TAC THENL
16711    [CONJ_TAC THENL
16712      [CONJ_TAC THEN MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN
16713       REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH] THEN
16714       ASM_REWRITE_TAC[CONTINUOUS_ON_SING; SEGMENT_REFL] THEN
16715       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
16716       REWRITE_TAC[PATH_IMAGE_COMPOSE; PATH_IMAGE_LINEPATH] THEN
16717       REWRITE_TAC[SEGMENT_REFL] THEN ASM SET_TAC[]];
16718     ALL_TAC] THEN
16719   ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHSTART_LINEPATH] THEN
16720   DISCH_THEN(X_CHOOSE_THEN `h1:real^1->real^M` STRIP_ASSUME_TAC) THEN
16721   DISCH_THEN(X_CHOOSE_THEN `h2:real^1->real^M` STRIP_ASSUME_TAC) THEN
16722   FIRST_ASSUM(MP_TAC o
16723     SPECL [`(p:real^M->real^N) o linepath(x:real^M,x)`;
16724            `(p:real^M->real^N) o (g:real^1->real^M)`;
16725            `h1:real^1->real^M`; `h2:real^1->real^M`] o
16726   MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
16727         COVERING_SPACE_MONODROMY)) THEN
16728   ASM_SIMP_TAC[] THEN ANTS_TAC THENL
16729    [FIRST_X_ASSUM(MATCH_MP_TAC o CONJUNCT2 o
16730         GEN_REWRITE_RULE I [SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS]) THEN
16731     ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN
16732     ASM_REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH];
16733     ALL_TAC] THEN
16734   MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL
16735    [MATCH_MP_TAC EQ_TRANS THEN
16736     EXISTS_TAC `pathfinish(linepath(x:real^M,x))` THEN
16737     CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[PATHFINISH_LINEPATH]];
16738     FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th])] THEN
16739   REWRITE_TAC[pathfinish] THEN
16740   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
16741         COVERING_SPACE_LIFT_UNIQUE))
16742   THENL
16743    [EXISTS_TAC `(p:real^M->real^N) o (h1:real^1->real^M)`;
16744     EXISTS_TAC `(p:real^M->real^N) o (h2:real^1->real^M)`] THEN
16745   MAP_EVERY EXISTS_TAC [`interval[vec 0:real^1,vec 1]`; `vec 0:real^1`] THEN
16746   REWRITE_TAC[CONNECTED_INTERVAL; ENDS_IN_UNIT_INTERVAL] THEN
16747   ASM_REWRITE_TAC[GSYM path; PATH_LINEPATH; GSYM path_image] THEN
16748   RULE_ASSUM_TAC(REWRITE_RULE[o_THM]) THEN ASM_REWRITE_TAC[o_THM] THEN
16749   ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN
16750   RULE_ASSUM_TAC(REWRITE_RULE[pathstart]) THEN
16751   ASM_REWRITE_TAC[LINEPATH_REFL; PATH_IMAGE_COMPOSE] THEN
16752   (CONJ_TAC THENL
16753     [ASM_MESON_TAC[PATH_CONTINUOUS_IMAGE; CONTINUOUS_ON_SUBSET];
16754      ASM SET_TAC[]]));;
16755
16756 let COVERING_SPACE_HOMEOMORPHISM = prove
16757  (`!p:real^M->real^N c s.
16758         covering_space (c,p) s /\ path_connected c /\ simply_connected s
16759         ==> ?q. homeomorphism (c,s) (p,q)`,
16760   REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN
16761   REPEAT CONJ_TAC THENL
16762    [ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS];
16763     ASM_MESON_TAC[COVERING_SPACE_IMP_SURJECTIVE];
16764     ASM_MESON_TAC[COVERING_SPACE_INJECTIVE];
16765     ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP]]);;
16766
16767 (* ------------------------------------------------------------------------- *)
16768 (* Results on finiteness of the number of sheets in a covering space.        *)
16769 (* ------------------------------------------------------------------------- *)
16770
16771 let COVERING_SPACE_FIBRE_NO_LIMPT = prove
16772  (`!p:real^M->real^N c s a b.
16773         covering_space (c,p) s /\ a IN c
16774         ==> ~(a limit_point_of {x | x IN c /\ p x = b})`,
16775   REPEAT STRIP_TAC THEN
16776   FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [covering_space]) THEN
16777   FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^M->real^N) a`) THEN
16778   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
16779   DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` MP_TAC) THEN
16780   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
16781   DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` MP_TAC) THEN
16782   GEN_REWRITE_TAC I [IMP_CONJ] THEN
16783   REWRITE_TAC[EXTENSION; IN_UNIONS; IN_ELIM_THM] THEN
16784   DISCH_THEN(MP_TAC o SPEC `a:real^M`) THEN ASM_REWRITE_TAC[] THEN
16785   DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN
16786   STRIP_TAC THEN
16787   REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `t:real^M->bool`)) THEN
16788   ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN
16789   FIRST_X_ASSUM(X_CHOOSE_THEN `q:real^N->real^M` MP_TAC) THEN
16790   REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN
16791   UNDISCH_TAC `open_in (subtopology euclidean c) (t:real^M->bool)` THEN
16792   REWRITE_TAC[OPEN_IN_OPEN] THEN
16793   DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN
16794   FIRST_X_ASSUM(MP_TAC o SPEC `v:real^M->bool` o
16795         GEN_REWRITE_RULE I [LIMPT_INFINITE_OPEN]) THEN
16796   ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[INFINITE]] THEN
16797   MATCH_MP_TAC(MESON[FINITE_SING; FINITE_SUBSET]
16798    `(?a. s SUBSET {a}) ==> FINITE s`) THEN
16799   ASM SET_TAC[]);;
16800
16801 let COVERING_SPACE_COUNTABLE_SHEETS = prove
16802  (`!p:real^M->real^N c s b.
16803         covering_space (c,p) s ==> COUNTABLE {x | x IN c /\ p x = b}`,
16804   REPEAT STRIP_TAC THEN
16805   MATCH_MP_TAC(REWRITE_RULE[] (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM]
16806         UNCOUNTABLE_CONTAINS_LIMIT_POINT)) THEN
16807   REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[COVERING_SPACE_FIBRE_NO_LIMPT]);;
16808
16809 let COVERING_SPACE_FINITE_EQ_COMPACT_FIBRE = prove
16810  (`!p:real^M->real^N c s b.
16811         covering_space (c,p) s
16812         ==> (FINITE {x | x IN c /\ p x = b} <=>
16813              compact {x | x IN c /\ p x = b})`,
16814   REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[FINITE_IMP_COMPACT] THEN
16815   DISCH_TAC THEN ASM_CASES_TAC `(b:real^N) IN s` THENL
16816    [ONCE_REWRITE_TAC[TAUT `p <=> (~p ==> F)`] THEN DISCH_TAC THEN
16817     FIRST_ASSUM(MP_TAC o
16818      SPEC `{x | x IN c /\ (p:real^M->real^N) x = b}` o
16819      GEN_REWRITE_RULE I [COMPACT_EQ_BOLZANO_WEIERSTRASS]) THEN
16820     ASM_REWRITE_TAC[INFINITE; SUBSET_REFL; IN_ELIM_THM] THEN
16821     DISCH_THEN(X_CHOOSE_THEN `a:real^M` STRIP_ASSUME_TAC) THEN
16822     FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^M`; `b:real^N`] o
16823        MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
16824         COVERING_SPACE_FIBRE_NO_LIMPT)) THEN
16825     ASM_REWRITE_TAC[];
16826     SUBGOAL_THEN `{x  | x IN c /\ (p:real^M->real^N) x = b} = {}`
16827      (fun th -> REWRITE_TAC[th; FINITE_EMPTY]) THEN
16828     FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
16829     ASM SET_TAC[]]);;
16830
16831 let COVERING_SPACE_CLOSED_MAP = prove
16832  (`!p:real^M->real^N c s t.
16833         covering_space (c,p) s /\
16834         (!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) /\
16835         closed_in (subtopology euclidean c) t
16836         ==> closed_in (subtopology euclidean s) (IMAGE p t)`,
16837   REPEAT STRIP_TAC THEN
16838   FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
16839   FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
16840   REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN CONJ_TAC THENL
16841    [ASM SET_TAC[]; ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN]] THEN
16842   X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
16843   FIRST_ASSUM(MP_TAC o SPEC `y:real^N` o last o CONJUNCTS o
16844     GEN_REWRITE_RULE I [covering_space]) THEN
16845   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `v:real^N->bool` THEN
16846   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
16847   FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN
16848   DISCH_TAC THEN
16849   DISCH_THEN(X_CHOOSE_THEN `uu:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
16850   ASM_CASES_TAC `uu:(real^M->bool)->bool = {}` THENL
16851    [ASM_REWRITE_TAC[UNIONS_0; NOT_IN_EMPTY] THEN ASM SET_TAC[]; ALL_TAC] THEN
16852   EXISTS_TAC `INTERS {IMAGE (p:real^M->real^N) (u DIFF t) | u IN uu}` THEN
16853   REPEAT CONJ_TAC THENL
16854    [MATCH_MP_TAC OPEN_IN_INTERS THEN
16855     ASM_REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN
16856     CONJ_TAC THENL
16857      [MATCH_MP_TAC FINITE_IMAGE THEN
16858       SUBGOAL_THEN
16859        `!u. u IN uu ==> ?x. x IN u /\ (p:real^M->real^N) x = y`
16860       ASSUME_TAC THENL
16861        [RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
16862         ALL_TAC] THEN
16863       SUBGOAL_THEN
16864        `FINITE (IMAGE (\u. @x. x IN u /\ (p:real^M->real^N) x = y) uu)`
16865       MP_TAC THENL
16866        [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
16867           FINITE_SUBSET)) THEN ASM SET_TAC[];
16868         MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC FINITE_IMAGE_INJ_EQ THEN
16869         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
16870         REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN ASM SET_TAC[]];
16871       X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN
16872       MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `v:real^N->bool` THEN
16873       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
16874       ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `u:real^M->bool` THEN
16875       ASM_SIMP_TAC[LEFT_EXISTS_AND_THM] THEN
16876       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN
16877       DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC) THEN
16878       ASM_REWRITE_TAC[OPEN_IN_OPEN] THEN
16879       EXISTS_TAC `(:real^M) DIFF k` THEN
16880       ASM_REWRITE_TAC[GSYM closed] THEN ASM SET_TAC[]];
16881     REWRITE_TAC[IN_INTERS; FORALL_IN_GSPEC] THEN
16882     X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN
16883     REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`)) THEN
16884     ASM_REWRITE_TAC[homeomorphism] THEN ASM SET_TAC[];
16885     REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_DIFF; IN_ELIM_THM] THEN
16886     X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN
16887     CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_IMAGE]] THEN
16888     DISCH_THEN(X_CHOOSE_THEN `w:real^M` STRIP_ASSUME_TAC) THEN
16889     FIRST_X_ASSUM SUBST_ALL_TAC THEN
16890     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN
16891     DISCH_THEN(MP_TAC o SPEC `w:real^M`) THEN
16892     REWRITE_TAC[IN_ELIM_THM] THEN
16893     MATCH_MP_TAC(TAUT `q /\ r /\ ~s ==> ~(s <=> q /\ r)`) THEN
16894     RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN
16895     REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
16896     REWRITE_TAC[IN_UNIONS] THEN ASM SET_TAC[]]);;
16897
16898 let COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP_STRONG = prove
16899  (`!p:real^M->real^N c s.
16900         covering_space (c,p) s /\ (!b. b IN s ==> b limit_point_of s)
16901         ==> ((!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) <=>
16902              (!t. closed_in (subtopology euclidean c) t
16903                   ==> closed_in (subtopology euclidean s) (IMAGE p t)))`,
16904   let lemma = prove
16905    (`!f:num->real^N.
16906           (!n. ~(s = v n) ==> DISJOINT s (v n))
16907           ==> (!n. f n IN v n) /\
16908               (!m n. v m = v n <=> m = n)
16909               ==> ?n. IMAGE f (:num) INTER s SUBSET {f n}`,
16910     ASM_CASES_TAC `?n. s = (v:num->real^N->bool) n` THENL
16911      [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th ->
16912         MP_TAC th THEN MATCH_MP_TAC MONO_EXISTS);
16913       RULE_ASSUM_TAC(REWRITE_RULE[NOT_EXISTS_THM]) THEN
16914       ASM_REWRITE_TAC[]] THEN
16915     ASM SET_TAC[]) in
16916   REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
16917    [MATCH_MP_TAC COVERING_SPACE_CLOSED_MAP THEN
16918     EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[];
16919     ALL_TAC] THEN
16920   REWRITE_TAC[MESON[INFINITE] `FINITE s <=> ~INFINITE s`] THEN DISCH_TAC THEN
16921   FIRST_ASSUM(MP_TAC o SPEC `b:real^N` o last o CONJUNCTS o
16922     GEN_REWRITE_RULE I [covering_space]) THEN
16923   ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `t:real^N->bool` THEN
16924   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
16925   DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
16926   SUBGOAL_THEN `(b:real^N) limit_point_of t` MP_TAC THENL
16927    [MATCH_MP_TAC LIMPT_OF_OPEN_IN THEN ASM_MESON_TAC[];
16928     PURE_REWRITE_TAC[LIMPT_SEQUENTIAL_INJ]] THEN
16929   DISCH_THEN(X_CHOOSE_THEN `y:num->real^N` STRIP_ASSUME_TAC) THEN
16930   SUBGOAL_THEN `INFINITE(vv:(real^M->bool)->bool)` MP_TAC THENL
16931    [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
16932         CARD_LE_INFINITE)) THEN REWRITE_TAC[le_c] THEN
16933     SUBGOAL_THEN
16934       `!x. ?v. x IN c /\ (p:real^M->real^N) x = b ==> v IN vv /\ x IN v`
16935     MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[SKOLEM_THM]] THEN
16936     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^M->bool` THEN
16937     REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN CONJ_TAC THENL
16938      [ASM SET_TAC[]; ALL_TAC] THEN
16939     MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN
16940     FIRST_X_ASSUM(fun th ->
16941       MP_TAC(SPEC `x:real^M` th) THEN MP_TAC(SPEC `y:real^M` th)) THEN
16942     ASM_REWRITE_TAC[] THEN
16943     RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
16944     ALL_TAC] THEN
16945   REWRITE_TAC[INFINITE_CARD_LE; le_c; INJECTIVE_ON_ALT] THEN
16946   REWRITE_TAC[IN_UNIV] THEN
16947   DISCH_THEN(X_CHOOSE_THEN `v:num->real^M->bool` STRIP_ASSUME_TAC) THEN
16948   UNDISCH_THEN
16949     `!u. u IN vv ==> ?q:real^N->real^M. homeomorphism (u,t) (p,q)`
16950     (MP_TAC o GEN `n:num` o SPEC `(v:num->real^M->bool) n`) THEN
16951   ASM_REWRITE_TAC[SKOLEM_THM; homeomorphism; FORALL_AND_THM] THEN
16952   DISCH_THEN(X_CHOOSE_THEN `q:num->real^N->real^M` STRIP_ASSUME_TAC) THEN
16953   SUBGOAL_THEN
16954    `closed_in (subtopology euclidean s)
16955               (IMAGE (p:real^M->real^N) (IMAGE (\n. q n (y n:real^N)) (:num)))`
16956   MP_TAC THENL
16957    [FIRST_X_ASSUM MATCH_MP_TAC THEN
16958     REWRITE_TAC[CLOSED_IN_LIMPT; SUBSET; FORALL_IN_IMAGE] THEN
16959     CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `a:real^M`] THEN STRIP_TAC THEN
16960     FIRST_ASSUM(MP_TAC o MATCH_MP LIMPT_OF_SEQUENCE_SUBSEQUENCE) THEN
16961     DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN
16962     SUBGOAL_THEN `(p:real^M->real^N) a = b` ASSUME_TAC THENL
16963      [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
16964       EXISTS_TAC
16965        `(p:real^M->real^N) o (\n:num. q n (y n :real^N)) o (r:num->num)` THEN
16966       REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL
16967        [MATCH_MP_TAC(GEN_ALL(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP]
16968         (fst(EQ_IMP_RULE(SPEC_ALL CONTINUOUS_ON_SEQUENTIALLY))))) THEN
16969         EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
16970          [ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS];
16971           REWRITE_TAC[o_DEF] THEN ASM SET_TAC[]];
16972         REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC LIM_SUBSEQUENCE THEN
16973         ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
16974          (REWRITE_RULE[IMP_CONJ_ALT] LIM_TRANSFORM_EVENTUALLY)) THEN
16975         MATCH_MP_TAC ALWAYS_EVENTUALLY THEN REWRITE_TAC[o_DEF] THEN
16976         ASM SET_TAC[]];
16977       SUBGOAL_THEN `?u. u IN vv /\ (a:real^M) IN u` STRIP_ASSUME_TAC THENL
16978        [ASM SET_TAC[]; ALL_TAC] THEN
16979       SUBGOAL_THEN `?w:real^M->bool. open w /\ u = c INTER w`
16980        (CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC))
16981       THENL [ASM_MESON_TAC[OPEN_IN_OPEN]; ALL_TAC] THEN
16982       RULE_ASSUM_TAC(REWRITE_RULE[IN_INTER]) THEN
16983       FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_INFINITE_OPEN]) THEN
16984       DISCH_THEN(MP_TAC o SPEC `w:real^M->bool`) THEN
16985       ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[]
16986        `INFINITE s ==> !k. s INTER k = s ==> INFINITE(s INTER k)`)) THEN
16987       DISCH_THEN(MP_TAC o SPEC `c:real^M->bool`) THEN ANTS_TAC THENL
16988        [ASM SET_TAC[]; REWRITE_TAC[INTER_ASSOC]] THEN
16989       ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
16990       REWRITE_TAC[INFINITE] THEN DISCH_TAC THEN
16991       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
16992       DISCH_THEN(MP_TAC o SPEC `c INTER w:real^M->bool`) THEN
16993       ASM_REWRITE_TAC[] THEN
16994       DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `(v:num->real^M->bool) n`) THEN
16995       ASM_REWRITE_TAC[] THEN
16996       DISCH_THEN(MP_TAC o SPEC `\n. (q:num->real^N->real^M) n (y n)` o
16997         MATCH_MP lemma) THEN
16998       ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
16999       MESON_TAC[FINITE_SUBSET; FINITE_SING; INTER_COMM]];
17000     SUBGOAL_THEN
17001      `IMAGE (p:real^M->real^N) (IMAGE (\n. q n (y n:real^N)) (:num)) =
17002       IMAGE y (:num)`
17003     SUBST1_TAC THENL
17004      [REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN ASM SET_TAC[]; ALL_TAC] THEN
17005     REWRITE_TAC[CLOSED_IN_LIMPT] THEN
17006     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `b:real^N`)) THEN
17007     ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
17008     REWRITE_TAC[LIMPT_SEQUENTIAL_INJ] THEN
17009     EXISTS_TAC `y:num->real^N` THEN ASM SET_TAC[]]);;
17010
17011 let COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP = prove
17012  (`!p:real^M->real^N c s.
17013         covering_space (c,p) s /\ connected s /\ ~(?a. s = {a})
17014         ==> ((!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) <=>
17015              (!t. closed_in (subtopology euclidean c) t
17016                   ==> closed_in (subtopology euclidean s) (IMAGE p t)))`,
17017   REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL
17018    [SUBGOAL_THEN `c:real^M->bool = {}` ASSUME_TAC THENL
17019      [FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
17020       ASM_REWRITE_TAC[IMAGE_EQ_EMPTY];
17021       ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_EMPTY; CLOSED_IN_SUBTOPOLOGY_EMPTY;
17022                       IMAGE_EQ_EMPTY; NOT_IN_EMPTY]];
17023     MATCH_MP_TAC COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP_STRONG THEN
17024     ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
17025     MATCH_MP_TAC CONNECTED_IMP_PERFECT THEN ASM SET_TAC[]]);;
17026
17027 let COVERING_SPACE_FINITE_SHEETS_EQ_PROPER_MAP = prove
17028  (`!p:real^M->real^N c s.
17029         covering_space (c,p) s
17030         ==> ((!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) <=>
17031              (!k. k SUBSET s /\ compact k
17032                   ==> compact {x | x IN c /\ p(x) IN k}))`,
17033   REPEAT STRIP_TAC THEN
17034   FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
17035   DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN
17036   DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP PROPER_MAP th]) THEN
17037   FIRST_ASSUM(fun th -> REWRITE_TAC
17038    [GSYM(MATCH_MP COVERING_SPACE_FINITE_EQ_COMPACT_FIBRE th)]) THEN
17039   REWRITE_TAC[TAUT `(p <=> q /\ p) <=> (p ==> q)`] THEN
17040   ASM_MESON_TAC[COVERING_SPACE_CLOSED_MAP]);;
17041
17042 (* ------------------------------------------------------------------------- *)
17043 (* Special cases where one or both of the sets is compact.                   *)
17044 (* ------------------------------------------------------------------------- *)
17045
17046 let COVERING_SPACE_FINITE_SHEETS = prove
17047  (`!p:real^M->real^N c s b.
17048       covering_space (c,p) s /\ compact c ==> FINITE {x | x IN c /\ p x = b}`,
17049   REPEAT STRIP_TAC THEN MATCH_MP_TAC BOLZANO_WEIERSTRASS_CONTRAPOS THEN
17050   EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN
17051   ASM_MESON_TAC[COVERING_SPACE_FIBRE_NO_LIMPT]);;
17052
17053 let COVERING_SPACE_COMPACT = prove
17054  (`!p:real^M->real^N c s.
17055         covering_space (c,p) s
17056         ==> (compact c <=>
17057              compact s /\ (!b. b IN s ==> FINITE {x | x IN c /\ p x = b}))`,
17058   REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
17059    [ASM_MESON_TAC[covering_space; COMPACT_CONTINUOUS_IMAGE];
17060     MATCH_MP_TAC COVERING_SPACE_FINITE_SHEETS THEN ASM_MESON_TAC[];
17061     FIRST_ASSUM(MP_TAC o
17062       MATCH_MP COVERING_SPACE_FINITE_SHEETS_EQ_PROPER_MAP) THEN
17063     ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN
17064     ASM_REWRITE_TAC[SUBSET_REFL] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
17065     FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
17066     SET_TAC[]]);;