(* ========================================================================= *)
(* Paths, connectedness, homotopy, simple connectedness & contractibility.   *)
(*                                                                           *)
(*              (c) Copyright, John Harrison 1998-2008                       *)
(*              (c) Copyright, Valentina Bruno 2010                          *)
(* ========================================================================= *)

needs "Multivariate/homology.ml";;
needs "Multivariate/convex.ml";;

(* ------------------------------------------------------------------------- *)
(* Paths and arcs.                                                           *)
(* ------------------------------------------------------------------------- *)

let path = new_definition
 `!g:real^1->real^N. path g <=> g continuous_on interval[vec 0,vec 1]`;;

let pathstart = new_definition
 `pathstart (g:real^1->real^N) = g(vec 0)`;;

let pathfinish = new_definition
 `pathfinish (g:real^1->real^N) = g(vec 1)`;;

let path_image = new_definition
 `path_image (g:real^1->real^N) = IMAGE g (interval[vec 0,vec 1])`;;

let reversepath = new_definition
 `reversepath (g:real^1->real^N) = \x. g(vec 1 - x)`;;

let joinpaths = new_definition
 `(g1 ++ g2) = \x. if drop x <= &1 / &2 then g1(&2 % x)
                   else g2(&2 % x - vec 1)`;;

let simple_path = new_definition
 `simple_path (g:real^1->real^N) <=>
        path g /\
        !x y. x IN interval[vec 0,vec 1] /\
              y IN interval[vec 0,vec 1] /\
              g x = g y
              ==> x = y \/ x = vec 0 /\ y = vec 1 \/ x = vec 1 /\ y = vec 0`;;

let arc = new_definition
 `arc (g:real^1->real^N) <=>
        path g /\
        !x y. x IN interval [vec 0,vec 1] /\
              y IN interval [vec 0,vec 1] /\
              g x = g y
              ==> x = y`;;

(* ------------------------------------------------------------------------- *)
(* Relate to topological general case.                                       *)
(* ------------------------------------------------------------------------- *)

let PATH_IN_EUCLIDEAN = prove
 (`!s:real^N->bool g.
        path_in (subtopology euclidean s) g <=>
        path (g o drop) /\ path_image (g o drop) SUBSET s`,
  REWRITE_TAC[path_in; path; GSYM CONTINUOUS_MAP_EUCLIDEAN] THEN
  REWRITE_TAC[path_image; INTERVAL_REAL_INTERVAL; DROP_VEC] THEN
  REWRITE_TAC[GSYM IMAGE_o; GSYM o_ASSOC] THEN
  ONCE_REWRITE_TAC[IMAGE_o] THEN
  REWRITE_TAC[IMAGE_LIFT_DROP; CONTINUOUS_MAP_IN_SUBTOPOLOGY] THEN
  REPEAT GEN_TAC THEN REWRITE_TAC[TOPSPACE_EUCLIDEANREAL_SUBTOPOLOGY] THEN
  EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
   [ALL_TAC;
    SUBGOAL_THEN `g:real->real^N = (g o drop) o lift` SUBST1_TAC THENL
     [REWRITE_TAC[FUN_EQ_THM; o_THM; LIFT_DROP]; ALL_TAC]] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
    CONTINUOUS_MAP_COMPOSE)) THEN
  REWRITE_TAC[CONTINUOUS_MAP_IN_SUBTOPOLOGY] THEN
  SIMP_TAC[CONTINUOUS_MAP_FROM_SUBTOPOLOGY;
           CONTINUOUS_MAP_LIFT; CONTINUOUS_MAP_DROP] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_REFL;
              TOPSPACE_EUCLIDEANREAL_SUBTOPOLOGY] THEN
  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_DEF; LIFT_DROP]);;

let PATH_EUCLIDEAN = prove
 (`!s g:real^1->real^N.
        path g /\ path_image g SUBSET s <=>
        path_in (subtopology euclidean s) (g o lift)`,
  REWRITE_TAC[PATH_IN_EUCLIDEAN] THEN
  REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]);;

let PATH_PATH_IN = prove
 (`!g:real^1->real^N. path g <=> path_in euclidean (g o lift)`,
  GEN_TAC THEN
  ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
  REWRITE_TAC[GSYM PATH_EUCLIDEAN; SUBSET_UNIV]);;

(* ------------------------------------------------------------------------- *)
(* Invariance theorems.                                                      *)
(* ------------------------------------------------------------------------- *)

let PATH_EQ = prove
 (`!p q. (!t. t IN interval[vec 0,vec 1] ==> p t = q t) /\ path p
         ==> path q`,
  REWRITE_TAC[path; CONTINUOUS_ON_EQ]);;

let PATH_CONTINUOUS_IMAGE = prove
 (`!f:real^M->real^N g.
     path g /\ f continuous_on path_image g ==> path(f o g)`,
  REWRITE_TAC[path; path_image; CONTINUOUS_ON_COMPOSE]);;

let PATH_TRANSLATION_EQ = prove
 (`!a g:real^1->real^N. path((\x. a + x) o g) <=> path g`,
  REPEAT GEN_TAC THEN REWRITE_TAC[path] THEN EQ_TAC THEN DISCH_TAC THENL
   [SUBGOAL_THEN `(g:real^1->real^N) = (\x. --a + x) o (\x. a + x) o g`
    SUBST1_TAC THENL
     [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN VECTOR_ARITH_TAC; ALL_TAC];
    ALL_TAC] THEN
  MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
  ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]);;

add_translation_invariants [PATH_TRANSLATION_EQ];;

let PATH_LINEAR_IMAGE_EQ = prove
 (`!f:real^M->real^N g.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (path(f o g) <=> path g)`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(X_CHOOSE_THEN `h:real^N->real^M` STRIP_ASSUME_TAC o
        MATCH_MP LINEAR_INJECTIVE_LEFT_INVERSE) THEN
  REWRITE_TAC[path] THEN EQ_TAC THEN DISCH_TAC THENL
   [SUBGOAL_THEN `g:real^1->real^M = h o (f:real^M->real^N) o g`
    SUBST1_TAC THENL [ASM_REWRITE_TAC[o_ASSOC; I_O_ID]; ALL_TAC];
    ALL_TAC] THEN
  MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
  ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON]);;

add_linear_invariants [PATH_LINEAR_IMAGE_EQ];;

let PATHSTART_TRANSLATION = prove
 (`!a g. pathstart((\x. a + x) o g) = a + pathstart g`,
  REWRITE_TAC[pathstart; o_THM]);;

add_translation_invariants [PATHSTART_TRANSLATION];;

let PATHSTART_LINEAR_IMAGE_EQ = prove
 (`!f g. linear f ==> pathstart(f o g) = f(pathstart g)`,
  REWRITE_TAC[pathstart; o_THM]);;

add_linear_invariants [PATHSTART_LINEAR_IMAGE_EQ];;

let PATHFINISH_TRANSLATION = prove
 (`!a g. pathfinish((\x. a + x) o g) = a + pathfinish g`,
  REWRITE_TAC[pathfinish; o_THM]);;

add_translation_invariants [PATHFINISH_TRANSLATION];;

let PATHFINISH_LINEAR_IMAGE = prove
 (`!f g. linear f ==> pathfinish(f o g) = f(pathfinish g)`,
  REWRITE_TAC[pathfinish; o_THM]);;

add_linear_invariants [PATHFINISH_LINEAR_IMAGE];;

let PATH_IMAGE_TRANSLATION = prove
 (`!a g. path_image((\x. a + x) o g) = IMAGE (\x. a + x) (path_image g)`,
  REWRITE_TAC[path_image; IMAGE_o]);;

add_translation_invariants [PATH_IMAGE_TRANSLATION];;

let PATH_IMAGE_LINEAR_IMAGE = prove
 (`!f g. linear f ==> path_image(f o g) = IMAGE f (path_image g)`,
  REWRITE_TAC[path_image; IMAGE_o]);;

add_linear_invariants [PATH_IMAGE_LINEAR_IMAGE];;

let REVERSEPATH_TRANSLATION = prove
 (`!a g. reversepath((\x. a + x) o g) = (\x. a + x) o reversepath g`,
  REWRITE_TAC[FUN_EQ_THM; reversepath; o_THM]);;

add_translation_invariants [REVERSEPATH_TRANSLATION];;

let REVERSEPATH_LINEAR_IMAGE = prove
 (`!f g. linear f ==> reversepath(f o g) = f o reversepath g`,
  REWRITE_TAC[FUN_EQ_THM; reversepath; o_THM]);;

add_linear_invariants [REVERSEPATH_LINEAR_IMAGE];;

let JOINPATHS_TRANSLATION = prove
 (`!a:real^N g1 g2. ((\x. a + x) o g1) ++ ((\x. a + x) o g2) =
                    (\x. a + x) o (g1 ++ g2)`,
  REWRITE_TAC[joinpaths; FUN_EQ_THM] THEN REPEAT GEN_TAC THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[o_THM]);;

add_translation_invariants [JOINPATHS_TRANSLATION];;

let JOINPATHS_LINEAR_IMAGE = prove
 (`!f g1 g2. linear f ==> (f o g1) ++ (f o g2) = f o (g1 ++ g2)`,
  REWRITE_TAC[joinpaths; FUN_EQ_THM] THEN REPEAT STRIP_TAC THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[o_THM]);;

add_linear_invariants [JOINPATHS_LINEAR_IMAGE];;

let SIMPLE_PATH_TRANSLATION_EQ = prove
 (`!a g:real^1->real^N. simple_path((\x. a + x) o g) <=> simple_path g`,
  REPEAT GEN_TAC THEN REWRITE_TAC[simple_path; PATH_TRANSLATION_EQ] THEN
  REWRITE_TAC[o_THM; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]);;

add_translation_invariants [SIMPLE_PATH_TRANSLATION_EQ];;

let SIMPLE_PATH_LINEAR_IMAGE_EQ = prove
 (`!f:real^M->real^N g.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (simple_path(f o g) <=> simple_path g)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[simple_path; PATH_TRANSLATION_EQ] THEN
  BINOP_TAC THENL [ASM_MESON_TAC[PATH_LINEAR_IMAGE_EQ]; ALL_TAC] THEN
  REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]);;

add_linear_invariants [SIMPLE_PATH_LINEAR_IMAGE_EQ];;

let ARC_TRANSLATION_EQ = prove
 (`!a g:real^1->real^N. arc((\x. a + x) o g) <=> arc g`,
  REPEAT GEN_TAC THEN REWRITE_TAC[arc; PATH_TRANSLATION_EQ] THEN
  REWRITE_TAC[o_THM; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]);;

add_translation_invariants [ARC_TRANSLATION_EQ];;

let ARC_LINEAR_IMAGE_EQ = prove
 (`!f:real^M->real^N g.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (arc(f o g) <=> arc g)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[arc; PATH_TRANSLATION_EQ] THEN
  BINOP_TAC THENL [ASM_MESON_TAC[PATH_LINEAR_IMAGE_EQ]; ALL_TAC] THEN
  REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]);;

add_linear_invariants [ARC_LINEAR_IMAGE_EQ];;

let SIMPLE_PATH_CONTINUOUS_IMAGE = prove
 (`!f g. simple_path g /\
         f continuous_on path_image g /\
         (!x y.
              x IN path_image g /\ y IN path_image g /\ f x = f y ==> x = y)
         ==> simple_path(f o g)`,
  REWRITE_TAC[simple_path; INJECTIVE_ON_ALT] THEN
  SIMP_TAC[PATH_CONTINUOUS_IMAGE] THEN
  REWRITE_TAC[path_image; o_THM] THEN SET_TAC[]);;

let ARC_CONTINUOUS_IMAGE = prove
 (`!f g:real^1->real^N.
        arc g /\
        f continuous_on path_image g /\
        (!x y. x IN path_image g /\ y IN path_image g /\ f x = f y ==> x = y)
        ==> arc(f o g)`,
  REWRITE_TAC[arc; INJECTIVE_ON_ALT] THEN SIMP_TAC[PATH_CONTINUOUS_IMAGE] THEN
  REWRITE_TAC[path_image; o_THM] THEN SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Basic lemmas about paths.                                                 *)
(* ------------------------------------------------------------------------- *)

let ARC_IMP_SIMPLE_PATH = prove
 (`!g. arc g ==> simple_path g`,
  REWRITE_TAC[arc; simple_path] THEN MESON_TAC[]);;

let ARC_IMP_PATH = prove
 (`!g. arc g ==> path g`,
  REWRITE_TAC[arc] THEN MESON_TAC[]);;

let SIMPLE_PATH_IMP_PATH = prove
 (`!g. simple_path g ==> path g`,
  REWRITE_TAC[simple_path] THEN MESON_TAC[]);;

let SIMPLE_PATH_CASES = prove
 (`!g:real^1->real^N. simple_path g ==> arc g \/ pathfinish g = pathstart g`,
  REWRITE_TAC[simple_path; arc; pathfinish; pathstart] THEN
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `(g:real^1->real^N) (vec 0) = g(vec 1)` THEN
  ASM_REWRITE_TAC[] THEN
  MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^1`; `v:real^1`]) THEN
  ASM_MESON_TAC[]);;

let SIMPLE_PATH_IMP_ARC = prove
 (`!g:real^1->real^N.
        simple_path g /\ ~(pathfinish g = pathstart g) ==> arc g`,
  MESON_TAC[SIMPLE_PATH_CASES]);;

let ARC_DISTINCT_ENDS = prove
 (`!g:real^1->real^N. arc g ==> ~(pathfinish g = pathstart g)`,
  GEN_TAC THEN REWRITE_TAC[arc; pathfinish; pathstart] THEN
  ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> a /\ b /\ ~d ==> ~c`] THEN
  DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN
  REWRITE_TAC[GSYM DROP_EQ; IN_INTERVAL_1; DROP_VEC] THEN
  CONV_TAC REAL_RAT_REDUCE_CONV);;

let ARC_SIMPLE_PATH = prove
 (`!g:real^1->real^N.
        arc g <=> simple_path g /\ ~(pathfinish g = pathstart g)`,
  MESON_TAC[SIMPLE_PATH_CASES; ARC_IMP_SIMPLE_PATH; ARC_DISTINCT_ENDS]);;

let SIMPLE_PATH_EQ_ARC = prove
 (`!g. ~(pathstart g = pathfinish g) ==> (simple_path g <=> arc g)`,
  SIMP_TAC[ARC_SIMPLE_PATH]);;

let PATH_IMAGE_NONEMPTY = prove
 (`!g. ~(path_image g = {})`,
  REWRITE_TAC[path_image; IMAGE_EQ_EMPTY; INTERVAL_EQ_EMPTY] THEN
  SIMP_TAC[DIMINDEX_1; CONJ_ASSOC; LE_ANTISYM; UNWIND_THM1; VEC_COMPONENT;
           ARITH; REAL_OF_NUM_LT]);;

let PATHSTART_IN_PATH_IMAGE = prove
 (`!g. (pathstart g) IN path_image g`,
  GEN_TAC THEN REWRITE_TAC[pathstart; path_image] THEN
  MATCH_MP_TAC FUN_IN_IMAGE THEN
  REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS]);;

let PATHFINISH_IN_PATH_IMAGE = prove
 (`!g. (pathfinish g) IN path_image g`,
  GEN_TAC THEN REWRITE_TAC[pathfinish; path_image] THEN
  MATCH_MP_TAC FUN_IN_IMAGE THEN
  REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN REAL_ARITH_TAC);;

let CONNECTED_PATH_IMAGE = prove
 (`!g. path g ==> connected(path_image g)`,
  REWRITE_TAC[path; path_image] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
  ASM_SIMP_TAC[CONVEX_CONNECTED; CONVEX_INTERVAL]);;

let COMPACT_PATH_IMAGE = prove
 (`!g. path g ==> compact(path_image g)`,
  REWRITE_TAC[path; path_image] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
  ASM_REWRITE_TAC[COMPACT_INTERVAL]);;

let BOUNDED_PATH_IMAGE = prove
 (`!g. path g ==> bounded(path_image g)`,
  MESON_TAC[COMPACT_PATH_IMAGE; COMPACT_IMP_BOUNDED]);;

let CLOSED_PATH_IMAGE = prove
 (`!g. path g ==> closed(path_image g)`,
  MESON_TAC[COMPACT_PATH_IMAGE; COMPACT_IMP_CLOSED]);;

let CONNECTED_SIMPLE_PATH_IMAGE = prove
 (`!g. simple_path g ==> connected(path_image g)`,
  MESON_TAC[CONNECTED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]);;

let COMPACT_SIMPLE_PATH_IMAGE = prove
 (`!g. simple_path g ==> compact(path_image g)`,
  MESON_TAC[COMPACT_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]);;

let BOUNDED_SIMPLE_PATH_IMAGE = prove
 (`!g. simple_path g ==> bounded(path_image g)`,
  MESON_TAC[BOUNDED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]);;

let CLOSED_SIMPLE_PATH_IMAGE = prove
 (`!g. simple_path g ==> closed(path_image g)`,
  MESON_TAC[CLOSED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]);;

let CONNECTED_ARC_IMAGE = prove
 (`!g. arc g ==> connected(path_image g)`,
  MESON_TAC[CONNECTED_PATH_IMAGE; ARC_IMP_PATH]);;

let COMPACT_ARC_IMAGE = prove
 (`!g. arc g ==> compact(path_image g)`,
  MESON_TAC[COMPACT_PATH_IMAGE; ARC_IMP_PATH]);;

let BOUNDED_ARC_IMAGE = prove
 (`!g. arc g ==> bounded(path_image g)`,
  MESON_TAC[BOUNDED_PATH_IMAGE; ARC_IMP_PATH]);;

let CLOSED_ARC_IMAGE = prove
 (`!g. arc g ==> closed(path_image g)`,
  MESON_TAC[CLOSED_PATH_IMAGE; ARC_IMP_PATH]);;

let PATHSTART_COMPOSE = prove
 (`!f p. pathstart(f o p) = f(pathstart p)`,
  REWRITE_TAC[pathstart; o_THM]);;

let PATHFINISH_COMPOSE = prove
 (`!f p. pathfinish(f o p) = f(pathfinish p)`,
  REWRITE_TAC[pathfinish; o_THM]);;

let PATH_IMAGE_COMPOSE = prove
 (`!f p. path_image (f o p) = IMAGE f (path_image p)`,
  REWRITE_TAC[path_image; IMAGE_o]);;

let PATH_COMPOSE_JOIN = prove
 (`!f p q. f o (p ++ q) = (f o p) ++ (f o q)`,
  REWRITE_TAC[joinpaths; o_DEF; FUN_EQ_THM] THEN MESON_TAC[]);;

let PATH_COMPOSE_REVERSEPATH = prove
 (`!f p. f o reversepath p = reversepath(f o p)`,
  REWRITE_TAC[reversepath; o_DEF; FUN_EQ_THM] THEN MESON_TAC[]);;

let JOIN_PATHS_EQ = prove
 (`!p q:real^1->real^N.
   (!t. t IN interval[vec 0,vec 1] ==> p t = p' t) /\
   (!t. t IN interval[vec 0,vec 1] ==> q t = q' t)
   ==> !t. t IN interval[vec 0,vec 1] ==> (p ++ q) t = (p' ++ q') t`,
  REWRITE_TAC[joinpaths; IN_INTERVAL_1; DROP_VEC] THEN REPEAT STRIP_TAC THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
  REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_SUB; DROP_VEC] THEN
  ASM_REAL_ARITH_TAC);;

let CARD_EQ_SIMPLE_PATH_IMAGE = prove
 (`!g. simple_path g ==> path_image g =_c (:real)`,
  SIMP_TAC[CONNECTED_CARD_EQ_IFF_NONTRIVIAL; CONNECTED_SIMPLE_PATH_IMAGE] THEN
  GEN_TAC THEN REWRITE_TAC[simple_path; path_image] THEN MATCH_MP_TAC(SET_RULE
   `(?u v. u IN s /\ v IN s /\ ~(u = a) /\ ~(v = a) /\ ~(u = v))
    ==> P /\ (!x y. x IN s /\ y IN s /\ f x = f y
                    ==> x = y \/ x = a /\ y = b \/ x = b /\ y = a)
        ==> ~(?c. IMAGE f s SUBSET {c})`) THEN
  MAP_EVERY EXISTS_TAC [`lift(&1 / &3)`; `lift(&1 / &2)`] THEN
  REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; GSYM LIFT_NUM; LIFT_EQ] THEN
  CONV_TAC REAL_RAT_REDUCE_CONV);;

let INFINITE_SIMPLE_PATH_IMAGE = prove
 (`!g. simple_path g ==> INFINITE(path_image g)`,
  MESON_TAC[CARD_EQ_SIMPLE_PATH_IMAGE; INFINITE; FINITE_IMP_COUNTABLE;
            UNCOUNTABLE_REAL; CARD_COUNTABLE_CONG]);;

let CARD_EQ_ARC_IMAGE = prove
 (`!g. arc g ==> path_image g =_c (:real)`,
  MESON_TAC[ARC_IMP_SIMPLE_PATH; CARD_EQ_SIMPLE_PATH_IMAGE]);;

let INFINITE_ARC_IMAGE = prove
 (`!g. arc g ==> INFINITE(path_image g)`,
  MESON_TAC[ARC_IMP_SIMPLE_PATH; INFINITE_SIMPLE_PATH_IMAGE]);;

(* ------------------------------------------------------------------------- *)
(* The operations on paths.                                                  *)
(* ------------------------------------------------------------------------- *)

let JOINPATHS = prove
 (`!g1 g2. pathfinish g1 = pathstart g2
           ==> g1 ++ g2 = \x. if drop x < &1 / &2 then g1(&2 % x)
                              else g2 (&2 % x - vec 1)`,
  REWRITE_TAC[pathstart; pathfinish] THEN REPEAT STRIP_TAC THEN
  REWRITE_TAC[joinpaths; FUN_EQ_THM] THEN
  X_GEN_TAC `x:real^1` THEN ASM_CASES_TAC `drop x = &1 / &2` THENL
   [FIRST_X_ASSUM(MP_TAC o AP_TERM `lift`) THEN
    REWRITE_TAC[LIFT_DROP] THEN DISCH_THEN SUBST1_TAC THEN
    REWRITE_TAC[LIFT_DROP; REAL_LE_REFL; GSYM LIFT_CMUL; REAL_LT_REFL] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN
    ASM_REWRITE_TAC[LIFT_NUM; VECTOR_SUB_REFL];
    REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_REAL_ARITH_TAC]);;

let REVERSEPATH_REVERSEPATH = prove
 (`!g:real^1->real^N. reversepath(reversepath g) = g`,
  REWRITE_TAC[reversepath; ETA_AX;
              VECTOR_ARITH `vec 1 - (vec 1 - x):real^1 = x`]);;

let PATHSTART_REVERSEPATH = prove
 (`pathstart(reversepath g) = pathfinish g`,
  REWRITE_TAC[pathstart; reversepath; pathfinish; VECTOR_SUB_RZERO]);;

let PATHFINISH_REVERSEPATH = prove
 (`pathfinish(reversepath g) = pathstart g`,
  REWRITE_TAC[pathstart; reversepath; pathfinish; VECTOR_SUB_REFL]);;

let PATHSTART_JOIN = prove
 (`!g1 g2. pathstart(g1 ++ g2) = pathstart g1`,
  REWRITE_TAC[joinpaths; pathstart; pathstart; DROP_VEC; VECTOR_MUL_RZERO] THEN
  CONV_TAC REAL_RAT_REDUCE_CONV);;

let PATHFINISH_JOIN = prove
 (`!g1 g2. pathfinish(g1 ++ g2) = pathfinish g2`,
  REPEAT GEN_TAC THEN REWRITE_TAC[joinpaths; pathfinish; DROP_VEC] THEN
  CONV_TAC REAL_RAT_REDUCE_CONV THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC);;

let PATH_IMAGE_REVERSEPATH = prove
 (`!g:real^1->real^N. path_image(reversepath g) = path_image g`,
  SUBGOAL_THEN `!g:real^1->real^N.
      path_image(reversepath g) SUBSET path_image g`
   (fun th -> MESON_TAC[th; REVERSEPATH_REVERSEPATH; SUBSET_ANTISYM]) THEN
  REWRITE_TAC[SUBSET; path_image; FORALL_IN_IMAGE] THEN
  MAP_EVERY X_GEN_TAC [`g:real^1->real^N`; `x:real^1`] THEN
  DISCH_TAC THEN REWRITE_TAC[reversepath; IN_IMAGE] THEN
  EXISTS_TAC `vec 1 - x:real^1` THEN POP_ASSUM MP_TAC THEN
  REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC);;

let PATH_REVERSEPATH = prove
 (`!g:real^1->real^N. path(reversepath g) <=> path g`,
  SUBGOAL_THEN `!g:real^1->real^N. path g ==> path(reversepath g)`
   (fun th -> MESON_TAC[th; REVERSEPATH_REVERSEPATH]) THEN
  GEN_TAC THEN REWRITE_TAC[path; reversepath] THEN STRIP_TAC THEN
  GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
  MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
  SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
  MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
  EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
  ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN
  REWRITE_TAC[DROP_VEC; DROP_SUB] THEN REAL_ARITH_TAC);;

let PATH_JOIN = prove
 (`!g1 g2:real^1->real^N.
        pathfinish g1 = pathstart g2
        ==> (path(g1 ++ g2) <=> path g1 /\ path g2)`,
  REWRITE_TAC[path; pathfinish; pathstart] THEN
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [STRIP_TAC THEN CONJ_TAC THENL
     [SUBGOAL_THEN
       `(g1:real^1->real^N) = (\x. g1 (&2 % x)) o (\x. &1 / &2 % x)`
      SUBST1_TAC THENL
       [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN
        VECTOR_ARITH_TAC;
        ALL_TAC] THEN
      MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
      SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN
      MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
      EXISTS_TAC `(g1 ++ g2):real^1->real^N` THEN CONJ_TAC THENL
       [REWRITE_TAC[FORALL_IN_IMAGE; joinpaths; IN_INTERVAL_1; DROP_CMUL] THEN
        SIMP_TAC[DROP_VEC; REAL_ARITH `&1 / &2 * x <= &1 / &2 <=> x <= &1`];
        ALL_TAC] THEN
      MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
      EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[] THEN
      REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_CMUL] THEN
      REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC;
      SUBGOAL_THEN
       `(g2:real^1->real^N) =
        (\x. g2 (&2 % x - vec 1)) o (\x. &1 / &2 % (x + vec 1))`
      SUBST1_TAC THENL
       [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN
        VECTOR_ARITH_TAC;
        ALL_TAC] THEN
      MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
      SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST;
               CONTINUOUS_ON_ADD] THEN
      MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
      EXISTS_TAC `(g1 ++ g2):real^1->real^N` THEN CONJ_TAC THENL
       [REWRITE_TAC[FORALL_IN_IMAGE; joinpaths; IN_INTERVAL_1; DROP_CMUL] THEN
        REWRITE_TAC[DROP_VEC; DROP_ADD; REAL_ARITH
         `&1 / &2 * (x + &1) <= &1 / &2 <=> x <= &0`] THEN
        SIMP_TAC[REAL_ARITH `&0 <= x ==> (x:real <= &0 <=> x = &0)`; LIFT_NUM;
          VECTOR_MUL_ASSOC; GSYM LIFT_EQ; LIFT_DROP; GSYM LIFT_CMUL] THEN
        CONV_TAC REAL_RAT_REDUCE_CONV THEN
        ASM_REWRITE_TAC[VECTOR_ADD_LID; VECTOR_MUL_LID] THEN
        REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
        REWRITE_TAC[VECTOR_ARITH `(x + vec 1):real^N - vec 1 = x`];
        ALL_TAC] THEN
      MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
      EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[] THEN
      REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_CMUL] THEN
      REWRITE_TAC[DROP_VEC; DROP_ADD] THEN REAL_ARITH_TAC];
    STRIP_TAC THEN
    SUBGOAL_THEN `interval[vec 0,vec 1] =
                  interval[vec 0,lift(&1 / &2)] UNION
                  interval[lift(&1 / &2),vec 1]`
    SUBST1_TAC THENL
     [SIMP_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
      REAL_ARITH_TAC;
      ALL_TAC] THEN
    MATCH_MP_TAC CONTINUOUS_ON_UNION THEN REWRITE_TAC[CLOSED_INTERVAL] THEN
    CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL
     [EXISTS_TAC `\x. (g1:real^1->real^N) (&2 % x)`;
      EXISTS_TAC `\x. (g2:real^1->real^N) (&2 % x - vec 1)`] THEN
    REWRITE_TAC[joinpaths] THEN SIMP_TAC[IN_INTERVAL_1; LIFT_DROP] THENL
     [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
      MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
      SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN
      ONCE_REWRITE_TAC[VECTOR_ARITH `&2 % (x:real^1) = &2 % x + vec 0`] THEN
      REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN
      REWRITE_TAC[REAL_POS; INTERVAL_EQ_EMPTY_1; LIFT_DROP; DROP_VEC] THEN
      REWRITE_TAC[GSYM LIFT_CMUL; VECTOR_ADD_RID; VECTOR_MUL_RZERO] THEN
      CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[LIFT_NUM];
      ALL_TAC] THEN
    CONJ_TAC THENL
     [SIMP_TAC[REAL_ARITH `&1 / &2 <= x ==> (x <= &1 / &2 <=> x = &1 / &2)`;
               GSYM LIFT_EQ; LIFT_DROP; GSYM LIFT_CMUL] THEN
      CONV_TAC REAL_RAT_REDUCE_CONV THEN
      RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
      ASM_REWRITE_TAC[LIFT_NUM] THEN
      REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
      REWRITE_TAC[GSYM LIFT_CMUL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
      REWRITE_TAC[LIFT_NUM; VECTOR_SUB_REFL];
      ALL_TAC] THEN
    GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST;
             CONTINUOUS_ON_ID] THEN
    ONCE_REWRITE_TAC[VECTOR_ARITH
     `&2 % x:real^N - vec 1 = &2 % x + --vec 1`] THEN
    REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN
    REWRITE_TAC[REAL_POS; INTERVAL_EQ_EMPTY_1; LIFT_DROP; DROP_VEC] THEN
    REWRITE_TAC[GSYM LIFT_CMUL; VECTOR_ADD_RID; VECTOR_MUL_RZERO] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[LIFT_NUM] THEN
    ASM_REWRITE_TAC[VECTOR_ARITH
     `&2 % x + --x:real^N = x /\ x + --x = vec 0`]]);;

let PATH_JOIN_IMP = prove
 (`!g1 g2:real^1->real^N.
        path g1 /\ path g2 /\ pathfinish g1 = pathstart g2
        ==> path(g1 ++ g2)`,
  MESON_TAC[PATH_JOIN]);;

let PATH_IMAGE_JOIN_SUBSET = prove
 (`!g1 g2:real^1->real^N.
        path_image(g1 ++ g2) SUBSET (path_image g1 UNION path_image g2)`,
  REWRITE_TAC[path_image; FORALL_IN_IMAGE; SUBSET] THEN
  GEN_TAC THEN GEN_TAC THEN X_GEN_TAC `x:real^1` THEN
  REWRITE_TAC[IN_INTERVAL_1; IN_UNION; IN_IMAGE; DROP_VEC; joinpaths] THEN
  STRIP_TAC THEN ASM_CASES_TAC `drop x <= &1 / &2` THEN ASM_REWRITE_TAC[] THENL
   [DISJ1_TAC THEN EXISTS_TAC `&2 % x:real^1` THEN REWRITE_TAC[DROP_CMUL];
    DISJ2_TAC THEN EXISTS_TAC `&2 % x - vec 1:real^1` THEN
    REWRITE_TAC[DROP_CMUL; DROP_SUB; DROP_VEC]] THEN
  ASM_REAL_ARITH_TAC);;

let SUBSET_PATH_IMAGE_JOIN = prove
 (`!g1 g2:real^1->real^N s.
        path_image g1 SUBSET s /\ path_image g2 SUBSET s
        ==> path_image(g1 ++ g2) SUBSET s`,
  MP_TAC PATH_IMAGE_JOIN_SUBSET THEN
  REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
  SET_TAC[]);;

let PATH_IMAGE_JOIN = prove
 (`!g1 g2. pathfinish g1 = pathstart g2
           ==> path_image(g1 ++ g2) = path_image g1 UNION path_image g2`,
  REWRITE_TAC[pathfinish; pathstart] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[PATH_IMAGE_JOIN_SUBSET] THEN
  REWRITE_TAC[path_image; SUBSET; FORALL_AND_THM; IN_UNION; TAUT
                `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN
  REWRITE_TAC[FORALL_IN_IMAGE; joinpaths] THEN
  REWRITE_TAC[IN_INTERVAL_1; IN_IMAGE; DROP_VEC] THEN
  CONJ_TAC THEN X_GEN_TAC `x:real^1` THEN REPEAT STRIP_TAC THENL
   [EXISTS_TAC `(&1 / &2) % x:real^1` THEN
    ASM_REWRITE_TAC[DROP_CMUL; REAL_ARITH
     `&1 / &2 * x <= &1 / &2 <=> x <= &1`] THEN
    REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
    ASM_REWRITE_TAC[VECTOR_MUL_LID];
    EXISTS_TAC `(&1 / &2) % (x + vec 1):real^1` THEN
    ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; DROP_VEC] THEN
    REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
    REWRITE_TAC[VECTOR_MUL_LID; VECTOR_ARITH `(x + vec 1) - vec 1 = x`] THEN
    ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> (&1 / &2 * (x + &1) <= &1 / &2 <=>
                                          x = &0)`] THEN
    REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM] THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_LID; DROP_VEC]] THEN
  ASM_REAL_ARITH_TAC);;

let NOT_IN_PATH_IMAGE_JOIN = prove
 (`!g1 g2 x. ~(x IN path_image g1) /\ ~(x IN path_image g2)
             ==> ~(x IN path_image(g1 ++ g2))`,
  MESON_TAC[PATH_IMAGE_JOIN_SUBSET; SUBSET; IN_UNION]);;

let ARC_REVERSEPATH = prove
 (`!g. arc g ==> arc(reversepath g)`,
  GEN_TAC THEN SIMP_TAC[arc; PATH_REVERSEPATH] THEN
  REWRITE_TAC[arc; reversepath] THEN STRIP_TAC THEN
  MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`vec 1 - x:real^1`; `vec 1 - y:real^1`]) THEN
  ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN
  REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ; DROP_SUB; DROP_VEC] THEN
  REAL_ARITH_TAC);;

let ARC_REVERSEPATH_EQ = prove
 (`!g:real^1->real^N. arc(reversepath g) <=> arc g`,
  MESON_TAC[ARC_REVERSEPATH; REVERSEPATH_REVERSEPATH]);;

let SIMPLE_PATH_REVERSEPATH = prove
 (`!g. simple_path g ==> simple_path (reversepath g)`,
  GEN_TAC THEN SIMP_TAC[simple_path; PATH_REVERSEPATH] THEN
  REWRITE_TAC[simple_path; reversepath] THEN STRIP_TAC THEN
  MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`vec 1 - x:real^1`; `vec 1 - y:real^1`]) THEN
  ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN
  REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ; DROP_SUB; DROP_VEC] THEN
  REAL_ARITH_TAC);;

let SIMPLE_PATH_REVERSEPATH_EQ = prove
 (`!g:real^1->real^N. simple_path(reversepath g) <=> simple_path g`,
  MESON_TAC[SIMPLE_PATH_REVERSEPATH; REVERSEPATH_REVERSEPATH]);;

let SIMPLE_PATH_JOIN_LOOP = prove
 (`!g1 g2:real^1->real^N.
        arc g1 /\ arc g2 /\
        pathfinish g1 = pathstart g2 /\
        pathfinish g2 = pathstart g1 /\
        (path_image g1 INTER path_image g2) SUBSET
            {pathstart g1,pathstart g2}
        ==> simple_path(g1 ++ g2)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[arc; simple_path] THEN
  MATCH_MP_TAC(TAUT
   `(a /\ b /\ c /\ d ==> f) /\
    (a' /\ b' /\ c /\ d /\ e ==> g)
    ==> (a /\ a') /\ (b /\ b') /\ c /\ d /\ e ==> f /\ g`) THEN
  CONJ_TAC THENL [MESON_TAC[PATH_JOIN]; ALL_TAC] THEN
  REWRITE_TAC[arc; simple_path; SUBSET; IN_INTER; pathstart;
    pathfinish; IN_INTERVAL_1; DROP_VEC; IN_INSERT; NOT_IN_EMPTY] THEN
  DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G1") MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G2") MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "G0")) THEN
  MATCH_MP_TAC DROP_WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
  REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[joinpaths] THEN
  MAP_EVERY ASM_CASES_TAC [`drop x <= &1 / &2`; `drop y <= &1 / &2`] THEN
  ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL
   [REMOVE_THEN "G1" (MP_TAC o SPECL [`&2 % x:real^1`; `&2 % y:real^1`]) THEN
    ASM_REWRITE_TAC[DROP_CMUL; DROP_VEC; DROP_SUB] THEN
    ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
    DISCH_THEN(fun th -> DISJ1_TAC THEN MP_TAC th) THEN VECTOR_ARITH_TAC;
    ALL_TAC;
    ASM_REAL_ARITH_TAC;
    REMOVE_THEN "G2" (MP_TAC o SPECL
     [`&2 % x:real^1 - vec 1`; `&2 % y:real^1 - vec 1`]) THEN
    ASM_REWRITE_TAC[DROP_CMUL; DROP_VEC; DROP_SUB] THEN
    ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
    DISCH_THEN(fun th -> DISJ1_TAC THEN MP_TAC th) THEN VECTOR_ARITH_TAC] THEN
  REMOVE_THEN "G0" (MP_TAC o SPEC `(g1:real^1->real^N) (&2 % x)`) THEN
  ANTS_TAC THENL
   [CONJ_TAC THENL
     [REWRITE_TAC[path_image; IN_IMAGE] THEN EXISTS_TAC `&2 % x:real^1` THEN
      REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL] THEN
      ASM_REAL_ARITH_TAC;
      ASM_REWRITE_TAC[path_image; IN_IMAGE] THEN
      EXISTS_TAC `&2 % y:real^1 - vec 1` THEN
      REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN
      ASM_REAL_ARITH_TAC];
    ALL_TAC] THEN
  STRIP_TAC THENL
   [DISJ2_TAC THEN DISJ1_TAC;
    DISJ1_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
    EXISTS_TAC `&1 / &2 % vec 1:real^1`] THEN
  MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
   [SUBGOAL_THEN `&2 % x:real^1 = vec 0` MP_TAC THENL
     [ALL_TAC; VECTOR_ARITH_TAC] THEN
    REMOVE_THEN "G1" MATCH_MP_TAC;
    DISCH_THEN SUBST_ALL_TAC THEN
    RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_MUL_RZERO]) THEN
    UNDISCH_TAC `T` THEN REWRITE_TAC[] THEN
    SUBGOAL_THEN `&2 % y:real^1 - vec 1 = vec 1` MP_TAC THENL
     [ALL_TAC; VECTOR_ARITH_TAC] THEN
    REMOVE_THEN "G2" MATCH_MP_TAC;
    SUBGOAL_THEN `&2 % x:real^1 = vec 1` MP_TAC THENL
     [ALL_TAC; VECTOR_ARITH_TAC] THEN
    REMOVE_THEN "G1" MATCH_MP_TAC;
    DISCH_THEN SUBST_ALL_TAC THEN
    SUBGOAL_THEN `&2 % y:real^1 - vec 1 = vec 0` MP_TAC THENL
     [ALL_TAC; VECTOR_ARITH_TAC] THEN
    REMOVE_THEN "G2" MATCH_MP_TAC] THEN
  (REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
    [ALL_TAC; ASM_MESON_TAC[]] THEN
   ASM_REWRITE_TAC[DROP_CMUL; DROP_SUB; DROP_VEC] THEN
   ASM_REAL_ARITH_TAC));;

let ARC_JOIN = prove
 (`!g1 g2:real^1->real^N.
        arc g1 /\ arc g2 /\
        pathfinish g1 = pathstart g2 /\
        (path_image g1 INTER path_image g2) SUBSET {pathstart g2}
        ==> arc(g1 ++ g2)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[arc; simple_path] THEN
  MATCH_MP_TAC(TAUT
   `(a /\ b /\ c /\ d ==> f) /\
    (a' /\ b' /\ c /\ d ==> g)
    ==> (a /\ a') /\ (b /\ b') /\ c /\ d ==> f /\ g`) THEN
  CONJ_TAC THENL [MESON_TAC[PATH_JOIN]; ALL_TAC] THEN
  REWRITE_TAC[arc; simple_path; SUBSET; IN_INTER; pathstart;
    pathfinish; IN_INTERVAL_1; DROP_VEC; IN_INSERT; NOT_IN_EMPTY] THEN
  DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G1") MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G2") MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "G0")) THEN
  MATCH_MP_TAC DROP_WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
  REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[joinpaths] THEN
  MAP_EVERY ASM_CASES_TAC [`drop x <= &1 / &2`; `drop y <= &1 / &2`] THEN
  ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL
   [REMOVE_THEN "G1" (MP_TAC o SPECL [`&2 % x:real^1`; `&2 % y:real^1`]) THEN
    ASM_REWRITE_TAC[DROP_CMUL; DROP_VEC; DROP_SUB] THEN
    ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
    VECTOR_ARITH_TAC;
    ALL_TAC;
    ASM_REAL_ARITH_TAC;
    REMOVE_THEN "G2" (MP_TAC o SPECL
     [`&2 % x:real^1 - vec 1`; `&2 % y:real^1 - vec 1`]) THEN
    ASM_REWRITE_TAC[DROP_CMUL; DROP_VEC; DROP_SUB] THEN
    ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
    VECTOR_ARITH_TAC] THEN
  REMOVE_THEN "G0" (MP_TAC o SPEC `(g1:real^1->real^N) (&2 % x)`) THEN
  ANTS_TAC THENL
   [CONJ_TAC THENL
     [REWRITE_TAC[path_image; IN_IMAGE] THEN EXISTS_TAC `&2 % x:real^1` THEN
      REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL] THEN
      ASM_REAL_ARITH_TAC;
      ASM_REWRITE_TAC[path_image; IN_IMAGE] THEN
      EXISTS_TAC `&2 % y:real^1 - vec 1` THEN
      REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN
      ASM_REAL_ARITH_TAC];
    ALL_TAC] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN `x:real^1 = &1 / &2 % vec 1` SUBST_ALL_TAC THENL
   [SUBGOAL_THEN `&2 % x:real^1 = vec 1` MP_TAC THENL
     [ALL_TAC; VECTOR_ARITH_TAC] THEN
    REMOVE_THEN "G1" MATCH_MP_TAC;
    SUBGOAL_THEN `&2 % y:real^1 - vec 1 = vec 0` MP_TAC THENL
     [ALL_TAC; VECTOR_ARITH_TAC] THEN
    REMOVE_THEN "G2" MATCH_MP_TAC] THEN
  (REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
    [ALL_TAC; ASM_MESON_TAC[]] THEN
   ASM_REWRITE_TAC[DROP_CMUL; DROP_SUB; DROP_VEC] THEN
   ASM_REAL_ARITH_TAC));;

let REVERSEPATH_JOINPATHS = prove
 (`!g1 g2. pathfinish g1 = pathstart g2
           ==> reversepath(g1 ++ g2) = reversepath g2 ++ reversepath g1`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[reversepath; joinpaths; pathfinish; pathstart; FUN_EQ_THM] THEN
  DISCH_TAC THEN X_GEN_TAC `t:real^1` THEN
  REWRITE_TAC[DROP_VEC; DROP_SUB; REAL_ARITH
   `&1 - x <= &1 / &2 <=> &1 / &2 <= x`] THEN
  ASM_CASES_TAC `t = lift(&1 / &2)` THENL
   [ASM_REWRITE_TAC[LIFT_DROP; REAL_LE_REFL; GSYM LIFT_NUM; GSYM LIFT_SUB;
                    GSYM LIFT_CMUL] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[LIFT_NUM];
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM DROP_EQ]) THEN
    REWRITE_TAC[LIFT_DROP] THEN DISCH_TAC THEN
    ASM_SIMP_TAC[REAL_ARITH
     `~(x = &1 / &2) ==> (&1 / &2 <= x <=> ~(x <= &1 / &2))`] THEN
    ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_REWRITE_TAC[] THEN
    AP_TERM_TAC THEN REWRITE_TAC[VECTOR_SUB_LDISTRIB] THEN VECTOR_ARITH_TAC]);;

(* ------------------------------------------------------------------------- *)
(* Some reversed and "if and only if" versions of joining theorems.          *)
(* ------------------------------------------------------------------------- *)

let PATH_JOIN_PATH_ENDS = prove
 (`!g1 g2:real^1->real^N.
        path g2 /\ path(g1 ++ g2) ==> pathfinish g1 = pathstart g2`,
  REPEAT GEN_TAC THEN DISJ_CASES_TAC(NORM_ARITH
   `pathfinish g1:real^N = pathstart g2 \/
    &0 < dist(pathfinish g1,pathstart g2)`) THEN
  ASM_REWRITE_TAC[path; continuous_on; joinpaths] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
  REWRITE_TAC[pathstart; pathfinish] THEN
  ABBREV_TAC `e = dist((g1:real^1->real^N)(vec 1),g2(vec 0:real^1))` THEN
  DISCH_THEN(CONJUNCTS_THEN2
   (MP_TAC o SPEC `vec 0:real^1`) (MP_TAC o SPEC `lift(&1 / &2)`)) THEN
  REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; LIFT_DROP; REAL_LE_REFL] THEN
  REWRITE_TAC[GSYM LIFT_CMUL; IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
  CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM] THEN
  DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN `d1:real`
   (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1"))) THEN
  DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN `d2:real`
   (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2"))) THEN
  REMOVE_THEN "2" (MP_TAC o SPEC `lift(min (&1 / &2) (min d1 d2) / &2)`) THEN
  REWRITE_TAC[LIFT_DROP; DIST_LIFT; DIST_0; NORM_REAL; GSYM drop] THEN
  ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
  REMOVE_THEN "1" (MP_TAC o SPEC
   `lift(&1 / &2 + min (&1 / &2) (min d1 d2) / &4)`) THEN
  REWRITE_TAC[LIFT_DROP; DIST_LIFT] THEN
  ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
  COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
  REWRITE_TAC[GSYM LIFT_CMUL; LIFT_ADD; REAL_ADD_LDISTRIB] THEN
  CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM] THEN
  REWRITE_TAC[VECTOR_ADD_SUB; REAL_ARITH `&2 * x / &4 = x / &2`] THEN
  REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);;

let PATH_JOIN_EQ = prove
 (`!g1 g2:real^1->real^N.
        path g1 /\ path g2
        ==> (path(g1 ++ g2) <=> pathfinish g1 = pathstart g2)`,
  MESON_TAC[PATH_JOIN_PATH_ENDS; PATH_JOIN_IMP]);;

let SIMPLE_PATH_JOIN_IMP = prove
 (`!g1 g2:real^1->real^N.
        simple_path(g1 ++ g2) /\ pathfinish g1 = pathstart g2
        ==> arc g1 /\ arc g2 /\
            path_image g1 INTER path_image g2 SUBSET
            {pathstart g1, pathstart g2}`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `path(g1:real^1->real^N) /\ path(g2:real^1->real^N)` THENL
   [ALL_TAC; ASM_MESON_TAC[PATH_JOIN; SIMPLE_PATH_IMP_PATH]] THEN
  REWRITE_TAC[simple_path; pathstart; pathfinish; arc] THEN
  STRIP_TAC THEN REPEAT CONJ_TAC THEN ASM_REWRITE_TAC[] THENL
   [MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
    REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL
     [`&1 / &2 % x:real^1`; `&1 / &2 % y:real^1`]) THEN
    REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; joinpaths; DROP_CMUL] THEN
    REPEAT(COND_CASES_TAC THEN TRY ASM_REAL_ARITH_TAC) THEN
    REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
    ASM_REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; VECTOR_MUL_LID; DROP_VEC] THEN
    ASM_REAL_ARITH_TAC;
    MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
    REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL
     [`&1 / &2 % (x + vec 1):real^1`; `&1 / &2 % (y + vec 1):real^1`]) THEN
    ASM_SIMP_TAC[JOINPATHS; pathstart; pathfinish] THEN
    REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_ADD; DROP_CMUL] THEN
    REPEAT(COND_CASES_TAC THEN TRY ASM_REAL_ARITH_TAC) THEN
    REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
    ASM_REWRITE_TAC[VECTOR_MUL_LID; VECTOR_ARITH `(a + b) - b:real^N = a`] THEN
    ASM_REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; VECTOR_MUL_LID; DROP_VEC;
                    DROP_ADD] THEN
    ASM_REAL_ARITH_TAC;
    REWRITE_TAC[SET_RULE
     `s INTER t SUBSET u <=> !x. x IN s ==> x IN t ==> x IN u`] THEN
    REWRITE_TAC[path_image; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^1` THEN
    REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN
    REWRITE_TAC[IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:real^1` THEN
    REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN
    SUBST1_TAC(SYM(ASSUME
     `(g1:real^1->real^N)(vec 1) = g2(vec 0:real^1)`)) THEN
    MATCH_MP_TAC(SET_RULE `x = a \/ x = b ==> f x IN {f a,f b}`) THEN
    FIRST_X_ASSUM(MP_TAC o SPECL
     [`&1 / &2 % x:real^1`; `&1 / &2 % (y + vec 1):real^1`]) THEN
    ANTS_TAC THENL
     [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_ADD] THEN
      REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
      GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [joinpaths] THEN
      ASM_SIMP_TAC[JOINPATHS; pathstart; pathfinish] THEN
      REWRITE_TAC[DROP_ADD; DROP_CMUL; DROP_VEC] THEN
      REPEAT(COND_CASES_TAC THEN TRY ASM_REAL_ARITH_TAC) THEN
      REWRITE_TAC[VECTOR_ARITH `&2 % &1 / &2 % x:real^N = x`] THEN
      ASM_REWRITE_TAC[VECTOR_ARITH `(a + b) - b:real^N = a`];
      REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_ADD; DROP_VEC] THEN
      ASM_REAL_ARITH_TAC]]);;

let SIMPLE_PATH_JOIN_LOOP_EQ = prove
 (`!g1 g2:real^1->real^N.
        pathfinish g2 = pathstart g1 /\
        pathfinish g1 = pathstart g2
        ==> (simple_path(g1 ++ g2) <=>
             arc g1 /\ arc g2 /\
             path_image g1 INTER path_image g2 SUBSET
             {pathstart g1, pathstart g2})`,
  MESON_TAC[SIMPLE_PATH_JOIN_IMP; SIMPLE_PATH_JOIN_LOOP]);;

let SIMPLE_PATH_JOIN_LOOP_EQ_ALT = prove
 (`!g1 g2:real^1->real^N.
        pathfinish g2 = pathstart g1 /\
        pathfinish g1 = pathstart g2
        ==> (simple_path(g1 ++ g2) <=>
             arc g1 /\ arc g2 /\
             path_image g1 INTER path_image g2 =
             {pathstart g1, pathstart g2})`,
  REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ] THEN
  AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE
   `a IN s /\ b IN s ==> (s SUBSET {a,b} <=> s = {a,b})`) THEN
  REWRITE_TAC[IN_INTER] THEN
  ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]);;

let ARC_JOIN_EQ = prove
 (`!g1 g2:real^1->real^N.
        pathfinish g1 = pathstart g2
        ==> (arc(g1 ++ g2) <=>
             arc g1 /\ arc g2 /\
             path_image g1 INTER path_image g2 SUBSET {pathstart g2})`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[ARC_JOIN] THEN
  GEN_REWRITE_TAC LAND_CONV [ARC_SIMPLE_PATH] THEN
  REWRITE_TAC[PATHFINISH_JOIN; PATHSTART_JOIN] THEN STRIP_TAC THEN
  MP_TAC(ISPECL [`g1:real^1->real^N`; `g2:real^1->real^N`]
        SIMPLE_PATH_JOIN_IMP) THEN
  ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  SUBGOAL_THEN `~((pathstart g1:real^N) IN path_image g2)`
   (fun th -> MP_TAC th THEN ASM SET_TAC[]) THEN
  REWRITE_TAC[path_image; IN_IMAGE; IN_INTERVAL_1; DROP_VEC] THEN
  DISCH_THEN(X_CHOOSE_THEN `u:real^1` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [simple_path]) THEN
  DISCH_THEN(MP_TAC o SPECL [`vec 0:real^1`; `lift(&1 / &2) + inv(&2) % u`] o
    CONJUNCT2) THEN
  REWRITE_TAC[GSYM DROP_EQ; IN_INTERVAL_1; DROP_ADD; DROP_VEC;
              DROP_CMUL; LIFT_DROP; joinpaths] THEN
  CONV_TAC REAL_RAT_REDUCE_CONV THEN
  ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_IMP_NZ;
               REAL_ARITH `&0 <= x ==> &0 < &1 / &2 + &1 / &2 * x`] THEN
  REWRITE_TAC[REAL_ARITH `&1 / &2 + &1 / &2 * u = &1 <=> u = &1`] THEN
  ASM_SIMP_TAC[REAL_ARITH
   `&0 <= u ==> (&1 / &2 + &1 / &2 * u <= &1 / &2 <=> u = &0)`] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
  ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN
  ASM_SIMP_TAC[REAL_ARITH `u <= &1 ==> &1 / &2 + &1 / &2 * u <= &1`] THEN
  REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN COND_CASES_TAC THENL
   [ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_RID; GSYM LIFT_CMUL] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM] THEN
    ASM_REWRITE_TAC[VEC_EQ] THEN ARITH_TAC;
    REWRITE_TAC[VECTOR_ADD_LDISTRIB; GSYM LIFT_CMUL] THEN
    REWRITE_TAC[VECTOR_MUL_ASSOC] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN
    REWRITE_TAC[LIFT_NUM; VECTOR_MUL_LID; VECTOR_ADD_SUB] THEN
    ASM_MESON_TAC[]]);;

let ARC_JOIN_EQ_ALT = prove
 (`!g1 g2:real^1->real^N.
        pathfinish g1 = pathstart g2
        ==> (arc(g1 ++ g2) <=>
             arc g1 /\ arc g2 /\
             path_image g1 INTER path_image g2 = {pathstart g2})`,
  REPEAT STRIP_TAC THEN ASM_SIMP_TAC[ARC_JOIN_EQ] THEN
  MP_TAC(ISPEC `g1:real^1->real^N` PATHFINISH_IN_PATH_IMAGE) THEN
  MP_TAC(ISPEC `g2:real^1->real^N` PATHSTART_IN_PATH_IMAGE) THEN
  ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Reassociating a joined path doesn't matter for various properties.        *)
(* ------------------------------------------------------------------------- *)

let PATH_ASSOC = prove
 (`!p q r:real^1->real^N.
        pathfinish p = pathstart q /\ pathfinish q = pathstart r
        ==> (path(p ++ (q ++ r)) <=> path((p ++ q) ++ r))`,
  SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN] THEN CONV_TAC TAUT);;

let SIMPLE_PATH_ASSOC = prove
 (`!p q r:real^1->real^N.
        pathfinish p = pathstart q /\ pathfinish q = pathstart r
        ==> (simple_path(p ++ (q ++ r)) <=> simple_path((p ++ q) ++ r))`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `pathstart(p:real^1->real^N) = pathfinish r` THENL
   [ALL_TAC;
    ASM_SIMP_TAC[SIMPLE_PATH_EQ_ARC; PATHSTART_JOIN; PATHFINISH_JOIN]] THEN
  ASM_SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; PATHSTART_JOIN; PATHFINISH_JOIN;
               ARC_JOIN_EQ; PATH_IMAGE_JOIN] THEN
  MAP_EVERY ASM_CASES_TAC
   [`arc(p:real^1->real^N)`; `arc(q:real^1->real^N)`;
    `arc(r:real^1->real^N)`] THEN
  ASM_REWRITE_TAC[UNION_OVER_INTER; UNION_SUBSET;
                  ONCE_REWRITE_RULE[INTER_COMM] UNION_OVER_INTER] THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP ARC_DISTINCT_ENDS)) THEN
  MAP_EVERY (fun t -> MP_TAC(ISPEC t PATHSTART_IN_PATH_IMAGE) THEN
                      MP_TAC(ISPEC t PATHFINISH_IN_PATH_IMAGE))
   [`p:real^1->real^N`; `q:real^1->real^N`; `r:real^1->real^N`] THEN
  ASM SET_TAC[]);;

let ARC_ASSOC = prove
 (`!p q r:real^1->real^N.
        pathfinish p = pathstart q /\ pathfinish q = pathstart r
        ==> (arc(p ++ (q ++ r)) <=> arc((p ++ q) ++ r))`,
  SIMP_TAC[ARC_SIMPLE_PATH; SIMPLE_PATH_ASSOC] THEN
  SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN]);;

(* ------------------------------------------------------------------------- *)
(* In the case of a loop, neither does symmetry.                             *)
(* ------------------------------------------------------------------------- *)

let PATH_SYM = prove
 (`!p q. pathfinish p = pathstart q /\ pathfinish q = pathstart p
         ==> (path(p ++ q) <=> path(q ++ p))`,
  SIMP_TAC[PATH_JOIN; CONJ_ACI]);;

let SIMPLE_PATH_SYM = prove
 (`!p q. pathfinish p = pathstart q /\ pathfinish q = pathstart p
         ==> (simple_path(p ++ q) <=> simple_path(q ++ p))`,
  SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; INTER_ACI; CONJ_ACI; INSERT_AC]);;

let PATH_IMAGE_SYM = prove
 (`!p q. pathfinish p = pathstart q /\ pathfinish q = pathstart p
         ==> path_image(p ++ q) = path_image(q ++ p)`,
  SIMP_TAC[PATH_IMAGE_JOIN; UNION_ACI]);;

(* ------------------------------------------------------------------------- *)
(* Reparametrizing a closed curve to start at some chosen point.             *)
(* ------------------------------------------------------------------------- *)

let shiftpath = new_definition
  `shiftpath a (f:real^1->real^N) =
        \x. if drop(a + x) <= &1 then f(a + x)
            else f(a + x - vec 1)`;;

let SHIFTPATH_TRANSLATION = prove
 (`!a t g. shiftpath t ((\x. a + x) o g) = (\x. a + x) o shiftpath t g`,
  REWRITE_TAC[FUN_EQ_THM; shiftpath; o_THM] THEN MESON_TAC[]);;

add_translation_invariants [SHIFTPATH_TRANSLATION];;

let SHIFTPATH_LINEAR_IMAGE = prove
 (`!f t g. linear f ==> shiftpath t (f o g) = f o shiftpath t g`,
  REWRITE_TAC[FUN_EQ_THM; shiftpath; o_THM] THEN MESON_TAC[]);;

add_linear_invariants [SHIFTPATH_LINEAR_IMAGE];;

let PATHSTART_SHIFTPATH = prove
 (`!a g. drop a <= &1 ==> pathstart(shiftpath a g) = g(a)`,
  SIMP_TAC[pathstart; shiftpath; VECTOR_ADD_RID]);;

let PATHFINISH_SHIFTPATH = prove
 (`!a g. &0 <= drop a /\ pathfinish g = pathstart g
         ==> pathfinish(shiftpath a g) = g(a)`,
  SIMP_TAC[pathfinish; shiftpath; pathstart; DROP_ADD; DROP_VEC] THEN
  REWRITE_TAC[VECTOR_ARITH `a + vec 1 - vec 1 = a`] THEN
  ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> (x + &1 <= &1 <=> x = &0)`] THEN
  SIMP_TAC[DROP_EQ_0; VECTOR_ADD_LID] THEN MESON_TAC[]);;

let ENDPOINTS_SHIFTPATH = prove
 (`!a g. pathfinish g = pathstart g /\ a IN interval[vec 0,vec 1]
         ==> pathfinish(shiftpath a g) = g a /\
             pathstart(shiftpath a g) = g a`,
  SIMP_TAC[IN_INTERVAL_1; DROP_VEC;
           PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH]);;

let CLOSED_SHIFTPATH = prove
 (`!a g. pathfinish g = pathstart g /\ a IN interval[vec 0,vec 1]
         ==> pathfinish(shiftpath a g) = pathstart(shiftpath a g)`,
  SIMP_TAC[IN_INTERVAL_1; PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH;
           DROP_VEC]);;

let PATH_SHIFTPATH = prove
 (`!g a. path g /\ pathfinish g:real^N = pathstart g /\
         a IN interval[vec 0,vec 1]
         ==> path(shiftpath a g)`,
  REWRITE_TAC[shiftpath; path] THEN REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `interval[vec 0,vec 1] = interval[vec 0,vec 1 - a:real^1] UNION
                            interval[vec 1 - a,vec 1]`
  SUBST1_TAC THENL
   [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
    REWRITE_TAC[DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC;
    ALL_TAC] THEN
  MATCH_MP_TAC CONTINUOUS_ON_UNION THEN REWRITE_TAC[CLOSED_INTERVAL] THEN
  CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL
   [EXISTS_TAC `(\x. g(a + x)):real^1->real^N` THEN
    REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; DROP_VEC; DROP_SUB] THEN
    SIMP_TAC[REAL_ARITH `a + x <= &1 <=> x <= &1 - a`];
    EXISTS_TAC `(\x. g(a + x - vec 1)):real^1->real^N` THEN
    REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; DROP_VEC; DROP_SUB] THEN
    SIMP_TAC[REAL_ARITH `&1 - a <= x ==> (a + x <= &1 <=> a + x = &1)`] THEN
    ONCE_REWRITE_TAC[COND_RAND] THEN
    REWRITE_TAC[VECTOR_ARITH `a + x - vec 1 = (a + x) - vec 1`] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
    ASM_SIMP_TAC[GSYM LIFT_EQ; LIFT_ADD; LIFT_NUM; LIFT_DROP] THEN
    REWRITE_TAC[VECTOR_SUB_REFL; COND_ID]] THEN
  MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN
  SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID;
           CONTINUOUS_ON_SUB] THEN
  MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
  EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
  ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
  REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; DROP_ADD] THEN
  REAL_ARITH_TAC);;

let SHIFTPATH_SHIFTPATH = prove
 (`!g a x. a IN interval[vec 0,vec 1] /\ pathfinish g = pathstart g /\
           x IN interval[vec 0,vec 1]
           ==> shiftpath (vec 1 - a) (shiftpath a g) x = g x`,
  REWRITE_TAC[shiftpath; pathfinish; pathstart] THEN
  REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC] THEN
  REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN
  REWRITE_TAC[DROP_VEC] THEN REPEAT STRIP_TAC THENL
   [ALL_TAC;
    AP_TERM_TAC THEN VECTOR_ARITH_TAC;
    AP_TERM_TAC THEN VECTOR_ARITH_TAC;
    ASM_REAL_ARITH_TAC] THEN
  SUBGOAL_THEN `x:real^1 = vec 0` SUBST1_TAC THENL
   [REWRITE_TAC[GSYM DROP_EQ; DROP_VEC] THEN
    ASM_REAL_ARITH_TAC;
    ASM_REWRITE_TAC[VECTOR_ARITH `a + vec 1 - a + vec 0:real^1 = vec 1`]]);;

let PATH_IMAGE_SHIFTPATH = prove
 (`!a g:real^1->real^N.
        a IN interval[vec 0,vec 1] /\ pathfinish g = pathstart g
        ==> path_image(shiftpath a g) = path_image g`,
  REWRITE_TAC[IN_INTERVAL_1; pathfinish; pathstart] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN
  REWRITE_TAC[path_image; shiftpath; FORALL_IN_IMAGE; SUBSET] THEN
  REWRITE_TAC[IN_IMAGE] THEN REPEAT STRIP_TAC THEN
  REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_IMAGE] THENL
   [EXISTS_TAC `a + x:real^1`;
    EXISTS_TAC `a + x - vec 1:real^1`;
    ALL_TAC] THEN
  REPEAT(POP_ASSUM MP_TAC) THEN
  REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_SUB; DROP_ADD] THEN
  TRY REAL_ARITH_TAC THEN REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `drop a <= drop x` THENL
   [EXISTS_TAC `x - a:real^1` THEN
    REWRITE_TAC[VECTOR_ARITH `a + x - a:real^1 = x`; DROP_SUB] THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
    ASM_REAL_ARITH_TAC;
    EXISTS_TAC `vec 1 + x - a:real^1` THEN
    REWRITE_TAC[VECTOR_ARITH `a + (v + x - a) - v:real^1 = x`] THEN
    REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC] THEN
    ASM_CASES_TAC `x:real^1 = vec 0` THEN
    ASM_REWRITE_TAC[VECTOR_ARITH `a + v + x - a:real^1 = v + x`] THEN
    ASM_REWRITE_TAC[VECTOR_ADD_RID; DROP_VEC; COND_ID] THEN
    ASM_REWRITE_TAC[REAL_ARITH `a + &1 + x - a <= &1 <=> x <= &0`] THEN
    REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[GSYM DROP_EQ; DROP_VEC] THEN
    TRY(COND_CASES_TAC THEN POP_ASSUM MP_TAC) THEN REWRITE_TAC[] THEN
    REAL_ARITH_TAC]);;

let SIMPLE_PATH_SHIFTPATH = prove
 (`!g a. simple_path g /\ pathfinish g = pathstart g /\
         a IN interval[vec 0,vec 1]
         ==> simple_path(shiftpath a g)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[simple_path] THEN
  MATCH_MP_TAC(TAUT
   `(a /\ c /\ d ==> e) /\ (b /\ c /\ d ==> f)
    ==>  (a /\ b) /\ c /\ d ==> e /\ f`) THEN
  CONJ_TAC THENL [MESON_TAC[PATH_SHIFTPATH]; ALL_TAC] THEN
  REWRITE_TAC[simple_path; shiftpath; IN_INTERVAL_1; DROP_VEC;
              DROP_ADD; DROP_SUB] THEN
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN
  STRIP_TAC THEN REPEAT GEN_TAC THEN
  REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
  DISCH_THEN(fun th -> FIRST_X_ASSUM(MP_TAC o C MATCH_MP th)) THEN
  REPEAT(POP_ASSUM MP_TAC) THEN
  REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC; GSYM DROP_EQ] THEN
  REAL_ARITH_TAC);;

(* ------------------------------------------------------------------------- *)
(* Choosing a sub-path of an existing path.                                  *)
(* ------------------------------------------------------------------------- *)

let subpath = new_definition
 `subpath u v g = \x. g(u + drop(v - u) % x)`;;

let SUBPATH_SCALING_LEMMA = prove
 (`!u v.
    IMAGE (\x. u + drop(v - u) % x) (interval[vec 0,vec 1]) = segment[u,v]`,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN
  REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; SEGMENT_1] THEN
  REWRITE_TAC[DROP_SUB; REAL_SUB_LE; INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN
  CONV_TAC REAL_RAT_REDUCE_CONV THEN COND_CASES_TAC THEN
  ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
  BINOP_TAC THEN REWRITE_TAC[GSYM LIFT_EQ_CMUL; VECTOR_MUL_RZERO] THEN
  REWRITE_TAC[LIFT_DROP; LIFT_SUB] THEN VECTOR_ARITH_TAC);;

let PATH_IMAGE_SUBPATH_GEN = prove
 (`!u v g:real^1->real^N. path_image(subpath u v g) = IMAGE g (segment[u,v])`,
  REPEAT GEN_TAC THEN REWRITE_TAC[path_image; subpath] THEN
  ONCE_REWRITE_TAC[GSYM o_DEF] THEN
  REWRITE_TAC[IMAGE_o; SUBPATH_SCALING_LEMMA]);;

let PATH_IMAGE_SUBPATH = prove
 (`!u v g:real^1->real^N.
        drop u <= drop v
        ==> path_image(subpath u v g) = IMAGE g (interval[u,v])`,
  SIMP_TAC[PATH_IMAGE_SUBPATH_GEN; SEGMENT_1]);;

let PATH_IMAGE_SUBPATH_COMBINE = prove
 (`!g:real^1->real^N u.
        path g /\ u IN interval[vec 0,vec 1]
        ==> path_image(subpath (vec 0) u g) UNION
            path_image(subpath u (vec 1) g) =
            path_image g`,
  REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT STRIP_TAC THEN
  ASM_SIMP_TAC[PATH_IMAGE_SUBPATH] THEN
  REWRITE_TAC[path_image; GSYM IMAGE_UNION] THEN
  AP_TERM_TAC THEN MATCH_MP_TAC UNION_INTERVAL_1 THEN
  ASM_REWRITE_TAC[IN_INTERVAL_1]);;

let PATH_SUBPATH = prove
 (`!u v g:real^1->real^N.
        path g /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1]
        ==> path(subpath u v g)`,
  REWRITE_TAC[path; subpath] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN
  SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID;
           CONTINUOUS_ON_CONST] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
    CONTINUOUS_ON_SUBSET)) THEN
  REWRITE_TAC[SUBPATH_SCALING_LEMMA; SEGMENT_1] THEN
  COND_CASES_TAC THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN
  REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
  REAL_ARITH_TAC);;

let PATHSTART_SUBPATH = prove
 (`!u v g:real^1->real^N. pathstart(subpath u v g) = g(u)`,
  REWRITE_TAC[pathstart; subpath; VECTOR_MUL_RZERO; VECTOR_ADD_RID]);;

let PATHFINISH_SUBPATH = prove
 (`!u v g:real^1->real^N. pathfinish(subpath u v g) = g(v)`,
  REWRITE_TAC[pathfinish; subpath; GSYM LIFT_EQ_CMUL] THEN
  REWRITE_TAC[LIFT_DROP; VECTOR_ARITH `u + v - u:real^N = v`]);;

let SUBPATH_TRIVIAL = prove
 (`!g. subpath (vec 0) (vec 1) g = g`,
  REWRITE_TAC[subpath; VECTOR_SUB_RZERO; DROP_VEC; VECTOR_MUL_LID;
              VECTOR_ADD_LID; ETA_AX]);;

let SUBPATH_REVERSEPATH = prove
 (`!g. subpath (vec 1) (vec 0) g = reversepath g`,
  REWRITE_TAC[subpath; reversepath; VECTOR_SUB_LZERO; DROP_NEG; DROP_VEC] THEN
  REWRITE_TAC[VECTOR_ARITH `a + -- &1 % b:real^N = a - b`]);;

let REVERSEPATH_SUBPATH = prove
 (`!g u v. reversepath(subpath u v g) = subpath v u g`,
  REWRITE_TAC[reversepath; subpath; FUN_EQ_THM] THEN REPEAT GEN_TAC THEN
  AP_TERM_TAC THEN REWRITE_TAC[DROP_SUB; VECTOR_SUB_LDISTRIB] THEN
  REWRITE_TAC[GSYM LIFT_EQ_CMUL; LIFT_SUB; LIFT_DROP] THEN
  VECTOR_ARITH_TAC);;

let SUBPATH_TRANSLATION = prove
 (`!a g:real^1->real^N u v.
        subpath u v ((\x. a + x) o g) = (\x. a + x) o subpath u v g`,
  REWRITE_TAC[FUN_EQ_THM; subpath; o_THM]);;

add_translation_invariants [SUBPATH_TRANSLATION];;

let SUBPATH_LINEAR_IMAGE = prove
 (`!f:real^M->real^N g u v.
    linear f ==> subpath u v (f o g) = f o subpath u v g`,
  REWRITE_TAC[FUN_EQ_THM; subpath; o_THM]);;

add_linear_invariants [SUBPATH_LINEAR_IMAGE];;

let SIMPLE_PATH_SUBPATH_EQ = prove
 (`!g u v. simple_path(subpath u v g) <=>
           path(subpath u v g) /\ ~(u = v) /\
           (!x y. x IN segment[u,v] /\ y IN segment[u,v] /\ g x = g y
                  ==> x = y \/ x = u /\ y = v \/ x = v /\ y = u)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[simple_path; subpath] THEN AP_TERM_TAC THEN
  REWRITE_TAC[GSYM SUBPATH_SCALING_LEMMA] THEN
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
  REWRITE_TAC[VECTOR_ARITH `u + a % x = u <=> a % x = vec 0`;
              VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN
  REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_MUL_LCANCEL] THEN
  REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_ADD; DROP_SUB;
              REAL_RING `u + (v - u) * y = v <=> v = u \/ y = &1`] THEN
  REWRITE_TAC[REAL_SUB_0; DROP_EQ; GSYM DROP_VEC] THEN
  ASM_CASES_TAC `v:real^1 = u` THEN ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[REAL_SUB_REFL; DROP_VEC; VECTOR_MUL_LZERO] THEN
  REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
  DISCH_THEN(MP_TAC o SPECL [`lift(&1 / &2)`; `lift(&3 / &4)`]) THEN
  REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ; LIFT_DROP] THEN
  CONV_TAC REAL_RAT_REDUCE_CONV);;

let ARC_SUBPATH_EQ = prove
 (`!g u v. arc(subpath u v g) <=>
           path(subpath u v g) /\ ~(u = v) /\
           (!x y. x IN segment[u,v] /\ y IN segment[u,v] /\ g x = g y
                  ==> x = y)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[arc; subpath] THEN AP_TERM_TAC THEN
  REWRITE_TAC[GSYM SUBPATH_SCALING_LEMMA] THEN
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
  REWRITE_TAC[VECTOR_ARITH `u + a % x = u + a % y <=> a % (x - y) = vec 0`;
              VECTOR_MUL_EQ_0; DROP_EQ_0; VECTOR_SUB_EQ] THEN
  ASM_CASES_TAC `v:real^1 = u` THEN ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[VECTOR_SUB_REFL; DROP_VEC; VECTOR_MUL_LZERO] THEN
  REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
  DISCH_THEN(MP_TAC o SPECL [`lift(&1 / &2)`; `lift(&3 / &4)`]) THEN
  REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ; LIFT_DROP] THEN
  CONV_TAC REAL_RAT_REDUCE_CONV);;

let SIMPLE_PATH_SUBPATH = prove
 (`!g u v. simple_path g /\
           u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\
           ~(u = v)
           ==> simple_path(subpath u v g)`,
  SIMP_TAC[SIMPLE_PATH_SUBPATH_EQ; PATH_SUBPATH; SIMPLE_PATH_IMP_PATH] THEN
  REWRITE_TAC[simple_path] THEN GEN_TAC THEN
  REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN
  REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN
  CONJ_TAC THENL [MESON_TAC[SEGMENT_SYM]; ALL_TAC] THEN
  SIMP_TAC[SEGMENT_1; REAL_LT_IMP_LE] THEN
  MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN DISCH_TAC THEN
  STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
  STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^1`; `y:real^1`]) THEN
  SUBGOAL_THEN
   `!x:real^1. x IN interval[u,v] ==> x IN interval[vec 0,vec 1]`
  ASSUME_TAC THENL
   [REWRITE_TAC[GSYM SUBSET; SUBSET_INTERVAL_1] THEN
    ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC; REAL_LE_TRANS];
    ASM_SIMP_TAC[]] THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN
  REWRITE_TAC[DROP_VEC; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC);;

let ARC_SIMPLE_PATH_SUBPATH = prove
 (`!g u v. simple_path g /\
           u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\
           ~(g u = g v)
           ==> arc(subpath u v g)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SIMPLE_PATH_IMP_ARC THEN
  ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
  ASM_MESON_TAC[SIMPLE_PATH_SUBPATH]);;

let ARC_SUBPATH_ARC = prove
 (`!u v g. arc g /\
           u IN interval [vec 0,vec 1] /\ v IN interval [vec 0,vec 1] /\
           ~(u = v)
           ==> arc(subpath u v g)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN
  ASM_MESON_TAC[ARC_IMP_SIMPLE_PATH; arc]);;

let ARC_SIMPLE_PATH_SUBPATH_INTERIOR = prove
 (`!g u v. simple_path g /\
           u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\
           ~(u = v) /\ abs(drop u - drop v) < &1
           ==> arc(subpath u v g)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN
  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [simple_path]) THEN
  DISCH_THEN(MP_TAC o SPECL [`u:real^1`; `v:real^1`] o CONJUNCT2) THEN
  ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
  ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC);;

let PATH_IMAGE_SUBPATH_SUBSET = prove
 (`!u v g:real^1->real^N.
        path g /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1]
        ==> path_image(subpath u v g) SUBSET path_image g`,
  SIMP_TAC[PATH_IMAGE_SUBPATH_GEN] THEN REPEAT STRIP_TAC THEN
  REWRITE_TAC[path_image] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
  SIMP_TAC[SEGMENT_CONVEX_HULL; SUBSET_HULL; CONVEX_INTERVAL] THEN
  ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET]);;

let JOIN_SUBPATHS_MIDDLE = prove
 (`!p:real^1->real^N.
   subpath (vec 0) (lift(&1 / &2)) p ++ subpath (lift(&1 / &2)) (vec 1) p = p`,
  REWRITE_TAC[FUN_EQ_THM] THEN REPEAT GEN_TAC THEN
  REWRITE_TAC[joinpaths; subpath] THEN COND_CASES_TAC THEN AP_TERM_TAC THEN
  REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_SUB; DROP_CMUL; LIFT_DROP;
              DROP_VEC] THEN
  REAL_ARITH_TAC);;

(* ------------------------------------------------------------------------- *)
(* Some additional lemmas about choosing sub-paths.                          *)
(* ------------------------------------------------------------------------- *)

let EXISTS_SUBPATH_OF_PATH = prove
 (`!g a b:real^N.
        path g /\ a IN path_image g /\ b IN path_image g
        ==> ?h. path h /\ pathstart h = a /\ pathfinish h = b /\
                path_image h SUBSET path_image g`,
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; path_image; FORALL_IN_IMAGE] THEN
  GEN_TAC THEN DISCH_TAC THEN
  X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN
  X_GEN_TAC `v:real^1` THEN DISCH_TAC THEN
  EXISTS_TAC `subpath u v (g:real^1->real^N)` THEN
  ASM_REWRITE_TAC[GSYM path_image; PATH_IMAGE_SUBPATH_GEN] THEN
  ASM_SIMP_TAC[PATH_SUBPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
  REWRITE_TAC[path_image] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
  SIMP_TAC[SEGMENT_CONVEX_HULL; SUBSET_HULL; CONVEX_INTERVAL] THEN
  ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET]);;

let EXISTS_SUBPATH_OF_ARC_NOENDS = prove
 (`!g a b:real^N.
        arc g /\ a IN path_image g /\ b IN path_image g /\
        {a,b} INTER {pathstart g,pathfinish g} = {}
        ==> ?h. path h /\ pathstart h = a /\ pathfinish h = b /\
                path_image h SUBSET
                (path_image g) DIFF {pathstart g,pathfinish g}`,
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; path_image; FORALL_IN_IMAGE] THEN
  GEN_TAC THEN DISCH_TAC THEN
  X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN
  X_GEN_TAC `v:real^1` THEN DISCH_TAC THEN DISCH_TAC THEN
  EXISTS_TAC `subpath u v (g:real^1->real^N)` THEN
  ASM_SIMP_TAC[PATH_SUBPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH;
               ARC_IMP_PATH; GSYM path_image; PATH_IMAGE_SUBPATH_GEN] THEN
  REWRITE_TAC[path_image; pathstart; pathfinish] THEN
  REWRITE_TAC[SET_RULE
   `s SUBSET t DIFF {a,b} <=> s SUBSET t /\ ~(a IN s) /\ ~(b IN s)`] THEN
  REWRITE_TAC[IN_IMAGE] THEN
  SUBGOAL_THEN `~(vec 0 IN segment[u:real^1,v]) /\ ~(vec 1 IN segment[u,v])`
  STRIP_ASSUME_TAC THENL
   [REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN
    REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THEN
    ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
    SIMP_TAC[REAL_ARITH `a:real <= b ==> (b <= a <=> a = b)`] THEN
    REWRITE_TAC[GSYM DROP_VEC; DROP_EQ] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[arc; pathstart; pathfinish]) THEN
    ASM SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN `segment[u:real^1,v] SUBSET interval[vec 0,vec 1]` MP_TAC THENL
   [SIMP_TAC[SEGMENT_CONVEX_HULL; SUBSET_HULL; CONVEX_INTERVAL] THEN
    ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET];
    ALL_TAC] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[arc; pathstart; pathfinish]) THEN
  SUBGOAL_THEN `(vec 0:real^1) IN interval[vec 0,vec 1] /\
                (vec 1:real^1) IN interval[vec 0,vec 1]`
  MP_TAC THENL
   [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL];
    ASM SET_TAC[]]);;

let EXISTS_SUBARC_OF_ARC_NOENDS = prove
 (`!g a b:real^N.
        arc g /\ a IN path_image g /\ b IN path_image g /\ ~(a = b) /\
        {a,b} INTER {pathstart g,pathfinish g} = {}
        ==> ?h. arc h /\ pathstart h = a /\ pathfinish h = b /\
                path_image h SUBSET
                (path_image g) DIFF {pathstart g,pathfinish g}`,
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; path_image; FORALL_IN_IMAGE] THEN
  GEN_TAC THEN DISCH_TAC THEN
  X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN
  X_GEN_TAC `v:real^1` THEN REPEAT DISCH_TAC THEN
  EXISTS_TAC `subpath u v (g:real^1->real^N)` THEN
  ASM_SIMP_TAC[PATH_SUBPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH;
               ARC_IMP_PATH; GSYM path_image; PATH_IMAGE_SUBPATH_GEN] THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN
    ASM_SIMP_TAC[ARC_IMP_SIMPLE_PATH];
    ALL_TAC] THEN
  REWRITE_TAC[path_image; pathstart; pathfinish] THEN
  REWRITE_TAC[SET_RULE
   `s SUBSET t DIFF {a,b} <=> s SUBSET t /\ ~(a IN s) /\ ~(b IN s)`] THEN
  REWRITE_TAC[IN_IMAGE] THEN
  SUBGOAL_THEN `~(vec 0 IN segment[u:real^1,v]) /\ ~(vec 1 IN segment[u,v])`
  STRIP_ASSUME_TAC THENL
   [REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN
    REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THEN
    ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
    SIMP_TAC[REAL_ARITH `a:real <= b ==> (b <= a <=> a = b)`] THEN
    REWRITE_TAC[GSYM DROP_VEC; DROP_EQ] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[arc; pathstart; pathfinish]) THEN
    ASM SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN `segment[u:real^1,v] SUBSET interval[vec 0,vec 1]` MP_TAC THENL
   [SIMP_TAC[SEGMENT_CONVEX_HULL; SUBSET_HULL; CONVEX_INTERVAL] THEN
    ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET];
    ALL_TAC] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[arc; pathstart; pathfinish]) THEN
  SUBGOAL_THEN `(vec 0:real^1) IN interval[vec 0,vec 1] /\
                (vec 1:real^1) IN interval[vec 0,vec 1]`
  MP_TAC THENL
   [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL];
    ASM SET_TAC[]]);;

let EXISTS_ARC_PSUBSET_SIMPLE_PATH = prove
 (`!g:real^1->real^N.
        simple_path g /\ closed s /\ s PSUBSET path_image g
        ==> ?h. arc h /\
                s SUBSET path_image h /\
                path_image h SUBSET path_image g`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP SIMPLE_PATH_CASES) THENL
   [EXISTS_TAC `g:real^1->real^N` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [PSUBSET_ALT]) THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [path_image] THEN
  REWRITE_TAC[EXISTS_IN_IMAGE] THEN
  DISCH_THEN(X_CHOOSE_THEN `u:real^1` STRIP_ASSUME_TAC) THEN
  ABBREV_TAC `(h:real^1->real^N) = shiftpath u g` THEN
  SUBGOAL_THEN
   `simple_path(h:real^1->real^N) /\
    pathstart h = (g:real^1->real^N) u /\
    pathfinish h = (g:real^1->real^N) u /\
    path_image h = path_image g`
  MP_TAC THENL
   [EXPAND_TAC "h" THEN
    ASM_MESON_TAC[SIMPLE_PATH_SHIFTPATH; PATH_IMAGE_SHIFTPATH;
                  PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH;
                  IN_INTERVAL_1; DROP_VEC];
    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
    UNDISCH_THEN `pathstart(h:real^1->real^N) = (g:real^1->real^N) u`
        (SUBST_ALL_TAC o SYM)] THEN
  SUBGOAL_THEN
   `open_in (subtopology euclidean (interval[vec 0,vec 1]))
            {x:real^1 | x IN interval[vec 0,vec 1] /\
                        (h x) IN ((:real^N) DIFF s)}`
  MP_TAC THENL
   [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN
    ASM_SIMP_TAC[GSYM path; GSYM closed; SIMPLE_PATH_IMP_PATH];
    REWRITE_TAC[open_in] THEN DISCH_THEN(MP_TAC o CONJUNCT2)] THEN
  REWRITE_TAC[IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN
  DISCH_THEN(fun th ->
    MP_TAC(SPEC `vec 0:real^1` th) THEN MP_TAC(SPEC `vec 1:real^1` th)) THEN
  REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN
  REWRITE_TAC[DIST_REAL; VEC_COMPONENT; REAL_SUB_RZERO] THEN
  SIMP_TAC[GSYM drop] THEN
  ANTS_TAC THENL [ASM_MESON_TAC[pathfinish]; ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN
  ANTS_TAC THENL [ASM_MESON_TAC[pathstart]; ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC
   `subpath (lift(min d1 (&1 / &4))) (lift(&1 - min d2 (&1 / &4)))
            (h:real^1->real^N)` THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH_INTERIOR THEN
    ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP; LIFT_EQ] THEN
    ASM_REAL_ARITH_TAC;
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `s SUBSET t ==> t INTER s SUBSET u ==> s SUBSET u`)) THEN
    REWRITE_TAC[SUBSET; IN_INTER; IMP_CONJ] THEN
    SIMP_TAC[PATH_IMAGE_SUBPATH; LIFT_DROP;
             REAL_ARITH `min d1 (&1 / &4) <= &1 - min d2 (&1 / &4)`] THEN
    REWRITE_TAC[FORALL_IN_IMAGE; path_image; IN_INTERVAL_1; DROP_VEC] THEN
    X_GEN_TAC `x:real^1` THEN REPEAT STRIP_TAC THEN
    REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `x:real^1` THEN
    ASM_REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`)) THEN
    ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
    MATCH_MP_TAC PATH_IMAGE_SUBPATH_SUBSET THEN
    ASM_SIMP_TAC[SIMPLE_PATH_IMP_PATH; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
    ASM_REAL_ARITH_TAC]);;

let EXISTS_DOUBLE_ARC_EXPLICIT = prove
 (`!g:real^1->real^N a b.
        simple_path g /\ pathfinish g = pathstart g /\
        a IN interval[vec 0,vec 1] /\ b IN interval[vec 0,vec 1] /\
        drop a <= drop b /\ ~(g a = g b)
        ==> ?u d. arc u /\ arc d /\
                  pathstart u = g a /\ pathfinish u = g b /\
                  pathstart d = g b /\ pathfinish d = g a /\
                  path_image u =
                    IMAGE g (interval[a,b]) /\
                  path_image d =
                    IMAGE g (interval[vec 0,vec 1] DIFF interval(a,b)) /\
                  (path_image u) INTER (path_image d) = {g a,g b} /\
                  (path_image u) UNION (path_image d) = path_image g`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `a:real^1 = vec 0` THENL
   [MAP_EVERY EXISTS_TAC
     [`subpath (vec 0) b (g:real^1->real^N)`;
      `subpath b (vec 1) (g:real^1->real^N)`] THEN
    REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN
      ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[];
      MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN
      ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
      ASM_MESON_TAC[pathfinish; pathstart];
      ASM_REWRITE_TAC[PATHSTART_SUBPATH];
      ASM_REWRITE_TAC[PATHFINISH_SUBPATH];
      ASM_REWRITE_TAC[PATHSTART_SUBPATH];
      ASM_REWRITE_TAC[PATHFINISH_SUBPATH] THEN
      ASM_MESON_TAC[pathfinish; pathstart];
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
      ASM_SIMP_TAC[PATH_IMAGE_SUBPATH];
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
      ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; DROP_VEC; GSYM IMAGE_UNION] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
       `g u = g l
        ==> u IN s /\ u IN t /\
            (!x. ~(x = l) ==> (x IN s <=> x IN t))
            ==> IMAGE g s = IMAGE g t`)) THEN
      REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ; IN_DIFF] THEN
      ASM_REAL_ARITH_TAC;
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
      ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; DROP_VEC; GSYM IMAGE_UNION] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
       `g c = g a
        ==> a IN ab /\ b IN ab /\ b IN b1 /\ c IN b1 /\
            (!x y. g x = g y /\ x IN ab /\ y IN b1
                   ==> x = a \/ x = b)
        ==> IMAGE g ab INTER IMAGE g b1 = {g a,g b}`)) THEN
      ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1; DROP_VEC] THEN
      MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
      FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [simple_path]) THEN
      DISCH_THEN(MP_TAC o SPECL [`x:real^1`; `y:real^1`]) THEN
      ASM_CASES_TAC `(g:real^1->real^N) x = g y` THEN ASM_REWRITE_TAC[] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC]) THEN
      REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ] THEN
      ASM_REAL_ARITH_TAC;
      RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
      ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
      ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; GSYM IMAGE_UNION; DROP_VEC] THEN
      REWRITE_TAC[path_image] THEN AP_TERM_TAC THEN
      REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1; DROP_VEC] THEN
      ASM_REAL_ARITH_TAC];
    ALL_TAC] THEN
  ASM_CASES_TAC `b:real^1 = vec 1` THENL
   [MAP_EVERY EXISTS_TAC
     [`subpath a b (g:real^1->real^N)`;
      `subpath (vec 0) a (g:real^1->real^N)`] THEN
    REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN
      ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[];
      MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN
      ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
      ASM_MESON_TAC[pathfinish; pathstart];
      ASM_REWRITE_TAC[PATHSTART_SUBPATH];
      ASM_REWRITE_TAC[PATHFINISH_SUBPATH];
      ASM_REWRITE_TAC[PATHSTART_SUBPATH] THEN
      ASM_MESON_TAC[pathfinish; pathstart];
      ASM_REWRITE_TAC[PATHFINISH_SUBPATH];
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
      ASM_SIMP_TAC[PATH_IMAGE_SUBPATH];
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
      ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; DROP_VEC; GSYM IMAGE_UNION] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
       `g u = g l
        ==> l IN s /\ u IN t /\
            (!x. ~(x = u) ==> (x IN s <=> x IN t))
            ==> IMAGE g s = IMAGE g t`)) THEN
      REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ; IN_DIFF] THEN
      ASM_REAL_ARITH_TAC;
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
      ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; DROP_VEC; GSYM IMAGE_UNION] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
       `g b = g c
        ==> a IN a1 /\ b IN a1 /\ a IN a0 /\ c IN a0 /\
            (!x y. g x = g y /\ x IN a0 /\ y IN a1
                   ==> x = a \/ x = c)
        ==> IMAGE g a1 INTER IMAGE g a0 = {g a,g b}`)) THEN
      ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1; DROP_VEC] THEN
      MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
      FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [simple_path]) THEN
      DISCH_THEN(MP_TAC o SPECL [`x:real^1`; `y:real^1`]) THEN
      ASM_CASES_TAC `(g:real^1->real^N) x = g y` THEN ASM_REWRITE_TAC[] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC]) THEN
      REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ] THEN
      ASM_REAL_ARITH_TAC;
      RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
      ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
      ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; GSYM IMAGE_UNION; DROP_VEC] THEN
      REWRITE_TAC[path_image] THEN AP_TERM_TAC THEN
      REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1; DROP_VEC] THEN
      ASM_REAL_ARITH_TAC];
    ALL_TAC] THEN
  MAP_EVERY EXISTS_TAC
   [`subpath a b (g:real^1->real^N)`;
    `subpath b (vec 1) (g:real^1->real^N) ++ subpath (vec 0) a g`] THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN ASM_REWRITE_TAC[];
    MATCH_MP_TAC ARC_JOIN THEN
    REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
    REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN
      ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [simple_path]) THEN
      DISCH_THEN(MP_TAC o SPECL [`b:real^1`; `vec 1:real^1`]) THEN
      ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
      REWRITE_TAC[GSYM DROP_EQ; DROP_VEC] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[GSYM DROP_EQ; IN_INTERVAL_1; DROP_VEC]) THEN
      ASM_REAL_ARITH_TAC;
      MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN
      ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [simple_path]) THEN
      DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `vec 0:real^1`]) THEN
      ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
      REWRITE_TAC[GSYM DROP_EQ; DROP_VEC] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[GSYM DROP_EQ; IN_INTERVAL_1; DROP_VEC]) THEN
      ASM_REAL_ARITH_TAC;
      ASM_MESON_TAC[pathstart; pathfinish];
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
      ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; GSYM IMAGE_UNION] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
       `g u = g l
        ==> (!x y. x IN b1 /\ y IN a0 /\ g x = g y
                   ==> x = l \/ x = u)
            ==> IMAGE g b1 INTER IMAGE g a0 SUBSET {g l}`)) THEN
      MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
      FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [simple_path]) THEN
      DISCH_THEN(MP_TAC o SPECL [`x:real^1`; `y:real^1`]) THEN
      ASM_CASES_TAC `(g:real^1->real^N) x = g y` THEN ASM_REWRITE_TAC[] THEN
      ASM_CASES_TAC `a:real^1 = b` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
      ASM_REWRITE_TAC[] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC; GSYM DROP_EQ]) THEN
      REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ] THEN
      ASM_REAL_ARITH_TAC];
    REWRITE_TAC[PATHSTART_SUBPATH];
    REWRITE_TAC[PATHFINISH_SUBPATH];
    REWRITE_TAC[PATHSTART_JOIN; PATHSTART_SUBPATH];
    REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_SUBPATH];
    ASM_SIMP_TAC[PATH_IMAGE_SUBPATH];
    RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
    ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
    ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; GSYM IMAGE_UNION] THEN
    AP_TERM_TAC THEN
    REWRITE_TAC[EXTENSION; IN_UNION; IN_DIFF; IN_INTERVAL_1] THEN
    ASM_REAL_ARITH_TAC;
    RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
    ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
    ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; GSYM IMAGE_UNION] THEN
    MATCH_MP_TAC(SET_RULE
     `a IN ab /\ b IN ab /\ a IN a0 /\ b IN b1 /\
      (!x y. g x = g y /\ x IN ab /\ (y IN b1 \/ y IN a0)
             ==> x = a \/ x = b)
      ==> IMAGE g ab INTER IMAGE g (b1 UNION a0) = {g a,g b}`) THEN
    ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN
    MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
    FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [simple_path]) THEN
    DISCH_THEN(MP_TAC o SPECL [`x:real^1`; `y:real^1`]) THEN
    ASM_CASES_TAC `(g:real^1->real^N) x = g y` THEN ASM_REWRITE_TAC[] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC]) THEN
    REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ] THEN
    ASM_REAL_ARITH_TAC;
    RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
    ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
    ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; GSYM IMAGE_UNION] THEN
    REWRITE_TAC[path_image] THEN AP_TERM_TAC THEN
    REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]);;

let EXISTS_DOUBLE_ARC = prove
 (`!g:real^1->real^N a b.
        simple_path g /\ pathfinish g = pathstart g /\
        a IN path_image g /\ b IN path_image g /\ ~(a = b)
        ==> ?u d. arc u /\ arc d /\
                  pathstart u = a /\ pathfinish u = b /\
                  pathstart d = b /\ pathfinish d = a /\
                  (path_image u) INTER (path_image d) = {a,b} /\
                  (path_image u) UNION (path_image d) = path_image g`,
  REPEAT STRIP_TAC THEN
  UNDISCH_TAC `(b:real^N) IN path_image g` THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [path_image] THEN
  UNDISCH_TAC `(a:real^N) IN path_image g` THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [path_image] THEN
  REWRITE_TAC[IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `u:real^1` THEN
  DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN
  X_GEN_TAC `v:real^1` THEN
  DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN
  DISJ_CASES_TAC(REAL_ARITH `drop u <= drop v \/ drop v <= drop u`) THENL
   [MP_TAC(ISPECL [`g:real^1->real^N`; `u:real^1`; `v:real^1`]
        EXISTS_DOUBLE_ARC_EXPLICIT) THEN
    ASM_REWRITE_TAC[] THEN MESON_TAC[];
    MP_TAC(ISPECL [`g:real^1->real^N`; `v:real^1`; `u:real^1`]
        EXISTS_DOUBLE_ARC_EXPLICIT) THEN
    ASM_REWRITE_TAC[] THEN MESON_TAC[INTER_COMM; UNION_COMM; INSERT_AC]]);;

let SUBPATH_TO_FRONTIER_EXPLICIT = prove
 (`!g:real^1->real^N s.
        path g /\ pathstart g IN s /\ ~(pathfinish g IN s)
        ==> ?u. u IN interval[vec 0,vec 1] /\
                (!x. &0 <= drop x /\ drop x < drop u ==> g x IN interior s) /\
                ~(g u IN interior s) /\
                (u = vec 0 \/ g u IN closure s)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC `{u | lift u IN interval[vec 0,vec 1] /\
                     g(lift u) IN closure((:real^N) DIFF s)}`
         COMPACT_ATTAINS_INF) THEN
  SIMP_TAC[LIFT_DROP; SET_RULE
   `(!x. lift(drop x) = x) ==> IMAGE lift {x | P(lift x)} = {x | P x}`] THEN
  ANTS_TAC THENL
   [RULE_ASSUM_TAC(REWRITE_RULE[path; pathstart; pathfinish; SUBSET;
                                path_image; FORALL_IN_IMAGE]) THEN
    CONJ_TAC THENL
     [REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL
       [MATCH_MP_TAC BOUNDED_SUBSET THEN
        EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
        REWRITE_TAC[BOUNDED_INTERVAL] THEN SET_TAC[];
        MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
        ASM_REWRITE_TAC[CLOSED_CLOSURE; CLOSED_INTERVAL]];
      REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN
      EXISTS_TAC `&1` THEN REWRITE_TAC[LIFT_NUM] THEN
      REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN
      MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN
      ASM_REWRITE_TAC[IN_DIFF; IN_UNIV]];
    ALL_TAC] THEN
  REWRITE_TAC[EXISTS_DROP; FORALL_DROP; IN_ELIM_THM; LIFT_DROP] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN
  REWRITE_TAC[CLOSURE_COMPLEMENT; IN_DIFF; IN_UNIV] THEN STRIP_TAC THEN
  ASM_REWRITE_TAC[subpath; VECTOR_SUB_RZERO; VECTOR_ADD_LID] THEN
  ASM_REWRITE_TAC[GSYM LIFT_EQ_CMUL; LIFT_DROP] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
  REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ] THEN
  MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
   [REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE BINDER_CONV
     [TAUT `a /\ ~b ==> c <=> a /\ ~c ==> b`]) THEN
    ASM_REAL_ARITH_TAC;
    FIRST_X_ASSUM(K ALL_TAC o SPEC `x:real^1`) THEN DISCH_TAC] THEN
  ASM_CASES_TAC `drop u = &0` THEN
  ASM_REWRITE_TAC[frontier; IN_DIFF; CLOSURE_APPROACHABLE] THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  RULE_ASSUM_TAC(REWRITE_RULE[path; pathstart; pathfinish]) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_on]) THEN
  DISCH_THEN(MP_TAC o SPEC `u:real^1`) THEN
  ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
  DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  DISCH_THEN(MP_TAC o SPEC `lift(max (&0) (drop u - d / &2))`) THEN
  REWRITE_TAC[LIFT_DROP; DIST_REAL; GSYM drop] THEN
  ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC
   (MESON[] `P a ==> dist(a,y) < e ==> ?x. P x /\ dist(x,y) < e`) THEN
  MATCH_MP_TAC(REWRITE_RULE[SUBSET] INTERIOR_SUBSET) THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[LIFT_DROP] THEN ASM_ARITH_TAC);;

let SUBPATH_TO_FRONTIER_STRONG = prove
 (`!g:real^1->real^N s.
        path g /\ pathstart g IN s /\ ~(pathfinish g IN s)
        ==> ?u. u IN interval[vec 0,vec 1] /\
                 ~(pathfinish(subpath (vec 0) u g) IN interior s) /\
                (u = vec 0 \/
                 (!x. x IN interval[vec 0,vec 1] /\ ~(x = vec 1)
                      ==> (subpath (vec 0) u g x) IN interior s) /\
                 pathfinish(subpath (vec 0) u g) IN closure s)`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP SUBPATH_TO_FRONTIER_EXPLICIT) THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN
  REWRITE_TAC[subpath; pathfinish; VECTOR_SUB_RZERO; VECTOR_ADD_LID] THEN
  ASM_CASES_TAC `u:real^1 = vec 0` THEN ASM_REWRITE_TAC[] THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[DROP_VEC; VECTOR_MUL_LZERO] THEN
  ASM_REWRITE_TAC[GSYM LIFT_EQ_CMUL; LIFT_DROP] THEN
  X_GEN_TAC `x:real^1` THEN
  REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ; DROP_VEC] THEN STRIP_TAC THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN
  RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
  ASM_SIMP_TAC[DROP_CMUL; REAL_LE_MUL] THEN
  REWRITE_TAC[REAL_ARITH `u * x < u <=> &0 < u * (&1 - x)`] THEN
  MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[REAL_SUB_LT] THEN
  ASM_REWRITE_TAC[REAL_LT_LE] THEN
  ASM_REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM]);;

let SUBPATH_TO_FRONTIER = prove
 (`!g:real^1->real^N s.
        path g /\ pathstart g IN s /\ ~(pathfinish g IN s)
        ==> ?u. u IN interval[vec 0,vec 1] /\
                pathfinish(subpath (vec 0) u g) IN frontier s /\
                (path_image(subpath (vec 0) u g) DELETE
                 pathfinish(subpath (vec 0) u g))
                SUBSET interior s`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[frontier; IN_DIFF] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP SUBPATH_TO_FRONTIER_STRONG) THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN
  ASM_CASES_TAC `u:real^1 = vec 0` THEN ASM_REWRITE_TAC[] THENL
   [REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[pathstart]) THEN STRIP_TAC THEN
    ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN
    REWRITE_TAC[subpath; path_image; VECTOR_SUB_REFL; DROP_VEC;
                VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN
    SET_TAC[];
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[SUBSET; path_image; FORALL_IN_IMAGE; IN_DELETE; IMP_CONJ] THEN
    REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; pathfinish] THEN
    REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_MESON_TAC[]]);;

let EXISTS_PATH_SUBPATH_TO_FRONTIER = prove
 (`!g:real^1->real^N s.
        path g /\ pathstart g IN s /\ ~(pathfinish g IN s)
        ==> ?h. path h /\ pathstart h = pathstart g /\
                (path_image h) SUBSET (path_image g) /\
                (path_image h DELETE (pathfinish h)) SUBSET interior s /\
                pathfinish h IN frontier s`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP SUBPATH_TO_FRONTIER) THEN
  EXISTS_TAC `subpath (vec 0) u (g:real^1->real^N)` THEN
  ASM_SIMP_TAC[PATH_SUBPATH; IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL;
               PATHSTART_SUBPATH; PATH_IMAGE_SUBPATH_SUBSET] THEN
  REWRITE_TAC[pathstart]);;

let EXISTS_PATH_SUBPATH_TO_FRONTIER_CLOSED = prove
 (`!g:real^1->real^N s.
        closed s /\ path g /\ pathstart g IN s /\ ~(pathfinish g IN s)
        ==> ?h. path h /\ pathstart h = pathstart g /\
                (path_image h) SUBSET (path_image g) INTER s /\
                pathfinish h IN frontier s`,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN
  MATCH_MP_TAC MONO_EXISTS THEN
  REWRITE_TAC[SUBSET_INTER] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC
   `(pathfinish h:real^N) INSERT (path_image h DELETE pathfinish h)` THEN
  CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[INSERT_SUBSET]] THEN CONJ_TAC THENL
   [ASM_MESON_TAC[frontier; CLOSURE_EQ; IN_DIFF];
    ASM_MESON_TAC[SUBSET_TRANS; INTERIOR_SUBSET]]);;

let PATH_COMBINE = prove
 (`!u g:real^1->real^N.
        u IN interval[vec 0,vec 1]
        ==> (path g <=>
             path(subpath (vec 0) u g) /\ path(subpath u (vec 1) g))`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN
  ASM_SIMP_TAC[PATH_SUBPATH; ENDS_IN_UNIT_INTERVAL] THEN
  ASM_CASES_TAC `u:real^1 = vec 0` THEN ASM_SIMP_TAC[SUBPATH_TRIVIAL] THEN
  ASM_CASES_TAC `u:real^1 = vec 1` THEN ASM_SIMP_TAC[SUBPATH_TRIVIAL] THEN
  REWRITE_TAC[path; subpath; VECTOR_ADD_LID; VECTOR_SUB_RZERO] THEN
  STRIP_TAC THEN SUBGOAL_THEN
   `interval[vec 0:real^1,vec 1] = interval[vec 0,u] UNION interval[u,vec 1]`
  SUBST1_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
    REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN REAL_ARITH_TAC;
    MATCH_MP_TAC CONTINUOUS_ON_UNION THEN REWRITE_TAC[CLOSED_INTERVAL] THEN
    CONJ_TAC THENL
     [SUBGOAL_THEN
       `(g:real^1->real^N) = (\x. g(drop u % x)) o (\x. inv(drop u) % x)`
      SUBST1_TAC THENL
       [REWRITE_TAC[FUN_EQ_THM; o_THM; VECTOR_MUL_ASSOC] THEN
        ASM_SIMP_TAC[REAL_MUL_RINV; VECTOR_MUL_LID;
                     GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP];
        MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
        SIMP_TAC[LINEAR_SCALING; LINEAR_CONTINUOUS_ON] THEN
        ONCE_REWRITE_TAC[VECTOR_ARITH
         `inv u % x:real^N = inv u % x + vec 0`] THEN
        REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN
        RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1;
                        GSYM DROP_EQ; DROP_VEC]) THEN
        ASM_REWRITE_TAC[INTERVAL_EQ_EMPTY_1; DROP_VEC; GSYM REAL_NOT_LE;
                        REAL_LE_INV_EQ] THEN
        REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_RID] THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN
        MATCH_MP_TAC(SET_RULE `s = t ==> s SUBSET t`) THEN
        AP_TERM_TAC THEN REWRITE_TAC[CONS_11; PAIR_EQ] THEN
        ASM_SIMP_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_VEC; REAL_MUL_LINV]];
      SUBGOAL_THEN
       `(g:real^1->real^N) = (\x. g(u + drop(vec 1 - u) % x)) o
                             (\x. inv(drop(vec 1 - u)) % (x - u))`
      SUBST1_TAC THENL
       [REWRITE_TAC[FUN_EQ_THM; o_THM; VECTOR_MUL_ASSOC] THEN
        ASM_SIMP_TAC[REAL_MUL_RINV; VECTOR_MUL_LID; VECTOR_SUB_EQ;
                     GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN
        REWRITE_TAC[VECTOR_ARITH `u + x - u:real^N = x`];
        MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
        SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB;
                 CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN
        MATCH_MP_TAC(SET_RULE `s = t ==> s SUBSET t`) THEN
        REWRITE_TAC[VECTOR_ARITH `c % (x - u):real^N = c % x + --(c % u)`] THEN
        REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN
        REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN
        RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1;
                        GSYM DROP_EQ; DROP_VEC]) THEN
        ASM_REWRITE_TAC[INTERVAL_EQ_EMPTY_1; DROP_VEC; GSYM REAL_NOT_LE;
                        REAL_LE_INV_EQ; DROP_SUB; REAL_SUB_LE] THEN
        AP_TERM_TAC THEN REWRITE_TAC[CONS_11; PAIR_EQ] THEN
        REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_VEC; DROP_ADD; DROP_NEG] THEN
        REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD]]]);;

(* ------------------------------------------------------------------------- *)
(* Special case of straight-line paths.                                      *)
(* ------------------------------------------------------------------------- *)

let linepath = new_definition
 `linepath(a,b) = \x. (&1 - drop x) % a + drop x % b`;;

let LINEPATH_TRANSLATION = prove
 (`!a b c. linepath(a + b,a + c) = (\x. a + x) o linepath(b,c)`,
  REWRITE_TAC[linepath; o_THM; FUN_EQ_THM] THEN VECTOR_ARITH_TAC);;

add_translation_invariants [LINEPATH_TRANSLATION];;

let LINEPATH_LINEAR_IMAGE = prove
 (`!f. linear f ==> !b c. linepath(f b,f c) = f o linepath(b,c)`,
  REWRITE_TAC[linepath; o_THM; FUN_EQ_THM] THEN REPEAT STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP LINEAR_ADD) THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP LINEAR_CMUL) THEN
  ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);;

add_linear_invariants [LINEPATH_LINEAR_IMAGE];;

let PATHSTART_LINEPATH = prove
 (`!a b. pathstart(linepath(a,b)) = a`,
  REWRITE_TAC[linepath; pathstart; DROP_VEC] THEN VECTOR_ARITH_TAC);;

let PATHFINISH_LINEPATH = prove
 (`!a b. pathfinish(linepath(a,b)) = b`,
  REWRITE_TAC[linepath; pathfinish; DROP_VEC] THEN VECTOR_ARITH_TAC);;

let CONTINUOUS_LINEPATH_AT = prove
 (`!a b x. linepath(a,b) continuous (at x)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[linepath] THEN
  REWRITE_TAC[VECTOR_ARITH `(&1 - u) % x + y = x + u % --x + y`] THEN
  MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN
  MATCH_MP_TAC CONTINUOUS_ADD THEN CONJ_TAC THEN
  MATCH_MP_TAC CONTINUOUS_VMUL THEN
  REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_AT_ID]);;

let CONTINUOUS_ON_LINEPATH = prove
 (`!a b s. linepath(a,b) continuous_on s`,
  MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_LINEPATH_AT]);;

let PATH_LINEPATH = prove
 (`!a b. path(linepath(a,b))`,
  REWRITE_TAC[path; CONTINUOUS_ON_LINEPATH]);;

let PATH_IMAGE_LINEPATH = prove
 (`!a b. path_image(linepath (a,b)) = segment[a,b]`,
  REWRITE_TAC[segment; path_image; linepath] THEN
  REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; IN_INTERVAL] THEN
  SIMP_TAC[DIMINDEX_1; FORALL_1; VEC_COMPONENT; ARITH] THEN
  REWRITE_TAC[EXISTS_LIFT; GSYM drop; LIFT_DROP] THEN MESON_TAC[]);;

let REVERSEPATH_LINEPATH = prove
 (`!a b. reversepath(linepath(a,b)) = linepath(b,a)`,
  REWRITE_TAC[reversepath; linepath; DROP_SUB; DROP_VEC; FUN_EQ_THM] THEN
  VECTOR_ARITH_TAC);;

let ARC_LINEPATH = prove
 (`!a b. ~(a = b) ==> arc(linepath(a,b))`,
  REWRITE_TAC[arc; PATH_LINEPATH] THEN REWRITE_TAC[linepath] THEN
  REWRITE_TAC[VECTOR_ARITH
   `(&1 - x) % a + x % b:real^N = (&1 - y) % a + y % b <=>
    (x - y) % (a - b) = vec 0`] THEN
  SIMP_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; DROP_EQ; REAL_SUB_0]);;

let SIMPLE_PATH_LINEPATH = prove
 (`!a b. ~(a = b) ==> simple_path(linepath(a,b))`,
  MESON_TAC[ARC_IMP_SIMPLE_PATH; ARC_LINEPATH]);;

let SIMPLE_PATH_LINEPATH_EQ = prove
 (`!a b:real^N. simple_path(linepath(a,b)) <=> ~(a = b)`,
  REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[SIMPLE_PATH_LINEPATH] THEN
  ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[simple_path] THEN
  DISCH_THEN SUBST1_TAC THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN
  REWRITE_TAC[linepath; GSYM VECTOR_ADD_RDISTRIB] THEN
  DISCH_THEN(MP_TAC o SPECL [`lift(&0)`; `lift(&1 / &2)`]) THEN
  REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; GSYM DROP_EQ; DROP_VEC] THEN
  CONV_TAC REAL_RAT_REDUCE_CONV);;

let ARC_LINEPATH_EQ = prove
 (`!a b. arc(linepath(a,b)) <=> ~(a = b)`,
  REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[ARC_LINEPATH] THEN
  MESON_TAC[SIMPLE_PATH_LINEPATH_EQ; ARC_IMP_SIMPLE_PATH]);;

let LINEPATH_REFL = prove
 (`!a. linepath(a,a) = \x. a`,
  REWRITE_TAC[linepath; VECTOR_ARITH `(&1 - u) % x + u % x:real^N = x`]);;

let PATH_IMAGE_CONST = prove
 (`!a:real^N. path_image (\x. a) = {a}`,
  REWRITE_TAC[GSYM LINEPATH_REFL; PATH_IMAGE_LINEPATH] THEN
  REWRITE_TAC[SEGMENT_REFL]);;

let SHIFTPATH_TRIVIAL = prove
 (`!t a. shiftpath t (linepath(a,a)) = linepath(a,a)`,
  REWRITE_TAC[shiftpath; LINEPATH_REFL; COND_ID]);;

let SUBPATH_REFL = prove
 (`!g a. subpath a a g = linepath(g a,g a)`,
  REWRITE_TAC[subpath; linepath; VECTOR_SUB_REFL; DROP_VEC; VECTOR_MUL_LZERO;
              FUN_EQ_THM; VECTOR_ADD_RID] THEN
  VECTOR_ARITH_TAC);;

let SEGMENT_TO_FRONTIER = prove
 (`!s a b:real^N.
        a IN interior s /\ ~(b IN interior s)
        ==> ?c. c IN segment[a,b] /\ ~(c = a) /\ c IN frontier s /\
                segment(a,c) SUBSET interior s`,
  GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC(MESON[]
   `(!x. R x ==> Q x) /\ (?x. P x /\ R x /\ S x)
    ==> ?x. P x /\ Q x /\ R x /\ S x`) THEN
  CONJ_TAC THENL [ASM_MESON_TAC[frontier; IN_DIFF]; ALL_TAC] THEN
  MP_TAC(ISPECL [`linepath(vec 0:real^N,b)`; `interior s:real^N->bool`]
    SUBPATH_TO_FRONTIER) THEN
  ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
  REWRITE_TAC[PATH_IMAGE_LINEPATH; INTERIOR_INTERIOR] THEN
  REWRITE_TAC[subpath; linepath; VECTOR_ADD_LID; VECTOR_SUB_RZERO;
              VECTOR_MUL_RZERO; pathstart; pathfinish] THEN
  REWRITE_TAC[IN_INTERVAL_1; GSYM EXISTS_DROP; DROP_VEC] THEN
  REWRITE_TAC[DROP_CMUL; path_image; DROP_VEC; REAL_MUL_RID] THEN
  DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `u % b:real^N` THEN
  REWRITE_TAC[IN_SEGMENT; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN
  CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL
    [ASM_MESON_TAC[FRONTIER_INTERIOR_SUBSET; SUBSET]; ALL_TAC] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
   SUBSET_TRANS)) THEN
  ONCE_REWRITE_TAC[segment] THEN MATCH_MP_TAC(SET_RULE
   `s SUBSET t ==> s DIFF {a,b} SUBSET t DELETE b`) THEN
  REWRITE_TAC[segment; SUBSET; FORALL_IN_GSPEC] THEN
  X_GEN_TAC `v:real` THEN STRIP_TAC THEN
  REWRITE_TAC[IN_IMAGE; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN
  EXISTS_TAC `lift v` THEN REWRITE_TAC[IN_INTERVAL_1] THEN
  ASM_REWRITE_TAC[LIFT_DROP; DROP_VEC; VECTOR_MUL_ASSOC] THEN
  REWRITE_TAC[REAL_MUL_SYM]);;

(* ------------------------------------------------------------------------- *)
(* Bounding a point away from a path.                                        *)
(* ------------------------------------------------------------------------- *)

let NOT_ON_PATH_BALL = prove
 (`!g z:real^N.
        path g /\ ~(z IN path_image g)
        ==> ?e. &0 < e /\ ball(z,e) INTER (path_image g) = {}`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`path_image g:real^N->bool`; `z:real^N`]
     DISTANCE_ATTAINS_INF) THEN
  REWRITE_TAC[PATH_IMAGE_NONEMPTY] THEN
  ASM_SIMP_TAC[COMPACT_PATH_IMAGE; COMPACT_IMP_CLOSED] THEN
  DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `dist(z:real^N,a)` THEN
  CONJ_TAC THENL [ASM_MESON_TAC[DIST_POS_LT]; ALL_TAC] THEN
  REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_BALL; IN_INTER] THEN
  ASM_MESON_TAC[REAL_NOT_LE]);;

let NOT_ON_PATH_CBALL = prove
 (`!g z:real^N.
        path g /\ ~(z IN path_image g)
        ==> ?e. &0 < e /\ cball(z,e) INTER (path_image g) = {}`,
  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP NOT_ON_PATH_BALL) THEN
  DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
   `s INTER u = {} ==> t SUBSET s ==> t INTER u = {}`)) THEN
  REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN
  UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC);;

(* ------------------------------------------------------------------------- *)
(* Homeomorphisms of arc images.                                             *)
(* ------------------------------------------------------------------------- *)

let HOMEOMORPHISM_ARC = prove
 (`!g:real^1->real^N.
     arc g ==> ?h. homeomorphism (interval[vec 0,vec 1],path_image g) (g,h)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN
  ASM_REWRITE_TAC[path_image; COMPACT_INTERVAL; GSYM path; GSYM arc]);;

let HOMEOMORPHIC_ARC_IMAGE_INTERVAL = prove
 (`!g:real^1->real^N a b:real^1.
      arc g /\ drop a < drop b ==> (path_image g) homeomorphic interval[a,b]`,
  REPEAT STRIP_TAC THEN
  TRANS_TAC HOMEOMORPHIC_TRANS `interval[vec 0:real^1,vec 1]` THEN
  CONJ_TAC THENL
   [ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN
    EXISTS_TAC `g:real^1->real^N` THEN ASM_SIMP_TAC[HOMEOMORPHISM_ARC];
    MATCH_MP_TAC HOMEOMORPHIC_CLOSED_INTERVALS THEN
    ASM_REWRITE_TAC[INTERVAL_NE_EMPTY_1; DROP_VEC; REAL_LT_01]]);;

let HOMEOMORPHIC_ARC_IMAGES = prove
 (`!g:real^1->real^M h:real^1->real^N.
        arc g /\ arc h ==> (path_image g) homeomorphic (path_image h)`,
  REPEAT STRIP_TAC THEN
  TRANS_TAC HOMEOMORPHIC_TRANS `interval[vec 0:real^1,vec 1]` THEN
  CONJ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM]] THEN
  MATCH_MP_TAC HOMEOMORPHIC_ARC_IMAGE_INTERVAL THEN
  ASM_REWRITE_TAC[DROP_VEC; REAL_LT_01]);;

let HOMEOMORPHIC_ARC_IMAGE_SEGMENT = prove
 (`!g:real^1->real^N a b:real^M.
        arc g /\ ~(a = b) ==> (path_image g) homeomorphic segment[a,b]`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM PATH_IMAGE_LINEPATH] THEN
  MATCH_MP_TAC HOMEOMORPHIC_ARC_IMAGES THEN
  ASM_REWRITE_TAC[ARC_LINEPATH_EQ]);;

let HOMEOMORPHIC_ARC_IMAGE_SEGMENT_EQ = prove
 (`!s:real^N->bool a b:real^M.
        ~(a = b)
        ==> (s homeomorphic segment[a,b] <=>
             ?g. arc g /\ path_image g = s)`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [ALL_TAC; ASM_MESON_TAC[HOMEOMORPHIC_ARC_IMAGE_SEGMENT]] THEN
  REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`f:real^N->real^M`; `g:real^M->real^N`] THEN
  STRIP_TAC THEN EXISTS_TAC `(g:real^M->real^N) o linepath(a,b)` THEN
  ASM_REWRITE_TAC[PATH_IMAGE_COMPOSE; PATH_IMAGE_LINEPATH] THEN
  MATCH_MP_TAC ARC_CONTINUOUS_IMAGE THEN
  ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; ARC_LINEPATH_EQ] THEN ASM SET_TAC[]);;

let CONNECTED_SUBSET_PATH_IMAGE_ARC = prove
 (`!s g:real^1->real^N.
        arc g /\ connected s /\
        s SUBSET path_image g /\ pathstart g IN s /\ pathfinish g IN s
        ==> s = path_image g`,
  REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHISM_ARC) THEN
  REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `h:real^N->real^1` THEN STRIP_TAC THEN
  SUBGOAL_THEN
   `IMAGE (h:real^N->real^1) (path_image g) SUBSET IMAGE h s`
  MP_TAC THENL [ASM_REWRITE_TAC[]; ASM SET_TAC[]] THEN
  W(MP_TAC o PART_MATCH (lhand o rand) INTERVAL_SUBSET_IS_INTERVAL o snd) THEN
  ANTS_TAC THENL
   [REWRITE_TAC[IS_INTERVAL_CONNECTED_1] THEN
    MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
    ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
    REWRITE_TAC[UNIT_INTERVAL_NONEMPTY] THEN DISCH_THEN SUBST1_TAC] THEN
  SUBGOAL_THEN
   `vec 0 IN interval[vec 0:real^1,vec 1] /\
    vec 1 IN interval[vec 0:real^1,vec 1]`
  MP_TAC THENL [REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]; ALL_TAC] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish; path_image]) THEN
  ASM SET_TAC[]);;

let ARC_IMAGE_UNIQUE = prove
 (`!g h:real^1->real^N.
        path g /\ arc h /\ path_image g SUBSET path_image h /\
        {pathstart g,pathfinish g} = {pathstart h,pathfinish h}
        ==> path_image g = path_image h`,
  REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
   `{a,b} = {c,d} ==> a = c /\ b = d \/ a = d /\ b = c`)) THEN
  STRIP_TAC THENL
   [ALL_TAC; GEN_REWRITE_TAC RAND_CONV [GSYM PATH_IMAGE_REVERSEPATH]] THEN
  MATCH_MP_TAC CONNECTED_SUBSET_PATH_IMAGE_ARC THEN
  ASM_REWRITE_TAC[ARC_REVERSEPATH_EQ; PATH_IMAGE_REVERSEPATH] THEN
  REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH] THEN
  ASM_MESON_TAC[CONNECTED_PATH_IMAGE; ARC_IMP_PATH;
                PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]);;

let CONNECTED_SUBSET_ARC_PAIR = prove
 (`!g h s:real^N->bool.
        arc g /\ arc h /\
        pathstart g = pathstart h /\ pathfinish g = pathfinish h /\
        path_image g INTER path_image h = {pathstart g,pathfinish g} /\
        connected s /\
        s SUBSET path_image g UNION path_image h /\
        pathstart g IN s /\ pathfinish g IN s
        ==> path_image g SUBSET s \/ path_image h SUBSET s`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC(SET_RULE
   `((?x. x IN t /\ ~(x IN s)) /\ (?y. y IN u /\ ~(y IN s)) ==> F)
    ==> t SUBSET s \/ u SUBSET s`) THEN
  REWRITE_TAC[path_image; EXISTS_IN_IMAGE] THEN DISCH_THEN(CONJUNCTS_THEN2
   (X_CHOOSE_THEN `p:real^1` STRIP_ASSUME_TAC)
   (X_CHOOSE_THEN `q:real^1` STRIP_ASSUME_TAC)) THEN
  UNDISCH_TAC `connected(s:real^N->bool)` THEN
  REWRITE_TAC[CONNECTED_OPEN_IN] THEN
  MAP_EVERY EXISTS_TAC
   [`s DIFF (path_image (subpath p (vec 1) g) UNION
             path_image (subpath q (vec 1) h)):real^N->bool`;
    `s DIFF (path_image (subpath (vec 0) p g) UNION
             path_image (subpath (vec 0) q h)):real^N->bool`] THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC OPEN_IN_DIFF_CLOSED THEN REWRITE_TAC[OPEN_IN_REFL] THEN
    MATCH_MP_TAC CLOSED_UNION THEN CONJ_TAC THEN
    MATCH_MP_TAC CLOSED_PATH_IMAGE THEN MATCH_MP_TAC PATH_SUBPATH THEN
    ASM_SIMP_TAC[ARC_IMP_PATH; ENDS_IN_UNIT_INTERVAL];
    MATCH_MP_TAC OPEN_IN_DIFF_CLOSED THEN REWRITE_TAC[OPEN_IN_REFL] THEN
    MATCH_MP_TAC CLOSED_UNION THEN CONJ_TAC THEN
    MATCH_MP_TAC CLOSED_PATH_IMAGE THEN MATCH_MP_TAC PATH_SUBPATH THEN
    ASM_SIMP_TAC[ARC_IMP_PATH; ENDS_IN_UNIT_INTERVAL];
    REWRITE_TAC[SUBSET; IN_UNION; IN_DIFF] THEN
    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
    ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; GSYM DE_MORGAN_THM] THEN
    DISCH_THEN(REPEAT_TCL STRIP_THM_THEN MP_TAC) THEN
    REWRITE_TAC[IN_IMAGE; LEFT_IMP_EXISTS_THM; NOT_EXISTS_THM] THEN
    X_GEN_TAC `a:real^1` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
    X_GEN_TAC `b:real^1` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THENL
     [UNDISCH_TAC `arc(g:real^1->real^N)` THEN REWRITE_TAC[arc] THEN
      DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `b:real^1`] o CONJUNCT2) THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
      ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
      ASM_CASES_TAC `a:real^1 = p` THENL [ASM SET_TAC[]; ALL_TAC] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[GSYM DROP_EQ]) THEN
      REWRITE_TAC[GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC;
      RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN
      FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
       `IMAGE f s INTER IMAGE g s = a
        ==> !x y. x IN s /\ y IN s /\ f x = g y ==> f(x) IN a`)) THEN
      DISCH_THEN(MP_TAC o SPECL [`b:real^1`; `a:real^1`]) THEN
      ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
       [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
        ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC;
        REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM]] THEN
      REPEAT STRIP_TAC THENL
       [UNDISCH_TAC `arc(g:real^1->real^N)` THEN REWRITE_TAC[arc] THEN
        DISCH_THEN(MP_TAC o SPECL [`b:real^1`; `vec 0:real^1`] o CONJUNCT2);
        UNDISCH_TAC `arc(h:real^1->real^N)` THEN REWRITE_TAC[arc] THEN
        DISCH_THEN(MP_TAC o SPECL
         [`a:real^1`; `vec 1:real^1`] o CONJUNCT2)];
      RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN
      FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
       `IMAGE f s INTER IMAGE g s = a
        ==> !x y. x IN s /\ y IN s /\ f x = g y ==> f(x) IN a`)) THEN
      DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `b:real^1`]) THEN
      ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
       [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
        ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC;
        REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM]] THEN
      REPEAT STRIP_TAC THENL
       [UNDISCH_TAC `arc(h:real^1->real^N)` THEN REWRITE_TAC[arc] THEN
        DISCH_THEN(MP_TAC o SPECL [`b:real^1`; `vec 0:real^1`] o CONJUNCT2);
        UNDISCH_TAC `arc(g:real^1->real^N)` THEN REWRITE_TAC[arc] THEN
        DISCH_THEN(MP_TAC o SPECL
         [`a:real^1`; `vec 1:real^1`] o CONJUNCT2)];
      UNDISCH_TAC `arc(h:real^1->real^N)` THEN REWRITE_TAC[arc] THEN
      DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `b:real^1`] o CONJUNCT2) THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
      ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
      ASM_CASES_TAC `a:real^1 = q` THENL [ASM SET_TAC[]; ALL_TAC] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[GSYM DROP_EQ]) THEN
      REWRITE_TAC[GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC];
    MP_TAC(ISPECL [`g:real^1->real^N`; `p:real^1`]
        PATH_IMAGE_SUBPATH_COMBINE) THEN
    MP_TAC(ISPECL [`h:real^1->real^N`; `q:real^1`]
        PATH_IMAGE_SUBPATH_COMBINE) THEN
    ASM_SIMP_TAC[ARC_IMP_PATH] THEN ASM SET_TAC[];
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
    EXISTS_TAC `pathstart g:real^N` THEN
    ASM_REWRITE_TAC[IN_DIFF; IN_UNION; DE_MORGAN_THM] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
    ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; ARC_IMP_PATH] THEN
    CONJ_TAC THENL
     [UNDISCH_TAC `arc(g:real^1->real^N)`;
      UNDISCH_TAC `arc(h:real^1->real^N)`] THEN
    REWRITE_TAC[arc; path_image; IN_IMAGE; NOT_EXISTS_THM] THEN
    DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC MONO_FORALL THEN
    X_GEN_TAC `a:real^1` THEN
    DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC(SPEC `vec 0:real^1` th)) THEN
    ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; NOT_IMP];
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
    EXISTS_TAC `pathfinish g:real^N` THEN
    ASM_REWRITE_TAC[IN_DIFF; IN_UNION; DE_MORGAN_THM] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
    ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; ARC_IMP_PATH] THEN
    CONJ_TAC THENL
     [UNDISCH_TAC `arc(g:real^1->real^N)`;
      UNDISCH_TAC `arc(h:real^1->real^N)`] THEN
    REWRITE_TAC[arc; path_image; IN_IMAGE; NOT_EXISTS_THM] THEN
    DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC MONO_FORALL THEN
    X_GEN_TAC `a:real^1` THEN
    DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC(SPEC `vec 1:real^1` th)) THEN
    ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; NOT_IMP]] THEN
  (REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; NOT_IMP] THEN REPEAT CONJ_TAC THENL
      [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
       ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC;
       ASM_MESON_TAC[pathstart; pathfinish];
       DISCH_THEN SUBST_ALL_TAC THEN
       RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
       ASM_MESON_TAC[REAL_LE_ANTISYM; LIFT_EQ; LIFT_NUM; LIFT_DROP;
                     pathstart; pathfinish]]));;

let HOMEOMORPHIC_SIMPLE_PATH_IMAGES = prove
 (`!g:real^1->real^M h:real^1->real^N.
        simple_path g /\ pathfinish g = pathstart g /\
        simple_path h /\ pathfinish h = pathstart h
        ==> (path_image g) homeomorphic (path_image h)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL
   [`g:real^1->real^M`; `h:real^1->real^N`; `interval[vec 0:real^1,vec 1]`;
    `path_image g:real^M->bool`; `path_image h:real^N->bool`]
   LIFT_TO_QUOTIENT_SPACE_UNIQUE) THEN
  REWRITE_TAC[path_image; CONJ_ASSOC] THEN DISCH_THEN MATCH_MP_TAC THEN
  CONJ_TAC THENL
   [CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_IMP_QUOTIENT_MAP_EXPLICIT THEN
    ASM_SIMP_TAC[GSYM path; COMPACT_INTERVAL; SIMPLE_PATH_IMP_PATH];
    RULE_ASSUM_TAC(REWRITE_RULE[simple_path; pathstart; pathfinish]) THEN
    MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL
      [`x:real^1`; `y:real^1`] o CONJUNCT2)) THEN
    ASM_MESON_TAC[]]);;

let HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE_EQ = prove
 (`!s:real^N->bool a:real^2 r.
        &0 < r
        ==> (s homeomorphic sphere(a,r) <=>
             ?g. simple_path g /\ pathfinish g = pathstart g /\
                 path_image g = s)`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `?p. simple_path p /\ pathfinish p = pathstart p /\
        (path_image p:real^2->bool) homeomorphic(sphere(a:real^2,r))`
  STRIP_ASSUME_TAC THENL
   [EXISTS_TAC
     `linepath(vec 0:real^2,basis 1) ++ linepath(basis 1,basis 2) ++
      linepath(basis 2,vec 0)` THEN
    SUBGOAL_THEN
     `~(basis 2:real^2 = basis 1) /\
      ~(basis 1:real^2 = vec 0) /\
      ~(basis 2:real^2 = vec 0)`
    STRIP_ASSUME_TAC THENL
     [SIMP_TAC[BASIS_INJ_EQ; BASIS_NONZERO; DIMINDEX_2; ARITH]; ALL_TAC] THEN
    SUBGOAL_THEN `~affine_dependent {vec 0:real^2,basis 1,basis 2}`
    ASSUME_TAC THENL
     [MATCH_MP_TAC INDEPENDENT_IMP_AFFINE_DEPENDENT_0 THEN
      ASM_REWRITE_TAC[independent; DEPENDENT_2] THEN STRIP_TAC THEN
      FIRST_X_ASSUM(fun th ->
       MP_TAC(AP_TERM `\x:real^2. x$1` th) THEN
       MP_TAC(AP_TERM `\x:real^2. x$2` th)) THEN
      REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
      SIMP_TAC[BASIS_COMPONENT; VEC_COMPONENT; DIMINDEX_2; ARITH] THEN
      ASM_REAL_ARITH_TAC;
      ALL_TAC] THEN
    SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; ARC_JOIN_EQ;
             PATHSTART_JOIN; PATHFINISH_JOIN; PATH_IMAGE_JOIN;
             PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
    ASM_REWRITE_TAC[ARC_LINEPATH_EQ; PATH_IMAGE_LINEPATH] THEN
    REWRITE_TAC[UNION_OVER_INTER; UNION_SUBSET; CONJ_ASSOC] THEN
    CONJ_TAC THENL
     [GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SEGMENT_SYM] THEN
      REPEAT CONJ_TAC THEN
      W(MP_TAC o PART_MATCH (lhand o rand) INTER_SEGMENT o lhand o snd) THEN
      (ANTS_TAC THENL [DISJ2_TAC; SET_TAC[]]) THEN
      ASM_REWRITE_TAC[COLLINEAR_3_EQ_AFFINE_DEPENDENT] THEN
      ASM_MESON_TAC[INSERT_AC];
      TRANS_TAC HOMEOMORPHIC_TRANS
       `relative_frontier(convex hull {vec 0:real^2,basis 1,basis 2})` THEN
      CONJ_TAC THENL
       [MATCH_MP_TAC(MESON[HOMEOMORPHIC_REFL]
         `s = t ==> s homeomorphic t`) THEN
        ASM_SIMP_TAC[RELATIVE_FRONTIER_OF_CONVEX_HULL] THEN
        REWRITE_TAC[SET_RULE `{f x | x IN {a,b,c}} = {f a,f b,f c}`] THEN
        ASM_REWRITE_TAC[DELETE_INSERT; GSYM SEGMENT_CONVEX_HULL;
                        EMPTY_DELETE; SEGMENT_SYM] THEN SET_TAC[];
        MP_TAC(ISPECL [`convex hull {vec 0:real^2,basis 1,basis 2}`;
                        `cball(a:real^2,r)`]
          HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS) THEN
        ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; CONVEX_CONVEX_HULL] THEN
        ASM_REWRITE_TAC[CONVEX_CONVEX_HULL; BOUNDED_CONVEX_HULL_EQ] THEN
        REWRITE_TAC[AFF_DIM_CONVEX_HULL; BOUNDED_INSERT; BOUNDED_EMPTY] THEN
        ASM_SIMP_TAC[RELATIVE_FRONTIER_CBALL; REAL_LT_IMP_NZ] THEN
        DISCH_THEN MATCH_MP_TAC THEN
        ASM_REWRITE_TAC[AFF_DIM_CBALL; DIMINDEX_2] THEN
        ASM_SIMP_TAC[AFF_DIM_AFFINE_INDEPENDENT] THEN
        SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN
        ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH] THEN
        CONV_TAC INT_REDUCE_CONV]];
    TRANS_TAC EQ_TRANS
     `(s:real^N->bool) homeomorphic (path_image p:real^2->bool)` THEN
    CONJ_TAC THENL
     [EQ_TAC THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMEOMORPHIC_TRANS) THEN
      ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
      ASM_REWRITE_TAC[];
      ALL_TAC] THEN
    EQ_TAC THENL
     [REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN
      MAP_EVERY X_GEN_TAC [`g:real^N->real^2`; `f:real^2->real^N`] THEN
      STRIP_TAC THEN
      EXISTS_TAC `(f:real^2->real^N) o (p:real^1->real^2)` THEN
      REWRITE_TAC[PATHFINISH_COMPOSE; PATHSTART_COMPOSE] THEN
      ASM_REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN
      MATCH_MP_TAC SIMPLE_PATH_CONTINUOUS_IMAGE THEN
      ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
      DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N`
        (STRIP_ASSUME_TAC o GSYM)) THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMEOMORPHIC_SIMPLE_PATH_IMAGES THEN
      ASM_REWRITE_TAC[]]]);;

let HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE = prove
 (`!g:real^1->real^N a:real^2 r.
        simple_path g /\ pathfinish g = pathstart g /\ &0 < r
        ==> (path_image g) homeomorphic sphere(a,r)`,
  MESON_TAC[HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE_EQ]);;

(* ------------------------------------------------------------------------- *)
(* Path component, considered as a "joinability" relation (from Tom Hales).  *)
(* ------------------------------------------------------------------------- *)

let path_component = new_definition
 `path_component s x y <=>
        ?g. path g /\ path_image g SUBSET s /\
            pathstart g = x /\ pathfinish g = y`;;

let path_components = new_definition
 `path_components s = {path_component s x | x | x IN s}`;;

let PATH_COMPONENT_OF_EUCLIDEAN = prove
 (`!s:real^N->bool.
        path_component_of (subtopology euclidean s) = path_component s`,
  REWRITE_TAC[FUN_EQ_THM; path_component; path_component_of] THEN
  REWRITE_TAC[PATH_IN_EUCLIDEAN; pathstart; pathfinish; GSYM DROP_VEC] THEN
  REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[o_THM]; ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `(g:real^1->real^N) o lift` THEN
  ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]);;

let PATH_COMPONENTS_OF_EUCLIDEAN = prove
 (`!s:real^N->bool.
        path_components_of (subtopology euclidean s) = path_components s`,
  REWRITE_TAC[path_components_of; path_components] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; PATH_COMPONENT_OF_EUCLIDEAN]);;

let PATH_COMPONENT_IN = prove
 (`!s x y. path_component s x y ==> x IN s /\ y IN s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM PATH_COMPONENT_OF_EUCLIDEAN] THEN
  DISCH_THEN(MP_TAC o MATCH_MP PATH_COMPONENT_IN_TOPSPACE) THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]);;

let PATH_COMPONENT_REFL_EQ = prove
 (`!s x:real^N. path_component s x x <=> x IN s`,
  REWRITE_TAC[GSYM PATH_COMPONENT_OF_EUCLIDEAN; PATH_COMPONENT_OF_REFL] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]);;

let PATH_COMPONENT_REFL = prove
 (`!s x:real^N. x IN s ==> path_component s x x`,
  REWRITE_TAC[PATH_COMPONENT_REFL_EQ]);;

let PATH_COMPONENT_SYM_EQ = prove
 (`!s x y. path_component s x y <=> path_component s y x`,
  REWRITE_TAC[GSYM PATH_COMPONENT_OF_EUCLIDEAN] THEN
  MATCH_ACCEPT_TAC PATH_COMPONENT_OF_SYM);;

let PATH_COMPONENT_SYM = prove
 (`!s x y:real^N. path_component s x y ==> path_component s y x`,
  MESON_TAC[PATH_COMPONENT_SYM_EQ]);;

let PATH_COMPONENT_TRANS = prove
 (`!s x y:real^N.
      path_component s x y /\ path_component s y z ==> path_component s x z`,
  REWRITE_TAC[GSYM PATH_COMPONENT_OF_EUCLIDEAN; PATH_COMPONENT_OF_TRANS]);;

let PATH_COMPONENT_OF_SUBSET = prove
 (`!s t x. s SUBSET t /\ path_component s x y ==> path_component t x y`,
  REWRITE_TAC[path_component] THEN SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Can also consider it as a set, as the name suggests.                      *)
(* ------------------------------------------------------------------------- *)

let PATH_COMPONENT_SET = prove
 (`!s x. path_component s x =
            { y | ?g. path g /\ path_image g SUBSET s /\
                      pathstart g = x /\ pathfinish g = y }`,
  REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REWRITE_TAC[IN; path_component]);;

let PATH_COMPONENT_SUBSET = prove
 (`!s x. (path_component s x) SUBSET s`,
  REWRITE_TAC[SUBSET; IN] THEN MESON_TAC[PATH_COMPONENT_IN; IN]);;

let PATH_COMPONENT_EQ_EMPTY = prove
 (`!s x. path_component s x = {} <=> ~(x IN s)`,
  REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN
  MESON_TAC[IN; PATH_COMPONENT_REFL; PATH_COMPONENT_IN]);;

let PATH_COMPONENT_EMPTY = prove
 (`!x. path_component {} x = {}`,
  REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY; NOT_IN_EMPTY]);;

let UNIONS_PATH_COMPONENT = prove
 (`!s:real^N->bool. UNIONS {path_component s x |x| x IN s} = s`,
  GEN_TAC THEN
  GEN_REWRITE_TAC RAND_CONV [GSYM TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  REWRITE_TAC[GSYM UNIONS_PATH_COMPONENTS_OF] THEN
  REWRITE_TAC[path_components_of; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  REWRITE_TAC[PATH_COMPONENT_OF_EUCLIDEAN]);;

let PATH_COMPONENT_TRANSLATION = prove
 (`!a s x. path_component (IMAGE (\x. a + x) s) (a + x) =
                IMAGE (\x. a + x) (path_component s x)`,
  REWRITE_TAC[PATH_COMPONENT_SET] THEN GEOM_TRANSLATE_TAC[]);;

add_translation_invariants [PATH_COMPONENT_TRANSLATION];;

let PATH_COMPONENT_LINEAR_IMAGE = prove
 (`!f s x. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
           ==> path_component (IMAGE f s) (f x) =
               IMAGE f (path_component s x)`,
  REWRITE_TAC[PATH_COMPONENT_SET] THEN
  GEOM_TRANSFORM_TAC[]);;

add_linear_invariants [PATH_COMPONENT_LINEAR_IMAGE];;

(* ------------------------------------------------------------------------- *)
(* Path connectedness of a space.                                            *)
(* ------------------------------------------------------------------------- *)

let path_connected = new_definition
 `path_connected s <=>
        !x y. x IN s /\ y IN s
              ==> ?g. path g /\ (path_image g) SUBSET s /\
                      pathstart g = x /\ pathfinish g = y`;;

let PATH_CONNECTED_IFF_PATH_COMPONENT = prove
 (`!s. path_connected s <=> !x y. x IN s /\ y IN s ==> path_component s x y`,
  REWRITE_TAC[path_connected; path_component]);;

let PATH_CONNECTED_IN_EUCLIDEAN = prove
 (`!s:real^N->bool. path_connected_in euclidean s <=> path_connected s`,
  REWRITE_TAC[path_connected_in; PATH_CONNECTED_SPACE_IFF_PATH_COMPONENT] THEN
  REWRITE_TAC[PATH_COMPONENT_OF_EUCLIDEAN; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  REWRITE_TAC[GSYM PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV]);;

let PATH_CONNECTED_SPACE_EUCLIDEAN_SUBTOPOLOGY = prove
 (`!s:real^N->bool.
       path_connected_space(subtopology euclidean s) <=> path_connected s`,
  REWRITE_TAC[GSYM PATH_CONNECTED_IN_TOPSPACE] THEN
  REWRITE_TAC[PATH_CONNECTED_IN_SUBTOPOLOGY] THEN
  REWRITE_TAC[PATH_CONNECTED_IN_EUCLIDEAN] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_REFL]);;

let PATH_CONNECTED_IMP_PATH_COMPONENT = prove
 (`!s a b:real^N.
     path_connected s /\ a IN s /\ b IN s ==> path_component s a b`,
  MESON_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT]);;

let PATH_CONNECTED_COMPONENT_SET = prove
 (`!s. path_connected s <=> !x. x IN s ==> path_component s x = s`,
  REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT; GSYM SUBSET_ANTISYM_EQ] THEN
  REWRITE_TAC[PATH_COMPONENT_SUBSET] THEN SET_TAC[]);;

let PATH_COMPONENT_MONO = prove
 (`!s t x. s SUBSET t ==> (path_component s x) SUBSET (path_component t x)`,
  REWRITE_TAC[PATH_COMPONENT_SET] THEN SET_TAC[]);;

let PATH_COMPONENT_MAXIMAL = prove
 (`!s t x. x IN t /\ path_connected t /\ t SUBSET s
           ==> t SUBSET (path_component s x)`,
  REWRITE_TAC[path_connected; PATH_COMPONENT_SET; SUBSET; IN_ELIM_THM] THEN
  MESON_TAC[]);;

let PATH_COMPONENT_EQ = prove
 (`!s x y. y IN path_component s x
           ==> path_component s y = path_component s x`,
  REWRITE_TAC[EXTENSION; IN] THEN
  MESON_TAC[PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS]);;

let PATH_CONNECTED_PATH_IMAGE = prove
 (`!p:real^1->real^N. path p ==> path_connected(path_image p)`,
  GEN_TAC THEN REWRITE_TAC[PATH_PATH_IN] THEN
  DISCH_THEN(MP_TAC o MATCH_MP PATH_CONNECTED_IN_PATH_IMAGE) THEN
  REWRITE_TAC[IMAGE_o; IMAGE_LIFT_REAL_INTERVAL; LIFT_NUM] THEN
  REWRITE_TAC[PATH_CONNECTED_IN_EUCLIDEAN; path_image]);;

let PATH_COMPONENT_PATH_IMAGE_PATHSTART = prove
 (`!p x:real^N.
        path p /\ x IN path_image p
        ==> path_component (path_image p) (pathstart p) x`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP PATH_CONNECTED_PATH_IMAGE) THEN
  REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
  DISCH_THEN MATCH_MP_TAC THEN
  ASM_SIMP_TAC[PATHSTART_IN_PATH_IMAGE]);;

let PATH_CONNECTED_PATH_COMPONENT = prove
 (`!s x:real^N. path_connected(path_component s x)`,
  REPEAT GEN_TAC THEN
  MP_TAC(ISPECL [`subtopology euclidean (s:real^N->bool)`; `x:real^N`]
        PATH_CONNECTED_IN_PATH_COMPONENT_OF) THEN
  REWRITE_TAC[PATH_CONNECTED_IN_SUBTOPOLOGY; PATH_CONNECTED_IN_EUCLIDEAN] THEN
  SIMP_TAC[PATH_COMPONENT_OF_EUCLIDEAN]);;

let PATH_COMPONENT = prove
 (`!s x y:real^N.
        path_component s x y <=>
        ?t. path_connected t /\ t SUBSET s /\ x IN t /\ y IN t`,
  REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL
   [EXISTS_TAC `path_component s (x:real^N)` THEN
    REWRITE_TAC[PATH_CONNECTED_PATH_COMPONENT; PATH_COMPONENT_SUBSET] THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP PATH_COMPONENT_IN) THEN
    ASM_SIMP_TAC[IN; PATH_COMPONENT_REFL_EQ];
    REWRITE_TAC[path_component] THEN ASM_MESON_TAC[path_connected; SUBSET]]);;

let PATH_COMPONENT_PATH_COMPONENT = prove
 (`!s x:real^N.
        path_component (path_component s x) x = path_component s x`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `(x:real^N) IN s` THENL
   [MATCH_MP_TAC SUBSET_ANTISYM THEN
    SIMP_TAC[PATH_COMPONENT_MONO; PATH_COMPONENT_SUBSET] THEN
    MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN
    REWRITE_TAC[SUBSET_REFL; PATH_CONNECTED_PATH_COMPONENT] THEN
    ASM_REWRITE_TAC[IN; PATH_COMPONENT_REFL_EQ];
    MATCH_MP_TAC(SET_RULE `s = {} /\ t = {} ==> s = t`) THEN
    ASM_REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY] THEN
    ASM_MESON_TAC[SUBSET; PATH_COMPONENT_SUBSET]]);;

let PATH_CONNECTED_LINEPATH = prove
 (`!s a b:real^N. segment[a,b] SUBSET s ==> path_component s a b`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[path_component] THEN
  EXISTS_TAC `linepath(a:real^N,b)` THEN
  ASM_REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_LINEPATH] THEN
  ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH]);;

let PATH_COMPONENT_DISJOINT = prove
 (`!s a b. DISJOINT (path_component s a) (path_component s b) <=>
             ~(a IN path_component s b)`,
  REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN
  REWRITE_TAC[IN] THEN MESON_TAC[PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS]);;

let PATH_COMPONENT_EQ_EQ = prove
 (`!s x y:real^N.
        path_component s x = path_component s y <=>
        ~(x IN s) /\ ~(y IN s) \/
        x IN s /\ y IN s /\ path_component s x y`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `(y:real^N) IN s` THENL
   [ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THENL
     [REWRITE_TAC[FUN_EQ_THM] THEN
      ASM_MESON_TAC[PATH_COMPONENT_TRANS; PATH_COMPONENT_REFL;
                    PATH_COMPONENT_SYM];
      ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY]];
    RULE_ASSUM_TAC(REWRITE_RULE[GSYM PATH_COMPONENT_EQ_EMPTY]) THEN
    ASM_REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY] THEN
    ONCE_REWRITE_TAC[PATH_COMPONENT_SYM_EQ] THEN
    ASM_REWRITE_TAC[EMPTY] THEN ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY]]);;

let PATH_COMPONENT_UNIQUE = prove
 (`!s c x:real^N.
        x IN c /\ c SUBSET s /\ path_connected c /\
        (!c'. x IN c' /\ c' SUBSET s /\ path_connected c'
              ==> c' SUBSET c)
        ==> path_component s x = c`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
   [FIRST_X_ASSUM MATCH_MP_TAC THEN
    REWRITE_TAC[PATH_COMPONENT_SUBSET; PATH_CONNECTED_PATH_COMPONENT] THEN
    REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[PATH_COMPONENT_REFL_EQ] THEN
    ASM SET_TAC[];
    MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[]]);;

let PATH_COMPONENT_INTERMEDIATE_SUBSET = prove
 (`!t u a:real^N.
        path_component u a SUBSET t /\ t SUBSET u
        ==> path_component t a = path_component u a`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN u` THENL
   [REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_COMPONENT_UNIQUE THEN
    ASM_REWRITE_TAC[PATH_CONNECTED_PATH_COMPONENT] THEN
    CONJ_TAC THENL [ASM_MESON_TAC[PATH_COMPONENT_REFL; IN]; ALL_TAC] THEN
    REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN
    ASM SET_TAC[];
    ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY; SUBSET]]);;

let COMPLEMENT_PATH_COMPONENT_UNIONS = prove
 (`!s x:real^N.
     s DIFF path_component s x =
     UNIONS({path_component s y | y | y IN s} DELETE (path_component s x))`,
  REPEAT GEN_TAC THEN
  GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM UNIONS_PATH_COMPONENT] THEN
  MATCH_MP_TAC(SET_RULE
   `(!x. x IN s DELETE a ==> DISJOINT a x)
     ==> UNIONS s DIFF a = UNIONS (s DELETE a)`) THEN
  REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC; IN_DELETE] THEN
  SIMP_TAC[PATH_COMPONENT_DISJOINT; PATH_COMPONENT_EQ_EQ] THEN
  MESON_TAC[IN; SUBSET; PATH_COMPONENT_SUBSET]);;

(* ------------------------------------------------------------------------- *)
(* General "locally connected implies connected" type results.               *)
(* ------------------------------------------------------------------------- *)

let OPEN_GENERAL_COMPONENT = prove
 (`!c. (!s x y. c s x y ==> x IN s /\ y IN s) /\
       (!s x y. c s x y ==> c s y x) /\
       (!s x y z. c s x y /\ c s y z ==> c s x z) /\
       (!s t x y. s SUBSET t /\ c s x y ==> c t x y) /\
       (!s x y e. y IN ball(x,e) /\ ball(x,e) SUBSET s
                  ==> c (ball(x,e)) x y)
       ==> !s x:real^N. open s ==> open(c s x)`,
  GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "IN") MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SYM") MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "TRANS") MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SUBSET") (LABEL_TAC "BALL")) THEN
  REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL; SUBSET; IN_BALL] THEN
  DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN
  REWRITE_TAC[SUBSET; IN] THEN STRIP_TAC THEN
  SUBGOAL_THEN `(x:real^N) IN s /\ y IN s` STRIP_ASSUME_TAC THENL
   [ASM_MESON_TAC[]; ALL_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(y:real^N) IN s`)) THEN
  MATCH_MP_TAC MONO_EXISTS THEN
  X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN
  REMOVE_THEN "TRANS" MATCH_MP_TAC THEN EXISTS_TAC `y:real^N` THEN
  ASM_REWRITE_TAC[] THEN REMOVE_THEN "SUBSET" MATCH_MP_TAC THEN
  EXISTS_TAC `ball(y:real^N,e)` THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN
  REMOVE_THEN "BALL" MATCH_MP_TAC THEN
  REWRITE_TAC[SUBSET; IN_BALL] THEN ASM_MESON_TAC[]);;

let OPEN_NON_GENERAL_COMPONENT = prove
 (`!c. (!s x y. c s x y ==> x IN s /\ y IN s) /\
       (!s x y. c s x y ==> c s y x) /\
       (!s x y z. c s x y /\ c s y z ==> c s x z) /\
       (!s t x y. s SUBSET t /\ c s x y ==> c t x y) /\
       (!s x y e. y IN ball(x,e) /\ ball(x,e) SUBSET s
                  ==> c (ball(x,e)) x y)
       ==> !s x:real^N. open s ==> open(s DIFF c s x)`,
  GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "IN") MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SYM") MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "TRANS") MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SUBSET") (LABEL_TAC "BALL")) THEN
  REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL; SUBSET; IN_BALL] THEN
  DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_DIFF] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o REWRITE_RULE[IN])) THEN
  FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(y:real^N) IN s`)) THEN
  MATCH_MP_TAC MONO_EXISTS THEN
  X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN ASM_SIMP_TAC[] THEN
  REWRITE_TAC[IN] THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN REWRITE_TAC[] THEN
  REMOVE_THEN "TRANS" MATCH_MP_TAC THEN EXISTS_TAC `z:real^N` THEN
  ASM_REWRITE_TAC[] THEN REMOVE_THEN "SUBSET" MATCH_MP_TAC THEN
  EXISTS_TAC `ball(y:real^N,e)` THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN
  REMOVE_THEN "SYM" MATCH_MP_TAC THEN
  REMOVE_THEN "BALL" MATCH_MP_TAC THEN
  REWRITE_TAC[SUBSET; IN_BALL] THEN ASM_MESON_TAC[]);;

let GENERAL_CONNECTED_OPEN = prove
 (`!c. (!s x y. c s x y ==> x IN s /\ y IN s) /\
       (!s x y. c s x y ==> c s y x) /\
       (!s x y z. c s x y /\ c s y z ==> c s x z) /\
       (!s t x y. s SUBSET t /\ c s x y ==> c t x y) /\
       (!s x y e. y IN ball(x,e) /\ ball(x,e) SUBSET s
                  ==> c (ball(x,e)) x y)
       ==> !s x y:real^N. open s /\ connected s /\ x IN s /\ y IN s
                          ==> c s x y`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [connected]) THEN
  REWRITE_TAC[IN] THEN REWRITE_TAC[NOT_EXISTS_THM; LEFT_IMP_FORALL_THM] THEN
  MAP_EVERY EXISTS_TAC
   [`c (s:real^N->bool) (x:real^N):real^N->bool`;
    `s DIFF (c (s:real^N->bool) (x:real^N))`] THEN
  MATCH_MP_TAC(TAUT `a /\ b /\ c /\ d /\ e /\ (f ==> g)
                     ==> ~(a /\ b /\ c /\ d /\ e /\ ~f) ==> g`) THEN
  REPEAT CONJ_TAC THENL
   [MP_TAC(SPEC `c:(real^N->bool)->real^N->real^N->bool`
        OPEN_GENERAL_COMPONENT) THEN ASM_MESON_TAC[];
    MP_TAC(SPEC `c:(real^N->bool)->real^N->real^N->bool`
        OPEN_NON_GENERAL_COMPONENT) THEN ASM_MESON_TAC[];
    SET_TAC[];
    SET_TAC[];
    ALL_TAC;
    ASM SET_TAC[]] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN
  DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^N` THEN
  ASM_REWRITE_TAC[IN_INTER] THEN REWRITE_TAC[IN] THEN
  FIRST_ASSUM(MATCH_MP_TAC o
    SPECL [`ball(x:real^N,e)`; `s:real^N->bool`]) THEN
  ASM_MESON_TAC[CENTRE_IN_BALL]);;

(* ------------------------------------------------------------------------- *)
(* Some useful lemmas about path-connectedness.                              *)
(* ------------------------------------------------------------------------- *)

let CONVEX_IMP_PATH_CONNECTED = prove
 (`!s:real^N->bool. convex s ==> path_connected s`,
  REWRITE_TAC[CONVEX_ALT; path_connected] THEN REPEAT GEN_TAC THEN
  DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
  STRIP_TAC THEN EXISTS_TAC `\u. (&1 - drop u) % x + drop u % y:real^N` THEN
  ASM_SIMP_TAC[pathstart; pathfinish; DROP_VEC; path; path_image;
               SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; GSYM FORALL_DROP] THEN
  CONJ_TAC THENL [ALL_TAC; CONJ_TAC THEN VECTOR_ARITH_TAC] THEN
  MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
  MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN
  REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP; LIFT_NUM] THEN
  SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);;

let PATH_CONNECTED_UNIV = prove
 (`path_connected(:real^N)`,
  SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; CONVEX_UNIV]);;

let IS_INTERVAL_PATH_CONNECTED = prove
 (`!s. is_interval s ==> path_connected s`,
  SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; IS_INTERVAL_CONVEX]);;

let PATH_CONNECTED_INTERVAL = prove
 (`(!a b:real^N. path_connected(interval[a,b])) /\
   (!a b:real^N. path_connected(interval(a,b)))`,
  SIMP_TAC[IS_INTERVAL_PATH_CONNECTED; IS_INTERVAL_INTERVAL]);;

let PATH_COMPONENT_UNIV = prove
 (`!x. path_component(:real^N) x = (:real^N)`,
  MESON_TAC[PATH_CONNECTED_COMPONENT_SET; PATH_CONNECTED_UNIV; IN_UNIV]);;

let PATH_CONNECTED_IMP_CONNECTED = prove
 (`!s:real^N->bool. path_connected s ==> connected s`,
  GEN_TAC THEN
  REWRITE_TAC[path_connected; CONNECTED_IFF_CONNECTED_COMPONENT] THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^N` THEN
  DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
  REWRITE_TAC[connected_component] THEN
  EXISTS_TAC `path_image(g:real^1->real^N)` THEN
  ASM_MESON_TAC[CONNECTED_PATH_IMAGE; PATHSTART_IN_PATH_IMAGE;
                PATHFINISH_IN_PATH_IMAGE]);;

let OPEN_PATH_COMPONENT = prove
 (`!s x:real^N. open s ==> open(path_component s x)`,
  MATCH_MP_TAC OPEN_GENERAL_COMPONENT THEN
  REWRITE_TAC[PATH_COMPONENT_IN; PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS;
              PATH_COMPONENT_OF_SUBSET] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC(REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]
   (MATCH_MP CONVEX_IMP_PATH_CONNECTED (SPEC_ALL CONVEX_BALL))) THEN
  ASM_MESON_TAC[CENTRE_IN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE; NOT_IN_EMPTY]);;

let OPEN_NON_PATH_COMPONENT = prove
 (`!s x:real^N. open s ==> open(s DIFF path_component s x)`,
  MATCH_MP_TAC OPEN_NON_GENERAL_COMPONENT THEN
  REWRITE_TAC[PATH_COMPONENT_IN; PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS;
              PATH_COMPONENT_OF_SUBSET] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC(REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]
   (MATCH_MP CONVEX_IMP_PATH_CONNECTED (SPEC_ALL CONVEX_BALL))) THEN
  ASM_MESON_TAC[CENTRE_IN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE; NOT_IN_EMPTY]);;

let PATH_CONNECTED_CONTINUOUS_IMAGE = prove
 (`!f:real^M->real^N s.
        f continuous_on s /\ path_connected s ==> path_connected (IMAGE f s)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[path_connected] THEN STRIP_TAC THEN
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
  X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
  X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `y:real^M`]) THEN
  ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish] THEN
  DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `(f:real^M->real^N) o (g:real^1->real^M)` THEN CONJ_TAC THENL
   [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
    ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
    ASM_REWRITE_TAC[o_DEF] THEN ASM SET_TAC[]]);;

let HOMEOMORPHIC_PATH_CONNECTEDNESS = prove
 (`!s t. s homeomorphic t ==> (path_connected s <=> path_connected t)`,
  REWRITE_TAC[homeomorphic; homeomorphism] THEN
  MESON_TAC[PATH_CONNECTED_CONTINUOUS_IMAGE]);;

let PATH_CONNECTED_LINEAR_IMAGE = prove
 (`!f:real^M->real^N s.
     path_connected s /\ linear f ==> path_connected(IMAGE f s)`,
  SIMP_TAC[LINEAR_CONTINUOUS_ON; PATH_CONNECTED_CONTINUOUS_IMAGE]);;

let PATH_CONNECTED_LINEAR_IMAGE_EQ = prove
 (`!f s. linear f /\ (!x y. f x = f y ==> x = y)
         ==> (path_connected (IMAGE f s) <=> path_connected s)`,
  MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE PATH_CONNECTED_LINEAR_IMAGE));;

add_linear_invariants [PATH_CONNECTED_LINEAR_IMAGE_EQ];;

let HOMEOMORPHISM_PATH_CONNECTEDNESS = prove
 (`!f:real^M->real^N g s t k.
        homeomorphism (s,t) (f,g) /\ k SUBSET s
        ==> (path_connected(IMAGE f k) <=> path_connected k)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_PATH_CONNECTEDNESS THEN
  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN
  MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
          HOMEOMORPHISM_OF_SUBSETS)) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);;

let PATH_CONNECTED_EMPTY = prove
 (`path_connected {}`,
  REWRITE_TAC[path_connected; NOT_IN_EMPTY]);;

let PATH_CONNECTED_SING = prove
 (`!a:real^N. path_connected {a}`,
  GEN_TAC THEN REWRITE_TAC[path_connected; IN_SING] THEN
  REPEAT STRIP_TAC THEN EXISTS_TAC `linepath(a:real^N,a)` THEN
  ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
  REWRITE_TAC[SEGMENT_REFL; PATH_IMAGE_LINEPATH; SUBSET_REFL]);;

let PATH_CONNECTED_UNION = prove
 (`!s t. path_connected s /\ path_connected t /\ ~(s INTER t = {})
         ==> path_connected (s UNION t)`,
  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
  REWRITE_TAC[IN_INTER; IN_UNION] THEN
  MESON_TAC[PATH_COMPONENT_OF_SUBSET; SUBSET_UNION; PATH_COMPONENT_TRANS]);;

let PATH_CONNECTED_UNIONS = prove
 (`!f:(real^N->bool)->bool.
        (!s. s IN f ==> path_connected s) /\ ~(INTERS f = {})
        ==> path_connected(UNIONS f)`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN
  REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
  MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
  MATCH_MP_TAC PATH_COMPONENT_TRANS THEN EXISTS_TAC `a:real^N` THEN
  CONJ_TAC THENL
   [ONCE_REWRITE_TAC[PATH_COMPONENT_SYM_EQ] THEN
    UNDISCH_TAC `(x:real^N) IN UNIONS f`;
    UNDISCH_TAC `(y:real^N) IN UNIONS f`] THEN
  REWRITE_TAC[IN_UNIONS; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN
  ASM_REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
  DISCH_THEN(MP_TAC o SPEC `a:real^N`) THENL
   [DISCH_THEN(MP_TAC o SPEC `x:real^N`);
    DISCH_THEN(MP_TAC o SPEC `y:real^N`)] THEN
  (ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
  MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s x ==> t x`) THEN
  REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC PATH_COMPONENT_MONO THEN
  ASM SET_TAC[]);;

let PATH_CONNECTED_TRANSLATION = prove
 (`!a s. path_connected s ==> path_connected (IMAGE (\x:real^N. a + x) s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN
  ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]);;

let PATH_CONNECTED_TRANSLATION_EQ = prove
 (`!a s. path_connected (IMAGE (\x:real^N. a + x) s) <=> path_connected s`,
  REWRITE_TAC[path_connected] THEN GEOM_TRANSLATE_TAC[]);;

add_translation_invariants [PATH_CONNECTED_TRANSLATION_EQ];;

let PATH_CONNECTED_PCROSS = prove
 (`!s:real^M->bool t:real^N->bool.
        path_connected s /\ path_connected t
        ==> path_connected (s PCROSS t)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS; path_connected] THEN DISCH_TAC THEN
  REWRITE_TAC[FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN
  MAP_EVERY X_GEN_TAC [`x1:real^M`; `y1:real^N`; `x2:real^M`; `y2:real^N`] THEN
  STRIP_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN2
   (MP_TAC o SPECL [`x1:real^M`; `x2:real^M`])
   (MP_TAC o SPECL [`y1:real^N`; `y2:real^N`])) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THEN
  X_GEN_TAC `g:real^1->real^M` THEN STRIP_TAC THEN
  EXISTS_TAC `(\t. pastecart (x1:real^M) ((h:real^1->real^N) t)) ++
              (\t. pastecart ((g:real^1->real^M) t) (y2:real^N))` THEN
  RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish; path]) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[path_image; FORALL_IN_IMAGE; SUBSET]) THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC PATH_JOIN_IMP THEN REPEAT CONJ_TAC THENL
     [REWRITE_TAC[path] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
      ASM_REWRITE_TAC[CONTINUOUS_ON_CONST];
      REWRITE_TAC[path] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
      ASM_REWRITE_TAC[CONTINUOUS_ON_CONST];
      ASM_REWRITE_TAC[pathstart; pathfinish]];
    MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN
    ASM_SIMP_TAC[path_image; FORALL_IN_IMAGE; SUBSET; IN_ELIM_PASTECART_THM];
    REWRITE_TAC[PATHSTART_JOIN] THEN ASM_REWRITE_TAC[pathstart];
    REWRITE_TAC[PATHFINISH_JOIN] THEN ASM_REWRITE_TAC[pathfinish]]);;

let PATH_CONNECTED_PCROSS_EQ = prove
 (`!s:real^M->bool t:real^N->bool.
        path_connected(s PCROSS t) <=>
        s = {} \/ t = {} \/ path_connected s /\ path_connected t`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `s:real^M->bool = {}` THEN
  ASM_REWRITE_TAC[PCROSS_EMPTY; PATH_CONNECTED_EMPTY] THEN
  ASM_CASES_TAC `t:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[PCROSS_EMPTY; PATH_CONNECTED_EMPTY] THEN
  EQ_TAC THEN REWRITE_TAC[PATH_CONNECTED_PCROSS] THEN REPEAT STRIP_TAC THENL
   [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`;
                    `(s:real^M->bool) PCROSS (t:real^N->bool)`]
       PATH_CONNECTED_LINEAR_IMAGE) THEN
    ASM_REWRITE_TAC[LINEAR_FSTCART];
    MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`;
                   `(s:real^M->bool) PCROSS (t:real^N->bool)`]
       PATH_CONNECTED_LINEAR_IMAGE) THEN
    ASM_REWRITE_TAC[LINEAR_SNDCART]] THEN
  MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
  REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS;
              FSTCART_PASTECART; SNDCART_PASTECART] THEN
  ASM SET_TAC[]);;

let PATH_COMPONENT_PCROSS = prove
 (`!s t a:real^M b:real^N.
        path_component (s PCROSS t) (pastecart a b) =
        path_component s a PCROSS path_component t b`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^M) IN s /\ (b:real^N) IN t` THENL
   [MATCH_MP_TAC PATH_COMPONENT_UNIQUE THEN
    REWRITE_TAC[PASTECART_IN_PCROSS; SUBSET_PCROSS;
                PATH_CONNECTED_PCROSS_EQ] THEN
    REWRITE_TAC[PATH_COMPONENT_SUBSET; PATH_CONNECTED_PATH_COMPONENT] THEN
    GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [IN] THEN
    ASM_REWRITE_TAC[PATH_COMPONENT_REFL_EQ] THEN
    X_GEN_TAC `c:real^(M,N)finite_sum->bool` THEN
    REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
    STRIP_TAC THEN
    MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN DISCH_TAC THEN
    REWRITE_TAC[IN] THEN REWRITE_TAC[PATH_COMPONENT] THEN CONJ_TAC THENL
     [EXISTS_TAC `IMAGE fstcart (c:real^(M,N)finite_sum->bool)`;
      EXISTS_TAC `IMAGE sndcart (c:real^(M,N)finite_sum->bool)`] THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
    REWRITE_TAC[FORALL_PASTECART; EXISTS_PASTECART; IN_IMAGE] THEN
    REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
    (CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]]) THEN
    MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN
    ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART];
    MATCH_MP_TAC(SET_RULE `s = {} /\ t = {} ==> s = t`) THEN
    REWRITE_TAC[PCROSS_EQ_EMPTY; PATH_COMPONENT_EQ_EMPTY] THEN
    REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM_MESON_TAC[]]);;

let PATH_CONNECTED_SCALING = prove
 (`!s:real^N->bool c.
        path_connected s ==> path_connected (IMAGE (\x. c % x) s)`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
  REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);;

let PATH_CONNECTED_SCALING_EQ = prove
 (`!s:real^N->bool c.
        path_connected (IMAGE (\x. c % x) s) <=> c = &0 \/ path_connected s`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[] THENL
   [REWRITE_TAC[IMAGE_CONST; VECTOR_MUL_LZERO] THEN
    MESON_TAC[PATH_CONNECTED_SING; PATH_CONNECTED_EMPTY];
    EQ_TAC THEN REWRITE_TAC[PATH_CONNECTED_SCALING] THEN
    DISCH_THEN(MP_TAC o
      SPEC `inv(c):real` o MATCH_MP PATH_CONNECTED_SCALING) THEN
    REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_MUL_ASSOC] THEN
    ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID; IMAGE_ID]]);;

let PATH_CONNECTED_AFFINITY_EQ = prove
 (`!s m c:real^N.
        path_connected (IMAGE (\x. m % x + c) s) <=>
        m = &0 \/ path_connected s`,
  REWRITE_TAC[AFFINITY_SCALING_TRANSLATION; PATH_CONNECTED_TRANSLATION_EQ;
              PATH_CONNECTED_SCALING_EQ; IMAGE_o]);;

let PATH_CONNECTED_AFFINITY = prove
 (`!s m c:real^N.
     path_connected s ==> path_connected (IMAGE (\x. m % x + c) s)`,
  SIMP_TAC[PATH_CONNECTED_AFFINITY_EQ]);;

let PATH_CONNECTED_NEGATIONS = prove
 (`!s:real^N->bool.
        path_connected s ==> path_connected (IMAGE (--) s)`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
  REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);;

let PATH_CONNECTED_SUMS = prove
 (`!s t:real^N->bool.
        path_connected s /\ path_connected t
        ==> path_connected {x + y | x IN s /\ y IN t}`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP PATH_CONNECTED_PCROSS) THEN
  DISCH_THEN(MP_TAC o ISPEC
   `\z. (fstcart z + sndcart z:real^N)` o
    MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
      PATH_CONNECTED_CONTINUOUS_IMAGE)) THEN
  SIMP_TAC[CONTINUOUS_ON_ADD; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART;
           LINEAR_SNDCART; PCROSS] THEN
  MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
  REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; EXISTS_PASTECART] THEN
  REWRITE_TAC[PASTECART_INJ; FSTCART_PASTECART; SNDCART_PASTECART] THEN
  MESON_TAC[]);;

let IS_INTERVAL_PATH_CONNECTED_1 = prove
 (`!s:real^1->bool. is_interval s <=> path_connected s`,
  MESON_TAC[CONVEX_IMP_PATH_CONNECTED; PATH_CONNECTED_IMP_CONNECTED;
            IS_INTERVAL_CONNECTED_1; IS_INTERVAL_CONVEX_1]);;

(* ------------------------------------------------------------------------- *)
(* Bounds on components of a continuous image.                               *)
(* ------------------------------------------------------------------------- *)

let CARD_LE_PATH_COMPONENTS = prove
 (`!f:real^M->real^N s.
        f continuous_on s
        ==> {path_component (IMAGE f s) y | y | y IN IMAGE f s}
            <=_c {path_component s x | x | x IN s}`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[LE_C] THEN
  SIMP_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC; FORALL_IN_IMAGE] THEN EXISTS_TAC
   `\c. path_component (IMAGE (f:real^M->real^N) s) (f(@x. x IN c))` THEN
  X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN EXISTS_TAC `x:real^M` THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC PATH_COMPONENT_EQ THEN
  REWRITE_TAC[IN] THEN ONCE_REWRITE_TAC[PATH_COMPONENT] THEN
  EXISTS_TAC `IMAGE (f:real^M->real^N) (path_component s x)` THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN
    ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; PATH_COMPONENT_SUBSET;
                  PATH_CONNECTED_PATH_COMPONENT];
    MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[PATH_COMPONENT_SUBSET];
    ALL_TAC; ALL_TAC] THEN
  MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN] THEN
  ASM_MESON_TAC[PATH_COMPONENT_REFL_EQ]);;

let CARD_LE_CONNECTED_COMPONENTS = prove
 (`!f:real^M->real^N s.
        f continuous_on s
        ==> {connected_component (IMAGE f s) y | y | y IN IMAGE f s}
            <=_c {connected_component s x | x | x IN s}`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[LE_C] THEN
  SIMP_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC; FORALL_IN_IMAGE] THEN EXISTS_TAC
   `\c. connected_component (IMAGE (f:real^M->real^N) s) (f(@x. x IN c))` THEN
  X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN EXISTS_TAC `x:real^M` THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN
  REWRITE_TAC[IN] THEN ONCE_REWRITE_TAC[connected_component] THEN
  EXISTS_TAC `IMAGE (f:real^M->real^N) (connected_component s x)` THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
    ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; CONNECTED_COMPONENT_SUBSET;
                  CONNECTED_CONNECTED_COMPONENT];
    MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET];
    ALL_TAC; ALL_TAC] THEN
  MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN] THEN
  ASM_MESON_TAC[CONNECTED_COMPONENT_REFL_EQ]);;

let CARD_LE_COMPONENTS = prove
 (`!f:real^M->real^N s.
        f continuous_on s ==> components(IMAGE f s) <=_c components s`,
  REWRITE_TAC[components; CARD_LE_CONNECTED_COMPONENTS]);;

(* ------------------------------------------------------------------------- *)
(* More stuff about segments.                                                *)
(* ------------------------------------------------------------------------- *)

let PATH_CONNECTED_SEGMENT = prove
 (`(!a b. path_connected(segment[a,b])) /\
   (!a b. path_connected(segment(a,b)))`,
  SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; CONVEX_SEGMENT]);;

let PATH_CONNECTED_SEMIOPEN_SEGMENT = prove
 (`(!a b:real^N. path_connected(segment[a,b] DELETE a)) /\
   (!a b:real^N. path_connected(segment[a,b] DELETE b))`,
  SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; CONVEX_SEMIOPEN_SEGMENT]);;

let SUBSET_CONTINUOUS_IMAGE_SEGMENT_1 = prove
 (`!f:real^N->real^1 a b.
        f continuous_on segment[a,b]
        ==> segment[f a,f b] SUBSET IMAGE f (segment[a,b])`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONNECTED_CONTINUOUS_IMAGE)) THEN
  REWRITE_TAC[CONNECTED_SEGMENT] THEN
  REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_CONVEX_1] THEN
  REWRITE_TAC[CONVEX_CONTAINS_SEGMENT] THEN
  MESON_TAC[IN_IMAGE; ENDS_IN_SEGMENT]);;

let CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1 = prove
 (`!f:real^N->real^1 a b.
        f continuous_on segment[a,b] /\
        (!x y. x IN segment[a,b] /\ y IN segment[a,b] /\ f x = f y ==> x = y)
        ==> IMAGE f (segment[a,b]) = segment[f a,f b]`,
  let lemma = prove
   (`!a b c:real^1.
      ~(a = b) /\ ~(a IN segment(c,b)) /\ ~(b IN segment(a,c))
      ==> c IN segment[a,b]`,
    REWRITE_TAC[FORALL_LIFT; SEGMENT_1; LIFT_DROP] THEN
    REPEAT GEN_TAC THEN REWRITE_TAC[SEGMENT_1; LIFT_EQ] THEN
    REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP]) THEN
    ASM_REAL_ARITH_TAC) in
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `g:real^1->real^N` THEN DISCH_TAC THEN
  MP_TAC(ISPECL [`f:real^N->real^1`; `g:real^1->real^N`;
                 `segment[a:real^N,b]`]
        CONTINUOUS_ON_INVERSE) THEN
  ASM_REWRITE_TAC[COMPACT_SEGMENT] THEN DISCH_TAC THEN
  REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
  MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL
   [ASM_SIMP_TAC[SUBSET_CONTINUOUS_IMAGE_SEGMENT_1]; DISCH_TAC] THEN
  ASM_CASES_TAC `a:real^N = b` THEN
  ASM_REWRITE_TAC[SEGMENT_REFL] THENL [SET_TAC[]; ALL_TAC] THEN
  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `c:real^N` THEN
  DISCH_TAC THEN MATCH_MP_TAC lemma THEN
  MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
   [ASM_MESON_TAC[ENDS_IN_SEGMENT]; DISCH_TAC] THEN
  ONCE_REWRITE_TAC[segment] THEN
  ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN
  REPEAT STRIP_TAC THENL
   [MP_TAC(ISPECL [`f:real^N->real^1`; `c:real^N`; `b:real^N`]
        SUBSET_CONTINUOUS_IMAGE_SEGMENT_1) THEN
    SUBGOAL_THEN `segment[c:real^N,b] SUBSET segment[a,b]` ASSUME_TAC THENL
     [ASM_REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT]; ALL_TAC] THEN
    REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
     [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[SUBSET]] THEN
    DISCH_THEN(MP_TAC o SPEC `(f:real^N->real^1) a`) THEN
    ASM_REWRITE_TAC[IN_IMAGE; NOT_EXISTS_THM] THEN
    X_GEN_TAC `d:real^N` THEN ASM_CASES_TAC `d:real^N = a` THENL
     [ASM_MESON_TAC[BETWEEN_ANTISYM; BETWEEN_IN_SEGMENT];
      ASM_MESON_TAC[ENDS_IN_SEGMENT; SUBSET]];
    MP_TAC(ISPECL [`f:real^N->real^1`; `a:real^N`; `c:real^N`]
        SUBSET_CONTINUOUS_IMAGE_SEGMENT_1) THEN
    SUBGOAL_THEN `segment[a:real^N,c] SUBSET segment[a,b]` ASSUME_TAC THENL
     [ASM_REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT]; ALL_TAC] THEN
    REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
     [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[SUBSET]] THEN
    DISCH_THEN(MP_TAC o SPEC `(f:real^N->real^1) b`) THEN
    ASM_REWRITE_TAC[IN_IMAGE; NOT_EXISTS_THM] THEN
    X_GEN_TAC `d:real^N` THEN ASM_CASES_TAC `d:real^N = b` THENL
     [ASM_MESON_TAC[BETWEEN_ANTISYM; BETWEEN_IN_SEGMENT; BETWEEN_SYM];
      ASM_MESON_TAC[ENDS_IN_SEGMENT; SUBSET]]]);;

let CONTINUOUS_INJECTIVE_IMAGE_OPEN_SEGMENT_1 = prove
 (`!f:real^N->real^1 a b.
        f continuous_on segment[a,b] /\
        (!x y. x IN segment[a,b] /\ y IN segment[a,b] /\ f x = f y ==> x = y)
        ==> IMAGE f (segment(a,b)) = segment(f a,f b)`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  ONCE_REWRITE_TAC[segment] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1) THEN
  MP_TAC(ISPECL [`a:real^N`; `b:real^N`] ENDS_IN_SEGMENT) THEN
  MP_TAC(ISPECL [`(f:real^N->real^1) a`; `(f:real^1->real^1) b`]
    ENDS_IN_SEGMENT) THEN
  ASM SET_TAC[]);;

let CONTINUOUS_IVT_LOCAL_EXTREMUM = prove
 (`!f:real^N->real^1 a b.
        f continuous_on segment[a,b] /\ ~(a = b) /\ f(a) = f(b)
         ==> ?z. z IN segment(a,b) /\
                 ((!w. w IN segment[a,b] ==> drop(f w) <= drop(f z)) \/
                  (!w. w IN segment[a,b] ==> drop(f z) <= drop(f w)))`,
  REPEAT STRIP_TAC THEN
  MAP_EVERY (MP_TAC o ISPECL
            [`drop o (f:real^N->real^1)`; `segment[a:real^N,b]`])
            [CONTINUOUS_ATTAINS_SUP; CONTINUOUS_ATTAINS_INF] THEN
  ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN
  REWRITE_TAC[COMPACT_SEGMENT; SEGMENT_EQ_EMPTY] THEN
  DISCH_THEN(X_CHOOSE_THEN `d:real^N` STRIP_ASSUME_TAC) THEN
  ASM_CASES_TAC `(d:real^N) IN segment(a,b)` THENL
   [ASM_MESON_TAC[]; ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC) THEN
  ASM_CASES_TAC `(c:real^N) IN segment(a,b)` THENL
   [ASM_MESON_TAC[]; ALL_TAC] THEN
  EXISTS_TAC `midpoint(a:real^N,b)` THEN
  MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
   [ASM_REWRITE_TAC[MIDPOINT_IN_SEGMENT]; DISCH_TAC] THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CONJUNCT2 segment]) THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o
    GEN_REWRITE_RULE (RAND_CONV o RAND_CONV) [segment])) THEN
  ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN
  REPEAT(DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC)) THEN
  FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_MESON_TAC[REAL_LE_ANTISYM; DROP_EQ]);;

let FRONTIER_UNIONS_SUBSET_CLOSURE = prove
 (`!f:(real^N->bool)->bool.
        frontier(UNIONS f) SUBSET closure(UNIONS {frontier t | t IN f})`,
  GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [frontier] THEN
  REWRITE_TAC[SUBSET; IN_DIFF; CLOSURE_APPROACHABLE] THEN
  X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN
  ASM_REWRITE_TAC[EXISTS_IN_UNIONS; EXISTS_IN_GSPEC; RIGHT_EXISTS_AND_THM] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
  ASM_CASES_TAC `(t:real^N->bool) IN f` THEN ASM_REWRITE_TAC[] THEN
  ASM_CASES_TAC `(x:real^N) IN t` THENL
   [DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `x:real^N` THEN
    ASM_REWRITE_TAC[frontier; DIST_REFL; IN_DIFF] THEN
    ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN
    FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN
    SPEC_TAC(`x:real^N`,`z:real^N`) THEN
    REWRITE_TAC[CONTRAPOS_THM; GSYM SUBSET] THEN
    MATCH_MP_TAC SUBSET_INTERIOR THEN ASM SET_TAC[];
    DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPECL [`segment[x:real^N,y]`; `t:real^N->bool`]
        CONNECTED_INTER_FRONTIER) THEN
    SIMP_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_DIFF] THEN
    ANTS_TAC THENL [ASM_MESON_TAC[ENDS_IN_SEGMENT]; ALL_TAC] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN
    ASM_MESON_TAC[DIST_IN_CLOSED_SEGMENT; DIST_SYM; REAL_LET_TRANS]]);;

let FRONTIER_UNIONS_SUBSET = prove
 (`!f:(real^N->bool)->bool.
        FINITE f ==> frontier(UNIONS f) SUBSET UNIONS {frontier t | t IN f}`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[]
   `s SUBSET closure t /\ closure t = t ==> s SUBSET t`) THEN
  REWRITE_TAC[FRONTIER_UNIONS_SUBSET_CLOSURE; CLOSURE_EQ] THEN
  MATCH_MP_TAC CLOSED_UNIONS THEN
  ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE; FRONTIER_CLOSED]);;

let CLOSURE_CONVEX_INTER_AFFINE = prove
 (`!s t:real^N->bool.
      convex s /\ affine t /\ ~(relative_interior s INTER t = {})
      ==> closure(s INTER t) = closure(s) INTER t`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
  REWRITE_TAC[SUBSET_INTER] THEN REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC SUBSET_CLOSURE THEN SET_TAC[];
    TRANS_TAC SUBSET_TRANS `closure t:real^N->bool` THEN
    SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN
    ASM_SIMP_TAC[CLOSURE_CLOSED; CLOSED_AFFINE; SUBSET_REFL];
    ALL_TAC] THEN
  FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^N` MP_TAC o
        GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
  GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT GEN_TAC THEN
  REWRITE_TAC[IN_INTER] THEN
  DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
  ASM_SIMP_TAC[AFFINE_EQ_SUBSPACE] THEN STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP(REWRITE_RULE[SUBSET]
    RELATIVE_INTERIOR_SUBSET)) THEN
  REWRITE_TAC[SUBSET; IN_INTER] THEN X_GEN_TAC `x:real^N` THEN
  STRIP_TAC THEN ASM_CASES_TAC `x:real^N = vec 0` THENL
   [MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN
    ASM_REWRITE_TAC[IN_INTER];
    ALL_TAC] THEN
  SUBGOAL_THEN `x IN closure(segment(vec 0:real^N,x))` MP_TAC THENL
   [ASM_REWRITE_TAC[CLOSURE_SEGMENT; ENDS_IN_SEGMENT]; ALL_TAC] THEN
  MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN
  MATCH_MP_TAC SUBSET_CLOSURE THEN REWRITE_TAC[SUBSET_INTER] THEN
  CONJ_TAC THENL
   [TRANS_TAC SUBSET_TRANS `relative_interior s:real^N->bool` THEN
    REWRITE_TAC[RELATIVE_INTERIOR_SUBSET] THEN
    MATCH_MP_TAC IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT THEN
    ASM_REWRITE_TAC[];
    ASM_SIMP_TAC[SUBSET; IN_SEGMENT; VECTOR_MUL_RZERO; VECTOR_ADD_LID;
                 SUBSPACE_MUL; LEFT_IMP_EXISTS_THM]]);;

let RELATIVE_FRONTIER_CONVEX_INTER_AFFINE = prove
 (`!s t:real^N->bool.
        convex s /\ affine t /\ ~(interior s INTER t = {})
        ==> relative_frontier(s INTER t) = frontier s INTER t`,
  SIMP_TAC[relative_frontier; RELATIVE_INTERIOR_CONVEX_INTER_AFFINE;
           frontier] THEN
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `~(relative_interior s INTER t:real^N->bool = {})`
  ASSUME_TAC THENL
   [MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET_RELATIVE_INTERIOR) THEN
    ASM SET_TAC[];
    ASM_SIMP_TAC[CLOSURE_CONVEX_INTER_AFFINE] THEN SET_TAC[]]);;

let RELATIVE_FRONTIER_CBALL_INTER_AFFINE = prove
 (`!s a:real^N r.
        affine s /\ a IN s /\ ~(r = &0)
        ==> relative_frontier(cball(a,r) INTER s) = sphere(a,r) INTER s`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `r < &0` THENL
   [ASM_SIMP_TAC[CBALL_EMPTY; SPHERE_EMPTY; INTER_EMPTY] THEN
    REWRITE_TAC[RELATIVE_FRONTIER_EMPTY];
    W(MP_TAC o PART_MATCH (lhand o rand)
      RELATIVE_FRONTIER_CONVEX_INTER_AFFINE o lhand o snd) THEN
    REWRITE_TAC[FRONTIER_CBALL] THEN DISCH_THEN MATCH_MP_TAC THEN
    ASM_REWRITE_TAC[CONVEX_CBALL; INTERIOR_CBALL; GSYM MEMBER_NOT_EMPTY] THEN
    EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL] THEN
    ASM_REAL_ARITH_TAC]);;

let CONNECTED_COMPONENT_1_GEN = prove
 (`!s a b:real^N.
        dimindex(:N) = 1
        ==> (connected_component s a b <=> segment[a,b] SUBSET s)`,
  SIMP_TAC[connected_component; CONNECTED_CONVEX_1_GEN] THEN
  MESON_TAC[CONVEX_CONTAINS_SEGMENT; SUBSET; CONVEX_SEGMENT;
            ENDS_IN_SEGMENT]);;

let CONNECTED_COMPONENT_1 = prove
 (`!s a b:real^1. connected_component s a b <=> segment[a,b] SUBSET s`,
  SIMP_TAC[CONNECTED_COMPONENT_1_GEN; DIMINDEX_1]);;

let HOMEOMORPHIC_SEGMENTS = prove
 (`(!a b:real^M c d:real^N.
        segment[a,b] homeomorphic segment[c,d] <=> (a = b <=> c = d)) /\
   (!a b:real^M c d:real^N.
        ~(segment[a,b] homeomorphic segment(c,d))) /\
   (!a b:real^M c d:real^N.
        ~(segment(a,b) homeomorphic segment[c,d])) /\
   (!a b:real^M c d:real^N.
        segment(a,b) homeomorphic segment(c,d) <=> (a = b <=> c = d))`,
  let lemma = prove
   (`!a b:real^N. (\u:real^1. (&1 - drop u) % a + drop u % b) =
                  (\u. a + u) o (\u. drop u % (b - a))`,
    REWRITE_TAC[FUN_EQ_THM; o_THM] THEN VECTOR_ARITH_TAC) in
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (q /\ r) /\ (p /\ s)`] THEN
  CONJ_TAC THENL
   [REPEAT STRIP_TAC THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN
    REWRITE_TAC[COMPACT_SEGMENT] THEN POP_ASSUM MP_TAC THEN
    ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
    SIMP_TAC[SEGMENT_REFL; HOMEOMORPHIC_EMPTY; SEGMENT_EQ_EMPTY];
    REPEAT STRIP_TAC THEN
    (EQ_TAC THENL
      [DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_FINITENESS) THEN
       REWRITE_TAC[FINITE_SEGMENT];
       ASM_CASES_TAC `c:real^N = d` THEN
       ASM_SIMP_TAC[SEGMENT_REFL; HOMEOMORPHIC_SING; HOMEOMORPHIC_EMPTY] THEN
       DISCH_TAC])] THEN
  ASM_SIMP_TAC[SEGMENT_IMAGE_INTERVAL] THENL
   [TRANS_TAC HOMEOMORPHIC_TRANS `interval[vec 0:real^1,vec 1]`;
    TRANS_TAC HOMEOMORPHIC_TRANS `interval(vec 0:real^1,vec 1)`] THEN
  (CONJ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM]]) THEN
  REWRITE_TAC[lemma; IMAGE_o; HOMEOMORPHIC_TRANSLATION_LEFT_EQ] THEN
  W(MP_TAC o PART_MATCH (lhand o rand)
    HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ o snd) THEN
  REWRITE_TAC[HOMEOMORPHIC_REFL] THEN DISCH_THEN MATCH_MP_TAC THEN
  SIMP_TAC[LINEAR_VMUL_DROP; LINEAR_ID; VECTOR_MUL_RCANCEL] THEN
  ASM_REWRITE_TAC[DROP_EQ; VECTOR_SUB_EQ]);;

let HOMEOMORPHISM_SEGMENT = prove
 (`!a b:real^N.
        ~(a = b)
        ==> ?h. homeomorphism (interval[vec 0:real^1,vec 1],segment[a,b])
                              ((\t. (&1 - drop t) % a + drop t % b),h)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN
  REWRITE_TAC[COMPACT_INTERVAL; GSYM SEGMENT_IMAGE_INTERVAL] THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
    MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
    SIMP_TAC[o_DEF; CONTINUOUS_ON_CONST; LIFT_DROP; CONTINUOUS_ON_ID;
             LIFT_SUB; CONTINUOUS_ON_SUB];
    REWRITE_TAC[VECTOR_ARITH
     `(&1 - x) % a + x % b:real^N = (&1 - y) % a + y % b <=>
      (x - y) % (a - b) = vec 0`] THEN
    ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_SUB_0; VECTOR_SUB_EQ; DROP_EQ]]);;

let CONNECTED_SUBSET_SEGMENT = prove
 (`!s a b:real^N.
        connected s /\ s SUBSET segment[a,b] /\ a IN s /\ b IN s
        ==> s = segment[a,b]`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THENL
   [ASM_REWRITE_TAC[SEGMENT_REFL] THEN SET_TAC[]; STRIP_TAC] THEN
  ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHISM_SEGMENT) THEN
  ABBREV_TAC `g = \x. (&1 - drop x) % a + drop x % (b:real^N)` THEN
  REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `h:real^N->real^1` THEN
  SUBGOAL_THEN `(g:real^1->real^N)(vec 0) = a /\ g(vec 1) = b`
  MP_TAC THENL
   [EXPAND_TAC "g" THEN REWRITE_TAC[DROP_VEC] THEN CONV_TAC VECTOR_ARITH;
    FIRST_X_ASSUM(K ALL_TAC o SYM) THEN REPEAT STRIP_TAC] THEN
  SUBGOAL_THEN
   `IMAGE (h:real^N->real^1) (segment[a,b]) SUBSET IMAGE h s`
  MP_TAC THENL [ASM_REWRITE_TAC[]; ASM SET_TAC[]] THEN
  W(MP_TAC o PART_MATCH (lhand o rand) INTERVAL_SUBSET_IS_INTERVAL o snd) THEN
  ANTS_TAC THENL
   [REWRITE_TAC[IS_INTERVAL_CONNECTED_1] THEN
    MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
    ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
    REWRITE_TAC[UNIT_INTERVAL_NONEMPTY] THEN DISCH_THEN SUBST1_TAC] THEN
  SUBGOAL_THEN
   `vec 0 IN interval[vec 0:real^1,vec 1] /\
    vec 1 IN interval[vec 0:real^1,vec 1]`
  MP_TAC THENL [REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]; ALL_TAC] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish; path_image]) THEN
  ASM SET_TAC[]);;

let DIAMETER_SEGMENT = prove
 (`(!a b:real^N. diameter(segment[a,b]) = dist(a,b)) /\
   (!a b:real^N. diameter(segment(a,b)) = dist(a,b))`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN
  ASM_REWRITE_TAC[SEGMENT_REFL; DIST_REFL; DIAMETER_SING; DIAMETER_EMPTY] THENL
   [ALL_TAC;
    GEN_REWRITE_TAC LAND_CONV [GSYM DIAMETER_CLOSURE] THEN
    ASM_REWRITE_TAC[CLOSURE_SEGMENT]] THEN
  (REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL
    [MATCH_MP_TAC DIAMETER_LE;
     REWRITE_TAC[dist] THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND]) THEN
  REWRITE_TAC[BOUNDED_SEGMENT; ENDS_IN_SEGMENT; DIST_POS_LE] THEN
  REWRITE_TAC[GSYM dist; DIST_IN_CLOSED_SEGMENT_2]);;

(* ------------------------------------------------------------------------- *)
(* Removing points from arcs and simple paths, hence allowing us to          *)
(* distinguish simple closed curves and arcs topologically.                  *)
(* ------------------------------------------------------------------------- *)

let SIMPLE_PATH_ENDLESS = prove
 (`!c:real^1->real^N.
        simple_path c
        ==> path_image c DIFF {pathstart c,pathfinish c} =
            IMAGE c (interval(vec 0,vec 1))`,
  REWRITE_TAC[simple_path; path_image; pathstart; pathfinish] THEN
  REWRITE_TAC[OPEN_CLOSED_INTERVAL_1; path] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE
   `(!x y. x IN s /\ y IN s /\ c x = c y
           ==> x = y \/ x = a /\ y = b \/ x = b /\ y = a) /\
    a IN s /\ b IN s
    ==>  IMAGE c s DIFF {c a,c b} = IMAGE c (s DIFF {a,b})`) THEN
  ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL]);;

let PATH_CONNECTED_SIMPLE_PATH_ENDLESS = prove
 (`!c:real^1->real^N.
        simple_path c
        ==> path_connected(path_image c DIFF {pathstart c,pathfinish c})`,
  REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SIMPLE_PATH_ENDLESS] THEN
  MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN
  REWRITE_TAC[GSYM IS_INTERVAL_PATH_CONNECTED_1; IS_INTERVAL_INTERVAL] THEN
  MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
  EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
  RULE_ASSUM_TAC(REWRITE_RULE[simple_path; path]) THEN
  ASM_REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED]);;

let CONNECTED_SIMPLE_PATH_ENDLESS = prove
 (`!c:real^1->real^N.
        simple_path c
        ==> connected(path_image c DIFF {pathstart c,pathfinish c})`,
  SIMP_TAC[PATH_CONNECTED_IMP_CONNECTED; PATH_CONNECTED_SIMPLE_PATH_ENDLESS]);;

let NONEMPTY_SIMPLE_PATH_ENDLESS = prove
 (`!c:real^1->real^N.
      simple_path c ==> ~(path_image c DIFF {pathstart c,pathfinish c} = {})`,
  SIMP_TAC[SIMPLE_PATH_ENDLESS; IMAGE_EQ_EMPTY; INTERVAL_EQ_EMPTY_1] THEN
  REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC);;

let CONNECTED_ARC_IMAGE_DELETE = prove
 (`!g a:real^N.
        arc g /\ a IN path_image g
        ==> (connected(path_image g DELETE a) <=>
             a IN {pathstart g,pathfinish g})`,
  REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHISM_ARC) THEN
  DISCH_THEN(X_CHOOSE_THEN `h:real^N->real^1` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [path_image]) THEN
  REWRITE_TAC[IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `t:real^1` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
  TRANS_TAC EQ_TRANS
   `connected(IMAGE (h:real^N->real^1) (path_image g DELETE a))` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC HOMEOMORPHIC_CONNECTEDNESS THEN REWRITE_TAC[homeomorphic] THEN
    MAP_EVERY EXISTS_TAC [`h:real^N->real^1`; `g:real^1->real^N`] THEN
    RULE_ASSUM_TAC(ONCE_REWRITE_RULE[HOMEOMORPHISM_SYM]) THEN
    FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        HOMEOMORPHISM_OF_SUBSETS)) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
    ALL_TAC] THEN
  TRANS_TAC EQ_TRANS `connected(interval[vec 0:real^1,vec 1] DELETE t)` THEN
  CONJ_TAC THENL
   [AP_TERM_TAC THEN
    RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
    REWRITE_TAC[pathstart; pathfinish]] THEN
  TRANS_TAC EQ_TRANS `t IN {vec 0:real^1,vec 1}` THEN CONJ_TAC THENL
   [REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_1];
    EXPAND_TAC "a" THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `x IN s
      ==> (!x y. x IN s /\ y IN s /\ g x = g y ==> x = y) /\ a IN s /\ b IN s
          ==> (x IN {a,b} <=> g x IN {g a,g b})`)) THEN
    REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]] THEN
  EQ_TAC THENL
   [DISCH_THEN(MP_TAC o SPECL
      [`vec 0:real^1`; `vec 1:real^1`; `t:real^1`]) THEN
    ASM_REWRITE_TAC[GSYM IN_INTERVAL_1; IN_DELETE; ENDS_IN_UNIT_INTERVAL] THEN
    SET_TAC[];
    REWRITE_TAC[IN_DELETE; IN_INSERT; NOT_IN_EMPTY; IN_INTERVAL_1;
                GSYM DROP_EQ; DROP_VEC] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
    ASM_REAL_ARITH_TAC]);;

let CONNECTED_SIMPLE_PATH_IMAGE_DELETE = prove
 (`!g a:real^N.
        simple_path g /\ pathfinish g = pathstart g
        ==> connected(path_image g DELETE a)`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN path_image g` THEN
  ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> s DELETE a = s`;
               CONNECTED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_IMAGE]) THEN
  DISCH_THEN(X_CHOOSE_THEN `t:real^1` (STRIP_ASSUME_TAC o GSYM)) THEN
  MP_TAC(ISPEC `shiftpath t (g:real^1->real^N)`
    CONNECTED_SIMPLE_PATH_ENDLESS) THEN
  ASM_SIMP_TAC[SIMPLE_PATH_SHIFTPATH; PATH_IMAGE_SHIFTPATH] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
  ASM_SIMP_TAC[PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH] THEN
  REWRITE_TAC[SET_RULE `s DIFF {a,a} = s DELETE a`]);;

let HOMEOMORPHIC_SIMPLE_PATH_ARC = prove
 (`!g:real^1->real^M h:real^1->real^N.
        arc g /\ simple_path h /\ (path_image g) homeomorphic (path_image h)
        ==> arc h`,
  REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[ARC_SIMPLE_PATH] THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `?a:real^M. a IN path_image g /\ ~connected(path_image g DELETE a)`
  STRIP_ASSUME_TAC THENL
   [ASM_SIMP_TAC[CONNECTED_ARC_IMAGE_DELETE;
                 TAUT `p /\ ~q <=> ~(p ==> q)`] THEN
    REWRITE_TAC[path_image; NOT_IMP; EXISTS_IN_IMAGE] THEN
    EXISTS_TAC `lift(&1 / &2)` THEN
    REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN
    REWRITE_TAC[IN_INSERT; pathstart; pathfinish; NOT_IN_EMPTY] THEN
    REWRITE_TAC[DE_MORGAN_THM] THEN
    FIRST_ASSUM(MP_TAC o CONJUNCT2 o REWRITE_RULE[arc]) THEN
    ONCE_REWRITE_TAC[SET_RULE `p /\ q /\ r ==> s <=> p /\ q /\ ~s ==> ~r`] THEN
    DISCH_TAC THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV;
    ALL_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`i:real^M->real^N`; `j:real^N->real^M`] THEN
  DISCH_TAC THEN
  MP_TAC(ISPECL [`h:real^1->real^N`; `(i:real^M->real^N) a`]
        CONNECTED_SIMPLE_PATH_IMAGE_DELETE) THEN
  ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN
  MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
  MATCH_MP_TAC HOMEOMORPHIC_CONNECTEDNESS THEN REWRITE_TAC[homeomorphic] THEN
  MAP_EVERY EXISTS_TAC [`i:real^M->real^N`; `j:real^N->real^M`] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
    HOMEOMORPHISM_OF_SUBSETS)) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);;

let HOMEOMORPHIC_SIMPLE_PATH_ARC_EQ = prove
 (`!g:real^1->real^M h:real^1->real^N.
        simple_path g /\ simple_path h /\
        (path_image g) homeomorphic (path_image h)
        ==> (arc g <=> arc h)`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [MP_TAC(ISPECL [`g:real^1->real^M`; `h:real^1->real^N`]
        HOMEOMORPHIC_SIMPLE_PATH_ARC);
    MP_TAC(ISPECL [`h:real^1->real^N`; `g:real^1->real^M`]
        HOMEOMORPHIC_SIMPLE_PATH_ARC)] THEN
  ASM_MESON_TAC[HOMEOMORPHIC_SYM]);;

let ARC_ENDS_UNIQUE = prove
 (`!g h:real^1->real^N.
        arc g /\ simple_path h /\ path_image g = path_image h
        ==> {pathstart g, pathfinish g} = {pathstart h, pathfinish h}`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`g:real^1->real^N`; `h:real^1->real^N`]
        HOMEOMORPHIC_SIMPLE_PATH_ARC) THEN
  ASM_REWRITE_TAC[HOMEOMORPHIC_REFL] THEN DISCH_TAC THEN
  TRANS_TAC EQ_TRANS
   `{x:real^N | x IN path_image g /\ connected(path_image g DELETE x)}` THEN
  CONJ_TAC THENL [CONV_TAC SYM_CONV; ASM_REWRITE_TAC[]] THEN
  MATCH_MP_TAC(SET_RULE
   `a IN s /\ b IN s /\ (!x. x IN s ==> (P x <=> x IN {a,b}))
    ==> {x | x IN s /\ P x} = {a,b}`) THEN
  REWRITE_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE] THEN
  ASM_SIMP_TAC[CONNECTED_ARC_IMAGE_DELETE]);;

let ARC_HOMEOMORPHISM_ENDS = prove
 (`!g h f f':real^N->real^N.
        homeomorphism (path_image g,path_image h) (f,f') /\ arc g /\ arc h
        ==> f(pathstart g) = pathstart h /\
            f(pathfinish g) = pathfinish h /\
            f'(pathstart h) = pathstart g /\
            f'(pathfinish h) = pathfinish g \/
            f(pathstart g) = pathfinish h /\
            f(pathfinish g) = pathstart h /\
            f'(pathstart h) = pathfinish g /\
            f'(pathfinish h) = pathstart g`,
  REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`(f:real^N->real^N) o (g:real^1->real^N)`; `h:real^1->real^N`]
        ARC_ENDS_UNIQUE) THEN
  ASM_REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN ANTS_TAC THENL
   [ASM_SIMP_TAC[ARC_IMP_SIMPLE_PATH] THEN
    MATCH_MP_TAC ARC_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
    ASM SET_TAC[];
    REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE; SET_RULE
     `{a,b} = {a',b'} <=> a = a' /\ b = b' \/ a = b' /\ b = a'`] THEN
    MATCH_MP_TAC MONO_OR THEN SIMP_TAC[] THEN CONJ_TAC THEN
    DISCH_THEN(CONJUNCTS_THEN(SUBST1_TAC o SYM)) THEN CONJ_TAC THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    REWRITE_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]]);;

let HOMEOMORPHISM_ARC_IMAGES = prove
 (`!g:real^1->real^M h:real^1->real^N.
        arc g /\ arc h
        ==> ?f f'. homeomorphism (path_image g,path_image h) (f,f') /\
                   f(pathstart g) = pathstart h /\
                   f(pathfinish g) = pathfinish h /\
                   f'(pathstart h) = pathstart g /\
                   f'(pathfinish h) = pathfinish g`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC `h:real^1->real^N` HOMEOMORPHISM_ARC) THEN
  MP_TAC(ISPEC `g:real^1->real^M` HOMEOMORPHISM_ARC) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `g':real^M->real^1` THEN STRIP_TAC THEN
  X_GEN_TAC `h':real^N->real^1` THEN STRIP_TAC THEN
  MAP_EVERY EXISTS_TAC
   [`(h:real^1->real^N) o (g':real^M->real^1)`;
    `(g:real^1->real^M) o (h':real^N->real^1)`] THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN ASM_MESON_TAC[HOMEOMORPHISM_SYM];
    RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN
    ASM_SIMP_TAC[o_THM; pathstart; pathfinish; ENDS_IN_UNIT_INTERVAL]]);;

let COLLINEAR_SIMPLE_PATH_IMAGE = prove
 (`!g:real^1->real^N.
        simple_path g /\ collinear(path_image g)
        ==> path_image g = segment[pathstart g,pathfinish g]`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC `path_image g:real^N->bool`
    COMPACT_CONVEX_COLLINEAR_SEGMENT) THEN
  ASM_SIMP_TAC[CONVEX_CONNECTED_COLLINEAR; CONNECTED_PATH_IMAGE;
    COMPACT_PATH_IMAGE; PATH_IMAGE_NONEMPTY; SIMPLE_PATH_IMP_PATH] THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
  DISCH_TAC THEN ASM_REWRITE_TAC[SEGMENT_EQ] THEN
  MP_TAC(ISPECL [`linepath(a:real^N,b)`; `g:real^1->real^N`]
        ARC_ENDS_UNIQUE) THEN
  ASM_REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
  ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN DISCH_THEN MATCH_MP_TAC THEN
  MATCH_MP_TAC ARC_LINEPATH THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[SEGMENT_REFL]) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP NONEMPTY_SIMPLE_PATH_ENDLESS) THEN
  ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
   `s = {a} ==> x IN s ==> {a} DIFF {x,y} = {}`)) THEN
  REWRITE_TAC[PATHSTART_IN_PATH_IMAGE]);;

(* ------------------------------------------------------------------------- *)
(* An injective function into R is a homeomorphism and so an open map.       *)
(* ------------------------------------------------------------------------- *)

let INJECTIVE_INTO_1D_EQ_HOMEOMORPHISM = prove
 (`!f:real^N->real^1 s.
        f continuous_on s /\ path_connected s
        ==>  ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=>
              ?g. homeomorphism (s,IMAGE f s) (f,g))`,
  REWRITE_TAC[FORALL_LIFT_FUN; EXISTS_FUN_DROP] THEN
  REWRITE_TAC[GSYM CONTINUOUS_MAP_EUCLIDEAN; GSYM CONTINUOUS_MAP_EQ_LIFT] THEN
  REPEAT GEN_TAC THEN REWRITE_TAC[o_THM; LIFT_EQ] THEN
  MATCH_MP_TAC(TAUT `(q ==> (p /\ r <=> s)) ==> p /\ q ==> (r <=> s)`) THEN
  DISCH_TAC THEN W(MP_TAC o PART_MATCH (lhand o rand o rand)
    EMBEDDING_MAP_INTO_EUCLIDEANREAL o lhand o lhand o snd) THEN
  ASM_REWRITE_TAC[PATH_CONNECTED_SPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  DISCH_THEN(SUBST1_TAC o SYM) THEN
  REWRITE_TAC[embedding_map; GSYM HOMEOMORPHIC_MAPS_EUCLIDEAN_SUBTOPOLOGY] THEN
  REWRITE_TAC[HOMEOMORPHIC_MAP_MAPS; homeomorphic_maps] THEN
  AP_TERM_TAC THEN ABS_TAC THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; FORALL_IN_IMAGE; o_THM;
              LIFT_DROP; LIFT_EQ; TOPSPACE_EUCLIDEANREAL_SUBTOPOLOGY;
              CONTINUOUS_MAP_IN_SUBTOPOLOGY; SUBSET] THEN
  REWRITE_TAC[GSYM CONTINUOUS_MAP_DROP_EQ_GEN; IMAGE_o] THEN
  REWRITE_TAC[GSYM CONTINUOUS_MAP_EQ_LIFT; LIFT_IN_IMAGE_LIFT]);;

let INJECTIVE_INTO_1D_IMP_OPEN_MAP = prove
 (`!f:real^N->real^1 s t.
        f continuous_on s /\ path_connected s /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
        open_in (subtopology euclidean s) t
        ==> open_in (subtopology euclidean (IMAGE f s)) (IMAGE f t)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
  ASM_MESON_TAC[INJECTIVE_INTO_1D_EQ_HOMEOMORPHISM]);;

let HOMEOMORPHISM_INTO_1D = prove
 (`!f:real^N->real^1 s t.
        path_connected s /\
        f continuous_on s /\ IMAGE f s = t /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
        ==> ?g. homeomorphism(s,t) (f,g)`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN
  ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INJECTIVE_INTO_1D_IMP_OPEN_MAP THEN
  ASM_MESON_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Injective function on an interval is strictly increasing or decreasing.   *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_INJECTIVE_IFF_MONOTONIC = prove
 (`!f:real^1->real^1 s.
        f continuous_on s /\ is_interval s
        ==> ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=>
             (!x y. x IN s /\ y IN s /\ drop x < drop y
                    ==> drop(f x) < drop(f y)) \/
             (!x y. x IN s /\ y IN s /\ drop x < drop y
                    ==> drop(f y) < drop(f x)))`,
  REWRITE_TAC[FORALL_LIFT_IMAGE] THEN
  REWRITE_TAC[FORALL_LIFT_FUN; FORALL_FUN_DROP] THEN
  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM IS_REALINTERVAL_IS_INTERVAL] THEN
  REWRITE_TAC[GSYM CONTINUOUS_MAP_EUCLIDEAN] THEN
  REWRITE_TAC[GSYM CONTINUOUS_MAP_DROP_EQ_GEN] THEN
  REWRITE_TAC[GSYM CONTINUOUS_MAP_EQ_LIFT] THEN
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
  REWRITE_TAC[o_THM; LIFT_DROP; LIFT_EQ] THEN
  REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN
  GEN_REWRITE_TAC LAND_CONV [CONJ_SYM] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN
  REWRITE_TAC[INJECTIVE_EQ_MONOTONE_MAP]);;

let CONTINUOUS_INJECTIVE_IMP_MONOTONIC = prove
 (`!f s.
        f continuous_on s /\ is_interval s /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
        ==> (!x y. x IN s /\ y IN s
                   ==> (drop(f x) < drop(f y) <=> drop x < drop y)) \/
            (!x y. x IN s /\ y IN s
                   ==> (drop(f x) < drop(f y) <=> drop y < drop x))`,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN(fun th ->
    MP_TAC th THEN ASM_SIMP_TAC[CONTINUOUS_INJECTIVE_IFF_MONOTONIC] THEN
    ASSUME_TAC(REWRITE_RULE[INJECTIVE_ON_ALT] th)) THEN
  MATCH_MP_TAC MONO_OR THEN CONJ_TAC THEN DISCH_TAC THEN
  MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
  STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[] THEN
  ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
  REWRITE_TAC[REAL_NOT_LT] THEN REWRITE_TAC[REAL_LE_LT] THEN
  ASM_MESON_TAC[DROP_EQ]);;

let HOMEOMORPHISM_1D_IMP_MONOTONIC = prove
 (`!f g s t.
        homeomorphism(s,t) (f,g) /\ is_interval s
        ==> (!x y. x IN s /\ y IN s
                   ==> (drop(f x) < drop(f y) <=> drop x < drop y)) /\
            (!x y. x IN t /\ y IN t
                   ==> (drop(g x) < drop(g y) <=> drop x < drop y)) \/
            (!x y. x IN s /\ y IN s
                   ==> (drop(f x) < drop(f y) <=> drop y < drop x)) /\
            (!x y. x IN t /\ y IN t
                   ==> (drop(g x) < drop(g y) <=> drop y < drop x))`,
  REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`f:real^1->real^1`; `s:real^1->bool`]
        CONTINUOUS_INJECTIVE_IMP_MONOTONIC) THEN
  ASM_REWRITE_TAC[] THEN
  REPEAT(ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC]) THEN
  ASM_REWRITE_TAC[] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[EXTENSION; IN_IMAGE]) THEN
  ASM_MESON_TAC[REAL_LT_ANTISYM]);;

(* ------------------------------------------------------------------------- *)
(* Topological rendering of Darboux continuity, proof it implies continuity  *)
(* for a regulated function from R^1 (having left and right limits).         *)
(* ------------------------------------------------------------------------- *)

let CONVEXITY_PRESERVING = prove
 (`!f:real^M->real^N s.
        (!c. c SUBSET s /\ convex c ==> convex(IMAGE f c)) <=>
        (!a b. segment[a,b] SUBSET s ==> convex(IMAGE f (segment[a,b])))`,
  REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CONVEX_SEGMENT] THEN
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[CONVEX_CONTAINS_SEGMENT; FORALL_IN_IMAGE_2] THEN
  ASM_SIMP_TAC[GSYM CONVEX_CONTAINS_SEGMENT_IMP] THEN
  MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^M`; `b:real^M`]) THEN
  ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  DISCH_THEN(MP_TAC o MATCH_MP CONVEX_CONTAINS_SEGMENT_IMP) THEN
  DISCH_THEN(MP_TAC o SPECL
   [`(f:real^M->real^N) a`; `(f:real^M->real^N) b`]) THEN
  SIMP_TAC[FUN_IN_IMAGE; ENDS_IN_SEGMENT] THEN ASM SET_TAC[]);;

let CONVEXITY_PRESERVING_ALT = prove
 (`!f:real^M->real^N s.
        (!c. c SUBSET s /\ convex c ==> convex(IMAGE f c)) <=>
        (!a b. segment[a,b] SUBSET s
               ==> segment[f a,f b] SUBSET IMAGE f (segment[a,b]))`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
   [MATCH_MP_TAC SEGMENT_SUBSET_CONVEX THEN
    SIMP_TAC[FUN_IN_IMAGE; ENDS_IN_SEGMENT] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[CONVEX_SEGMENT];
    REWRITE_TAC[CONVEX_CONTAINS_SEGMENT; FORALL_IN_IMAGE_2] THEN
    ASM_SIMP_TAC[GSYM CONVEX_CONTAINS_SEGMENT_IMP] THEN
    MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^M`; `b:real^M`]) THEN
    ASM SET_TAC[]]);;

let DARBOUX_AND_REGULATED_IMP_CONTINUOUS = prove
 (`!f:real^1->real^N s.
      is_interval s /\
      (!c. c SUBSET s /\ connected c ==> connected(IMAGE f c)) /\
      (!a. a IN s
           ==> (?l. (f --> l) (at a within s INTER {x | drop x <= drop a})) /\
               (?r. (f --> r) (at a within s INTER {x | drop a <= drop x})))
      ==> f continuous_on s`,
  SUBGOAL_THEN
   `!f:real^1->real^1 s.
      is_interval s /\
      (!c. c SUBSET s /\ connected c ==> connected(IMAGE f c)) /\
      (!a. a IN s
           ==> (?l. (f --> l) (at a within s INTER {x | drop x <= drop a})) /\
               (?r. (f --> r) (at a within s INTER {x | drop a <= drop x})))
      ==> f continuous_on s`
  ASSUME_TAC THENL
   [ALL_TAC;
    REPEAT STRIP_TAC THEN
    ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN
    X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
     [X_GEN_TAC `c:real^1->bool` THEN STRIP_TAC THEN
      SUBGOAL_THEN `(\x. lift(((f:real^1->real^N) x)$i)) = (\x. lift(x$i)) o f`
       (fun th -> ONCE_REWRITE_TAC[th])
      THENL [REWRITE_TAC[o_DEF]; REWRITE_TAC[IMAGE_o]] THEN
      MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
      ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT];
      X_GEN_TAC `a:real^1` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `a:real^1`) THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN
      DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN
      EXISTS_TAC `lift((y:real^N)$i)` THEN ASM_SIMP_TAC[LIM_COMPONENT]]] THEN
  REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON] THEN
  X_GEN_TAC `a:real^1` THEN DISCH_TAC THEN
  ONCE_REWRITE_TAC[TWO_SIDED_LIMIT_WITHIN] THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `a:real^1`) THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN
  DISCH_THEN(X_CHOOSE_THEN `m:real^1` MP_TAC) THEN
  MATCH_MP_TAC(MESON[LIM_TRIVIAL]
   `(~trivial_limit net /\ (f --> l) net ==> m = l)
    ==> (f --> l) net ==> (f --> m) net`) THEN
  REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN STRIP_TAC THEN
  MATCH_MP_TAC(NORM_ARITH `~(&0 < norm(x - y:real^N)) ==> x = y`) THEN
  DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_WITHIN]) THEN
  DISCH_THEN(MP_TAC o SPEC `norm((f:real^1->real^1) a - m) / &2`) THEN
  ASM_REWRITE_TAC[REAL_HALF; IN_INTER; IN_ELIM_THM; GSYM DIST_NZ] THEN
  DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_APPROACHABLE]) THEN
  DISCH_THEN(MP_TAC o SPEC `d:real`) THEN
  ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM; GSYM DIST_NZ] THEN
  DISCH_THEN(X_CHOOSE_THEN `b:real^1` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL
   [`IMAGE (f:real^1->real^1) (segment(a,b))`; `(f:real^1->real^1) a`]
   CONNECTED_INSERT) THEN
  ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; SEGMENT_EQ_EMPTY] THEN
  MATCH_MP_TAC(TAUT `(p /\ q) /\ ~r ==> ~(p ==> (q <=> r))`) THEN
  (CONJ_TAC THENL
    [REWRITE_TAC[GSYM(CONJUNCT2 IMAGE_CLAUSES)] THEN
     CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
     ASM_SIMP_TAC[CONNECTED_INSERT; CONNECTED_SEGMENT] THEN
     ASM_REWRITE_TAC[CLOSURE_SEGMENT; ENDS_IN_SEGMENT; INSERT_SUBSET] THEN
     ASM_MESON_TAC[CONVEX_CONTAINS_OPEN_SEGMENT; IS_INTERVAL_CONVEX_1];
     DISCH_THEN(MP_TAC o
       SPEC `closure(ball(m,norm((f:real^1->real^1) a - m) / &2))` o
       MATCH_MP(SET_RULE `a IN s ==> !t. s SUBSET t ==> a IN t`)) THEN
     REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
      [MATCH_MP_TAC SUBSET_CLOSURE THEN
       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^1` THEN
       REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THEN
       TRY(RULE_ASSUM_TAC(REWRITE_RULE[GSYM DROP_EQ]) THEN
           ASM_REAL_ARITH_TAC) THEN
       REWRITE_TAC[IN_INTERVAL_1; IN_BALL] THEN STRIP_TAC THEN
       ONCE_REWRITE_TAC[DIST_SYM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
       ASM_REWRITE_TAC[GSYM DROP_EQ; DIST_1; GSYM CONJ_ASSOC] THEN
       RULE_ASSUM_TAC(REWRITE_RULE[DIST_1; IS_INTERVAL_1]) THEN
       (CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC]) THEN
       FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[REAL_LT_IMP_LE];
       ASM_SIMP_TAC[CLOSURE_BALL; REAL_HALF; IN_CBALL] THEN
       MATCH_MP_TAC(NORM_ARITH
        `&0 < norm(y - x) ==> ~(dist(x:real^N,y) <= norm(y - x) / &2)`) THEN
       ASM_REWRITE_TAC[]]]));;

(* ------------------------------------------------------------------------- *)
(* Some handy facts about Lipschitz functions.                               *)
(* ------------------------------------------------------------------------- *)

let LIPSCHITZ_ON_UNION = prove
 (`!(f:real^1->real^N) s t l.
        is_interval s /\ is_interval t /\ ~(s INTER t = {}) /\
        (!x y. x IN s /\ y IN s ==> norm(f x - f y) <= l * norm(x - y)) /\
        (!x y. x IN t /\ y IN t ==> norm(f x - f y) <= l * norm(x - y))
        ==> !x y. x IN s UNION t /\ y IN s UNION t
                  ==> norm(f x - f y) <= l * norm(x - y)`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  MATCH_MP_TAC(MESON[]
   `!Q. (!x y. P x y <=> P y x) /\
        (!x y. ~Q x /\ ~Q y ==> P x y) /\
        (!x y. Q x /\ Q y ==> P x y) /\
        (!x y. ~Q x /\ Q y ==> P x y)
    ==> !x y. P x y`) THEN
  EXISTS_TAC `\x:real^1. x IN s` THEN
  ASM_SIMP_TAC[SET_RULE `~(x IN s) ==> (x IN s UNION t <=> x IN t)`] THEN
  CONJ_TAC THENL [MESON_TAC[NORM_SUB]; ALL_TAC] THEN
  MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
  STRIP_TAC THEN DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN
  ASM_CASES_TAC `(y:real^1) IN t` THEN ASM_SIMP_TAC[] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `z:real^1` THEN STRIP_TAC THEN
  MP_TAC(ISPEC `{z:real^1,x,y}` COLLINEAR_1) THEN
  REWRITE_TAC[COLLINEAR_BETWEEN_CASES] THEN
  DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL
   [REWRITE_TAC[between; dist] THEN DISCH_THEN SUBST1_TAC THEN
    REWRITE_TAC[REAL_ADD_LDISTRIB] THEN
    TRANS_TAC REAL_LE_TRANS
     `norm((f:real^1->real^N) x - f z) + norm(f z - f y)` THEN
    CONJ_TAC THENL [CONV_TAC NORM_ARITH; ASM_MESON_TAC[REAL_LE_ADD2]];
    RULE_ASSUM_TAC(REWRITE_RULE[IS_INTERVAL_CONVEX_1]) THEN
    REWRITE_TAC[BETWEEN_IN_SEGMENT] THEN
    ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; SUBSET]]);;

let LIPSCHITZ_ON_COMBINE = prove
 (`!(f:real^1->real^N) a b c l.
        (!x y. x IN interval[a,b] /\ y IN interval[a,b]
               ==> norm(f x - f y) <= l * norm(x - y)) /\
        (!x y. x IN interval[b,c] /\ y IN interval[b,c]
               ==> norm(f x - f y) <= l * norm(x - y))
        ==> !x y. x IN interval[a,c] /\ y IN interval[a,c]
                  ==> norm(f x - f y) <= l * norm(x - y)`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  ASM_CASES_TAC `interval[a:real^1,c] = {}` THENL
   [ASM_MESON_TAC[NOT_IN_EMPTY];
    RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1])] THEN
  ASM_CASES_TAC `interval[a,c] SUBSET interval[a,b] \/
                 interval[a:real^1,c] SUBSET interval[b,c]`
  THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
  SUBGOAL_THEN `b IN interval[a:real^1,c]` ASSUME_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN
    REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL; IN_INTERVAL_1] THEN
    ASM_REAL_ARITH_TAC;
    FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP UNION_INTERVAL_1) THEN
    MATCH_MP_TAC LIPSCHITZ_ON_UNION THEN
    ASM_REWRITE_TAC[IS_INTERVAL_INTERVAL] THEN
    REWRITE_TAC[INTER_INTERVAL_1; INTERVAL_NE_EMPTY_1] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC]);;

let LOCALLY_LIPSCHITZ_GEN = prove
 (`!f:real^M->real^N s b.
        convex s /\
        (!x c. x IN s /\ b < c
               ==> eventually (\y. norm(f y - f x) <= c * norm(y - x))
                              (at x within s))
        ==> !x y. x IN s /\ y IN s ==> norm(f x - f y) <= b * norm(x - y)`,
  let lemma = prove
   (`{x | x IN s /\ !y. P x y} =
     s INTER INTERS {{x | x IN s /\ P x y} | y IN UNIV}`,
    REWRITE_TAC[INTERS_GSPEC] THEN SET_TAC[]) in
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `x:real^M = y` THEN
  ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_MUL_RZERO; REAL_LE_REFL] THEN
  ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN
  GEN_REWRITE_TAC I [REAL_LE_TRANS_LTE] THEN
  ASM_SIMP_TAC[REAL_LE_LDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN
  X_GEN_TAC `c:real` THEN DISCH_TAC THEN
  MP_TAC(ISPECL [`x:real^M`; `y:real^M`] (CONJUNCT1 CONNECTED_SEGMENT)) THEN
  REWRITE_TAC[CONNECTED_CLOPEN] THEN DISCH_THEN(MP_TAC o SPEC
   `{z | z IN segment[x,y] /\
        !t. t IN segment[x,z]
            ==> norm((f:real^M->real^N) t - f x) <= c * norm(t - x)}`) THEN
  ANTS_TAC THENL
   [ALL_TAC;
    DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `y:real^M`] o MATCH_MP (SET_RULE
     `!a b. {x | x IN s /\ P x} = {} \/ {x | x IN s /\ P x} = s
            ==> a IN s /\ b IN s /\ P a ==> P b`)) THEN
    REWRITE_TAC[ENDS_IN_SEGMENT; DIST_REFL; DIST_POS_LE] THEN
    REWRITE_TAC[SEGMENT_REFL; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN
    REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_MUL_RZERO; REAL_LE_REFL] THEN
    DISCH_THEN(MP_TAC o SPEC `y:real^M`) THEN
    REWRITE_TAC[ENDS_IN_SEGMENT; NORM_SUB]] THEN
  CONJ_TAC THENL
   [REWRITE_TAC[open_in; SUBSET_RESTRICT; IN_ELIM_THM] THEN
    X_GEN_TAC `z:real^M` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`z:real^M`; `c:real`]) THEN
    ASM_REWRITE_TAC[EVENTUALLY_WITHIN] THEN ANTS_TAC THENL
     [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; SUBSET]; ALL_TAC] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `u:real^M` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `v:real^M` THEN
    DISCH_TAC THEN
    ASM_CASES_TAC `v IN segment[x:real^M,z]` THEN ASM_SIMP_TAC[] THEN
    FIRST_X_ASSUM(MP_TAC o C MATCH_MP
     (MESON[ENDS_IN_SEGMENT] `z IN segment[x:real^M,z]`)) THEN
    MATCH_MP_TAC(NORM_ARITH
     `norm(v - z:real^N) <= d - c
      ==> norm(z - x) <= c ==> norm(v - x) <= d`) THEN
    SUBGOAL_THEN `v IN segment[x:real^M,y] /\ ~(u IN segment[x:real^M,z])`
    STRIP_ASSUME_TAC THENL
     [ASM_MESON_TAC[BETWEEN_TRANS; BETWEEN_IN_SEGMENT; BETWEEN_SYM];
      ALL_TAC] THEN
    SUBGOAL_THEN `u IN segment[z:real^M,y] /\ v IN segment[z,y]`
    STRIP_ASSUME_TAC THENL
     [MP_TAC(ISPECL [`x:real^M`; `z:real^M`; `y:real^M`]
        UNION_SEGMENT) THEN ASM SET_TAC[];
      ALL_TAC] THEN
    TRANS_TAC REAL_LE_TRANS `c * norm(v - z:real^M)` THEN CONJ_TAC THENL
     [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GSYM DIST_NZ] THEN CONJ_TAC
      THENL [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; SUBSET]; ALL_TAC] THEN
      CONJ_TAC THENL [ASM_MESON_TAC[ENDS_IN_SEGMENT]; ALL_TAC] THEN
      SUBGOAL_THEN `v IN segment[z:real^M,u]` ASSUME_TAC THENL
       [ALL_TAC;
        ASM_MESON_TAC[DIST_IN_CLOSED_SEGMENT; REAL_LET_TRANS; DIST_SYM]];
      MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC(REAL_RING
       `z = x + y:real ==> c * x = c * z - c * y`)] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[GSYM BETWEEN_IN_SEGMENT; between]) THEN
    REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; GSYM dist; between] THEN
    REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[DIST_SYM] THEN REAL_ARITH_TAC;
    ALL_TAC] THEN
  SUBGOAL_THEN
   `{z | z IN segment [x,y] /\
         !t. t IN segment[x,z]
             ==> norm((f:real^M->real^N) t - f x) <= c * norm (t - x)} =
    {z | z IN segment [x,y] /\
         !t. t IN segment(x,z) ==> norm(f t - f x) <= c * norm(t - x)}`
  SUBST1_TAC THENL
   [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `z:real^M` THEN
    ASM_CASES_TAC `z IN segment[x:real^M,y]` THEN ASM_REWRITE_TAC[] THEN
    REPEAT STRIP_TAC THEN ASM_CASES_TAC `z:real^M = x` THEN
    ASM_REWRITE_TAC[SEGMENT_REFL; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN
    REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_MUL_RZERO; REAL_LE_REFL] THEN
    MP_TAC(ISPECL
     [`\t. lift(c * norm(t - x) - norm((f:real^M->real^N) t - f x))`;
      `segment(x:real^M,z)`; `{t | &0 <= drop t}`]
     FORALL_IN_CLOSURE_EQ) THEN
    ASM_REWRITE_TAC[CLOSURE_SEGMENT; IN_ELIM_THM; LIFT_DROP; REAL_SUB_LE] THEN
    DISCH_THEN MATCH_MP_TAC THEN
    REWRITE_TAC[CLOSED_SING; drop;
                REWRITE_RULE[real_ge] CLOSED_HALFSPACE_COMPONENT_GE] THEN
    REWRITE_TAC[LIFT_SUB; LIFT_CMUL] THEN
    MATCH_MP_TAC CONTINUOUS_ON_SUB THEN CONJ_TAC THEN
    TRY(MATCH_MP_TAC CONTINUOUS_ON_CMUL) THEN
    MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN
    MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
    REWRITE_TAC[CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
    REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
    X_GEN_TAC `w:real^M` THEN DISCH_TAC THEN
    MATCH_MP_TAC CONTINUOUS_WITHIN_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN
    MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL
     [TRANS_TAC SUBSET_TRANS `segment[x:real^M,y]` THEN
      CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT]] THEN
      ASM_REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT];
      DISCH_TAC] THEN
    REWRITE_TAC[continuous_within] THEN
    X_GEN_TAC `e:real` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^M`; `abs b + &1`]) THEN
    REWRITE_TAC[ARITH_RULE `b < abs b + &1`] THEN
    ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[EVENTUALLY_WITHIN]] THEN
    DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `min d (e / (abs b + &1))` THEN
    ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_MUL_LZERO; dist; REAL_LT_MIN;
                 REAL_ARITH `&0 < abs b + &1`] THEN
    X_GEN_TAC `v:real^M` THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
    STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `v:real^M`) THEN
    ASM_CASES_TAC `v:real^M = w` THEN
    ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; GSYM DIST_NZ] THEN
    ASM_REWRITE_TAC[dist] THEN ASM_REAL_ARITH_TAC;
    ALL_TAC] THEN
  REWRITE_TAC[lemma] THEN
  MATCH_MP_TAC CLOSED_IN_INTER THEN REWRITE_TAC[CLOSED_IN_REFL] THEN
  MATCH_MP_TAC CLOSED_IN_INTERS THEN
  REWRITE_TAC[SIMPLE_IMAGE; IMAGE_EQ_EMPTY; SEGMENT_EQ_EMPTY] THEN
  REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; UNIV_NOT_EMPTY; SET_RULE
   `{x | x IN s /\ (P x ==> Q x)} =
    {x | x IN s /\ ~P x} UNION {x | x IN s /\ Q x}`] THEN
  X_GEN_TAC `z:real^M` THEN MATCH_MP_TAC CLOSED_IN_UNION THEN
  REWRITE_TAC[SET_RULE `{x | x IN s /\ P} = if P then s else {}`] THEN
  CONJ_TAC THENL [ALL_TAC; MESON_TAC[CLOSED_IN_REFL; CLOSED_IN_EMPTY]] THEN
  ASM_CASES_TAC `z IN segment[x:real^M,y]` THENL
   [SUBGOAL_THEN
     `{w:real^M | w IN segment[x,y] /\ ~(z IN segment (x,w))} =
      {w | w IN segment[x,y] /\ (z = x \/ z IN segment[w,y])}`
    SUBST1_TAC THENL
     [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `w:real^M` THEN
      MP_TAC(ISPECL [`x:real^M`; `w:real^M`; `y:real^M`]
        UNION_SEGMENT) THEN
      ASM_CASES_TAC `w IN segment[x:real^M,y]` THEN ASM_REWRITE_TAC[] THEN
      DISCH_THEN(MP_TAC o SPEC `z:real^M` o REWRITE_RULE[EXTENSION]) THEN
      ASM_REWRITE_TAC[IN_UNION] THEN
      MP_TAC(ISPECL [`x:real^M`; `w:real^M`] SEGMENT_CLOSED_OPEN) THEN
      DISCH_THEN(MP_TAC o SPEC `z:real^M` o REWRITE_RULE[EXTENSION]) THEN
      ASM_REWRITE_TAC[IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN
      MAP_EVERY ASM_CASES_TAC [`z:real^M = x`; `z:real^M = w`] THEN
      ASM_REWRITE_TAC[ENDS_NOT_IN_SEGMENT; ENDS_IN_SEGMENT] THEN
      DISCH_THEN(SUBST1_TAC o SYM) THEN
      MATCH_MP_TAC(TAUT `~(p /\ q) ==> p \/ q ==> (~p <=> q)`) THEN
      RULE_ASSUM_TAC(REWRITE_RULE[GSYM BETWEEN_IN_SEGMENT; between]) THEN
      REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; GSYM dist; between] THEN
      REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[DIST_SYM] THEN
      REWRITE_TAC[GSYM DIST_EQ_0; DIST_SYM] THEN REAL_ARITH_TAC;
      ASM_CASES_TAC `z:real^M = x` THEN
      ASM_REWRITE_TAC[CLOSED_IN_REFL; SET_RULE `{x | x IN s} = s`] THEN
      REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between] THEN
      ONCE_REWRITE_TAC[REAL_ARITH
        `a:real = b /\ c = d <=> a = b /\ d - c = &0`] THEN
      REWRITE_TAC[GSYM between; BETWEEN_IN_SEGMENT] THEN
      REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN
      REWRITE_TAC[GSYM IN_SING] THEN
      MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN
      REWRITE_TAC[CLOSED_SING; LIFT_SUB; LIFT_ADD] THEN
      MATCH_MP_TAC CONTINUOUS_ON_SUB THEN CONJ_TAC THEN
      TRY(MATCH_MP_TAC CONTINUOUS_ON_ADD) THEN
      REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN
      REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_DIST]];
    MATCH_MP_TAC(MESON[CLOSED_IN_REFL]
     `s = t ==> closed_in (subtopology euclidean t) s`) THEN
    REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN
    X_GEN_TAC `w:real^M` THEN
    EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET]
       SEGMENT_OPEN_SUBSET_CLOSED)) THEN
    ASM_MESON_TAC[BETWEEN_TRANS; BETWEEN_IN_SEGMENT; BETWEEN_SYM]]);;

let LOCALLY_LIPSCHITZ = prove
 (`!f:real^M->real^N s b.
        convex s /\
        (!x. x IN s
             ==> eventually (\y. norm(f y - f x) <= b * norm(y - x))
                            (at x within s))
        ==> !x y. x IN s /\ y IN s ==> norm(f x - f y) <= b * norm(x - y)`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  MATCH_MP_TAC LOCALLY_LIPSCHITZ_GEN THEN ASM_REWRITE_TAC[] THEN
  MAP_EVERY X_GEN_TAC [`x:real^M`; `c:real`] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
  X_GEN_TAC `y:real^M` THEN REWRITE_TAC[] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
  MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE]);;

(* ------------------------------------------------------------------------- *)
(* Some uncountability results for relevant sets.                            *)
(* ------------------------------------------------------------------------- *)

let CARD_EQ_SEGMENT = prove
 (`(!a b:real^N. ~(a = b) ==> segment[a,b] =_c (:real)) /\
   (!a b:real^N. ~(a = b) ==> segment(a,b) =_c (:real))`,
  REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SEGMENT_IMAGE_INTERVAL] THENL
   [TRANS_TAC CARD_EQ_TRANS `interval[vec 0:real^1,vec 1]`;
    TRANS_TAC CARD_EQ_TRANS `interval(vec 0:real^1,vec 1)`] THEN
  SIMP_TAC[CARD_EQ_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN
  MATCH_MP_TAC CARD_EQ_IMAGE THEN
  ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; VECTOR_ARITH
   `(&1 - x) % a + x % b:real^N = (&1 - y) % a + y % b <=>
    (x - y) % (a - b) = vec 0`] THEN
  SIMP_TAC[REAL_SUB_0; DROP_EQ]);;

let UNCOUNTABLE_SEGMENT = prove
 (`(!a b:real^N. ~(a = b) ==> ~COUNTABLE(segment[a,b])) /\
   (!a b:real^N. ~(a = b) ==> ~COUNTABLE(segment(a,b)))`,
  SIMP_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; CARD_EQ_SEGMENT]);;

let CARD_EQ_PATH_CONNECTED = prove
 (`!s a b:real^N.
        path_connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> s =_c (:real)`,
  MESON_TAC[CARD_EQ_CONNECTED; PATH_CONNECTED_IMP_CONNECTED]);;

let UNCOUNTABLE_PATH_CONNECTED = prove
 (`!s a b:real^N.
        path_connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> ~COUNTABLE s`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN
  MATCH_MP_TAC CARD_EQ_PATH_CONNECTED THEN
  ASM_MESON_TAC[]);;

let CARD_EQ_CONVEX = prove
 (`!s a b:real^N.
        convex s /\ a IN s /\ b IN s /\ ~(a = b) ==> s =_c (:real)`,
  MESON_TAC[CARD_EQ_PATH_CONNECTED; CONVEX_IMP_PATH_CONNECTED]);;

let UNCOUNTABLE_CONVEX = prove
 (`!s a b:real^N.
        convex s /\ a IN s /\ b IN s /\ ~(a = b) ==> ~COUNTABLE s`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN
  MATCH_MP_TAC CARD_EQ_CONVEX THEN
  ASM_MESON_TAC[]);;

let CARD_EQ_NONEMPTY_INTERIOR = prove
 (`!s:real^N->bool. ~(interior s = {}) ==> s =_c (:real)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
   [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
    SIMP_TAC[CARD_LE_UNIV; CARD_EQ_IMP_LE; CARD_EQ_EUCLIDEAN];
    TRANS_TAC CARD_LE_TRANS `interior(s:real^N->bool)` THEN
    SIMP_TAC[CARD_LE_SUBSET; INTERIOR_SUBSET] THEN
    MATCH_MP_TAC(ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE) THEN
    MATCH_MP_TAC CARD_EQ_OPEN THEN ASM_REWRITE_TAC[OPEN_INTERIOR]]);;

let UNCOUNTABLE_NONEMPTY_INTERIOR = prove
 (`!s:real^N->bool. ~(interior s = {}) ==> ~(COUNTABLE s)`,
  SIMP_TAC[CARD_EQ_NONEMPTY_INTERIOR; CARD_EQ_REAL_IMP_UNCOUNTABLE]);;

let COUNTABLE_EMPTY_INTERIOR = prove
 (`!s:real^N->bool. COUNTABLE s ==> interior s = {}`,
  MESON_TAC[UNCOUNTABLE_NONEMPTY_INTERIOR]);;

let [CONNECTED_FINITE_IFF_SING;
     CONNECTED_FINITE_IFF_COUNTABLE;
     CONNECTED_INFINITE_IFF_CARD_EQ] = (CONJUNCTS o prove)
 (`(!s:real^N->bool. connected s ==> (FINITE s <=> s = {} \/ ?a. s = {a})) /\
   (!s:real^N->bool. connected s ==> (FINITE s <=> COUNTABLE s)) /\
   (!s:real^N->bool. connected s ==> (INFINITE s <=> s =_c (:real)))`,
  REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN
  ASM_CASES_TAC `connected(s:real^N->bool)` THEN
  ASM_REWRITE_TAC[INFINITE] THEN MATCH_MP_TAC(TAUT
   `(f ==> c) /\ (r ==> ~c) /\ (s ==> f) /\ (~s ==> r)
    ==> (f <=> s) /\ (f <=> c) /\ (~f <=> r)`) THEN
  REWRITE_TAC[FINITE_IMP_COUNTABLE] THEN
  REPEAT CONJ_TAC THEN STRIP_TAC THEN
  ASM_SIMP_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; FINITE_INSERT; FINITE_EMPTY] THEN
  MATCH_MP_TAC CARD_EQ_CONNECTED THEN ASM SET_TAC[]);;

let CONNECTED_FINITE_EQ_LOWDIM = prove
 (`!s:real^N->bool. connected s ==> (FINITE s <=> aff_dim s <= &0)`,
  REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CONNECTED_FINITE_IFF_SING] THEN
  REWRITE_TAC[GSYM AFF_DIM_EQ_0; GSYM AFF_DIM_EQ_MINUS1] THEN
  MP_TAC(ISPEC `s:real^N->bool` AFF_DIM_GE) THEN INT_ARITH_TAC);;

let CLOSED_AS_FRONTIER_OF_SUBSET = prove
 (`!s:real^N->bool. closed s <=> ?t. t SUBSET s /\ s = frontier t`,
  GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[FRONTIER_CLOSED]] THEN
  DISCH_TAC THEN MP_TAC(ISPEC `s:real^N->bool` SEPARABLE) THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
  SIMP_TAC[frontier] THEN STRIP_TAC THEN MATCH_MP_TAC(SET_RULE
   `s SUBSET c /\ c SUBSET s /\ i = {} ==> s = c DIFF i`) THEN
  ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
   [ASM_MESON_TAC[SUBSET_CLOSURE; CLOSURE_CLOSED];
    ASM_MESON_TAC[UNCOUNTABLE_NONEMPTY_INTERIOR]]);;

let CLOSED_AS_FRONTIER = prove
 (`!s:real^N->bool. closed s <=> ?t. s = frontier t`,
  GEN_TAC THEN EQ_TAC THENL
   [MESON_TAC[CLOSED_AS_FRONTIER_OF_SUBSET]; MESON_TAC[FRONTIER_CLOSED]]);;

let CARD_EQ_PERFECT_SET = prove
 (`!s:real^N->bool.
        closed s /\ (!x. x IN s ==> x limit_point_of s) /\ ~(s = {})
        ==> s =_c (:real)`,
  REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN REPEAT STRIP_TAC THENL
   [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
    SIMP_TAC[CARD_LE_UNIV; CARD_EQ_IMP_LE; CARD_EQ_EUCLIDEAN];
    MATCH_MP_TAC CARD_GE_PERFECT_SET THEN
    EXISTS_TAC `euclidean:(real^N)topology` THEN
    ASM_REWRITE_TAC[COMPLETELY_METRIZABLE_SPACE_EUCLIDEAN] THEN
    REWRITE_TAC[EUCLIDEAN_DERIVED_SET_OF_IFF_LIMIT_POINT_OF] THEN
    REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN
    ASM_MESON_TAC[CLOSED_LIMPT]]);;

let CARD_EQ_CLOSED = prove
 (`!s:real^N->bool. closed s ==> s <=_c (:num) \/ s =_c (:real)`,
  REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CANTOR_BENDIXSON) THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `d:real^N->bool`] THEN
  ASM_CASES_TAC `c:real^N->bool = {}` THEN
  ASM_SIMP_TAC[UNION_EMPTY; GSYM ge_c; GSYM COUNTABLE] THEN
  STRIP_TAC THEN DISJ2_TAC THEN TRANS_TAC CARD_EQ_TRANS `c:real^N->bool` THEN
  ASM_SIMP_TAC[CARD_EQ_PERFECT_SET] THEN
  MATCH_MP_TAC CARD_UNION_ABSORB_RIGHT THEN
  MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN
  ASM_SIMP_TAC[CARD_LE_COUNTABLE_INFINITE] THEN
  REWRITE_TAC[INFINITE_CARD_LE] THEN TRANS_TAC CARD_LE_TRANS `(:real)` THEN
  SIMP_TAC[CARD_LT_NUM_REAL; CARD_LT_IMP_LE] THEN
  MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
  ASM_SIMP_TAC[CARD_EQ_PERFECT_SET]);;

let CONDENSATION_POINTS_EQ_EMPTY,CARD_EQ_CONDENSATION_POINTS =
 (CONJ_PAIR o prove)
 (`(!s:real^N->bool.
        {x | x condensation_point_of s} = {} <=> COUNTABLE s) /\
   (!s:real^N->bool.
        {x | x condensation_point_of s} =_c (:real) <=> ~(COUNTABLE s))`,
  REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT
   `(r ==> p) /\ (~r ==> q) /\ (p ==> ~q)
    ==> (p <=> r) /\ (q <=> ~r)`) THEN
  REPEAT CONJ_TAC THENL
   [DISCH_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN
    REWRITE_TAC[condensation_point_of] THEN
    ASM_MESON_TAC[COUNTABLE_SUBSET; INTER_SUBSET; IN_UNIV; OPEN_UNIV];
    DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE
     [TAUT `p ==> q \/ r <=> p /\ ~q ==> r`] CARD_EQ_CLOSED) THEN
    REWRITE_TAC[CLOSED_CONDENSATION_POINTS; GSYM COUNTABLE_ALT] THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP CARD_EQ_CONDENSATION_POINTS_IN_SET) THEN
    DISCH_THEN(MP_TAC o MATCH_MP CARD_COUNTABLE_CONG) THEN
    ASM_REWRITE_TAC[CONTRAPOS_THM] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN SET_TAC[];
    DISCH_THEN SUBST1_TAC THEN
    DISCH_THEN(MP_TAC o MATCH_MP CARD_FINITE_CONG) THEN
    REWRITE_TAC[FINITE_EMPTY; GSYM INFINITE; real_INFINITE]]);;

let UNCOUNTABLE_HAS_CONDENSATION_POINT = prove
 (`!s:real^N->bool. ~COUNTABLE s ==> ?x. x condensation_point_of s`,
  REWRITE_TAC[GSYM CONDENSATION_POINTS_EQ_EMPTY] THEN SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Density of sets with small complement, including irrationals.             *)
(* ------------------------------------------------------------------------- *)

let COSMALL_APPROXIMATION = prove
 (`!s. ((:real) DIFF s) <_c (:real)
       ==> !x e. &0 < e ==> ?y. y IN s /\ abs(y - x) < e`,
  let lemma = prove
   (`!s. ((:real^1) DIFF s) <_c (:real)
         ==> !x e. &0 < e ==> ?y. y IN s /\ norm(y - x) < e`,
    REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE
      `~({x | P x} SUBSET UNIV DIFF s) ==> ?x. x IN s /\ P x`) THEN
    MP_TAC(ISPEC `ball(x:real^1,e)` CARD_EQ_OPEN) THEN
    ASM_REWRITE_TAC[OPEN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE] THEN DISCH_TAC THEN
    DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN
    REWRITE_TAC[CARD_NOT_LE] THEN
    REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] dist); GSYM ball] THEN
    TRANS_TAC CARD_LTE_TRANS `(:real)` THEN
    ASM_SIMP_TAC[ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE]) in
  REWRITE_TAC[FORALL_DROP_IMAGE; FORALL_DROP; EXISTS_DROP] THEN
  REWRITE_TAC[GSYM IMAGE_DROP_UNIV; GSYM DROP_SUB; GSYM NORM_1] THEN
  REWRITE_TAC[DROP_IN_IMAGE_DROP] THEN REWRITE_TAC[GSYM FORALL_DROP] THEN
  SIMP_TAC[GSYM IMAGE_DIFF_INJ; DROP_EQ] THEN GEN_TAC THEN
  DISCH_TAC THEN MATCH_MP_TAC lemma THEN POP_ASSUM MP_TAC THEN
  MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC CARD_LT_CONG THEN
  REWRITE_TAC[IMAGE_DROP_UNIV; CARD_EQ_REFL] THEN
  MATCH_MP_TAC CARD_EQ_IMAGE THEN SIMP_TAC[DROP_EQ]);;

let COCOUNTABLE_APPROXIMATION = prove
 (`!s. COUNTABLE((:real) DIFF s)
       ==> !x e. &0 < e ==> ?y. y IN s /\ abs(y - x) < e`,
  GEN_TAC THEN REWRITE_TAC[COUNTABLE; ge_c] THEN DISCH_TAC THEN
  MATCH_MP_TAC COSMALL_APPROXIMATION THEN
  TRANS_TAC CARD_LET_TRANS `(:num)` THEN ASM_REWRITE_TAC[] THEN
  TRANS_TAC CARD_LTE_TRANS `(:num->bool)` THEN SIMP_TAC[CANTOR_THM_UNIV] THEN
  MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
  REWRITE_TAC[CARD_EQ_REAL]);;

let OPEN_SET_COSMALL_COORDINATES = prove
 (`!P. (!i. 1 <= i /\ i <= dimindex(:N)
            ==> (:real) DIFF {x | P i x} <_c (:real))
       ==> !s:real^N->bool.
              open s /\ ~(s = {})
              ==> ?x. x IN s /\ !i. 1 <= i /\ i <= dimindex(:N) ==> P i (x$i)`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
  DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN
   `!i. 1 <= i /\ i <= dimindex(:N)
        ==> ?y:real. P i y /\ abs(y - (a:real^N)$i) < d / &(dimindex(:N))`
  MP_TAC THENL
   [X_GEN_TAC `i:num` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(MP_TAC o MATCH_MP COSMALL_APPROXIMATION) THEN
    REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN
    ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1];
    REWRITE_TAC[LAMBDA_SKOLEM] THEN MATCH_MP_TAC MONO_EXISTS THEN
    REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
    REWRITE_TAC[IN_CBALL; dist] THEN
    W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
    MATCH_MP_TAC SUM_BOUND_GEN THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
    REWRITE_TAC[VECTOR_SUB_COMPONENT; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1] THEN
    ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN
    ASM_SIMP_TAC[REAL_LT_IMP_LE; CARD_NUMSEG_1]]);;

let OPEN_SET_COCOUNTABLE_COORDINATES = prove
 (`!P. (!i. 1 <= i /\ i <= dimindex(:N)
            ==> COUNTABLE((:real) DIFF {x | P i x}))
       ==> !s:real^N->bool.
              open s /\ ~(s = {})
              ==> ?x. x IN s /\ !i. 1 <= i /\ i <= dimindex(:N) ==> P i (x$i)`,
  GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC OPEN_SET_COSMALL_COORDINATES THEN
  REPEAT STRIP_TAC THEN
  TRANS_TAC CARD_LET_TRANS `(:num)` THEN ASM_SIMP_TAC[GSYM COUNTABLE_ALT] THEN
  TRANS_TAC CARD_LTE_TRANS `(:num->bool)` THEN SIMP_TAC[CANTOR_THM_UNIV] THEN
  MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
  REWRITE_TAC[CARD_EQ_REAL]);;

let OPEN_SET_IRRATIONAL_COORDINATES = prove
 (`!s:real^N->bool.
        open s /\ ~(s = {})
        ==> ?x. x IN s /\ !i. 1 <= i /\ i <= dimindex(:N) ==> ~rational(x$i)`,
  MATCH_MP_TAC OPEN_SET_COCOUNTABLE_COORDINATES THEN
  REWRITE_TAC[SET_RULE `UNIV DIFF {x | ~P x} = P`; COUNTABLE_RATIONAL]);;

let CLOSURE_COSMALL_COORDINATES = prove
 (`!P. (!i. 1 <= i /\ i <= dimindex(:N)
            ==> (:real) DIFF {x | P i x} <_c (:real))
       ==> closure {x | !i. 1 <= i /\ i <= dimindex (:N) ==> P i (x$i)} =
           (:real^N)`,
  GEN_TAC THEN DISCH_TAC THEN
  REWRITE_TAC[CLOSURE_APPROACHABLE; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN
  MAP_EVERY X_GEN_TAC [`x:real^N`; `e:real`] THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_SET_COSMALL_COORDINATES) THEN
  DISCH_THEN(MP_TAC o SPEC `ball(x:real^N,e)`) THEN
  ASM_REWRITE_TAC[OPEN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE; IN_BALL] THEN
  MESON_TAC[DIST_SYM]);;

let CLOSURE_COCOUNTABLE_COORDINATES = prove
 (`!P. (!i. 1 <= i /\ i <= dimindex(:N)
            ==> COUNTABLE((:real) DIFF {x | P i x}))
       ==> closure {x | !i. 1 <= i /\ i <= dimindex (:N) ==> P i (x$i)} =
           (:real^N)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_COSMALL_COORDINATES THEN
  REPEAT STRIP_TAC THEN
  TRANS_TAC CARD_LET_TRANS `(:num)` THEN ASM_SIMP_TAC[GSYM COUNTABLE_ALT] THEN
  TRANS_TAC CARD_LTE_TRANS `(:num->bool)` THEN SIMP_TAC[CANTOR_THM_UNIV] THEN
  MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
  REWRITE_TAC[CARD_EQ_REAL]);;

let CLOSURE_IRRATIONAL_COORDINATES = prove
 (`closure {x | !i. 1 <= i /\ i <= dimindex (:N) ==> ~rational(x$i)} =
   (:real^N)`,
  MATCH_MP_TAC CLOSURE_COCOUNTABLE_COORDINATES THEN
  REWRITE_TAC[SET_RULE `UNIV DIFF {x | ~P x} = P`; COUNTABLE_RATIONAL]);;

(* ------------------------------------------------------------------------- *)
(* Every path between distinct points contains an arc, and hence             *)
(* that path connection is equivalent to arcwise connection, for distinct    *)
(* points. The proof is based on Whyburn's "Topological Analysis".           *)
(* ------------------------------------------------------------------------- *)

let HOMEOMORPHIC_MONOTONE_IMAGE_INTERVAL = prove
 (`!f:real^1->real^N.
       f continuous_on interval[vec 0,vec 1] /\
       (!y. connected {x | x IN interval[vec 0,vec 1] /\ f x = y}) /\
       ~(f(vec 1) = f(vec 0))
       ==> (IMAGE f (interval[vec 0,vec 1])) homeomorphic
           (interval[vec 0:real^1,vec 1])`,
  let closure_dyadic_rationals_in_convex_set_pos_1 = prove
   (`!s. convex s /\ ~(interior s = {}) /\ (!x. x IN s ==> &0 <= drop x)
         ==> closure(s INTER { lift(&m / &2 pow n) |
                               m IN (:num) /\ n IN (:num)}) =
             closure s`,
    REPEAT STRIP_TAC THEN
    MP_TAC(ISPEC `s:real^1->bool` CLOSURE_DYADIC_RATIONALS_IN_CONVEX_SET) THEN
    ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN
    MATCH_MP_TAC(SET_RULE
     `(!x. x IN t ==> x IN u) /\ (!x. x IN u ==> x IN s ==> x IN t)
      ==> s INTER t = s INTER u`) THEN
    REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; DIMINDEX_1; FORALL_1] THEN
    REWRITE_TAC[IN_ELIM_THM; EXISTS_LIFT; GSYM drop; LIFT_DROP] THEN
    REWRITE_TAC[REAL_ARITH `x / y:real = inv y * x`; LIFT_CMUL] THEN
    CONJ_TAC THENL [MESON_TAC[INTEGER_CLOSED]; ALL_TAC] THEN
    MAP_EVERY X_GEN_TAC [`n:num`; `x:real^1`] THEN REPEAT DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `inv(&2 pow n) % x:real^1`) THEN
    ASM_SIMP_TAC[DROP_CMUL; REAL_LE_MUL_EQ; REAL_LT_POW2; REAL_LT_INV_EQ] THEN
    ASM_MESON_TAC[INTEGER_POS; LIFT_DROP]) in
  let function_on_dyadic_rationals = prove
   (`!f:num->num->A.
          (!m n. f (2 * m) (n + 1) = f m n)
          ==> ?g. !m n. g(&m / &2 pow n) = f m n`,
    REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN MP_TAC(ISPECL
     [`\(m,n). (f:num->num->A) m n`; `\(m,n). &m / &2 pow n`]
     FUNCTION_FACTORS_LEFT) THEN
    REWRITE_TAC[FORALL_PAIR_THM; FUN_EQ_THM; o_THM] THEN
    DISCH_THEN (SUBST1_TAC o SYM) THEN
    ONCE_REWRITE_TAC[MESON[]
      `(!a b c d. P a b c d) <=> (!b d a c. P a b c d)`] THEN
    MATCH_MP_TAC WLOG_LE THEN REPEAT CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
    SIMP_TAC[REAL_FIELD `~(y = &0) /\ ~(y' = &0)
                         ==> (x / y = x' / y' <=> y' / y * x = x')`;
       REAL_POW_EQ_0; REAL_OF_NUM_EQ; REAL_DIV_POW2; ARITH_EQ] THEN
    SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN
    SIMP_TAC[ADD_SUB2; REAL_OF_NUM_MUL; REAL_OF_NUM_EQ; REAL_OF_NUM_POW] THEN
    REWRITE_TAC[MESON[]
     `(!n n' d. n' = f d n ==> !m m'. g d m = m' ==> P m m' n d) <=>
      (!d m n. P m (g d m) n d)`] THEN
    INDUCT_TAC THEN SIMP_TAC[EXP; MULT_CLAUSES; ADD_CLAUSES] THEN
    REWRITE_TAC[GSYM MULT_ASSOC; ADD1] THEN ASM_MESON_TAC[]) in
  let recursion_on_dyadic_rationals = prove
   (`!b:num->A l r.
          ?f. (!m. f(&m) = b m) /\
              (!m n. f(&(4 * m + 1) / &2 pow (n + 1)) =
                     l(f(&(2 * m + 1) / &2 pow n))) /\
              (!m n. f(&(4 * m + 3) / &2 pow (n + 1)) =
                     r(f(&(2 * m + 1) / &2 pow n)))`,
    REPEAT GEN_TAC THEN
    SUBGOAL_THEN
     `?f:num->num->A.
          (!m n. f (2 * m) (n + 1) = f m n) /\
          (!m. f m 0 = b m) /\
          (!m n. f (4 * m + 1) (n + 1) = l(f (2 * m + 1) n)) /\
          (!m n. f (4 * m + 3) (n + 1) = r(f (2 * m + 1) n))`
    MP_TAC THENL
     [MP_TAC(prove_recursive_functions_exist num_RECURSION
       `(!m. f m 0 = (b:num->A) m) /\
        (!m n. f m (SUC n) =
                  if EVEN m then f (m DIV 2) n
                  else if EVEN(m DIV 2)
                       then l(f ((m + 1) DIV 2) n)
                       else r(f (m DIV 2) n))`) THEN
      MATCH_MP_TAC MONO_EXISTS THEN
      X_GEN_TAC `f:num->num->A` THEN STRIP_TAC THEN
      RULE_ASSUM_TAC(REWRITE_RULE[ADD1]) THEN ASM_REWRITE_TAC[] THEN
      REWRITE_TAC[EVEN_MULT; ARITH_EVEN; ARITH_RULE `(2 * m) DIV 2 = m`] THEN
      REWRITE_TAC[ARITH_RULE `(4 * m + 1) DIV 2 = 2 * m`;
                  ARITH_RULE `(4 * m + 3) DIV 2 = 2 * m + 1`;
                  ARITH_RULE `((4 * m + 1) + 1) DIV 2 = 2 * m + 1`;
                  ARITH_RULE `((4 * m + 3) + 1) DIV 2 = 2 * m + 2`] THEN
      REWRITE_TAC[EVEN_ADD; EVEN_MULT; EVEN; ARITH_EVEN; SND];
      DISCH_THEN(X_CHOOSE_THEN `f:num->num->A`
       (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN
      DISCH_THEN(MP_TAC o MATCH_MP function_on_dyadic_rationals) THEN
      MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
      DISCH_THEN(fun th -> RULE_ASSUM_TAC(REWRITE_RULE[GSYM th])) THEN
      RULE_ASSUM_TAC(REWRITE_RULE[REAL_ARITH `x / &2 pow 0 = x`]) THEN
      ASM_REWRITE_TAC[]]) in
  let recursion_on_dyadic_rationals_1 = prove
   (`!b:A l r.
          ?f. (!m. f(&m / &2) = b) /\
              (!m n. 0 < n ==> f(&(4 * m + 1) / &2 pow (n + 1)) =
                               l(f(&(2 * m + 1) / &2 pow n))) /\
              (!m n. 0 < n ==> f(&(4 * m + 3) / &2 pow (n + 1)) =
                               r(f(&(2 * m + 1) / &2 pow n)))`,
    REPEAT GEN_TAC THEN
    MP_TAC(ISPECL [`(\n. b):num->A`; `l:A->A`; `r:A->A`]
          recursion_on_dyadic_rationals) THEN
    REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `f:real->A` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `\x. (f:real->A)(&2 * x)` THEN
    ASM_REWRITE_TAC[REAL_ARITH `&2 * x / &2 = x`] THEN
    CONJ_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[LT_REFL] THEN
    ASM_SIMP_TAC[ADD_CLAUSES; real_pow; REAL_POW_EQ_0; REAL_OF_NUM_EQ;
      ARITH_EQ; REAL_FIELD `~(y = &0) ==> &2 * x / (&2 * y) = x / y`]) in
  let exists_function_unpair = prove
   (`(?f:A->B#C. P f) <=> (?f1 f2. P(\x. (f1 x,f2 x)))`,
    EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN STRIP_TAC THEN
    EXISTS_TAC `\x. FST((f:A->B#C) x)` THEN
    EXISTS_TAC `\x. SND((f:A->B#C) x)` THEN
    ASM_REWRITE_TAC[PAIR; ETA_AX]) in
  let dyadics_in_open_unit_interval = prove
   (`interval(vec 0,vec 1) INTER
      {lift(&m / &2 pow n) | m IN (:num) /\ n IN (:num)} =
      {lift(&m / &2 pow n) | 0 < m /\ m < 2 EXP n}`,
    MATCH_MP_TAC(SET_RULE
     `(!m n. (f m n) IN s <=> P m n)
      ==> s INTER {f m n | m IN UNIV /\ n IN UNIV} =
          {f m n | P m n}`) THEN
    REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
    SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN
    SIMP_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_POW; REAL_OF_NUM_LT]) in
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `!a b m. m IN interval[a,b] /\ interval[a,b] SUBSET interval[vec 0,vec 1]
            ==> ?c d. drop a <= drop c /\ drop c <= drop m /\
                      drop m <= drop d /\ drop d <= drop b /\
                      (!x. x IN interval[c,d] ==> f x = f m) /\
                      (!x. x IN interval[a,c] DELETE c ==> ~(f x = f m)) /\
                      (!x. x IN interval[d,b] DELETE d ==> ~(f x = f m)) /\
                      (!x y. x IN interval[a,c] DELETE c /\
                             y IN interval[d,b] DELETE d
                             ==> ~((f:real^1->real^N) x = f y))`
  MP_TAC THENL
   [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; SUBSET_INTERVAL_1] THEN
    REPEAT STRIP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
    SUBGOAL_THEN
     `?c d. {x | x IN interval[a,b] /\ (f:real^1->real^N) x = f m} =
            interval[c,d]`
    MP_TAC THENL
     [SUBGOAL_THEN
       `{x | x IN interval[a,b] /\ (f:real^1->real^N) x = f m} =
        interval[a,b] INTER
        {x | x IN interval[vec 0,vec 1] /\ (f:real^1->real^N) x = f m}`
      SUBST1_TAC THENL
       [REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL_1; IN_ELIM_THM;
                    DROP_VEC] THEN
        GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN ASM_REAL_ARITH_TAC;
        ALL_TAC] THEN
      SUBGOAL_THEN
       `?c d. {x | x IN interval[vec 0,vec 1] /\ (f:real^1->real^N) x = f m} =
              interval[c,d]`
      MP_TAC THENL
       [ASM_REWRITE_TAC[GSYM CONNECTED_COMPACT_INTERVAL_1] THEN
        ONCE_REWRITE_TAC[SET_RULE
         `{x | x IN s /\ P x} = s INTER {x | x IN s /\ P x}`] THEN
        MATCH_MP_TAC COMPACT_INTER_CLOSED THEN
        REWRITE_TAC[COMPACT_INTERVAL] THEN
        MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_CONSTANT THEN
        ASM_REWRITE_TAC[CLOSED_INTERVAL];
        STRIP_TAC THEN ASM_REWRITE_TAC[INTER_INTERVAL_1] THEN MESON_TAC[]];
      ALL_TAC] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^1` THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^1` THEN DISCH_TAC THEN
    SUBGOAL_THEN `m IN interval[c:real^1,d]` MP_TAC THENL
     [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN
      REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
                  ASM_REAL_ARITH_TAC;
      REWRITE_TAC[IN_INTERVAL_1; IN_DELETE] THEN STRIP_TAC] THEN
    SUBGOAL_THEN `{c:real^1,d} SUBSET interval[c,d]` MP_TAC THENL
     [ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_INTERVAL_1] THEN
      ASM_REAL_ARITH_TAC;
      FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV)
       [GSYM th]) THEN
      REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM; IN_INTERVAL_1] THEN
      STRIP_TAC THEN ASM_REWRITE_TAC[]] THEN
    CONJ_TAC THENL
     [GEN_TAC THEN REWRITE_TAC[GSYM IN_INTERVAL_1] THEN
      FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC  (LAND_CONV o RAND_CONV)
       [GSYM th]) THEN SIMP_TAC[IN_ELIM_THM];
      ALL_TAC] THEN
    GEN_REWRITE_TAC I [CONJ_ASSOC] THEN CONJ_TAC THENL
     [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
      `{x | x IN s /\ f x = a} = t
       ==> (!x. P x ==> x IN s) /\ (!x. P x /\ Q x ==> ~(x IN t))
           ==> !x. P x /\ Q x ==> ~(f x = a)`)) THEN
      REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC;
      ALL_TAC] THEN
    MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
    REWRITE_TAC[GSYM DROP_EQ] THEN STRIP_TAC THEN
    SUBGOAL_THEN `{x:real^1,y} INTER interval[c,d] = {}` MP_TAC THENL
     [REWRITE_TAC[SET_RULE `{a,b} INTER s = {} <=> ~(a IN s) /\ ~(b IN s)`;
                  IN_INTERVAL_1] THEN
      ASM_REAL_ARITH_TAC;
      FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC
       (LAND_CONV o LAND_CONV o RAND_CONV) [GSYM th])] THEN
    REWRITE_TAC[SET_RULE `{a,b} INTER s = {} <=> ~(a IN s) /\ ~(b IN s)`] THEN
    REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL_1] THEN
    ASM_CASES_TAC `(f:real^1->real^N) x = f m` THENL
     [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN
    ASM_CASES_TAC `(f:real^1->real^N) y = f m` THENL
     [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN
    ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM IS_INTERVAL_CONNECTED_1] o
                  SPEC `(f:real^1->real^N) y`) THEN
    ASM_REWRITE_TAC[IS_INTERVAL_1] THEN DISCH_THEN(MP_TAC o SPECL
     [`x:real^1`; `y:real^1`; `m:real^1`]) THEN
    ASM_REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
    ASM_REAL_ARITH_TAC;
    REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC
     [`leftcut:real^1->real^1->real^1->real^1`;
      `rightcut:real^1->real^1->real^1->real^1`] THEN
    STRIP_TAC] THEN
  FIRST_ASSUM(MP_TAC o SPECL
   [`vec 0:real^1`; `vec 1:real^1`; `vec 0:real^1`]) THEN
  REWRITE_TAC[SUBSET_REFL; ENDS_IN_UNIT_INTERVAL] THEN ABBREV_TAC
   `u = (rightcut:real^1->real^1->real^1->real^1) (vec 0) (vec 1) (vec 0)` THEN
  REWRITE_TAC[CONJ_ASSOC; REAL_LE_ANTISYM; DROP_EQ] THEN
  REWRITE_TAC[GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
  DISCH_THEN(SUBST1_TAC o SYM) THEN
  REWRITE_TAC[INTERVAL_SING; SET_RULE `~(x IN ({a} DELETE a))`] THEN
  STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o SPECL
   [`u:real^1`; `vec 1:real^1`; `vec 1:real^1`]) THEN
  REWRITE_TAC[ENDS_IN_INTERVAL; SUBSET_INTERVAL_1; INTERVAL_NE_EMPTY_1] THEN
  ASM_REWRITE_TAC[REAL_LE_REFL] THEN ABBREV_TAC
   `v = (leftcut:real^1->real^1->real^1->real^1) u (vec 1) (vec 1)` THEN
  ONCE_REWRITE_TAC[TAUT
    `a /\ b /\ c /\ d /\ e <=> (c /\ d) /\ a /\ b /\ e`] THEN
  REWRITE_TAC[REAL_LE_ANTISYM; DROP_EQ] THEN
  ONCE_REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
  REWRITE_TAC[INTERVAL_SING; SET_RULE `~(x IN ({a} DELETE a))`] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN
   `!x. x IN interval[vec 0,v] DELETE v
        ==> ~((f:real^1->real^N) x = f(vec 1))`
  ASSUME_TAC THENL
   [X_GEN_TAC `t:real^1` THEN
    REWRITE_TAC[IN_DELETE; IN_INTERVAL_1; GSYM DROP_EQ] THEN STRIP_TAC THEN
    ASM_CASES_TAC `drop t < drop u` THENL
     [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
       `~(f1 = f0) ==> ft = f0 ==> ~(ft = f1)`));
      ALL_TAC] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    ASM_REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN
    ASM_REAL_ARITH_TAC;
    UNDISCH_THEN
      `!x. x IN interval[u,v] DELETE v ==> ~((f:real^1->real^N) x = f (vec 1))`
      (K ALL_TAC)] THEN
  MP_TAC(ISPECL
   [`(u:real^1,v:real^1)`;
    `\(a,b). (a:real^1,leftcut a b (midpoint(a,b)):real^1)`;
    `\(a,b). (rightcut a b (midpoint(a,b)):real^1,b:real^1)`]
        recursion_on_dyadic_rationals_1) THEN
  REWRITE_TAC[exists_function_unpair; PAIR_EQ] THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`a:real->real^1`; `b:real->real^1`] THEN
  ABBREV_TAC `(c:real->real^1) x = midpoint(a x,b x)` THEN
  REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN
  REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN
  SUBGOAL_THEN
   `!m n. drop u <= drop(a(&m / &2 pow n)) /\
          drop(a(&m / &2 pow n)) <= drop(b(&m / &2 pow n)) /\
          drop(b(&m / &2 pow n)) <= drop v`
  MP_TAC THENL
   [GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN MATCH_MP_TAC num_INDUCTION THEN
    CONJ_TAC THENL
     [REWRITE_TAC[REAL_ARITH `x / &2 pow 0 = (&2 * x) / &2`] THEN
      ASM_REWRITE_TAC[REAL_OF_NUM_MUL; REAL_LE_REFL];
      X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "*")] THEN
    X_GEN_TAC `p:num` THEN DISJ_CASES_TAC(SPEC `p:num` EVEN_OR_ODD) THENL
     [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
      DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
      REWRITE_TAC[GSYM REAL_OF_NUM_MUL; real_pow] THEN
      ASM_SIMP_TAC[REAL_LT_POW2; REAL_FIELD
       `&0 < y ==> (&2 * x) / (&2 * y) = x / y`];
      ALL_TAC] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
    DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
    DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL
     [ASM_REWRITE_TAC[real_pow; REAL_MUL_RID; REAL_LE_REFL];
      REWRITE_TAC[ADD1]] THEN
    DISJ_CASES_TAC(SPEC `m:num` EVEN_OR_ODD) THENL
     [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
      DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN
      ASM_SIMP_TAC[ARITH_RULE `2 * 2 * r = 4 * r`];
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
      DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN
      ASM_SIMP_TAC[ARITH_RULE `2 * SUC(2 * r) + 1 = 4 * r + 3`]] THEN
    (FIRST_X_ASSUM(MP_TAC o SPECL
      [`a(&(2 * r + 1) / &2 pow n):real^1`;
       `b(&(2 * r + 1) / &2 pow n):real^1`;
       `c(&(2 * r + 1) / &2 pow n):real^1`]) THEN
     ANTS_TAC THENL
      [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
        [GSYM th]) THEN
       REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
       REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
       UNDISCH_TAC `drop(vec 0) <= drop u` THEN
       UNDISCH_TAC `drop v <= drop (vec 1)`;
       ALL_TAC] THEN
     REMOVE_THEN "*" (MP_TAC o SPEC `2 * r + 1`) THEN REAL_ARITH_TAC);
    REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN
  SUBGOAL_THEN `!m n. drop(vec 0) <= drop(a(&m / &2 pow n))` ASSUME_TAC THENL
   [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN
  SUBGOAL_THEN `!m n. drop(b(&m / &2 pow n)) <= drop(vec 1)` ASSUME_TAC THENL
   [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN
  SUBGOAL_THEN
   `!m n. drop(a(&m / &2 pow n)) <= drop(c(&m / &2 pow n)) /\
          drop(c(&m / &2 pow n)) <= drop(b(&m / &2 pow n))`
  MP_TAC THENL
   [UNDISCH_THEN `!x:real. midpoint(a x:real^1,b x) = c x`
      (fun th -> REWRITE_TAC[GSYM th]) THEN
    REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
    ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
     `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`];
    REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN
  SUBGOAL_THEN
   `!i m n j. ODD j /\
              abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n)
              ==> drop(a(&j / &2 pow n)) <= drop(c(&i / &2 pow m)) /\
                  drop(c(&i / &2 pow m)) <= drop(b(&j / &2 pow n))`
  ASSUME_TAC THENL
   [REPLICATE_TAC 3 GEN_TAC THEN WF_INDUCT_TAC `m - n:num` THEN
    DISJ_CASES_TAC(ARITH_RULE `m <= n \/ n:num < m`) THENL
     [GEN_TAC THEN STRIP_TAC THEN
      MP_TAC(SPEC `abs(&2 pow n) * abs(&i / &2 pow m - &j / &2 pow n)`
                REAL_ABS_INTEGER_LEMMA) THEN
      MATCH_MP_TAC(TAUT
       `i /\ ~b /\ (n ==> p) ==> (i /\ ~n ==> b) ==> p`) THEN
      REPEAT CONJ_TAC THENL
       [REWRITE_TAC[GSYM REAL_ABS_MUL; INTEGER_ABS] THEN
        REWRITE_TAC[REAL_ARITH
         `n * (x / m - y / n):real = x * (n / m) - y * (n / n)`] THEN
        ASM_SIMP_TAC[GSYM REAL_POW_SUB; LE_REFL; REAL_OF_NUM_EQ; ARITH_EQ] THEN
        MESON_TAC[INTEGER_CLOSED];
        SIMP_TAC[REAL_ABS_MUL; REAL_ABS_ABS; REAL_ABS_POW; REAL_ABS_NUM] THEN
        REWRITE_TAC[REAL_ARITH `~(&1 <= x * y) <=> y * x < &1`] THEN
        SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
        ASM_REWRITE_TAC[REAL_ARITH `&1 / x = inv x`];
        ASM_SIMP_TAC[REAL_ABS_POW; REAL_ABS_NUM; REAL_ENTIRE; REAL_LT_IMP_NZ;
          REAL_LT_POW2; REAL_ARITH `abs(x - y) = &0 <=> x = y`]];
      ALL_TAC] THEN
    X_GEN_TAC `k:num` THEN REWRITE_TAC[IMP_CONJ; ODD_EXISTS] THEN
    DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
    DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL
     [ASM_REWRITE_TAC[REAL_ARITH `x / &2 pow 0 = (&2 * x) / &2`] THEN
      ASM_REWRITE_TAC[REAL_OF_NUM_MUL] THEN ASM_MESON_TAC[REAL_LE_TRANS];
      ALL_TAC] THEN
    UNDISCH_THEN `n:num < m`
      (fun th -> let th' = MATCH_MP
                   (ARITH_RULE `n < m ==> m - SUC n < m - n`) th in
                 FIRST_X_ASSUM(MP_TAC o C MATCH_MP th')) THEN
    REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH
     `&i / &2 pow m = &(2 * j + 1) / &2 pow n \/
      &i / &2 pow m < &(2 * j + 1) / &2 pow n \/
      &(2 * j + 1) / &2 pow n < &i / &2 pow m`)
    THENL
     [ASM_REWRITE_TAC[ADD1];
      DISCH_THEN(MP_TAC o SPEC `4 * j + 1`) THEN
      REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN ASM_SIMP_TAC[ADD1] THEN
      MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL
       [MATCH_MP_TAC(REAL_ARITH
         `x < i /\ &2 * n1 = n /\ j + n1 = i
          ==> abs(x - i) < n ==> abs(x - j) < n1`) THEN
        ASM_REWRITE_TAC[REAL_ARITH `a / b + inv b = (a + &1) / b`] THEN
        REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN
        REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
        REAL_ARITH_TAC;
        MATCH_MP_TAC(REAL_ARITH
         `b' <= b ==> a <= c /\ c <= b' ==> a <= c /\ c <= b`) THEN
        FIRST_X_ASSUM(MP_TAC o SPECL
         [`a(&(2 * j + 1) / &2 pow n):real^1`;
          `b(&(2 * j + 1) / &2 pow n):real^1`;
          `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
        ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN
        FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
          [GSYM th]) THEN
        REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
        REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
        ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
         `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]];
      DISCH_THEN(MP_TAC o SPEC `4 * j + 3`) THEN
      REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN ASM_SIMP_TAC[ADD1] THEN
      MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL
       [MATCH_MP_TAC(REAL_ARITH
         `i < x /\ &2 * n1 = n /\ j - n1 = i
          ==> abs(x - i) < n ==> abs(x - j) < n1`) THEN
        ASM_REWRITE_TAC[REAL_ARITH `a / b - inv b = (a - &1) / b`] THEN
        REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN
        REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
        REAL_ARITH_TAC;
        MATCH_MP_TAC(REAL_ARITH
         `a <= a' ==> a' <= c /\ c <= b ==> a <= c /\ c <= b`) THEN
        FIRST_X_ASSUM(MP_TAC o SPECL
         [`a(&(2 * j + 1) / &2 pow n):real^1`;
          `b(&(2 * j + 1) / &2 pow n):real^1`;
          `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
        ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN
        FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
          [GSYM th]) THEN
        REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
        REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
        ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
         `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]]];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `!m n. ODD m ==> abs(drop(a(&m / &2 pow n)) - drop(b(&m / &2 pow n)))
                    <= &2 / &2 pow n`
  ASSUME_TAC THENL
   [ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN INDUCT_TAC THENL
     [ASM_REWRITE_TAC[REAL_ARITH `x / &2 pow 0 = (&2 * x) / &2`] THEN
      ASM_REWRITE_TAC[REAL_OF_NUM_MUL] THEN CONV_TAC NUM_REDUCE_CONV THEN
      RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC]) THEN ASM_REAL_ARITH_TAC;
      ALL_TAC] THEN
    X_GEN_TAC `m:num` THEN REWRITE_TAC[ODD_EXISTS] THEN
    DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
    DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL
     [ASM_REWRITE_TAC[ARITH; REAL_POW_1] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC]) THEN ASM_REAL_ARITH_TAC;
      ALL_TAC] THEN
    DISJ_CASES_TAC(SPEC `k:num` EVEN_OR_ODD) THENL
     [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
      DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
      REWRITE_TAC[ARITH_RULE `SUC(2 * 2 * j) = 4 * j + 1`] THEN
      ASM_SIMP_TAC[ADD1] THEN
      MATCH_MP_TAC(REAL_ARITH
       `drop c = (drop a + drop b) / &2 /\
        abs(drop a - drop b) <= &2 * k /\
        drop a <= drop(leftcut a b c) /\
        drop(leftcut a b c) <= drop c
        ==> abs(drop a - drop(leftcut a b c)) <= k`);
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
      DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
      REWRITE_TAC[ARITH_RULE `SUC(2 * SUC(2 * j)) = 4 * j + 3`] THEN
      ASM_SIMP_TAC[ADD1] THEN
      MATCH_MP_TAC(REAL_ARITH
       `drop c = (drop a + drop b) / &2 /\
        abs(drop a - drop b) <= &2 * k /\
        drop c <= drop(rightcut a b c) /\
        drop(rightcut a b c) <= drop b
        ==> abs(drop(rightcut a b c) - drop b) <= k`)] THEN
    (CONJ_TAC THENL
      [UNDISCH_THEN `!x:real. midpoint(a x:real^1,b x) = c x`
        (fun th -> REWRITE_TAC[GSYM th]) THEN
       REWRITE_TAC[midpoint; DROP_CMUL; DROP_ADD] THEN REAL_ARITH_TAC;
       ALL_TAC] THEN
     CONJ_TAC THENL
      [REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN
       REWRITE_TAC[REAL_ARITH `&2 * x * inv y * inv(&2 pow 1) = x / y`] THEN
       ASM_SIMP_TAC[GSYM real_div; ODD_ADD; ODD_MULT; ARITH];
       ALL_TAC] THEN
     FIRST_X_ASSUM(MP_TAC o SPECL
      [`a(&(2 * j + 1) / &2 pow n):real^1`;
       `b(&(2 * j + 1) / &2 pow n):real^1`;
       `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
     ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN
     FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
       [GSYM th]) THEN
     REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
     REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
     ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
      `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]);
    ALL_TAC] THEN
  SUBGOAL_THEN
   `!n j. 0 < 2 * j /\ 2 * j < 2 EXP n
          ==> (f:real^1->real^N)(b(&(2 * j - 1) / &2 pow n)) =
              f(a(&(2 * j + 1) / &2 pow n))`
  ASSUME_TAC THENL
   [MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
     [REWRITE_TAC[ARITH_RULE `0 < 2 * j <=> 0 < j`;
                  ARITH_RULE `2 * j < 2 <=> j < 1`] THEN
      ARITH_TAC;
      ALL_TAC] THEN
    X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "+") THEN
    DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL
     [ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN
      REWRITE_TAC[ARITH_RULE `0 < 2 * j <=> 0 < j`;
                   ARITH_RULE `2 * j < 2  <=> j < 1`] THEN
      ARITH_TAC;
      ALL_TAC] THEN
    X_GEN_TAC `k:num` THEN DISJ_CASES_TAC(SPEC `k:num` EVEN_OR_ODD) THENL
     [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
      DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
      REWRITE_TAC[EXP; ARITH_RULE `0 < 2 * j <=> 0 < j`; LT_MULT_LCANCEL] THEN
      CONV_TAC NUM_REDUCE_CONV THEN
      ASM_SIMP_TAC[ARITH_RULE `0 < j ==> 2 * 2 * j - 1 = 4 * (j - 1) + 3`;
        ADD1; ARITH_RULE `2 * 2 * j + 1 = 4 * j + 1`] THEN
      SIMP_TAC[ARITH_RULE `0 < j ==> 2 * (j - 1) + 1 = 2 * j - 1`] THEN
      STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
      DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN
      STRIP_TAC THEN
      ASM_SIMP_TAC[ADD1; ARITH_RULE `2 * SUC(2 * j) - 1 = 4 * j + 1`;
                   ARITH_RULE `2 * SUC(2 * j) + 1 = 4 * j + 3`] THEN
      FIRST_X_ASSUM(MP_TAC o SPECL
       [`a(&(2 * j + 1) / &2 pow n):real^1`;
        `b(&(2 * j + 1) / &2 pow n):real^1`;
        `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
      ANTS_TAC THENL
       [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
         [GSYM th]) THEN
        REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
        REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
        ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH
         `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`];
        REPLICATE_TAC 4 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
        DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
        MATCH_MP_TAC(MESON[]
         `a IN s /\ b IN s ==> (!x. x IN s ==> f x = c) ==> f a = f b`) THEN
        REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN
        ASM_MESON_TAC[REAL_LE_TRANS]]];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `!n j. 0 < j /\ j < 2 EXP n
          ==> (f:real^1->real^N)(b(&(2 * j - 1) / &2 pow (n + 1))) =
              f(c(&j / &2 pow n)) /\
              f(a(&(2 * j + 1) / &2 pow (n + 1))) = f(c(&j / &2 pow n))`
  ASSUME_TAC THENL
   [MATCH_MP_TAC num_INDUCTION THEN
    REWRITE_TAC[ARITH_RULE `~(0 < j /\ j < 2 EXP 0)`] THEN
    X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "*") THEN
    X_GEN_TAC `j:num` THEN
    DISJ_CASES_TAC(SPEC `j:num` EVEN_OR_ODD) THENL
     [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
      DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
      REWRITE_TAC[ADD_CLAUSES; EXP; ARITH_RULE `0 < 2 * k <=> 0 < k`;
                  ARITH_RULE `2 * x < 2 * y <=> x < y`] THEN STRIP_TAC THEN
      REMOVE_THEN "*" (MP_TAC o SPEC `k:num`) THEN
      ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC(MESON[]
       `c' = c /\ a' = a /\ b' = b
        ==> b = c /\ a = c ==> b' = c' /\ a' = c'`) THEN
      REPEAT CONJ_TAC THEN AP_TERM_TAC THENL
       [AP_TERM_TAC THEN
        REWRITE_TAC[real_pow; real_div; REAL_INV_MUL;
                    GSYM REAL_OF_NUM_MUL] THEN
        REAL_ARITH_TAC;
        REWRITE_TAC[ADD1; ARITH_RULE `2 * 2 * n = 4 * n`] THEN
        FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC;
        SUBGOAL_THEN `k = PRE k + 1` SUBST1_TAC THENL
         [ASM_ARITH_TAC; ALL_TAC] THEN
        REWRITE_TAC[ARITH_RULE `2 * (k + 1) - 1 = 2 * k + 1`;
                    ARITH_RULE `2 * 2 * (k + 1) - 1 = 4 * k + 3`] THEN
        REWRITE_TAC[ADD1] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC];
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
      DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
      REWRITE_TAC[EXP; ARITH_RULE `SUC(2 * k) < 2 * n <=> k < n`] THEN
      STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
       [`a(&(2 * k + 1) / &2 pow (SUC n)):real^1`;
        `b(&(2 * k + 1) / &2 pow (SUC n)):real^1`;
        `c(&(2 * k + 1) / &2 pow (SUC n)):real^1`]) THEN
      ANTS_TAC THENL
       [ASM_REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1];
        REPLICATE_TAC 4 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
        DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)] THEN
      REWRITE_TAC[ARITH_RULE `SUC(2 * k) = 2 * k + 1`] THEN
      DISCH_THEN(fun th -> CONJ_TAC THEN MATCH_MP_TAC th) THEN
      ASM_SIMP_TAC[ARITH_RULE `2 * (2 * k + 1) - 1 = 4 * k + 1`; ADD1;
                   ARITH_RULE `2 * (2 * k + 1) + 1 = 4 * k + 3`;
                   ARITH_RULE `0 < n + 1`] THEN
      ASM_REWRITE_TAC[IN_INTERVAL_1; GSYM ADD1] THEN
      ASM_SIMP_TAC[ARITH_RULE `SUC(2 * k) = 2 * k + 1`] THEN
      ASM_REAL_ARITH_TAC];
    ALL_TAC] THEN
  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
  MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN
  REWRITE_TAC[COMPACT_INTERVAL] THEN
  MP_TAC(ISPECL [`\x. (f:real^1->real^N)(c(drop x))`;
                 `interval(vec 0,vec 1) INTER
                  {lift(&m / &2 pow n) | m IN (:num) /\ n IN (:num)}`]
        UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN
  SIMP_TAC[closure_dyadic_rationals_in_convex_set_pos_1;
           CONVEX_INTERVAL; INTERIOR_OPEN; OPEN_INTERVAL;
           UNIT_INTERVAL_NONEMPTY; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC;
           CLOSURE_OPEN_INTERVAL] THEN
  REWRITE_TAC[dyadics_in_open_unit_interval] THEN
  ANTS_TAC THENL
   [REWRITE_TAC[uniformly_continuous_on; FORALL_IN_GSPEC] THEN
    X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN
     `(f:real^1->real^N) uniformly_continuous_on interval[vec 0,vec 1]`
    MP_TAC THENL
     [ASM_SIMP_TAC[COMPACT_UNIFORMLY_CONTINUOUS; COMPACT_INTERVAL];
      REWRITE_TAC[uniformly_continuous_on]] THEN
    DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
    DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
    MP_TAC(SPECL [`inv(&2)`; `min (d:real) (&1 / &4)`] REAL_ARCH_POW_INV) THEN
    ASM_REWRITE_TAC[REAL_HALF; REAL_POW_INV; REAL_LT_MIN] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN
    DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN
    ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN STRIP_TAC THEN
    EXISTS_TAC `inv(&2 pow n)` THEN
    REWRITE_TAC[REAL_LT_POW2; REAL_LT_INV_EQ] THEN
    REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
    REWRITE_TAC[FORALL_IN_GSPEC] THEN
    SUBGOAL_THEN
     `!i j m. 0 < i /\ i < 2 EXP m /\ 0 < j /\ j < 2 EXP n /\
              abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n)
              ==> norm((f:real^1->real^N)(c(&i / &2 pow m)) -
                       f(c(&j / &2 pow n))) < e / &2`
    ASSUME_TAC THENL
     [REPEAT GEN_TAC THEN
      REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
      DISCH_THEN(DISJ_CASES_THEN MP_TAC o MATCH_MP (REAL_ARITH
       `abs(x - a) < e
        ==> x = a \/
            abs(x - (a - e / &2)) < e / &2 \/
            abs(x - (a + e / &2)) < e / &2`))
      THENL
       [DISCH_THEN SUBST1_TAC THEN
        ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_HALF];
        ALL_TAC] THEN
      SUBGOAL_THEN
       `&j / &2 pow n = &(2 * j) / &2 pow (n + 1)`
       (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th])
      THENL
       [REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL;
                    GSYM REAL_OF_NUM_MUL] THEN
        REAL_ARITH_TAC;
        ALL_TAC] THEN
      REWRITE_TAC[real_div; GSYM REAL_INV_MUL] THEN
      REWRITE_TAC[GSYM real_div;
           GSYM(ONCE_REWRITE_RULE[REAL_MUL_SYM] (CONJUNCT2 real_pow))] THEN
      REWRITE_TAC[ADD1; REAL_ARITH `x / n + inv n = (x + &1) / n`;
                  REAL_ARITH `x / n - inv n = (x - &1) / n`] THEN
      ASM_SIMP_TAC[REAL_OF_NUM_SUB; ARITH_RULE `0 < j ==> 1 <= 2 * j`] THEN
      REWRITE_TAC[REAL_OF_NUM_ADD] THEN STRIP_TAC THENL
       [SUBGOAL_THEN `(f:real^1->real^N)(c(&j / &2 pow n)) =
                      f(b (&(2 * j - 1) / &2 pow (n + 1)))`
        SUBST1_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC];
        SUBGOAL_THEN `(f:real^1->real^N)(c(&j / &2 pow n)) =
                      f(a (&(2 * j + 1) / &2 pow (n + 1)))`
        SUBST1_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC]] THEN
      REWRITE_TAC[GSYM dist] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      REWRITE_TAC[IN_INTERVAL_1] THEN
      REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC]) THEN
      FIRST_X_ASSUM(MP_TAC o SPECL [`i:num`; `m:num`; `n + 1`]) THENL
       [DISCH_THEN(MP_TAC o SPEC `2 * j - 1`) THEN REWRITE_TAC[ODD_SUB];
        DISCH_THEN(MP_TAC o SPEC `2 * j + 1`) THEN REWRITE_TAC[ODD_ADD]] THEN
      ASM_REWRITE_TAC[ODD_MULT; ARITH; ARITH_RULE `1 < 2 * j <=> 0 < j`] THEN
      REWRITE_TAC[DIST_REAL; GSYM drop] THENL
       [MATCH_MP_TAC(NORM_ARITH
         `!t. abs(a - b) <= t /\ t < d
              ==> a <= c /\ c <= b ==> abs(c - b) < d`);
        MATCH_MP_TAC(NORM_ARITH
         `!t. abs(a - b) <= t /\ t < d
              ==> a <= c /\ c <= b ==> abs(c - a) < d`)] THEN
      EXISTS_TAC `&2 / &2 pow (n + 1)` THEN
      (CONJ_TAC THENL
        [FIRST_X_ASSUM MATCH_MP_TAC THEN
         REWRITE_TAC[ODD_SUB; ODD_ADD; ODD_MULT; ARITH_ODD] THEN
         ASM_REWRITE_TAC[ARITH_RULE `1 < 2 * j <=> 0 < j`];
         REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN
         ASM_REAL_ARITH_TAC]);
      ALL_TAC] THEN
    MAP_EVERY X_GEN_TAC [`i:num`; `m:num`] THEN STRIP_TAC THEN
    MAP_EVERY X_GEN_TAC [`k:num`; `p:num`] THEN STRIP_TAC THEN
    REWRITE_TAC[DIST_LIFT; LIFT_DROP] THEN STRIP_TAC THEN
    SUBGOAL_THEN
     `?j. 0 < j /\ j < 2 EXP n /\
          abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n) /\
          abs(&k / &2 pow p - &j / &2 pow n) < inv(&2 pow n)`
    STRIP_ASSUME_TAC THENL
     [MP_TAC(SPEC `max (&2 pow n * &i / &2 pow m)
                       (&2 pow n * &k / &2 pow p)`
        FLOOR_POS) THEN
      SIMP_TAC[REAL_LE_MUL; REAL_LE_MAX; REAL_LE_DIV;
               REAL_POS; REAL_POW_LE] THEN
      DISCH_THEN(X_CHOOSE_TAC `j:num`) THEN
      MP_TAC(SPEC `max (&2 pow n * &i / &2 pow m)
                       (&2 pow n * &k / &2 pow p)` FLOOR) THEN
      ASM_REWRITE_TAC[REAL_LE_MAX; REAL_MAX_LT] THEN
      ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
      SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
      REWRITE_TAC[REAL_ARITH `(j + &1) / n = j / n + inv n`] THEN
      ASM_CASES_TAC `j = 0` THENL
       [ASM_REWRITE_TAC[REAL_ARITH `&0 / x = &0`; REAL_ADD_LID] THEN
        DISCH_TAC THEN EXISTS_TAC `1` THEN CONV_TAC NUM_REDUCE_CONV THEN
        REWRITE_TAC[ARITH_RULE `1 < n <=> 2 EXP 1 <= n`] THEN
        ASM_SIMP_TAC[LE_EXP; LE_1] THEN CONV_TAC NUM_REDUCE_CONV THEN
        MATCH_MP_TAC(REAL_ARITH
         `&0 < x /\ x < inv n /\ &0 < y /\ y < inv n
          ==> abs(x - &1 / n) < inv n /\ abs(y - &1 / n) < inv n`) THEN
        ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; REAL_LT_POW2];
        DISCH_TAC THEN EXISTS_TAC `j:num` THEN ASM_SIMP_TAC[LE_1] THEN
        REWRITE_TAC[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_POW] THEN
        CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
        FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN
        SIMP_TAC[GSYM REAL_NOT_LE; REAL_LE_FLOOR; INTEGER_CLOSED] THEN
        REWRITE_TAC[REAL_NOT_LE; REAL_MAX_LT] THEN
        REWRITE_TAC[REAL_ARITH `n * x < n <=> n * x < n * &1`] THEN
        SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LT_POW2; REAL_LT_LDIV_EQ] THEN
        ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_POW; REAL_OF_NUM_LT]];
      MATCH_MP_TAC(NORM_ARITH
       `!u. dist(w:real^N,u) < e / &2 /\ dist(z,u) < e / &2
            ==> dist(w,z) < e`) THEN
      EXISTS_TAC `(f:real^1->real^N)(c(&j / &2 pow n))` THEN
      REWRITE_TAC[dist] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      ASM_REWRITE_TAC[]];
    ALL_TAC] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^1->real^N` THEN
  REWRITE_TAC[FORALL_IN_GSPEC; LIFT_DROP] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o CONJUNCT1)) THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS) THEN
  ONCE_REWRITE_TAC[MESON[] `h x = f(c(drop x)) <=> f(c(drop x)) = h x`] THEN
  REWRITE_TAC[IN_INTER; IMP_CONJ_ALT; FORALL_IN_GSPEC] THEN
  ASM_REWRITE_TAC[IN_UNIV; LIFT_DROP; IMP_IMP; GSYM CONJ_ASSOC] THEN
  REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
  SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN
  REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN
  REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LT] THEN
  REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN DISCH_TAC THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
     [MP_TAC(ISPEC `interval(vec 0:real^1,vec 1)`
        closure_dyadic_rationals_in_convex_set_pos_1) THEN
      SIMP_TAC[CONVEX_INTERVAL; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC;
        INTERIOR_OPEN; OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; REAL_LT_01;
        CLOSURE_OPEN_INTERVAL] THEN
      DISCH_THEN(fun th ->
        GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM th]) THEN
      MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN REPEAT CONJ_TAC THENL
       [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN
        MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_INTERVAL] THEN
        MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN
        REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED];
        MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
        MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
        ASM_REWRITE_TAC[COMPACT_INTERVAL];
        SIMP_TAC[dyadics_in_open_unit_interval; SUBSET; FORALL_IN_IMAGE] THEN
        ASM_SIMP_TAC[FORALL_IN_GSPEC] THEN
        MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN
        MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1] THEN
        ASM_MESON_TAC[REAL_LE_TRANS]];
      MATCH_MP_TAC SUBSET_TRANS THEN
      EXISTS_TAC `closure(IMAGE (h:real^1->real^N)
                                 (interval (vec 0,vec 1) INTER
        {lift (&m / &2 pow n) | m IN (:num) /\ n IN (:num)}))` THEN
      CONJ_TAC THENL
       [ALL_TAC;
        MATCH_MP_TAC CLOSURE_MINIMAL THEN
        ASM_SIMP_TAC[COMPACT_IMP_CLOSED; COMPACT_INTERVAL;
                     COMPACT_CONTINUOUS_IMAGE] THEN
        MATCH_MP_TAC IMAGE_SUBSET THEN
        MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN
        REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED]] THEN
      REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE; FORALL_IN_IMAGE] THEN
      REWRITE_TAC[dyadics_in_open_unit_interval;
                  EXISTS_IN_IMAGE; EXISTS_IN_GSPEC] THEN
      X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN
      X_GEN_TAC `e:real` THEN DISCH_TAC THEN UNDISCH_TAC
       `(f:real^1->real^N) continuous_on interval [vec 0,vec 1]` THEN
      DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        COMPACT_UNIFORMLY_CONTINUOUS)) THEN
      REWRITE_TAC[COMPACT_INTERVAL; uniformly_continuous_on] THEN
      DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
      DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
      SUBGOAL_THEN
       `!n. ~(n = 0)
            ==> ?m y. ODD m /\ 0 < m /\ m < 2 EXP n /\
                      y IN interval[a(&m / &2 pow n),b(&m / &2 pow n)] /\
                     (f:real^1->real^N) y = f x`
      MP_TAC THENL
       [ALL_TAC;
        MP_TAC(SPECL [`inv(&2)`; `min (d / &2) (&1 / &4)`]
         REAL_ARCH_POW_INV) THEN
        ASM_REWRITE_TAC[REAL_HALF; REAL_POW_INV; REAL_LT_MIN] THEN
        CONV_TAC REAL_RAT_REDUCE_CONV THEN
        DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN
        ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN
        CONV_TAC REAL_RAT_REDUCE_CONV THEN STRIP_TAC THEN
        DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN
        MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN
        DISCH_THEN(X_CHOOSE_THEN `y:real^1` MP_TAC) THEN
        REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
        DISCH_THEN(SUBST1_TAC o SYM) THEN EXISTS_TAC `n:num` THEN
        ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
        RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
        REWRITE_TAC[DIST_REAL; GSYM drop; IN_INTERVAL_1] THEN
        REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC]) THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
         `a <= y /\ y <= b
          ==> a <= c /\ c <= b /\ abs(a - b) < d
              ==> abs(c - y) < d`)) THEN
        REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC]) THEN
        MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&2 / &2 pow n` THEN
        ASM_SIMP_TAC[] THEN ASM_REAL_ARITH_TAC] THEN
      MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[NOT_SUC] THEN
      X_GEN_TAC `n:num` THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THENL
       [EXISTS_TAC `1` THEN CONV_TAC NUM_REDUCE_CONV THEN
        ASM_REWRITE_TAC[REAL_POW_1] THEN
        SUBGOAL_THEN
         `x IN interval[vec 0:real^1,u] \/
          x IN interval[u,v] \/
          x IN interval[v,vec 1]`
        STRIP_ASSUME_TAC THENL
         [REWRITE_TAC[IN_INTERVAL_1] THEN
          RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
          ASM_REAL_ARITH_TAC;
          EXISTS_TAC `u:real^1` THEN
          ASM_MESON_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1];
          EXISTS_TAC `x:real^1` THEN ASM_MESON_TAC[];
          EXISTS_TAC `v:real^1` THEN
          ASM_MESON_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1]];
        DISCH_THEN(X_CHOOSE_THEN `m:num`
         (X_CHOOSE_THEN `y:real^1` MP_TAC)) THEN
        REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
        DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (SUBST1_TAC o SYM)) THEN
        FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
        DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST_ALL_TAC) THEN
        REWRITE_TAC[ADD1] THEN DISCH_TAC THEN
        SUBGOAL_THEN
        `y IN interval[a(&(2 * j + 1) / &2 pow n):real^1,
                       b(&(4 * j + 1) / &2 pow (n + 1))] \/
         y IN interval[b(&(4 * j + 1) / &2 pow (n + 1)),
                       a(&(4 * j + 3) / &2 pow (n + 1))] \/
         y IN interval[a(&(4 * j + 3) / &2 pow (n + 1)),
                       b(&(2 * j + 1) / &2 pow n)]`
        STRIP_ASSUME_TAC THENL
         [REWRITE_TAC[IN_INTERVAL_1] THEN
          RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
          ASM_REAL_ARITH_TAC;
          EXISTS_TAC `4 * j + 1` THEN
          EXISTS_TAC `y:real^1` THEN
          REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH; EXP_ADD] THEN
          REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN
          FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
           `y IN interval[a,b]
            ==> a = a' /\ b = b' ==> y IN interval[a',b']`)) THEN
          ASM_MESON_TAC[LE_1];
          EXISTS_TAC `4 * j + 1` THEN
          EXISTS_TAC `b(&(4 * j + 1) / &2 pow (n + 1)):real^1` THEN
          REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH; EXP_ADD] THEN
          REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN
          REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN
          CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN
          FIRST_X_ASSUM(MP_TAC o SPECL
           [`a(&(2 * j + 1) / &2 pow n):real^1`;
            `b(&(2 * j + 1) / &2 pow n):real^1`;
            `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN
          ANTS_TAC THENL
           [ASM_REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1];
            REPLICATE_TAC 4
             (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
            DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)] THEN
          MATCH_MP_TAC(MESON[]
           `a IN s /\ b IN s ==> (!x. x IN s ==> f x = k) ==> f a = f b`) THEN
          SUBGOAL_THEN
           `leftcut (a (&(2 * j + 1) / &2 pow n))
                    (b (&(2 * j + 1) / &2 pow n))
                    (c (&(2 * j + 1) / &2 pow n):real^1):real^1 =
            b(&(4 * j + 1) / &2 pow (n + 1)) /\
            rightcut (a (&(2 * j + 1) / &2 pow n))
                     (b (&(2 * j + 1) / &2 pow n))
                     (c (&(2 * j + 1) / &2 pow n)):real^1 =
            a(&(4 * j + 3) / &2 pow (n + 1))`
          (CONJUNCTS_THEN SUBST_ALL_TAC) THENL
            [ASM_MESON_TAC[LE_1]; ALL_TAC] THEN
          REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN
          CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
          FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
           `y IN interval[a,b]
            ==> a = a' /\ b = b' ==> y IN interval[a',b']`)) THEN
          ASM_MESON_TAC[LE_1];
          EXISTS_TAC `4 * j + 3` THEN
          EXISTS_TAC `y:real^1` THEN
          REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH; EXP_ADD] THEN
          REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN
          FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
           `y IN interval[a,b]
            ==> a = a' /\ b = b' ==> y IN interval[a',b']`)) THEN
          ASM_MESON_TAC[LE_1]]]];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `!n m. drop(a(&m / &2 pow n)) < drop(b(&m / &2 pow n)) /\
          (!x. drop(a(&m / &2 pow n)) < drop x /\
               drop x <= drop(b(&m / &2 pow n))
               ==> ~(f x = f(a(&m / &2 pow n)))) /\
          (!x. drop(a(&m / &2 pow n)) <= drop x /\
               drop x < drop(b(&m / &2 pow n))
               ==> ~(f x :real^N = f(b(&m / &2 pow n))))`
  ASSUME_TAC THENL
   [SUBGOAL_THEN `drop u < drop v` ASSUME_TAC THENL
     [ASM_REWRITE_TAC[REAL_LT_LE; DROP_EQ] THEN DISCH_THEN SUBST_ALL_TAC THEN
      RULE_ASSUM_TAC(REWRITE_RULE
       [IN_DELETE; IN_INTERVAL_1; GSYM DROP_EQ; DROP_VEC]) THEN
      ASM_MESON_TAC[DROP_EQ];
      ALL_TAC] THEN
    SUBGOAL_THEN
     `(!x. drop u < drop x /\ drop x <= drop v
          ==> ~((f:real^1->real^N) x = f u)) /\
      (!x. drop u <= drop x /\ drop x < drop v
           ==> ~(f x = f v))`
    STRIP_ASSUME_TAC THENL
     [SUBGOAL_THEN
       `(f:real^1->real^N) u = f(vec 0) /\
        (f:real^1->real^N) v = f(vec 1)`
       (CONJUNCTS_THEN SUBST1_TAC)
      THENL
       [CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
        ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL];
        ALL_TAC] THEN
      CONJ_TAC THEN GEN_TAC THEN STRIP_TAC THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN
      ASM_REWRITE_TAC[IN_DELETE; IN_INTERVAL_1; GSYM DROP_EQ] THEN
      ASM_REAL_ARITH_TAC;
      ALL_TAC] THEN
    MATCH_MP_TAC num_INDUCTION THEN
    ASM_REWRITE_TAC[REAL_ARITH `&m / &2 pow 0 = (&2 * &m) / &2`] THEN
    ASM_REWRITE_TAC[REAL_OF_NUM_MUL] THEN
    X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "*") THEN
    DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THEN
    ASM_REWRITE_TAC[ARITH; REAL_POW_1] THEN
    X_GEN_TAC `j:num` THEN
    DISJ_CASES_TAC(ISPEC `j:num` EVEN_OR_ODD) THENL
     [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
      DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
      SIMP_TAC[GSYM REAL_OF_NUM_MUL; real_div; REAL_INV_MUL; real_pow] THEN
      ASM_REWRITE_TAC[REAL_ARITH `(&2 * p) * inv(&2) * inv q = p / q`];
      ALL_TAC] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
    DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN
    DISJ_CASES_TAC(ISPEC `k:num` EVEN_OR_ODD) THENL
     [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
      DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
      ASM_SIMP_TAC[ARITH_RULE `2 * 2 * m = 4 * m`; ADD1] THEN
      FIRST_X_ASSUM(MP_TAC o SPECL
       [`a(&(2 * m + 1) / &2 pow n):real^1`;
        `b(&(2 * m + 1) / &2 pow n):real^1`;
        `c(&(2 * m + 1) / &2 pow n):real^1`]) THEN
      ANTS_TAC THENL
       [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
        ASM_MESON_TAC[REAL_LE_TRANS];
        REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
        DISCH_THEN(K ALL_TAC)] THEN
      SUBGOAL_THEN
       `(f:real^1->real^N)
        (leftcut (a (&(2 * m + 1) / &2 pow n):real^1)
                 (b (&(2 * m + 1) / &2 pow n):real^1)
                 (c (&(2 * m + 1) / &2 pow n):real^1)) =
        (f:real^1->real^N) (c(&(2 * m + 1) / &2 pow n))`
      ASSUME_TAC THENL
       [FIRST_X_ASSUM MATCH_MP_TAC THEN
        ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN ASM_REAL_ARITH_TAC;
        ASM_REWRITE_TAC[]] THEN
      GEN_REWRITE_TAC LAND_CONV [REAL_LT_LE] THEN ASM_REWRITE_TAC[DROP_EQ] THEN
      REPEAT CONJ_TAC THENL
       [DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
        UNDISCH_THEN
         `(f:real^1->real^N) (a (&(2 * m + 1) / &2 pow n)) =
          f(c (&(2 * m + 1) / &2 pow n))` (MP_TAC o SYM) THEN
        REWRITE_TAC[] THEN
        FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT1 o CONJUNCT2 o SPEC_ALL) THEN
        REWRITE_TAC[GSYM(ASSUME `!x. midpoint ((a:real->real^1) x,b x) = c x`);
                    midpoint; DROP_CMUL; DROP_ADD] THEN
        ASM_REWRITE_TAC[REAL_ARITH
         `a < inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a < b`];
        GEN_TAC THEN STRIP_TAC THEN
        FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT1 o CONJUNCT2 o SPEC_ALL) THEN
        ASM_MESON_TAC[REAL_LE_TRANS];
        GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM
         (fun th -> MATCH_MP_TAC th THEN
                    REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN
             GEN_REWRITE_TAC I [REAL_ARITH
              `(a <= x /\ x <= b) /\ ~(x = b) <=> a <= x /\ x < b`]) THEN
        ASM_REWRITE_TAC[]];
       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
       DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN
       ASM_SIMP_TAC[ARITH_RULE `2 * (2 * m + 1) + 1  = 4 * m + 3`; ADD1] THEN
       FIRST_X_ASSUM(MP_TAC o SPECL
        [`a(&(2 * m + 1) / &2 pow n):real^1`;
         `b(&(2 * m + 1) / &2 pow n):real^1`;
         `c(&(2 * m + 1) / &2 pow n):real^1`]) THEN
      ANTS_TAC THENL
       [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
        ASM_MESON_TAC[REAL_LE_TRANS];
        REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
        DISCH_THEN(K ALL_TAC)] THEN
      SUBGOAL_THEN
       `(f:real^1->real^N)
        (rightcut (a (&(2 * m + 1) / &2 pow n):real^1)
                  (b (&(2 * m + 1) / &2 pow n):real^1)
                  (c (&(2 * m + 1) / &2 pow n):real^1)) =
        (f:real^1->real^N) (c(&(2 * m + 1) / &2 pow n))`
      ASSUME_TAC THENL
       [FIRST_X_ASSUM MATCH_MP_TAC THEN
        ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN ASM_REAL_ARITH_TAC;
        ASM_REWRITE_TAC[]] THEN
      GEN_REWRITE_TAC LAND_CONV [REAL_LT_LE] THEN ASM_REWRITE_TAC[DROP_EQ] THEN
      REPEAT CONJ_TAC THENL
       [DISCH_THEN SUBST_ALL_TAC THEN
        UNDISCH_THEN
         `(f:real^1->real^N) (b (&(2 * m + 1) / &2 pow n)) =
          f(c (&(2 * m + 1) / &2 pow n))` (MP_TAC o SYM) THEN
        REWRITE_TAC[] THEN
        FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2 o CONJUNCT2 o SPEC_ALL) THEN
        REWRITE_TAC[GSYM(ASSUME `!x. midpoint ((a:real->real^1) x,b x) = c x`);
                    midpoint; DROP_CMUL; DROP_ADD] THEN
        ASM_REWRITE_TAC[REAL_ARITH
         `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) < b <=> a < b`];
        GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM
         (fun th -> MATCH_MP_TAC th THEN
                    REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN
             GEN_REWRITE_TAC I [REAL_ARITH
              `(a <= x /\ x <= b) /\ ~(x = a) <=> a < x /\ x <= b`]) THEN
        ASM_REWRITE_TAC[];
        GEN_TAC THEN STRIP_TAC THEN
        FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2 o CONJUNCT2 o SPEC_ALL) THEN
        ASM_MESON_TAC[REAL_LE_TRANS]]];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `!m i n j. 0 < i /\ i < 2 EXP m /\ 0 < j /\ j < 2 EXP n /\
              &i / &2 pow m < &j / &2 pow n
              ==> drop(c(&i / &2 pow m)) <= drop(c(&j / &2 pow n))`
  ASSUME_TAC THENL
   [SUBGOAL_THEN
     `!N m p i k.
         0 < i /\ i < 2 EXP m /\ 0 < k /\ k < 2 EXP p /\
         &i / &2 pow m < &k / &2 pow p /\ m + p = N
         ==> ?j n. ODD(j) /\ ~(n = 0) /\
                   &i / &2 pow m <= &j / &2 pow n /\
                   &j / &2 pow n <= &k / &2 pow p /\
                   abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n) /\
                   abs(&k / &2 pow p - &j / &2 pow n) < inv(&2 pow n)`
    MP_TAC THENL
     [MATCH_MP_TAC num_WF THEN X_GEN_TAC `N:num` THEN
      DISCH_THEN(LABEL_TAC "I") THEN
      MAP_EVERY X_GEN_TAC [`m:num`; `p:num`; `i:num`; `k:num`] THEN
      STRIP_TAC THEN
      SUBGOAL_THEN
       `&i / &2 pow m <= &1 / &2 pow 1 /\
        &1 / &2 pow 1 <= &k / &2 pow p \/
        &k / &2 pow p < &1 / &2 \/
        &1 / &2 < &i / &2 pow m`
       (REPEAT_TCL DISJ_CASES_THEN STRIP_ASSUME_TAC)
      THENL
       [ASM_REAL_ARITH_TAC;
        MAP_EVERY EXISTS_TAC [`1`; `1`] THEN ASM_REWRITE_TAC[ARITH] THEN
        MATCH_MP_TAC(REAL_ARITH
         `&0 < i /\ i <= &1 / &2 pow 1 /\ &1 / &2 pow 1 <= k /\ k < &1
          ==> abs(i -  &1 / &2 pow 1) < inv(&2 pow 1) /\
              abs(k -  &1 / &2 pow 1) < inv(&2 pow 1)`) THEN
        ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN
        REWRITE_TAC[MULT_CLAUSES; REAL_OF_NUM_POW; REAL_OF_NUM_MUL] THEN
        ASM_REWRITE_TAC[REAL_OF_NUM_LT];
        REMOVE_THEN "I" MP_TAC THEN
        POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
        SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THEN
        REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN
        REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN
        SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN
        REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN
        REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN
        STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `m + p:num`) THEN
        ANTS_TAC THENL [EXPAND_TAC "N" THEN ARITH_TAC; ALL_TAC] THEN
        DISCH_THEN(MP_TAC o SPECL [`m:num`; `p:num`; `i:num`; `k:num`]) THEN
        ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
         [MAP_EVERY UNDISCH_TAC
           [`&k / &2 pow SUC p < &1 / &2`;
            `&i / &2 pow SUC m < &k / &2 pow SUC p`] THEN
          REWRITE_TAC[real_div; real_pow; REAL_INV_MUL;
                      REAL_ARITH `x * inv(&2) * y = (x * y) * inv(&2)`] THEN
          SIMP_TAC[GSYM real_div; REAL_LT_DIV2_EQ; REAL_OF_NUM_LT; ARITH] THEN
          REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
           `x < y /\ y < &1 ==> x < &1 /\ y < &1`)) THEN
          SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN
          REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LT];
          MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `j:num` THEN
          DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN
          EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[NOT_SUC] THEN
          REWRITE_TAC[real_div; real_pow; REAL_INV_MUL;
                      REAL_ARITH `inv(&2) * y = y * inv(&2)`] THEN
          REWRITE_TAC[GSYM REAL_SUB_RDISTRIB; REAL_MUL_ASSOC;
                      REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN
          REWRITE_TAC[GSYM real_div; REAL_ABS_NUM] THEN
          ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LE_DIV2_EQ;
                       REAL_OF_NUM_LT; ARITH]];
        REMOVE_THEN "I" MP_TAC THEN
        POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
        SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THEN
        REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN
        REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN
        SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN
        REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN
        REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN
        STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `m + p:num`) THEN
        ANTS_TAC THENL [EXPAND_TAC "N" THEN ARITH_TAC; ALL_TAC] THEN
        DISCH_THEN(MP_TAC o SPECL
         [`m:num`; `p:num`; `i - 2 EXP m`; `k - 2 EXP p`]) THEN
        ASM_REWRITE_TAC[] THEN
        MAP_EVERY UNDISCH_TAC
         [`&1 / &2 < &i / &2 pow SUC m`;
          `&i / &2 pow SUC m < &k / &2 pow SUC p`] THEN
        REWRITE_TAC[real_div; real_pow; REAL_INV_MUL;
                    REAL_ARITH `x * inv(&2) * y = (x * y) * inv(&2)`] THEN
        SIMP_TAC[GSYM real_div; REAL_LT_DIV2_EQ; REAL_OF_NUM_LT; ARITH] THEN
        GEN_REWRITE_TAC I [IMP_IMP] THEN DISCH_THEN(fun th ->
          STRIP_ASSUME_TAC th THEN MP_TAC(MATCH_MP
           (REAL_ARITH `i < k /\ &1 < i ==> &1 < i /\ &1 < k`) th)) THEN
        SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN
        GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_OF_NUM_POW] THEN
        SIMP_TAC[REAL_OF_NUM_LT; GSYM REAL_OF_NUM_SUB; LT_IMP_LE] THEN
        STRIP_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN ANTS_TAC THENL
         [ASM_SIMP_TAC[ARITH_RULE `a < b ==> 0 < b - a`] THEN
          ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
          REWRITE_TAC[real_div; REAL_SUB_RDISTRIB] THEN
          ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN
          ASM_REWRITE_TAC[REAL_ARITH `u * inv v - &1 < w * inv z - &1 <=>
                                      u / v < w / z`] THEN
          CONJ_TAC THEN MATCH_MP_TAC(ARITH_RULE
           `i < 2 * m ==> i - m < m`) THEN
          ASM_REWRITE_TAC[GSYM(CONJUNCT2 EXP)];
          REWRITE_TAC[real_div; REAL_SUB_RDISTRIB] THEN
          ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN
          REWRITE_TAC[GSYM real_div] THEN
          DISCH_THEN(X_CHOOSE_THEN `j:num` (X_CHOOSE_THEN `n:num`
           STRIP_ASSUME_TAC)) THEN
          EXISTS_TAC `2 EXP n + j` THEN EXISTS_TAC `SUC n` THEN
          ASM_REWRITE_TAC[NOT_SUC; ODD_ADD; ODD_EXP; ARITH] THEN
          REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_POW] THEN
          REWRITE_TAC[real_div; real_pow; REAL_INV_MUL;
                      REAL_ARITH `inv(&2) * y = y * inv(&2)`] THEN
          REWRITE_TAC[GSYM REAL_SUB_RDISTRIB; REAL_MUL_ASSOC;
                      REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN
          REWRITE_TAC[GSYM real_div; REAL_ABS_NUM] THEN
          ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LE_DIV2_EQ;
                       REAL_OF_NUM_LT; ARITH] THEN
          REWRITE_TAC[real_div; REAL_ADD_RDISTRIB] THEN
          ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN
          REWRITE_TAC[GSYM real_div] THEN ASM_REAL_ARITH_TAC]];
      DISCH_THEN(fun th ->
       MAP_EVERY X_GEN_TAC [`m:num`; `i:num`; `p:num`; `k:num`] THEN
       STRIP_TAC THEN MP_TAC(ISPECL
        [`m + p:num`; `m:num`; `p:num`; `i:num`; `k:num`] th)) THEN
      ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
      MAP_EVERY X_GEN_TAC [`j:num`; `n:num`] THEN STRIP_TAC THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
      REWRITE_TAC[ADD1; LEFT_IMP_EXISTS_THM] THEN
      X_GEN_TAC `q:num` THEN DISCH_THEN SUBST_ALL_TAC THEN
      MATCH_MP_TAC REAL_LE_TRANS THEN
      EXISTS_TAC `drop(c(&(2 * q + 1) / &2 pow n))` THEN CONJ_TAC THENL
       [ASM_CASES_TAC `&i / &2 pow m = &(2 * q + 1) / &2 pow n` THEN
        ASM_REWRITE_TAC[REAL_LE_REFL] THEN
        SUBGOAL_THEN
         `drop(a(&(4 * q + 1) / &2 pow (n + 1))) <= drop(c(&i / &2 pow m)) /\
          drop(c(&i / &2 pow m)) <= drop(b(&(4 * q + 1) / &2 pow (n + 1)))`
        MP_TAC THENL
         [FIRST_X_ASSUM MATCH_MP_TAC THEN
          REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN
          SIMP_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL; REAL_MUL_ASSOC] THEN
          REWRITE_TAC[GSYM real_div; REAL_POW_1] THEN
          FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
           `abs(i - q) < n
            ==> i <= q /\ ~(i = q) /\ q = q' + n / &2
                ==> abs(i - q') < n / &2`)) THEN
          ASM_REWRITE_TAC[] THEN
          REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
          REAL_ARITH_TAC;
          ASM_SIMP_TAC[LE_1] THEN MATCH_MP_TAC(REAL_ARITH
           `l <= d ==> u <= v /\ c <= l ==> c <= d`) THEN
          FIRST_X_ASSUM(MP_TAC o SPECL
           [`a(&(2 * q + 1) / &2 pow n):real^1`;
            `b(&(2 * q + 1) / &2 pow n):real^1`;
            `c(&(2 * q + 1) / &2 pow n):real^1`]) THEN
          ANTS_TAC THENL
           [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
            ASM_MESON_TAC[REAL_LE_TRANS];
            DISCH_THEN(fun th -> REWRITE_TAC[th])]];
        ASM_CASES_TAC `&k / &2 pow p = &(2 * q + 1) / &2 pow n` THEN
        ASM_REWRITE_TAC[REAL_LE_REFL] THEN
        SUBGOAL_THEN
         `drop(a(&(4 * q + 3) / &2 pow (n + 1))) <= drop(c(&k / &2 pow p)) /\
          drop(c(&k / &2 pow p)) <= drop(b(&(4 * q + 3) / &2 pow (n + 1)))`
        MP_TAC THENL
         [FIRST_X_ASSUM MATCH_MP_TAC THEN
          REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN
          SIMP_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL; REAL_MUL_ASSOC] THEN
          REWRITE_TAC[GSYM real_div; REAL_POW_1] THEN
          FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
           `abs(i - q) < n
            ==> q <= i /\ ~(i = q) /\ q' = q +  n / &2
                ==> abs(i - q') < n / &2`)) THEN
          ASM_REWRITE_TAC[] THEN
          REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
          REAL_ARITH_TAC;
          ASM_SIMP_TAC[LE_1] THEN MATCH_MP_TAC(REAL_ARITH
           `d <= l ==> l <= c /\ u <= v ==> d <= c`) THEN
          FIRST_X_ASSUM(MP_TAC o SPECL
           [`a(&(2 * q + 1) / &2 pow n):real^1`;
            `b(&(2 * q + 1) / &2 pow n):real^1`;
            `c(&(2 * q + 1) / &2 pow n):real^1`]) THEN
          ANTS_TAC THENL
           [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
            ASM_MESON_TAC[REAL_LE_TRANS];
            DISCH_THEN(fun th -> REWRITE_TAC[th])]]]];
    ALL_TAC] THEN
  REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN
  REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
  REWRITE_TAC[FORALL_DROP; LIFT_DROP; IN_INTERVAL_1; DROP_VEC] THEN
  MAP_EVERY X_GEN_TAC [`x1:real^1`; `x2:real^1`] THEN REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `?m n. 0 < m /\ m < 2 EXP n /\
          drop x1 < &m / &2 pow n /\ &m / &2 pow n < drop x2 /\
          ~(h(x1):real^N = h(lift(&m / &2 pow n)))`
  STRIP_ASSUME_TAC THENL
   [MP_TAC(ISPEC `interval(vec 0:real^1,vec 1)`
        closure_dyadic_rationals_in_convex_set_pos_1) THEN
    SIMP_TAC[CONVEX_INTERVAL; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC;
            INTERIOR_OPEN; OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; REAL_LT_01;
            CLOSURE_OPEN_INTERVAL] THEN
    REWRITE_TAC[EXTENSION] THEN
    DISCH_THEN(MP_TAC o SPEC `inv(&2) % (x1 + x2):real^1`) THEN
    REWRITE_TAC[dyadics_in_open_unit_interval; IN_INTERVAL_1; DROP_VEC] THEN
    REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN
    MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (q <=> p) ==> r`) THEN
    CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[CLOSURE_APPROACHABLE]] THEN
    DISCH_THEN(MP_TAC o SPEC `(drop x2 - drop x1) / &64`) THEN
    ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[EXISTS_IN_GSPEC]] THEN
    REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP; DROP_CMUL; DROP_ADD] THEN
    DISCH_TAC THEN
    SUBGOAL_THEN
     `?m n. (0 < m /\ m < 2 EXP n) /\
            abs(&m / &2 pow n - inv (&2) * (drop x1 + drop x2)) <
            (drop x2 - drop x1) / &64 /\
            inv(&2 pow n) < (drop x2 - drop x1) / &128`
    STRIP_ASSUME_TAC THENL
     [MP_TAC(ISPECL [`inv(&2)`; `min (&1 / &4) ((drop x2 - drop x1) / &128)`]
      REAL_ARCH_POW_INV) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
      DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN
      ASM_CASES_TAC `N = 0` THENL
       [ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN
      REWRITE_TAC[REAL_INV_POW; REAL_LT_MIN; EXISTS_IN_GSPEC] THEN
      STRIP_TAC THEN
      FIRST_X_ASSUM(X_CHOOSE_THEN `m:num` (X_CHOOSE_THEN `n:num`
        STRIP_ASSUME_TAC)) THEN
      EXISTS_TAC `2 EXP N * m` THEN EXISTS_TAC `N + n:num` THEN
      ASM_SIMP_TAC[EXP_ADD; LT_MULT; EXP_LT_0; LT_MULT_LCANCEL; LE_1;
                   ARITH_EQ] THEN
      CONJ_TAC THENL
       [REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN
        REWRITE_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_POW; REAL_ARITH
         `(N * n) * inv N * inv m:real = (N / N) * (n / m)`] THEN
        ASM_SIMP_TAC[REAL_DIV_REFL; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ;
                     REAL_MUL_LID; GSYM real_div];
        MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2) pow N` THEN
        ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN
        CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LE_ADD]];
      REWRITE_TAC[CONJ_ASSOC] THEN MATCH_MP_TAC(MESON[]
       `!m n m' n'. (P m n /\ P m' n') /\
                    (P m n /\ P m' n' ==> ~(g m n = g m' n'))
        ==> (?m n. P m n /\ ~(a = g m n))`) THEN
      MAP_EVERY EXISTS_TAC
       [`2 * m + 1`; `n + 1`; `4 * m + 3`; `n + 2`] THEN
      CONJ_TAC THENL
       [REWRITE_TAC[EXP_ADD] THEN CONV_TAC NUM_REDUCE_CONV THEN CONJ_TAC THEN
        (REWRITE_TAC[GSYM CONJ_ASSOC] THEN
         REPLICATE_TAC 2 (CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC])) THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
         `abs(x - inv(&2) * (x1 + x2)) < (x2 - x1) / &64
          ==> abs(x - y) < (x2 - x1) / &4
              ==> x1 < y /\ y < x2`)) THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
         `n < x / &128 ==> &0 < x /\ y < &4 * n ==> y < x / &4`)) THEN
        ASM_REWRITE_TAC[REAL_SUB_LT] THEN
        REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
        MATCH_MP_TAC(REAL_ARITH
         `a / y = x /\ abs(b / y) < z
          ==> abs(x - (a + b) / y) < z`) THEN
        ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[REAL_POW_ADD] THEN
        SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_MUL; REAL_ABS_POW] THEN
        REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN
        SIMP_TAC[REAL_LT_RMUL_EQ; REAL_EQ_MUL_RCANCEL; REAL_LT_INV_EQ;
           REAL_LT_POW2; REAL_INV_EQ_0; REAL_POW_EQ_0; ARITH_EQ;
           REAL_OF_NUM_EQ] THEN
        CONV_TAC REAL_RAT_REDUCE_CONV THEN REAL_ARITH_TAC;
        ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN
        FIRST_X_ASSUM(MP_TAC o CONJUNCT1 o SPECL [`n + 2`; `4 * m + 3`]) THEN
        UNDISCH_THEN `!x. midpoint ((a:real->real^1) x,b x) = c x`
         (fun th -> REWRITE_TAC[GSYM th] THEN
              ASM_SIMP_TAC[ARITH_RULE `n + 2 = (n + 1) + 1 /\ 0 < n + 1`] THEN
              REWRITE_TAC[th] THEN ASSUME_TAC th) THEN
        DISCH_TAC THEN
        CONV_TAC(RAND_CONV SYM_CONV) THEN
        FIRST_X_ASSUM(MP_TAC o SPECL
         [`a(&(2 * m + 1) / &2 pow (n + 1)):real^1`;
          `b(&(2 * m + 1) / &2 pow (n + 1)):real^1`;
          `c(&(2 * m + 1) / &2 pow (n + 1)):real^1`]) THEN
        ANTS_TAC THENL
         [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN
          ASM_MESON_TAC[REAL_LE_TRANS];
          REPLICATE_TAC 6 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
          DISCH_THEN(MATCH_MP_TAC o CONJUNCT1)] THEN
        REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN
        REWRITE_TAC[REAL_ARITH
         `(a <= b /\ b <= c) /\ ~(b = a) <=> a < b /\ b <= c`] THEN
        REWRITE_TAC[midpoint; DROP_CMUL; DROP_ADD] THEN
        ASM_REWRITE_TAC[REAL_ARITH
           `a < inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a < b`] THEN
        ASM_REWRITE_TAC[REAL_LT_LE]]];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `IMAGE h (interval[vec 0,lift(&m / &2 pow n)]) SUBSET
    IMAGE (f:real^1->real^N) (interval[vec 0,c(&m / &2 pow n)]) /\
    IMAGE h (interval[lift(&m / &2 pow n),vec 1]) SUBSET
    IMAGE (f:real^1->real^N) (interval[c(&m / &2 pow n),vec 1])`
  MP_TAC THENL
   [MP_TAC(ISPEC `interval(lift(&m / &2 pow n),vec 1)`
      closure_dyadic_rationals_in_convex_set_pos_1) THEN
    MP_TAC(ISPEC `interval(vec 0,lift(&m / &2 pow n))`
      closure_dyadic_rationals_in_convex_set_pos_1) THEN
    SUBGOAL_THEN `&0 < &m / &2 pow n /\ &m / &2 pow n < &1`
    STRIP_ASSUME_TAC THENL
     [ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2; REAL_OF_NUM_LT; REAL_LT_LDIV_EQ;
        REAL_OF_NUM_MUL; REAL_OF_NUM_LT; REAL_OF_NUM_POW; MULT_CLAUSES];
      ALL_TAC] THEN
    MATCH_MP_TAC(TAUT
     `(p1 /\ p2) /\ (q1 ==> r1) /\ (q2 ==> r2)
      ==> (p1 ==> q1) ==> (p2 ==> q2) ==> r1 /\ r2`) THEN
    ASM_SIMP_TAC[CONVEX_INTERVAL; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC;
     INTERIOR_OPEN; OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; REAL_LT_01;
     CLOSURE_OPEN_INTERVAL; LIFT_DROP] THEN
    CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
    CONJ_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
    (MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN REPEAT CONJ_TAC THENL
      [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
         CONTINUOUS_ON_SUBSET)) THEN
       MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_INTERVAL] THEN
       MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN
       ASM_SIMP_TAC[SUBSET_INTERVAL_1; LIFT_DROP; REAL_LT_IMP_LE; DROP_VEC;
                    REAL_LE_REFL];
       MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
       MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
       ASM_REWRITE_TAC[COMPACT_INTERVAL] THEN
       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
         CONTINUOUS_ON_SUBSET)) THEN
       REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL] THEN
       ASM_MESON_TAC[REAL_LE_TRANS];
       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
       MATCH_MP_TAC(SET_RULE
        `i SUBSET interval(vec 0,vec 1) /\
         (!x. x IN interval(vec 0,vec 1) INTER l ==> x IN i ==> P x)
         ==> !x. x IN i INTER l ==> P x`) THEN
       ASM_SIMP_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC;
                    REAL_LT_IMP_LE; REAL_LE_REFL] THEN
       REWRITE_TAC[dyadics_in_open_unit_interval; FORALL_IN_GSPEC] THEN
       MAP_EVERY X_GEN_TAC [`k:num`; `p:num`] THEN STRIP_TAC THEN
       REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
       STRIP_TAC THEN ASM_SIMP_TAC[] THEN
       MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1] THEN
       ASM_SIMP_TAC[] THEN ASM_MESON_TAC[REAL_LE_TRANS]]);
    DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
     `IMAGE h s SUBSET t /\ IMAGE h s' SUBSET t'
      ==> !x y. x IN s /\ y IN s' ==> h(x) IN t /\ h(y) IN t'`)) THEN
    DISCH_THEN(MP_TAC o SPECL [`x1:real^1`; `x2:real^1`]) THEN
    ASM_SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC; REAL_LT_IMP_LE] THEN
    DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
     `a IN IMAGE f s /\ a IN IMAGE f t
      ==> ?x y. x IN s /\ y IN t /\ f x = a /\ f y = a`)) THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`t1:real^1`; `t2:real^1`] THEN
    REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `(h:real^1->real^N) x2` o
     GEN_REWRITE_RULE BINDER_CONV [GSYM IS_INTERVAL_CONNECTED_1]) THEN
    REWRITE_TAC[IS_INTERVAL_1; IN_ELIM_THM] THEN
    DISCH_THEN(MP_TAC o SPECL
     [`t1:real^1`; `t2:real^1`; `c(&m / &2 pow n):real^1`]) THEN
    UNDISCH_TAC `~(h x1:real^N = h(lift (&m / &2 pow n)))` THEN
    ASM_SIMP_TAC[] THEN MATCH_MP_TAC(TAUT `q ==> p ==> ~q ==> r`) THEN
    ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
    ASM_MESON_TAC[REAL_LE_TRANS]]);;

let PATH_CONTAINS_ARC = prove
 (`!p:real^1->real^N a b.
        path p /\ pathstart p = a /\ pathfinish p = b /\ ~(a = b)
        ==> ?q. arc q /\ path_image q SUBSET path_image p /\
                pathstart q = a /\ pathfinish q = b`,
  REWRITE_TAC[pathstart; pathfinish; path] THEN
  MAP_EVERY X_GEN_TAC [`f:real^1->real^N`; `a:real^N`; `b:real^N`] THEN
  STRIP_TAC THEN MP_TAC(ISPECL
   [`\s. s SUBSET interval[vec 0,vec 1] /\
         vec 0 IN s /\ vec 1 IN s /\
         (!x y. x IN s /\ y IN s /\ segment(x,y) INTER s = {}
                ==> (f:real^1->real^N)(x) = f(y))`;
    `interval[vec 0:real^1,vec 1]`]
  BROUWER_REDUCTION_THEOREM_GEN) THEN
  ASM_REWRITE_TAC[GSYM path_image; CLOSED_INTERVAL; SUBSET_REFL] THEN
  ANTS_TAC THENL
   [CONJ_TAC THENL
     [ALL_TAC;
      REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
      REPEAT GEN_TAC THEN STRIP_TAC THEN
      FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
       `s INTER i = {} ==> s SUBSET i ==> s = {}`)) THEN
      REWRITE_TAC[SEGMENT_EQ_EMPTY] THEN
      ANTS_TAC THENL [ONCE_REWRITE_TAC[segment]; MESON_TAC[]] THEN
      MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF i SUBSET t`) THEN
      ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; CONVEX_INTERVAL]] THEN
    X_GEN_TAC `s:num->real^1->bool` THEN
    REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN CONJ_TAC THENL
     [REWRITE_TAC[INTERS_GSPEC; SUBSET; IN_ELIM_THM; IN_UNIV] THEN
      ASM SET_TAC[];
      ALL_TAC] THEN
    REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
    REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN
    REWRITE_TAC[] THEN CONJ_TAC THENL
     [REWRITE_TAC[SEGMENT_SYM] THEN MESON_TAC[];
      REWRITE_TAC[FORALL_DROP; LIFT_DROP]] THEN
    MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
    REWRITE_TAC[INTERS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN
    SIMP_TAC[SEGMENT_1; REAL_LT_IMP_LE] THEN DISCH_TAC THEN STRIP_TAC THEN
    MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        COMPACT_UNIFORMLY_CONTINUOUS)) THEN
    REWRITE_TAC[COMPACT_INTERVAL; uniformly_continuous_on] THEN
    DISCH_THEN(MP_TAC o SPEC `norm((f:real^1->real^N) x - f y) / &2`) THEN
    ASM_REWRITE_TAC[REAL_HALF; NORM_POS_LT; VECTOR_SUB_EQ] THEN
    DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
    SUBGOAL_THEN
     `?u v. u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\
            norm(u - x) < e /\ norm(v - y) < e /\ (f:real^1->real^N) u = f v`
    STRIP_ASSUME_TAC THENL
     [ALL_TAC;
      FIRST_X_ASSUM(fun th ->
        MP_TAC(ISPECL [`x:real^1`; `u:real^1`] th) THEN
        MP_TAC(ISPECL [`y:real^1`; `v:real^1`] th)) THEN
      ASM_REWRITE_TAC[dist] THEN
      ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      MATCH_MP_TAC(TAUT `q /\ (p ==> ~r) ==> p ==> ~(q ==> r)`) THEN
      CONJ_TAC THENL [ASM SET_TAC[]; CONV_TAC NORM_ARITH]] THEN
    SUBGOAL_THEN
     `?w z. w IN interval(x,y) /\ z IN interval(x,y) /\ drop w < drop z /\
            norm(w - x) < e /\ norm(z - y) < e`
    STRIP_ASSUME_TAC THENL
     [EXISTS_TAC `x + lift(min e (drop y - drop x) / &3)` THEN
      EXISTS_TAC `y - lift(min e (drop y - drop x) / &3)` THEN
      REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; DROP_SUB; LIFT_DROP;
                  NORM_REAL; GSYM drop] THEN
      ASM_REAL_ARITH_TAC;
      ALL_TAC] THEN
    MP_TAC(ISPECL [`interval[w:real^1,z]`;
                   `{s n :real^1->bool | n IN (:num)}`] COMPACT_IMP_FIP) THEN
    ASM_REWRITE_TAC[COMPACT_INTERVAL; FORALL_IN_GSPEC] THEN
    MATCH_MP_TAC(TAUT `q /\ (~p ==> r) ==> (p ==> ~q) ==> r`) THEN
    CONJ_TAC THENL
     [REWRITE_TAC[INTERS_GSPEC; IN_UNIV] THEN FIRST_X_ASSUM(MATCH_MP_TAC o
       MATCH_MP (SET_RULE
        `s INTER u = {} ==> t SUBSET s ==> t INTER u = {}`)) THEN
      REWRITE_TAC[SUBSET_INTERVAL_1] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
      ASM_REAL_ARITH_TAC;
      ALL_TAC] THEN
    REWRITE_TAC[MESON[] `~(!x. P x /\ Q x ==> R x) <=>
                         (?x. P x /\ Q x /\ ~R x)`] THEN
    ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
    REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN
    DISCH_THEN(X_CHOOSE_THEN `k:num->bool` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `\n:num. n` o MATCH_MP
      UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `n:num` THEN DISCH_TAC THEN
    SUBGOAL_THEN
     `interval[w,z] INTER (s:num->real^1->bool) n = {}`
    ASSUME_TAC THENL
     [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
       `a INTER t = {} ==> s SUBSET t ==> a INTER s = {}`)) THEN
      REWRITE_TAC[SUBSET; INTERS_IMAGE; IN_ELIM_THM] THEN
      REWRITE_TAC[SET_RULE
       `(!x. x IN s n ==> !i. i IN k ==> x IN s i) <=>
        (!i. i IN k ==> s n SUBSET s i)`] THEN
      SUBGOAL_THEN
       `!i n. i <= n ==> (s:num->real^1->bool) n SUBSET s i`
       (fun th -> ASM_MESON_TAC[th]) THEN
      MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN
      SET_TAC[];
      ALL_TAC] THEN
    SUBGOAL_THEN
     `?u. u IN (s:num->real^1->bool) n /\ u IN interval[x,w] /\
          (interval[u,w] DELETE u) INTER (s n) = {}`
    MP_TAC THENL
     [ASM_CASES_TAC `w IN (s:num->real^1->bool) n` THENL
       [EXISTS_TAC `w:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN
        REWRITE_TAC[INTERVAL_SING; SET_RULE `{a} DELETE a = {}`] THEN
        REWRITE_TAC[INTER_EMPTY; INTERVAL_NE_EMPTY_1] THEN
        RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
        ALL_TAC] THEN
      MP_TAC(ISPECL [`(s:num->real^1->bool) n INTER interval[x,w]`;
                   `w:real^1`] SEGMENT_TO_POINT_EXISTS) THEN
      ASM_SIMP_TAC[CLOSED_INTER; CLOSED_INTERVAL] THEN ANTS_TAC THENL
       [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^1` THEN
        ASM_REWRITE_TAC[IN_INTER; IN_INTERVAL_1] THEN
        RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
        MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN
        REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
        FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
         `s INTER t INTER u = {} ==> s SUBSET u ==> s INTER t = {}`)) THEN
        REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THENL
         [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
          ASM_MESON_TAC[DROP_EQ; REAL_LE_ANTISYM];
          ANTS_TAC THENL
           [REWRITE_TAC[SUBSET_INTERVAL_1] THEN
            RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
            ASM_REAL_ARITH_TAC;
            REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN ASM SET_TAC[]]]];
      ALL_TAC] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN STRIP_TAC THEN
    SUBGOAL_THEN
     `?v. v IN (s:num->real^1->bool) n /\ v IN interval[z,y] /\
          (interval[z,v] DELETE v) INTER (s n) = {}`
    MP_TAC THENL
     [ASM_CASES_TAC `z IN (s:num->real^1->bool) n` THENL
       [EXISTS_TAC `z:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN
        REWRITE_TAC[INTERVAL_SING; SET_RULE `{a} DELETE a = {}`] THEN
        REWRITE_TAC[INTER_EMPTY; INTERVAL_NE_EMPTY_1] THEN
        RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
        ALL_TAC] THEN
      MP_TAC(ISPECL [`(s:num->real^1->bool) n INTER interval[z,y]`;
                   `z:real^1`] SEGMENT_TO_POINT_EXISTS) THEN
      ASM_SIMP_TAC[CLOSED_INTER; CLOSED_INTERVAL] THEN ANTS_TAC THENL
       [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `y:real^1` THEN
        ASM_REWRITE_TAC[IN_INTER; IN_INTERVAL_1] THEN
        RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
        MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^1` THEN
        REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
        FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
         `s INTER t INTER u = {} ==> s SUBSET u ==> s INTER t = {}`)) THEN
        REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THENL
         [ANTS_TAC THENL
           [REWRITE_TAC[SUBSET_INTERVAL_1] THEN
            RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
            ASM_REAL_ARITH_TAC;
            REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN ASM SET_TAC[]];
          RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
          ASM_MESON_TAC[DROP_EQ; REAL_LE_ANTISYM]]];
      ALL_TAC] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^1` THEN STRIP_TAC THEN
    REPEAT CONJ_TAC THENL
     [ASM SET_TAC[];
      ASM SET_TAC[];
      RULE_ASSUM_TAC(REWRITE_RULE[NORM_REAL; GSYM drop; DROP_SUB]) THEN
      REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
      RULE_ASSUM_TAC(REWRITE_RULE[NORM_REAL; GSYM drop; DROP_SUB]) THEN
      REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC;
      FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `n:num` THEN
      ASM_REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THENL
       [MAP_EVERY UNDISCH_TAC
         [`interval[w,z] INTER (s:num->real^1->bool) n = {}`;
          `interval[u,w] DELETE u INTER (s:num->real^1->bool) n = {}`;
          `interval[z,v] DELETE v INTER (s:num->real^1->bool) n = {}`] THEN
        REWRITE_TAC[IMP_IMP; SET_RULE
          `s1 INTER t = {} /\ s2 INTER t = {} <=>
           (s1 UNION s2) INTER t = {}`] THEN
        MATCH_MP_TAC(SET_RULE
         `t SUBSET s ==> s INTER u = {} ==> t INTER u = {}`) THEN
        REWRITE_TAC[SUBSET; IN_UNION; IN_DELETE;
                    GSYM DROP_EQ; IN_INTERVAL_1] THEN
        ASM_REAL_ARITH_TAC;
        RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC]];
    ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `t:real^1->bool` STRIP_ASSUME_TAC) THEN
  ASM_CASES_TAC `t:real^1->bool = {}` THENL
   [ASM_MESON_TAC[IN_IMAGE; NOT_IN_EMPTY]; ALL_TAC] THEN
  ABBREV_TAC
   `h = \x. (f:real^1->real^N)(@y. y IN t /\ segment(x,y) INTER t = {})` THEN
  SUBGOAL_THEN
   `!x y. y IN t /\ segment(x,y) INTER t = {} ==> h(x) = (f:real^1->real^N)(y)`
  ASSUME_TAC THENL
   [SUBGOAL_THEN
     `!x y z. y IN t /\ segment(x,y) INTER t = {} /\
              z IN t /\ segment(x,z) INTER t = {}
              ==> (f:real^1->real^N)(y) = f(z)`
    ASSUME_TAC THENL
     [REPEAT GEN_TAC THEN ASM_CASES_TAC `(x:real^1) IN t` THENL
       [ASM_MESON_TAC[]; UNDISCH_TAC `~((x:real^1) IN t)`] THEN
      ONCE_REWRITE_TAC[TAUT `p ==> a /\ b /\ c /\ d ==> q <=>
                             (a /\ c) ==> p /\ b /\ d ==> q`] THEN
      STRIP_TAC THEN
      REWRITE_TAC[SET_RULE `~(x IN t) /\ s INTER t = {} /\ s' INTER t = {} <=>
                            (x INSERT (s UNION s')) INTER t = {}`] THEN
      DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE
       `s SUBSET s' ==> s' INTER t = {} ==> s INTER t = {}`) THEN
      REWRITE_TAC[SEGMENT_1; SUBSET; IN_UNION; IN_INSERT; IN_INTERVAL_1] THEN
      GEN_TAC THEN REWRITE_TAC[GSYM DROP_EQ] THEN
      REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN
      ASM_REAL_ARITH_TAC;
      REPEAT STRIP_TAC THEN EXPAND_TAC "h" THEN ASM_MESON_TAC[]];
    ALL_TAC] THEN
  SUBGOAL_THEN `!x. x IN t ==> h(x) = (f:real^1->real^N)(x)` ASSUME_TAC THENL
   [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    ASM_REWRITE_TAC[SEGMENT_REFL; INTER_EMPTY];
    ALL_TAC] THEN
  SUBGOAL_THEN `!x:real^1. ?y. y IN t /\ segment(x,y) INTER t = {}`
  ASSUME_TAC THENL
   [X_GEN_TAC `x:real^1` THEN
    EXISTS_TAC `closest_point t (x:real^1)` THEN
    ASM_SIMP_TAC[SEGMENT_TO_CLOSEST_POINT; CLOSEST_POINT_EXISTS];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `!x y. segment(x,y) INTER t = {} ==> (h:real^1->real^N) x = h y`
  ASSUME_TAC THENL
   [MAP_EVERY X_GEN_TAC [`x:real^1`; `x':real^1`] THEN
    ASM_CASES_TAC `(x:real^1) IN t` THENL
     [ASM_MESON_TAC[SEGMENT_SYM]; ALL_TAC] THEN
    ASM_CASES_TAC `(x':real^1) IN t` THENL
     [ASM_MESON_TAC[]; ALL_TAC] THEN
    SUBGOAL_THEN
     `?y y'. y IN t /\ segment(x,y) INTER t = {} /\ h x = f y /\
             y' IN t /\ segment(x',y') INTER t = {} /\
             (h:real^1->real^N) x' = f y'`
    STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    ASM_REWRITE_TAC[] THEN MAP_EVERY UNDISCH_TAC
     [`~((x:real^1) IN t)`; `~((x':real^1) IN t)`;
      `segment(x:real^1,y) INTER t = {}`;
      `segment(x':real^1,y') INTER t = {}`;
      `segment(x:real^1,x') INTER t = {}`] THEN
    MATCH_MP_TAC(SET_RULE
     `s SUBSET (x1 INSERT x2 INSERT (s0 UNION s1 UNION s2))
      ==> s0 INTER t = {} ==> s1 INTER t = {} ==> s2 INTER t = {}
          ==> ~(x1 IN t) ==> ~(x2 IN t) ==> s INTER t = {}`) THEN
    REWRITE_TAC[SEGMENT_1; SUBSET; IN_UNION; IN_INSERT; IN_INTERVAL_1] THEN
      GEN_TAC THEN REWRITE_TAC[GSYM DROP_EQ] THEN
    REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN
    ASM_REAL_ARITH_TAC;
    ALL_TAC] THEN
  MP_TAC(ISPEC `h:real^1->real^N` HOMEOMORPHIC_MONOTONE_IMAGE_INTERVAL) THEN
  ANTS_TAC THENL
   [REPEAT CONJ_TAC THENL
     [REWRITE_TAC[continuous_on] THEN X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN
      X_GEN_TAC `e:real` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_on]) THEN
      DISCH_THEN(MP_TAC o SPEC `u:real^1`) THEN ASM_REWRITE_TAC[] THEN
      DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN
      ASM_REWRITE_TAC[] THEN X_GEN_TAC `v:real^1` THEN STRIP_TAC THEN
      ASM_CASES_TAC `segment(u:real^1,v) INTER t = {}` THENL
       [ASM_MESON_TAC[DIST_REFL]; ALL_TAC] THEN
      SUBGOAL_THEN
       `(?w:real^1. w IN t /\ w IN segment[u,v] /\ segment(u,w) INTER t = {}) /\
        (?z:real^1. z IN t /\ z IN segment[u,v] /\ segment(v,z) INTER t = {})`
      STRIP_ASSUME_TAC THENL
       [CONJ_TAC THENL
         [MP_TAC(ISPECL [`segment[u:real^1,v] INTER t`; `u:real^1`]
            SEGMENT_TO_POINT_EXISTS);
          MP_TAC(ISPECL [`segment[u:real^1,v] INTER t`; `v:real^1`]
          SEGMENT_TO_POINT_EXISTS)] THEN
       (ASM_SIMP_TAC[CLOSED_INTER; CLOSED_SEGMENT] THEN ANTS_TAC THENL
         [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
            `~(segment(u,v) INTER t = {})
             ==> segment(u,v) SUBSET segment[u,v]
                 ==> ~(segment[u,v] INTER t = {})`)) THEN
          REWRITE_TAC[SEGMENT_OPEN_SUBSET_CLOSED];
          ALL_TAC] THEN
        MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `w:real^1` THEN
        SIMP_TAC[IN_INTER] THEN
        MATCH_MP_TAC(SET_RULE
         `(w IN uv ==> uw SUBSET uv)
          ==> (w IN uv /\ w IN t) /\ (uw INTER uv INTER t = {})
          ==> uw INTER t = {}`) THEN
        DISCH_TAC THEN REWRITE_TAC[open_segment] THEN
        MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF u SUBSET t`) THEN
        REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
        REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL; CONVEX_SEGMENT] THEN
        ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; ENDS_IN_SEGMENT]);
        SUBGOAL_THEN `(h:real^1->real^N) u = (f:real^1->real^N) w /\
                      (h:real^1->real^N) v = (f:real^1->real^N) z`
          (fun th -> REWRITE_TAC[th]) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
        MATCH_MP_TAC(NORM_ARITH
         `!u. dist(w:real^N,u) < e / &2 /\ dist(z,u) < e / &2
              ==> dist(w,z) < e`) THEN
        EXISTS_TAC `(f:real^1->real^N) u` THEN CONJ_TAC THEN
        FIRST_X_ASSUM MATCH_MP_TAC THEN
        (CONJ_TAC THENL
          [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
            `x IN s ==> s SUBSET t ==> x IN t`)) THEN
           REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
           ASM_REWRITE_TAC[CONVEX_INTERVAL; INSERT_SUBSET; EMPTY_SUBSET];
           ASM_MESON_TAC[DIST_IN_CLOSED_SEGMENT; REAL_LET_TRANS; DIST_SYM]])];
      X_GEN_TAC `z:real^N` THEN
      REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
      MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN
      REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
      REWRITE_TAC[connected_component] THEN
      EXISTS_TAC `segment[u:real^1,v]` THEN
      REWRITE_TAC[CONNECTED_SEGMENT; ENDS_IN_SEGMENT] THEN
      ASM_CASES_TAC `segment(u:real^1,v) INTER t = {}` THENL
       [REWRITE_TAC[SET_RULE `s SUBSET {x | x IN t /\ P x} <=>
                              s SUBSET t /\ !x. x IN s ==> P x`] THEN
        CONJ_TAC THENL
         [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; CONVEX_INTERVAL];
          X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN
          SUBGOAL_THEN `segment(u:real^1,x) INTER t = {}`
            (fun th -> ASM_MESON_TAC[th]) THEN
          FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
           `uv INTER t = {} ==> ux SUBSET uv ==> ux INTER t = {}`)) THEN
          UNDISCH_TAC `(x:real^1) IN segment[u,v]` THEN
          REWRITE_TAC[SEGMENT_1] THEN
          REPEAT(COND_CASES_TAC THEN
                 ASM_REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1]) THEN
          ASM_REAL_ARITH_TAC];
        ALL_TAC] THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF segment(u:real^1,v)`) THEN
      ASM_REWRITE_TAC[SET_RULE `t DIFF s PSUBSET t <=> ~(s INTER t = {})`] THEN
      MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN
      REPEAT CONJ_TAC THENL
       [ASM SET_TAC[];
        MATCH_MP_TAC CLOSED_DIFF THEN ASM_REWRITE_TAC[OPEN_SEGMENT_1];
        ASM SET_TAC[];
        ASM_REWRITE_TAC[IN_DIFF] THEN MAP_EVERY UNDISCH_TAC
         [`(u:real^1) IN interval[vec 0,vec 1]`;
          `(v:real^1) IN interval[vec 0,vec 1]`] THEN
        REWRITE_TAC[SEGMENT_1] THEN
        REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN
        ASM_REAL_ARITH_TAC;
        ASM_REWRITE_TAC[IN_DIFF] THEN MAP_EVERY UNDISCH_TAC
         [`(u:real^1) IN interval[vec 0,vec 1]`;
          `(v:real^1) IN interval[vec 0,vec 1]`] THEN
        REWRITE_TAC[SEGMENT_1] THEN
        REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN
        ASM_REAL_ARITH_TAC;
        MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN
        REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
        ASM_CASES_TAC `segment(x:real^1,y) INTER segment(u,v) = {}` THENL
         [ASM SET_TAC[]; ALL_TAC] THEN
        SUBGOAL_THEN
         `(segment(x:real^1,u) SUBSET segment(x,y) DIFF segment(u,v) /\
           segment(y:real^1,v) SUBSET segment(x,y) DIFF segment(u,v)) \/
          (segment(y:real^1,u) SUBSET segment(x,y) DIFF segment(u,v) /\
           segment(x:real^1,v) SUBSET segment(x,y) DIFF segment(u,v))`
        MP_TAC THENL
         [MAP_EVERY UNDISCH_TAC
           [`~(x IN segment(u:real^1,v))`; `~(y IN segment(u:real^1,v))`;
            `~(segment(x:real^1,y) INTER segment (u,v) = {})`] THEN
          POP_ASSUM_LIST(K ALL_TAC) THEN
          MAP_EVERY (fun t -> SPEC_TAC(t,t))
           [`v:real^1`; `u:real^1`; `y:real^1`; `x:real^1`] THEN
          REWRITE_TAC[FORALL_LIFT] THEN
          MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL
           [REWRITE_TAC[SEGMENT_SYM] THEN MESON_TAC[]; ALL_TAC] THEN
          REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN
          MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN DISCH_TAC THEN
          REWRITE_TAC[FORALL_LIFT] THEN
          MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL
           [REWRITE_TAC[SEGMENT_SYM] THEN MESON_TAC[]; ALL_TAC] THEN
          REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN
          MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN DISCH_TAC THEN
          ASM_REWRITE_TAC[SEGMENT_1] THEN
          REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
          REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
          REWRITE_TAC[IN_INTERVAL_1; SUBSET; IN_DIFF; AND_FORALL_THM] THEN
          ASM_REAL_ARITH_TAC;
          DISCH_THEN(DISJ_CASES_THEN(CONJUNCTS_THEN
           (let sl = SET_RULE
             `i SUBSET xy DIFF uv
              ==> xy INTER (t DIFF uv) = {} ==> i INTER t = {}` in
            fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP (MATCH_MP sl th))))) THEN
          ASM_MESON_TAC[]]];
      ASM_MESON_TAC[]];
    DISCH_TAC] THEN
  SUBGOAL_THEN
   `?q:real^1->real^N.
        arc q /\ path_image q SUBSET path_image f /\
        a IN path_image q /\ b IN path_image q`
  STRIP_ASSUME_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
    REWRITE_TAC[homeomorphism] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^1->real^N` THEN
    REWRITE_TAC[arc; path; path_image] THEN
    REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
     [ASM MESON_TAC[];
      REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; path_image] THEN ASM SET_TAC[];
      REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 0:real^1` THEN
      REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[];
      REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 1:real^1` THEN
      REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[]];
    SUBGOAL_THEN
     `?u v. u IN interval[vec 0,vec 1] /\ a = (q:real^1->real^N) u /\
            v IN interval[vec 0,vec 1] /\ b = (q:real^1->real^N) v`
    STRIP_ASSUME_TAC THENL
     [RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN ASM SET_TAC[];
      ALL_TAC] THEN
    EXISTS_TAC `subpath u v (q:real^1->real^N)` THEN REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN
      ASM_MESON_TAC[ARC_IMP_SIMPLE_PATH];
      ASM_MESON_TAC[SUBSET_TRANS; PATH_IMAGE_SUBPATH_SUBSET; ARC_IMP_PATH];
      ASM_MESON_TAC[pathstart; PATHSTART_SUBPATH];
      ASM_MESON_TAC[pathfinish; PATHFINISH_SUBPATH]]]);;

let PATH_CONNECTED_ARCWISE = prove
 (`!s:real^N->bool.
        path_connected s <=>
        !x y. x IN s /\ y IN s /\ ~(x = y)
              ==> ?g. arc g /\
                      path_image g SUBSET s /\
                      pathstart g = x /\
                      pathfinish g = y`,
  GEN_TAC THEN REWRITE_TAC[path_connected] THEN EQ_TAC THEN DISCH_TAC THEN
  MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN
  ASM_REWRITE_TAC[] THENL
   [DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPECL [`g:real^1->real^N`; `x:real^N`; `y:real^N`]
        PATH_CONTAINS_ARC) THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
    ASM_MESON_TAC[SUBSET_TRANS];
    ASM_CASES_TAC `y:real^N = x` THEN ASM_REWRITE_TAC[] THENL
     [EXISTS_TAC `linepath(y:real^N,y)` THEN
      ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH;
                      PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET];
      MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[ARC_IMP_PATH]]]);;

let ARC_CONNECTED_TRANS = prove
 (`!g h:real^1->real^N.
        arc g /\ arc h /\
        pathfinish g = pathstart h /\ ~(pathstart g = pathfinish h)
        ==> ?i. arc i /\
                path_image i SUBSET (path_image g UNION path_image h) /\
                pathstart i = pathstart g /\
                pathfinish i = pathfinish h`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`g ++ h:real^1->real^N`; `pathstart(g):real^N`;
                 `pathfinish(h):real^N`] PATH_CONTAINS_ARC) THEN
  ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATH_JOIN_EQ; ARC_IMP_PATH;
               PATH_IMAGE_JOIN]);;

(* ------------------------------------------------------------------------- *)
(* Local connectedness and local path connectedness.                         *)
(* ------------------------------------------------------------------------- *)

let LOCALLY_CONNECTED_SPACE_SUBTOPOLOGY_EUCLIDEAN = prove
 (`!s:real^N->bool.
        locally_connected_space (subtopology euclidean s) <=>
        locally connected s`,
  GEN_TAC THEN
  SIMP_TAC[locally_connected_space; NEIGHBOURHOOD_BASE_OF_EUCLIDEAN] THEN
  GEN_REWRITE_TAC RAND_CONV [LOCALLY_AND_SUBSET] THEN
  AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
  REWRITE_TAC[CONNECTED_IN_SUBTOPOLOGY; CONNECTED_IN_EUCLIDEAN] THEN
  CONV_TAC TAUT);;

let LOCALLY_CONNECTED,LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT =
 (CONJ_PAIR o prove)
 (`(!s:real^N->bool.
        locally connected s <=>
        !v x. open_in (subtopology euclidean s) v /\ x IN v
              ==> ?u. open_in (subtopology euclidean s) u /\
                      connected u /\
                      x IN u /\ u SUBSET v) /\
   (!s:real^N->bool.
        locally connected s <=>
        !t x. open_in (subtopology euclidean s) t /\ x IN t
              ==> open_in (subtopology euclidean s)
                          (connected_component t x))`,
  REWRITE_TAC[AND_FORALL_THM; locally] THEN X_GEN_TAC `s:real^N->bool` THEN
  MATCH_MP_TAC(TAUT
   `(q ==> p) /\ (p ==> r) /\ (r ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN
  REPEAT CONJ_TAC THENL
   [MESON_TAC[SUBSET_REFL];
    DISCH_TAC THEN
    MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN
    ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP CONNECTED_COMPONENT_EQ) THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN ANTS_TAC
    THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN
    DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (X_CHOOSE_THEN `a:real^N->bool`
          STRIP_ASSUME_TAC)) THEN
    EXISTS_TAC `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `a:real^N->bool` THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
    ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
    DISCH_TAC THEN
    MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
    EXISTS_TAC `connected_component u (x:real^N)` THEN
    REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_CONNECTED_COMPONENT] THEN
    ASM_SIMP_TAC[IN; CONNECTED_COMPONENT_REFL]]);;

let LOCALLY_PATH_CONNECTED_SPACE_SUBTOPOLOGY_EUCLIDEAN = prove
 (`!s:real^N->bool.
        locally_path_connected_space (subtopology euclidean s) <=>
        locally path_connected s`,
  GEN_TAC THEN
  SIMP_TAC[locally_path_connected_space; NEIGHBOURHOOD_BASE_OF_EUCLIDEAN] THEN
  GEN_REWRITE_TAC RAND_CONV [LOCALLY_AND_SUBSET] THEN
  AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
  REWRITE_TAC[PATH_CONNECTED_IN_SUBTOPOLOGY; PATH_CONNECTED_IN_EUCLIDEAN] THEN
  CONV_TAC TAUT);;

let LOCALLY_PATH_CONNECTED,LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT =
 (CONJ_PAIR o prove)
 (`(!s:real^N->bool.
        locally path_connected s <=>
        !v x. open_in (subtopology euclidean s) v /\ x IN v
              ==> ?u. open_in (subtopology euclidean s) u /\
                      path_connected u /\
                      x IN u /\ u SUBSET v) /\
   (!s:real^N->bool.
        locally path_connected s <=>
        !t x. open_in (subtopology euclidean s) t /\ x IN t
              ==> open_in (subtopology euclidean s)
                          (path_component t x))`,
  REWRITE_TAC[AND_FORALL_THM; locally] THEN X_GEN_TAC `s:real^N->bool` THEN
  MATCH_MP_TAC(TAUT
   `(q ==> p) /\ (p ==> r) /\ (r ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN
  REPEAT CONJ_TAC THENL
   [MESON_TAC[SUBSET_REFL];
    DISCH_TAC THEN
    MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN
    ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP PATH_COMPONENT_EQ) THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN ANTS_TAC
    THENL [ASM_MESON_TAC[PATH_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN
    DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (X_CHOOSE_THEN `a:real^N->bool`
          STRIP_ASSUME_TAC)) THEN
    EXISTS_TAC `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `a:real^N->bool` THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN
    ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
    DISCH_TAC THEN
    MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
    EXISTS_TAC `path_component u (x:real^N)` THEN
    REWRITE_TAC[PATH_COMPONENT_SUBSET; PATH_CONNECTED_PATH_COMPONENT] THEN
    ASM_SIMP_TAC[IN; PATH_COMPONENT_REFL]]);;

let LOCALLY_CONNECTED_OPEN_COMPONENT = prove
 (`!s:real^N->bool.
        locally connected s <=>
        !t c. open_in (subtopology euclidean s) t /\ c IN components t
              ==> open_in (subtopology euclidean s) c`,
  REWRITE_TAC[LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT] THEN
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; components; FORALL_IN_GSPEC]);;

let LOCALLY_CONNECTED_IM_KLEINEN = prove
 (`!s:real^N->bool.
      locally connected s <=>
      !v x. open_in (subtopology euclidean s) v /\ x IN v
            ==> ?u. open_in (subtopology euclidean s) u /\
                    x IN u /\ u SUBSET v /\
                    !y. y IN u
                        ==> ?c. connected c /\ c SUBSET v /\ x IN c /\ y IN c`,
  GEN_TAC THEN EQ_TAC THENL
   [REWRITE_TAC[LOCALLY_CONNECTED] THEN MESON_TAC[SUBSET_REFL]; DISCH_TAC] THEN
  REWRITE_TAC[LOCALLY_CONNECTED_OPEN_COMPONENT] THEN
  MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `c:real^N->bool`] THEN STRIP_TAC THEN
  ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN
  ANTS_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_SUBSET; SUBSET]; ALL_TAC] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN `(k:real^N->bool) SUBSET c` MP_TAC THENL
   [ALL_TAC; ASM SET_TAC[]] THEN
  MATCH_MP_TAC COMPONENTS_MAXIMAL THEN
  EXISTS_TAC `u:real^N->bool` THEN ASM SET_TAC[]);;

let LOCALLY_PATH_CONNECTED_IM_KLEINEN = prove
 (`!s:real^N->bool.
      locally path_connected s <=>
      !v x. open_in (subtopology euclidean s) v /\ x IN v
            ==> ?u. open_in (subtopology euclidean s) u /\
                    x IN u /\ u SUBSET v /\
                    !y. y IN u
                        ==> ?p. path p /\ path_image p SUBSET v /\
                                pathstart p = x /\ pathfinish p = y`,
  GEN_TAC THEN EQ_TAC THENL
   [REWRITE_TAC[LOCALLY_PATH_CONNECTED] THEN
    REWRITE_TAC[path_connected] THEN
    REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
    MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
    MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN
    ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
    REWRITE_TAC[LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT] THEN DISCH_TAC THEN
    MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `z:real^N`] THEN STRIP_TAC THEN
    ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN
    ANTS_TAC THENL [ASM_MESON_TAC[PATH_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `p:real^1->real^N` STRIP_ASSUME_TAC) THEN
    SUBGOAL_THEN
     `(path_image p) SUBSET path_component u (z:real^N)` MP_TAC
    THENL [ALL_TAC; ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE; SUBSET]] THEN
    FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP PATH_COMPONENT_EQ) THEN
    MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN
    ASM_SIMP_TAC[PATH_CONNECTED_PATH_IMAGE] THEN
    ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]]);;

let LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED = prove
 (`!s:real^N->bool. locally path_connected s ==> locally connected s`,
  MESON_TAC[LOCALLY_MONO; PATH_CONNECTED_IMP_CONNECTED]);;

let LOCALLY_CONNECTED_COMPONENTS = prove
 (`!s c:real^N->bool.
        locally connected s /\ c IN components s ==> locally connected c`,
  REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
   (REWRITE_RULE[IMP_CONJ] LOCALLY_OPEN_SUBSET)) THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o
   GEN_REWRITE_RULE I [LOCALLY_CONNECTED_OPEN_COMPONENT]) THEN
  EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[OPEN_IN_REFL]);;

let LOCALLY_CONNECTED_CONNECTED_COMPONENT = prove
 (`!s x:real^N.
        locally connected s
        ==> locally connected (connected_component s x)`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `connected_component s (x:real^N) = {}` THEN
  ASM_REWRITE_TAC[LOCALLY_EMPTY] THEN
  MATCH_MP_TAC LOCALLY_CONNECTED_COMPONENTS THEN
  EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[IN_COMPONENTS] THEN
  ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]);;

let LOCALLY_PATH_CONNECTED_COMPONENTS = prove
 (`!s c:real^N->bool.
        locally path_connected s /\ c IN components s
        ==> locally path_connected c`,
  REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
   (REWRITE_RULE[IMP_CONJ] LOCALLY_OPEN_SUBSET)) THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o
   GEN_REWRITE_RULE I [LOCALLY_CONNECTED_OPEN_COMPONENT] o
   MATCH_MP LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED) THEN
  EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[OPEN_IN_REFL]);;

let LOCALLY_PATH_CONNECTED_CONNECTED_COMPONENT = prove
 (`!s x:real^N.
        locally path_connected s
        ==> locally path_connected (connected_component s x)`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `connected_component s (x:real^N) = {}` THEN
  ASM_REWRITE_TAC[LOCALLY_EMPTY] THEN
  MATCH_MP_TAC LOCALLY_PATH_CONNECTED_COMPONENTS THEN
  EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[IN_COMPONENTS] THEN
  ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]);;

let OPEN_IMP_LOCALLY_PATH_CONNECTED = prove
 (`!s:real^N->bool. open s ==> locally path_connected s`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_MONO THEN
  EXISTS_TAC `convex:(real^N->bool)->bool` THEN
  REWRITE_TAC[CONVEX_IMP_PATH_CONNECTED] THEN
  ASM_SIMP_TAC[locally; OPEN_IN_OPEN_EQ] THEN
  ASM_MESON_TAC[OPEN_CONTAINS_BALL; CENTRE_IN_BALL; OPEN_BALL; CONVEX_BALL;
                SUBSET]);;

let OPEN_IMP_LOCALLY_CONNECTED = prove
 (`!s:real^N->bool. open s ==> locally connected s`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_MONO THEN
  EXISTS_TAC `path_connected:(real^N->bool)->bool` THEN
  ASM_SIMP_TAC[OPEN_IMP_LOCALLY_PATH_CONNECTED;
               PATH_CONNECTED_IMP_CONNECTED]);;

let LOCALLY_PATH_CONNECTED_UNIV = prove
 (`locally path_connected (:real^N)`,
  SIMP_TAC[OPEN_IMP_LOCALLY_PATH_CONNECTED; OPEN_UNIV]);;

let LOCALLY_CONNECTED_UNIV = prove
 (`locally connected (:real^N)`,
  SIMP_TAC[OPEN_IMP_LOCALLY_CONNECTED; OPEN_UNIV]);;

let OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED = prove
 (`!s x:real^N.
        locally connected s
        ==> open_in (subtopology euclidean s) (connected_component s x)`,
  REWRITE_TAC[LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT] THEN
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THENL
   [FIRST_X_ASSUM MATCH_MP_TAC THEN
    ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; SUBSET_UNIV; TOPSPACE_EUCLIDEAN];
    ASM_MESON_TAC[OPEN_IN_EMPTY; CONNECTED_COMPONENT_EQ_EMPTY]]);;

let OPEN_IN_COMPONENTS_LOCALLY_CONNECTED = prove
 (`!s c:real^N->bool.
        locally connected s /\ c IN components s
        ==> open_in (subtopology euclidean s) c`,
  MESON_TAC[LOCALLY_CONNECTED_OPEN_COMPONENT; OPEN_IN_REFL]);;

let OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED = prove
 (`!s x:real^N.
        locally path_connected s
        ==> open_in (subtopology euclidean s) (path_component s x)`,
  REWRITE_TAC[LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT] THEN
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THENL
   [FIRST_X_ASSUM MATCH_MP_TAC THEN
    ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; SUBSET_UNIV; TOPSPACE_EUCLIDEAN];
    ASM_MESON_TAC[OPEN_IN_EMPTY; PATH_COMPONENT_EQ_EMPTY]]);;

let CLOSED_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED = prove
 (`!s x:real^N.
        locally path_connected s
        ==> closed_in (subtopology euclidean s) (path_component s x)`,
  REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY;
              PATH_COMPONENT_SUBSET] THEN
  REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEMENT_PATH_COMPONENT_UNIONS] THEN
  MATCH_MP_TAC OPEN_IN_UNIONS THEN
  REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC; IN_DELETE] THEN
  ASM_SIMP_TAC[OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED]);;

let CONVEX_IMP_LOCALLY_PATH_CONNECTED = prove
 (`!s:real^N->bool. convex s ==> locally path_connected s`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_PATH_CONNECTED] THEN
  MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
  DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM SUBST_ALL_TAC THEN
  RULE_ASSUM_TAC(REWRITE_RULE[IN_INTER]) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN
  DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `s INTER ball(x:real^N,e)` THEN REPEAT CONJ_TAC THENL
   [REWRITE_TAC[OPEN_IN_OPEN] THEN MESON_TAC[OPEN_BALL];
    MATCH_MP_TAC CONVEX_IMP_PATH_CONNECTED THEN
    ASM_SIMP_TAC[CONVEX_INTER; CONVEX_BALL];
    ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL];
    ASM SET_TAC[]]);;

let OPEN_IN_IMP_LOCALLY_PATH_CONNECTED = prove
 (`!s:real^N->bool.
        open_in (subtopology euclidean (affine hull s)) s
        ==> locally path_connected s`,
  GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_OPEN_SUBSET) THEN
  MATCH_MP_TAC CONVEX_IMP_LOCALLY_PATH_CONNECTED THEN
  SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL]);;

let OPEN_IN_CONNECTED_COMPONENTS = prove
 (`!s c:real^N->bool.
        FINITE(components s) /\ c IN components s
        ==> open_in (subtopology euclidean s) c`,
  REWRITE_TAC[components; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN
  SIMP_TAC[OPEN_IN_CONNECTED_COMPONENT]);;

let FINITE_COMPONENTS_MEETING_COMPACT_SUBSET = prove
 (`!k s:real^N->bool.
        compact k /\ locally connected s /\ k SUBSET s
        ==> FINITE {c | c IN components s /\ ~(c INTER k = {})}`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I
   [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN
  DISCH_THEN(MP_TAC o SPEC
   `{k INTER c:real^N->bool |c|
     c IN {d | d IN components s /\ ~(d INTER k = {})}}`) THEN
  REWRITE_TAC[FORALL_IN_GSPEC] THEN
  REWRITE_TAC[GSYM INTER_UNIONS] THEN ANTS_TAC THENL
   [CONJ_TAC THENL
     [X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN
      MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN
      EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC OPEN_IN_INTER THEN REWRITE_TAC[OPEN_IN_REFL] THEN
      ASM_SIMP_TAC[OPEN_IN_COMPONENTS_LOCALLY_CONNECTED];
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
       `k SUBSET s ==> k INTER s SUBSET t ==> k SUBSET k INTER t`)) THEN
      GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [UNIONS_COMPONENTS] THEN
      SET_TAC[]];
    ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
    REWRITE_TAC[SIMPLE_IMAGE; EXISTS_FINITE_SUBSET_IMAGE] THEN
    REWRITE_TAC[GSYM SIMPLE_IMAGE; GSYM INTER_UNIONS] THEN
    REWRITE_TAC[SUBSET_INTER; SUBSET_REFL; LEFT_IMP_EXISTS_THM]] THEN
  X_GEN_TAC `p:(real^N->bool)->bool` THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
   `FINITE s ==> t = s ==> FINITE t`)) THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
    `p SUBSET k ==> ~(p PSUBSET k) ==> k = p`)) THEN
  REWRITE_TAC[PSUBSET_ALT; IN_ELIM_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC o CONJUNCT2) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN
  SUBGOAL_THEN `(a:real^N) IN UNIONS p` MP_TAC THENL
   [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS; NOT_EXISTS_THM]] THEN
  X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN
  MP_TAC(ISPEC `s:real^N->bool` PAIRWISE_DISJOINT_COMPONENTS) THEN
  REWRITE_TAC[pairwise] THEN
  DISCH_THEN(MP_TAC o SPECL [`c:real^N->bool`; `d:real^N->bool`]) THEN
  ASM_REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN
  CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  CONJ_TAC THENL [ASM_MESON_TAC[]; ASM SET_TAC[]]);;

let FINITE_COMPONENTS = prove
 (`!s:real^N->bool. compact s /\ locally connected s ==> FINITE(components s)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `s:real^N->bool`]
        FINITE_COMPONENTS_MEETING_COMPACT_SUBSET) THEN
  ASM_REWRITE_TAC[SUBSET_REFL] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
  REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s <=> !x. x IN s ==> P x`] THEN
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
  FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN
  ASM SET_TAC[]);;

let FINITE_LOCALLY_CONNECTED_CONNECTED_COMPONENTS = prove
 (`!s:real^N->bool.
        compact s /\ locally connected s
        ==> FINITE {connected_component s x |x|  x IN s}`,
  REWRITE_TAC[GSYM components; FINITE_COMPONENTS]);;

let FINITE_LOCALLY_PATH_CONNECTED_PATH_COMPONENTS = prove
 (`!s:real^N->bool.
        compact s /\ locally path_connected s
        ==> FINITE {path_component s x |x|  x IN s}`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `{path_component s (x:real^N) |x| x IN s}` o
    GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN
  ASM_SIMP_TAC[OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED; FORALL_IN_GSPEC;
               UNIONS_PATH_COMPONENT; SUBSET_REFL] THEN
  DISCH_THEN(X_CHOOSE_THEN `cs:(real^N->bool)->bool` MP_TAC) THEN
  ASM_CASES_TAC `{path_component s (x:real^N) |x| x IN s} = cs` THEN
  ASM_SIMP_TAC[] THEN
  MATCH_MP_TAC(TAUT `(p ==> ~r) ==> p /\ q /\ r ==> s`) THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `?x:real^N. x IN s /\ ~(path_component s x IN cs)`
  MP_TAC THENL [ASM SET_TAC[]; SIMP_TAC[SUBSET; NOT_FORALL_THM]] THEN

  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN
  REWRITE_TAC[NOT_IMP] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  SUBGOAL_THEN `?y:real^N. y IN s /\ x IN path_component s y /\
                           path_component s y IN cs`
  STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP PATH_COMPONENT_EQ) THEN
  ASM_MESON_TAC[]);;

let CONVEX_IMP_LOCALLY_CONNECTED = prove
 (`!s:real^N->bool. convex s ==> locally connected s`,
  MESON_TAC[CONVEX_IMP_LOCALLY_PATH_CONNECTED;
            LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);;

let HOMEOMORPHIC_LOCAL_CONNECTEDNESS = prove
 (`!s t. s homeomorphic t ==> (locally connected s <=> locally connected t)`,
  MATCH_MP_TAC HOMEOMORPHIC_LOCALLY THEN
  REWRITE_TAC[HOMEOMORPHIC_CONNECTEDNESS]);;

let HOMEOMORPHISM_LOCAL_CONNECTEDNESS = prove
 (`!f:real^M->real^N g s t k.
        homeomorphism (s,t) (f,g) /\ k SUBSET s
        ==> (locally connected (IMAGE f k) <=> locally connected k)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_LOCAL_CONNECTEDNESS THEN
  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN
  MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
          HOMEOMORPHISM_OF_SUBSETS)) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);;

let HOMEOMORPHIC_LOCAL_PATH_CONNECTEDNESS = prove
 (`!s t. s homeomorphic t
         ==> (locally path_connected s <=> locally path_connected t)`,
  MATCH_MP_TAC HOMEOMORPHIC_LOCALLY THEN
  REWRITE_TAC[HOMEOMORPHIC_PATH_CONNECTEDNESS]);;

let HOMEOMORPHISM_LOCAL_PATH_CONNECTEDNESS = prove
 (`!f:real^M->real^N g s t k.
        homeomorphism (s,t) (f,g) /\ k SUBSET s
        ==> (locally path_connected (IMAGE f k) <=> locally path_connected k)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_LOCAL_PATH_CONNECTEDNESS THEN
  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN
  MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
          HOMEOMORPHISM_OF_SUBSETS)) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);;

let LOCALLY_PATH_CONNECTED_TRANSLATION_EQ = prove
 (`!a:real^N s. locally path_connected (IMAGE (\x. a + x) s) <=>
                locally path_connected s`,
  MATCH_MP_TAC LOCALLY_TRANSLATION THEN
  REWRITE_TAC[PATH_CONNECTED_TRANSLATION_EQ]);;

add_translation_invariants [LOCALLY_PATH_CONNECTED_TRANSLATION_EQ];;

let LOCALLY_CONNECTED_TRANSLATION_EQ = prove
 (`!a:real^N s. locally connected (IMAGE (\x. a + x) s) <=>
                locally connected s`,
  MATCH_MP_TAC LOCALLY_TRANSLATION THEN
  REWRITE_TAC[CONNECTED_TRANSLATION_EQ]);;

add_translation_invariants [LOCALLY_CONNECTED_TRANSLATION_EQ];;

let LOCALLY_PATH_CONNECTED_LINEAR_IMAGE_EQ = prove
 (`!f:real^M->real^N s.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (locally path_connected (IMAGE f s) <=> locally path_connected s)`,
  MATCH_MP_TAC LOCALLY_INJECTIVE_LINEAR_IMAGE THEN
  REWRITE_TAC[PATH_CONNECTED_LINEAR_IMAGE_EQ]);;

add_linear_invariants [LOCALLY_PATH_CONNECTED_LINEAR_IMAGE_EQ];;

let LOCALLY_CONNECTED_LINEAR_IMAGE_EQ = prove
 (`!f:real^M->real^N s.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (locally connected (IMAGE f s) <=> locally connected s)`,
  MATCH_MP_TAC LOCALLY_INJECTIVE_LINEAR_IMAGE THEN
  REWRITE_TAC[CONNECTED_LINEAR_IMAGE_EQ]);;

add_linear_invariants [LOCALLY_CONNECTED_LINEAR_IMAGE_EQ];;

let LOCALLY_CONNECTED_QUOTIENT_IMAGE = prove
 (`!f:real^M->real^N s.
      (!t. t SUBSET IMAGE f s
           ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=>
                open_in (subtopology euclidean (IMAGE f s)) t)) /\
      locally connected s
      ==> locally connected (IMAGE f s)`,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  REWRITE_TAC[GSYM LOCALLY_CONNECTED_SPACE_SUBTOPOLOGY_EUCLIDEAN] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ]
    LOCALLY_CONNECTED_SPACE_QUOTIENT_MAP_IMAGE) THEN
  EXISTS_TAC `f:real^M->real^N` THEN
  ASM_REWRITE_TAC[quotient_map; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]);;

let LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE = prove
 (`!f:real^M->real^N s.
      (!t. t SUBSET IMAGE f s
           ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=>
                open_in (subtopology euclidean (IMAGE f s)) t)) /\
      locally path_connected s
      ==> locally path_connected (IMAGE f s)`,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  REWRITE_TAC[GSYM LOCALLY_PATH_CONNECTED_SPACE_SUBTOPOLOGY_EUCLIDEAN] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ]
    LOCALLY_PATH_CONNECTED_SPACE_QUOTIENT_MAP_IMAGE) THEN
  EXISTS_TAC `f:real^M->real^N` THEN
  ASM_REWRITE_TAC[quotient_map; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]);;


let LOCALLY_CONNECTED_CONTINUOUS_IMAGE_COMPACT = prove
 (`!f:real^M->real^N s.
        locally connected s /\ compact s /\ f continuous_on s
        ==> locally connected (IMAGE f s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_CONNECTED_QUOTIENT_IMAGE THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_MAP_IMP_QUOTIENT_MAP THEN
  ASM_SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED;
               COMPACT_CONTINUOUS_IMAGE; IMAGE_SUBSET] THEN
  ASM_MESON_TAC[COMPACT_IMP_CLOSED; COMPACT_CONTINUOUS_IMAGE;
    CONTINUOUS_ON_SUBSET; BOUNDED_SUBSET; COMPACT_EQ_BOUNDED_CLOSED]);;

let LOCALLY_PATH_CONNECTED_CONTINUOUS_IMAGE_COMPACT = prove
 (`!f:real^M->real^N s.
        locally path_connected s /\ compact s /\ f continuous_on s
        ==> locally path_connected (IMAGE f s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_MAP_IMP_QUOTIENT_MAP THEN
  ASM_SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED;
               COMPACT_CONTINUOUS_IMAGE; IMAGE_SUBSET] THEN
  ASM_MESON_TAC[COMPACT_IMP_CLOSED; COMPACT_CONTINUOUS_IMAGE;
    CONTINUOUS_ON_SUBSET; BOUNDED_SUBSET; COMPACT_EQ_BOUNDED_CLOSED]);;

let LOCALLY_PATH_CONNECTED_PATH_IMAGE = prove
 (`!p:real^1->real^N. path p ==> locally path_connected (path_image p)`,
  REWRITE_TAC[path; path_image] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC LOCALLY_PATH_CONNECTED_CONTINUOUS_IMAGE_COMPACT THEN
  ASM_SIMP_TAC[COMPACT_INTERVAL; CONVEX_INTERVAL;
               CONVEX_IMP_LOCALLY_PATH_CONNECTED]);;

let LOCALLY_CONNECTED_PATH_IMAGE = prove
 (`!p:real^1->real^N. path p ==> locally connected (path_image p)`,
  SIMP_TAC[LOCALLY_PATH_CONNECTED_PATH_IMAGE;
           LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);;

let LOCALLY_CONNECTED_LEFT_INVERTIBLE_IMAGE = prove
 (`!f:real^M->real^N g s.
        f continuous_on s /\ g continuous_on (IMAGE f s) /\
        (!x. x IN s ==> g(f x) = x) /\
        locally connected s
        ==> locally connected (IMAGE f s)`,
  REPEAT GEN_TAC THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_CONNECTED_QUOTIENT_IMAGE) THEN
  MATCH_MP_TAC CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP THEN ASM_MESON_TAC[]);;

let LOCALLY_CONNECTED_RIGHT_INVERTIBLE_IMAGE = prove
 (`!f:real^M->real^N g s.
        f continuous_on s /\ g continuous_on (IMAGE f s) /\
        IMAGE g (IMAGE f s) SUBSET s /\ (!x. x IN IMAGE f s ==> f(g x) = x) /\
        locally connected s
        ==> locally connected (IMAGE f s)`,
  REPEAT GEN_TAC THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_CONNECTED_QUOTIENT_IMAGE) THEN
  MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN
  EXISTS_TAC `g:real^N->real^M` THEN ASM SET_TAC[]);;

let LOCALLY_PATH_CONNECTED_LEFT_INVERTIBLE_IMAGE = prove
 (`!f:real^M->real^N g s.
        f continuous_on s /\ g continuous_on (IMAGE f s) /\
        (!x. x IN s ==> g(f x) = x) /\
        locally path_connected s
        ==> locally path_connected (IMAGE f s)`,
  REPEAT GEN_TAC THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ]
    LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE) THEN
  MATCH_MP_TAC CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP THEN ASM_MESON_TAC[]);;

let LOCALLY_PATH_CONNECTED_RIGHT_INVERTIBLE_IMAGE = prove
 (`!f:real^M->real^N g s.
        f continuous_on s /\ g continuous_on (IMAGE f s) /\
        IMAGE g (IMAGE f s) SUBSET s /\ (!x. x IN IMAGE f s ==> f(g x) = x) /\
        locally path_connected s
        ==> locally path_connected (IMAGE f s)`,
  REPEAT GEN_TAC THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ]
    LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE) THEN
  MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN
  EXISTS_TAC `g:real^N->real^M` THEN ASM SET_TAC[]);;

let LOCALLY_CONNECTED_PCROSS = prove
 (`!s:real^M->bool t:real^N->bool.
        locally connected s /\ locally connected t
        ==> locally connected (s PCROSS t)`,
  MATCH_MP_TAC LOCALLY_PCROSS THEN REWRITE_TAC[CONNECTED_PCROSS]);;

let LOCALLY_PATH_CONNECTED_PCROSS = prove
 (`!s:real^M->bool t:real^N->bool.
        locally path_connected s /\ locally path_connected t
        ==> locally path_connected (s PCROSS t)`,
  MATCH_MP_TAC LOCALLY_PCROSS THEN REWRITE_TAC[PATH_CONNECTED_PCROSS]);;

let LOCALLY_CONNECTED_PCROSS_EQ = prove
 (`!s:real^M->bool t:real^N->bool.
        locally connected (s PCROSS t) <=>
        s = {} \/ t = {} \/ locally connected s /\ locally connected t`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `s:real^M->bool = {}` THEN
  ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN
  ASM_CASES_TAC `t:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN
  EQ_TAC THEN REWRITE_TAC[LOCALLY_CONNECTED_PCROSS] THEN
  GEN_REWRITE_TAC LAND_CONV [LOCALLY_CONNECTED] THEN DISCH_TAC THEN
  REWRITE_TAC[LOCALLY_CONNECTED_IM_KLEINEN] THEN CONJ_TAC THENL
   [MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `x:real^M`] THEN STRIP_TAC THEN
    UNDISCH_TAC `~(t:real^N->bool = {})` THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
    DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN
    FIRST_X_ASSUM(MP_TAC o SPECL
     [`(u:real^M->bool) PCROSS (t:real^N->bool)`;
      `pastecart (x:real^M) (y:real^N)`]);
    MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN
    UNDISCH_TAC `~(s:real^M->bool = {})` THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
    DISCH_THEN(X_CHOOSE_TAC `x:real^M`) THEN
    FIRST_X_ASSUM(MP_TAC o SPECL
     [`(s:real^M->bool) PCROSS (v:real^N->bool)`;
      `pastecart (x:real^M) (y:real^N)`])] THEN
  ASM_SIMP_TAC[OPEN_IN_PCROSS_EQ; PASTECART_IN_PCROSS; SUBSET_UNIV;
    OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `w:real^(M,N)finite_sum->bool` THEN STRIP_TAC THEN
  MP_TAC(ISPECL
   [`s:real^M->bool`; `t:real^N->bool`; `w:real^(M,N)finite_sum->bool`;
    `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN
  ASM_REWRITE_TAC[] THENL
   [MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u':real^M->bool` THEN
    DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
    ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
     [ALL_TAC;
      X_GEN_TAC `z:real^M` THEN DISCH_TAC THEN
      EXISTS_TAC `IMAGE fstcart (w:real^(M,N)finite_sum->bool)` THEN
      ASM_SIMP_TAC[CONNECTED_LINEAR_IMAGE; LINEAR_FSTCART] THEN
      REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART]];
    DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` MP_TAC) THEN
    MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `v':real^N->bool` THEN STRIP_TAC THEN
    ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
     [ALL_TAC;
      X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN
      EXISTS_TAC `IMAGE sndcart (w:real^(M,N)finite_sum->bool)` THEN
      ASM_SIMP_TAC[CONNECTED_LINEAR_IMAGE; LINEAR_SNDCART] THEN
      REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; SNDCART_PASTECART]]] THEN
  RULE_ASSUM_TAC(REWRITE_RULE
   [SUBSET; FORALL_IN_PCROSS; PASTECART_IN_PCROSS; FORALL_PASTECART]) THEN
  ASM SET_TAC[]);;

let LOCALLY_PATH_CONNECTED_PCROSS_EQ = prove
 (`!s:real^M->bool t:real^N->bool.
        locally path_connected (s PCROSS t) <=>
        s = {} \/ t = {} \/
        locally path_connected s /\ locally path_connected t`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `s:real^M->bool = {}` THEN
  ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN
  ASM_CASES_TAC `t:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN
  EQ_TAC THEN REWRITE_TAC[LOCALLY_PATH_CONNECTED_PCROSS] THEN
  GEN_REWRITE_TAC LAND_CONV [LOCALLY_PATH_CONNECTED] THEN DISCH_TAC THEN
  REWRITE_TAC[LOCALLY_PATH_CONNECTED_IM_KLEINEN] THEN CONJ_TAC THENL
   [MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `x:real^M`] THEN STRIP_TAC THEN
    UNDISCH_TAC `~(t:real^N->bool = {})` THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
    DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN
    FIRST_X_ASSUM(MP_TAC o SPECL
     [`(u:real^M->bool) PCROSS (t:real^N->bool)`;
      `pastecart (x:real^M) (y:real^N)`]);
    MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN
    UNDISCH_TAC `~(s:real^M->bool = {})` THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
    DISCH_THEN(X_CHOOSE_TAC `x:real^M`) THEN
    FIRST_X_ASSUM(MP_TAC o SPECL
     [`(s:real^M->bool) PCROSS (v:real^N->bool)`;
      `pastecart (x:real^M) (y:real^N)`])] THEN
  ASM_SIMP_TAC[OPEN_IN_PCROSS_EQ; PASTECART_IN_PCROSS; SUBSET_UNIV;
    OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `w:real^(M,N)finite_sum->bool` THEN STRIP_TAC THEN
  MP_TAC(ISPECL
   [`s:real^M->bool`; `t:real^N->bool`; `w:real^(M,N)finite_sum->bool`;
    `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN
  ASM_REWRITE_TAC[] THENL
   [MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u':real^M->bool` THEN
    DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
    ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
     [ALL_TAC;
      X_GEN_TAC `z:real^M` THEN DISCH_TAC THEN
      MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`;
                     `w:real^(M,N)finite_sum->bool`]
        PATH_CONNECTED_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_FSTCART] THEN
      REWRITE_TAC[path_connected] THEN
      DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `z:real^M`]) THEN ANTS_TAC THENL
       [REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART];
        MATCH_MP_TAC MONO_EXISTS THEN
        REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART] THEN
        REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]];
    DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` MP_TAC) THEN
    MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `v':real^N->bool` THEN STRIP_TAC THEN
    ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
     [ALL_TAC;
      X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN
      MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`;
                     `w:real^(M,N)finite_sum->bool`]
        PATH_CONNECTED_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_SNDCART] THEN
      REWRITE_TAC[path_connected] THEN
      DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `z:real^N`]) THEN ANTS_TAC THENL
       [REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; SNDCART_PASTECART];
        MATCH_MP_TAC MONO_EXISTS THEN
        REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; SNDCART_PASTECART] THEN
        REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]]] THEN
  RULE_ASSUM_TAC(REWRITE_RULE
   [SUBSET; FORALL_IN_PCROSS; PASTECART_IN_PCROSS; FORALL_PASTECART]) THEN
  ASM SET_TAC[]);;

let LOCALLY_CONNECTED_SUBREGION = prove
 (`!s t c:real^N->bool.
        locally connected s /\ t SUBSET s /\
        connected c /\ open_in (subtopology euclidean t) c
        ==> ?c'. connected c' /\ open_in (subtopology euclidean s) c' /\
                 c = t INTER c'`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
  DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN
  ASM_CASES_TAC `s INTER u:real^N->bool = {}` THENL
   [EXISTS_TAC `{}:real^N->bool` THEN
    ASM_REWRITE_TAC[CONNECTED_EMPTY; OPEN_IN_EMPTY] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  MP_TAC(ISPECL [`s INTER u:real^N->bool`; `t INTER u:real^N->bool`]
        EXISTS_COMPONENT_SUPERSET) THEN
  ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^N->bool` THEN
  REPEAT STRIP_TAC THENL
   [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED];
    MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `s INTER u:real^N->bool` THEN
    ASM_SIMP_TAC[OPEN_IN_OPEN_INTER] THEN
    MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN
    ASM_REWRITE_TAC[] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        LOCALLY_OPEN_SUBSET)) THEN
    ASM_SIMP_TAC[OPEN_IN_OPEN_INTER];
    ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_INTER; INTER_SUBSET] THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN SET_TAC[]]);;

let CARD_EQ_OPEN_IN = prove
 (`!u s:real^N->bool.
      locally connected u /\
      open_in (subtopology euclidean u) s /\
      (?x. x IN s /\ x limit_point_of u)
      ==> s =_c (:real)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
   [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
    SIMP_TAC[CARD_EQ_IMP_LE; CARD_EQ_EUCLIDEAN] THEN
    MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[SUBSET_UNIV];
    ALL_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
  DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
  UNDISCH_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[IN_INTER] THEN
  STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_CONNECTED]) THEN
  DISCH_THEN(MP_TAC o SPECL [`u INTER t:real^N->bool`; `x:real^N`]) THEN
  ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; IN_INTER] THEN
  REWRITE_TAC[OPEN_IN_OPEN; GSYM CONJ_ASSOC; LEFT_AND_EXISTS_THM] THEN
  ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
  REWRITE_TAC[UNWIND_THM2; IN_INTER] THEN
  DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [limit_point_of]) THEN
  DISCH_THEN(MP_TAC o SPEC `t INTER v:real^N->bool`) THEN
  ASM_SIMP_TAC[IN_INTER; OPEN_INTER] THEN
  DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
  TRANS_TAC CARD_LE_TRANS `u INTER v:real^N->bool` THEN
  ASM_SIMP_TAC[CARD_LE_SUBSET] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
  ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN MATCH_MP_TAC CARD_EQ_CONNECTED THEN
  ASM SET_TAC[]);;

let CARD_EQ_OPEN_IN_AFFINE = prove
 (`!u s:real^N->bool.
        affine u /\ ~(aff_dim u = &0) /\
        open_in (subtopology euclidean u) s /\ ~(s = {})
        ==> s =_c (:real)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CARD_EQ_OPEN_IN THEN
  EXISTS_TAC `u:real^N->bool` THEN
  ASM_SIMP_TAC[CONVEX_IMP_LOCALLY_CONNECTED; AFFINE_IMP_CONVEX] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_IMP_PERFECT_AFF_DIM THEN
  ASM_SIMP_TAC[AFFINE_IMP_CONVEX; CONVEX_CONNECTED] THEN
  FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]);;

let SEPARATION_BY_CLOSED_INTERMEDIATES = prove
 (`!u s:real^N->bool.
        ~connected(u DIFF s)
        ==> ?t. closed_in (subtopology euclidean u) t /\ t SUBSET s /\
                !c. closed_in (subtopology euclidean u) c /\
                    t SUBSET c /\ c SUBSET s
                    ==> ~connected(u DIFF c)`,
  REPEAT GEN_TAC THEN
  MP_TAC(ISPECL [`subtopology euclidean (u:real^N->bool)`; `s:real^N->bool`]
        SEPARATION_BY_CLOSED_INTERMEDIATES_GEN) THEN
  REWRITE_TAC[CONNECTED_IN_SUBTOPOLOGY; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  REWRITE_TAC[CONNECTED_IN_EUCLIDEAN; SUBSET_DIFF] THEN
  SIMP_TAC[METRIZABLE_IMP_HEREDITARILY_NORMAL_SPACE;
           METRIZABLE_SPACE_SUBTOPOLOGY; METRIZABLE_SPACE_EUCLIDEAN]);;

let SEPARATION_BY_CLOSED_INTERMEDIATES_EQ = prove
 (`!u s:real^N->bool.
        locally connected u
        ==> (~connected(u DIFF s) <=>
             ?t. closed_in (subtopology euclidean u) t /\ t SUBSET s /\
                 !c. closed_in (subtopology euclidean u) c /\
                     t SUBSET c /\ c SUBSET s
                     ==> ~connected(u DIFF c))`,
  REPEAT GEN_TAC THEN
  MP_TAC(ISPECL [`subtopology euclidean (u:real^N->bool)`; `s:real^N->bool`]
        SEPARATION_BY_CLOSED_INTERMEDIATES_EQ_GEN) THEN
  REWRITE_TAC[CONNECTED_IN_SUBTOPOLOGY; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  REWRITE_TAC[CONNECTED_IN_EUCLIDEAN; SUBSET_DIFF] THEN
  REWRITE_TAC[LOCALLY_CONNECTED_SPACE_SUBTOPOLOGY_EUCLIDEAN] THEN
  SIMP_TAC[METRIZABLE_IMP_HEREDITARILY_NORMAL_SPACE;
           METRIZABLE_SPACE_SUBTOPOLOGY; METRIZABLE_SPACE_EUCLIDEAN]);;

let LOCALLY_CONNECTED_CLOSED_UNION_GEN = prove
 (`!s t u:real^N->bool.
        closed_in (subtopology euclidean u) s /\
        closed_in (subtopology euclidean u) t /\
        locally connected s /\ locally connected t
        ==> locally connected (s UNION t)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[locally] THEN
  MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN
  ASM_CASES_TAC `(a:real^N) IN s` THENL
   [ALL_TAC;
    MATCH_MP_TAC(MESON[] `(?x. P x x) ==> (?x y. P x y)`) THEN
    SUBGOAL_THEN `locally connected(t DIFF s:real^N->bool)` MP_TAC THENL
     [MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `t:real^N->bool` THEN
      ASM_REWRITE_TAC[] THEN
      ONCE_REWRITE_TAC[SET_RULE `t DIFF s = t DIFF (t INTER s)`] THEN
      MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
      MATCH_MP_TAC CLOSED_IN_SUBTOPOLOGY_INTER_SUBSET THEN
      EXISTS_TAC `u:real^N->bool` THEN
      ASM_SIMP_TAC[CLOSED_IN_INTER; CLOSED_IN_REFL] THEN
      ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET];
      REWRITE_TAC[LOCALLY_CONNECTED] THEN
      DISCH_THEN(MP_TAC o SPECL [`v DIFF s:real^N->bool`; `a:real^N`]) THEN
      ASM_REWRITE_TAC[IN_DIFF] THEN ANTS_TAC THENL
       [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
        REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[];
        MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `w:real^N->bool` THEN
        MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
        MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] OPEN_IN_TRANS) THEN
        ONCE_REWRITE_TAC[SET_RULE `t DIFF s = (s UNION t) DIFF s`] THEN
        MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
        MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN
        EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
        REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN
        SET_TAC[]]]] THEN
  ASM_CASES_TAC `(a:real^N) IN t` THENL
   [ALL_TAC;
    MATCH_MP_TAC(MESON[] `(?x. P x x) ==> (?x y. P x y)`) THEN
    SUBGOAL_THEN `locally connected(s DIFF t:real^N->bool)` MP_TAC THENL
     [MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN
      ASM_REWRITE_TAC[] THEN
      ONCE_REWRITE_TAC[SET_RULE `t DIFF s = t DIFF (t INTER s)`] THEN
      MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
      MATCH_MP_TAC CLOSED_IN_SUBTOPOLOGY_INTER_SUBSET THEN
      EXISTS_TAC `u:real^N->bool` THEN
      ASM_SIMP_TAC[CLOSED_IN_INTER; CLOSED_IN_REFL] THEN
      ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET];
      REWRITE_TAC[LOCALLY_CONNECTED] THEN
      DISCH_THEN(MP_TAC o SPECL [`v DIFF t:real^N->bool`; `a:real^N`]) THEN
      ASM_REWRITE_TAC[IN_DIFF] THEN ANTS_TAC THENL
       [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
        REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[];
        MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `w:real^N->bool` THEN
        MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
        MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] OPEN_IN_TRANS) THEN
        ONCE_REWRITE_TAC[SET_RULE `s DIFF t = (s UNION t) DIFF t`] THEN
        MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
        MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN
        EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
        REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN
        SET_TAC[]]]] THEN
  UNDISCH_TAC `locally connected (t:real^N->bool)` THEN
  UNDISCH_TAC `locally connected (s:real^N->bool)` THEN
  REWRITE_TAC[LOCALLY_CONNECTED] THEN
  DISCH_THEN(MP_TAC o SPECL [`s INTER v:real^N->bool`; `a:real^N`]) THEN
  ASM_REWRITE_TAC[IN_INTER] THEN ANTS_TAC THENL
   [MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN
    EXISTS_TAC `s UNION t:real^N->bool` THEN
    ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_REFL; SUBSET_UNION];
    GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [OPEN_IN_OPEN] THEN
    REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
    GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN
    ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ r <=> q /\ p /\ r`] THEN
    REWRITE_TAC[UNWIND_THM2; IN_INTER; SUBSET_INTER] THEN
    DISCH_THEN(X_CHOOSE_THEN `m:real^N->bool` STRIP_ASSUME_TAC)] THEN
  DISCH_THEN(MP_TAC o SPECL [`t INTER v:real^N->bool`; `a:real^N`]) THEN
  ASM_REWRITE_TAC[IN_INTER] THEN ANTS_TAC THENL
   [MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN
    EXISTS_TAC `s UNION t:real^N->bool` THEN
    ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_REFL; SUBSET_UNION];
    GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [OPEN_IN_OPEN] THEN
    REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
    GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN
    ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ r <=> q /\ p /\ r`] THEN
    REWRITE_TAC[UNWIND_THM2; IN_INTER; SUBSET_INTER] THEN
    DISCH_THEN(X_CHOOSE_THEN `n:real^N->bool` STRIP_ASSUME_TAC)] THEN
  EXISTS_TAC `(s UNION t) INTER (m INTER n):real^N->bool` THEN
  EXISTS_TAC `(s INTER m) UNION (t INTER n):real^N->bool` THEN
  ASM_SIMP_TAC[OPEN_INTER; OPEN_IN_OPEN_INTER] THEN
  CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  MATCH_MP_TAC CONNECTED_UNION THEN ASM SET_TAC[]);;

let LOCALLY_CONNECTED_CLOSED_UNION = prove
 (`!s t:real^N->bool.
        locally connected s /\ locally connected t /\ closed s /\ closed t
        ==> locally connected (s UNION t)`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC LOCALLY_CONNECTED_CLOSED_UNION_GEN THEN
  EXISTS_TAC `(:real^N)` THEN
  ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN]);;

let LOCALLY_CONNECTED_CLOSED_UNIONS = prove
 (`!f:(real^N->bool)->bool.
        FINITE f /\ (!s. s IN f ==> closed s /\ locally connected s)
        ==> locally connected (UNIONS f)`,
  REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; UNIONS_0; UNIONS_INSERT] THEN
  REWRITE_TAC[LOCALLY_EMPTY] THEN
  ASM_SIMP_TAC[LOCALLY_CONNECTED_CLOSED_UNION; CLOSED_UNIONS]);;

let LOCALLY_CONNECTED_FROM_UNION_AND_INTER_GEN = prove
 (`!s t u:real^N->bool.
        closed_in (subtopology euclidean u) s /\
        closed_in (subtopology euclidean u) t /\
        locally connected (s UNION t) /\ locally connected (s INTER t)
        ==> locally connected s`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `closed_in (subtopology euclidean (s UNION t)) (s:real^N->bool) /\
    closed_in (subtopology euclidean (s UNION t)) (t:real^N->bool)`
  MP_TAC THENL
   [CONJ_TAC THEN
    FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        CLOSED_IN_SUBSET_TRANS)) THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN
    SET_TAC[];
    REPEAT(FIRST_X_ASSUM(K ALL_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN
    REPEAT STRIP_TAC] THEN
  REWRITE_TAC[LOCALLY_CONNECTED] THEN
  MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
  ASM_CASES_TAC `(x:real^N) IN t` THENL
   [ALL_TAC;
    SUBGOAL_THEN `locally connected (s DIFF t:real^N->bool)` MP_TAC THENL
     [MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
      EXISTS_TAC `s UNION t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
      ONCE_REWRITE_TAC[SET_RULE `s DIFF t = (s UNION t) DIFF t`] THEN
      MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[OPEN_IN_REFL];
      REWRITE_TAC[LOCALLY_CONNECTED] THEN
      DISCH_THEN(MP_TAC o SPECL [`u DIFF t:real^N->bool`; `x:real^N`]) THEN
      ASM_REWRITE_TAC[IN_DIFF] THEN ANTS_TAC THENL
       [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
        REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[];
        MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN
        CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
        MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] OPEN_IN_TRANS) THEN
        MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN
        EXISTS_TAC `s UNION t:real^N->bool` THEN
        CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
        ONCE_REWRITE_TAC[SET_RULE `s DIFF t = (s UNION t) DIFF t`] THEN
        MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[OPEN_IN_REFL]]]] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
  DISCH_THEN(X_CHOOSE_THEN `g:real^N->bool` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM SUBST_ALL_TAC THEN
  FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC o REWRITE_RULE[IN_INTER]) THEN
  ABBREV_TAC `c = connected_component (s INTER t INTER g) (x:real^N)` THEN
  MP_TAC(ISPECL [`(s UNION t) INTER g:real^N->bool`;
                 `s INTER t INTER g:real^N->bool`;
                 `c:real^N->bool`] LOCALLY_CONNECTED_SUBREGION) THEN
  ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
   [REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
      EXISTS_TAC `s UNION t:real^N->bool` THEN
      ASM_SIMP_TAC[OPEN_IN_OPEN_INTER];
      SET_TAC[];
      ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT];
      EXPAND_TAC "c" THEN
      MATCH_MP_TAC OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED THEN
      MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
      EXISTS_TAC `s INTER t:real^N->bool` THEN
      ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; GSYM INTER_ASSOC]];
    DISCH_THEN(X_CHOOSE_THEN `h:real^N->bool` (STRIP_ASSUME_TAC o GSYM))] THEN
  EXISTS_TAC `s INTER h:real^N->bool` THEN REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN
    EXISTS_TAC `s UNION t:real^N->bool` THEN REWRITE_TAC[SUBSET_UNION] THEN
    MATCH_MP_TAC OPEN_IN_TRANS THEN
    EXISTS_TAC `(s UNION t) INTER g:real^N->bool` THEN
    ASM_SIMP_TAC[OPEN_IN_OPEN_INTER] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
    REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[];
    ALL_TAC;
    SUBGOAL_THEN `(x:real^N) IN c` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    ASM_MESON_TAC[CONNECTED_COMPONENT_REFL_EQ; IN; IN_INTER];
    FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
    ASM SET_TAC[]] THEN
  MATCH_MP_TAC(TAUT `!q. p /\ q ==> p`) THEN
  EXISTS_TAC `connected(t INTER h:real^N->bool)` THEN
  MATCH_MP_TAC CONNECTED_FROM_CLOSED_UNION_AND_INTER_LOCAL THEN
  EXISTS_TAC `h:real^N->bool` THEN
  ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
   [CONJ_TAC THENL
     [UNDISCH_TAC
       `closed_in (subtopology euclidean (s UNION t)) (s:real^N->bool)`;
      UNDISCH_TAC
       `closed_in (subtopology euclidean (s UNION t)) (t:real^N->bool)`] THEN
    REWRITE_TAC[CLOSED_IN_CLOSED] THEN MATCH_MP_TAC MONO_EXISTS THEN
    FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
    ASM SET_TAC[];
    SUBGOAL_THEN `s INTER h UNION t INTER h:real^N->bool = h`
    SUBST1_TAC THENL
     [FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
      ASM SET_TAC[];
      ASM_REWRITE_TAC[]] THEN
    SUBGOAL_THEN `(s INTER h) INTER t INTER h:real^N->bool = c`
    SUBST1_TAC THENL
     [FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
      ASM SET_TAC[];
      ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT]]]);;

let LOCALLY_CONNECTED_FROM_UNION_AND_INTER = prove
 (`!s t:real^N->bool.
        closed s /\ closed t /\
        locally connected (s UNION t) /\ locally connected (s INTER t)
        ==> locally connected s`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC LOCALLY_CONNECTED_FROM_UNION_AND_INTER_GEN THEN
  MAP_EVERY EXISTS_TAC [`t:real^N->bool`; `s UNION t:real^N->bool`] THEN
  ASM_SIMP_TAC[CLOSED_SUBSET; SUBSET_UNION]);;

let LOCALLY_CONNECTED_CLOSURE_FROM_FRONTIER = prove
 (`!s:real^N->bool.
        locally connected (frontier s) ==> locally connected (closure s)`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC LOCALLY_CONNECTED_FROM_UNION_AND_INTER THEN
  EXISTS_TAC `closure((:real^N) DIFF s)` THEN
  ASM_REWRITE_TAC[GSYM FRONTIER_CLOSURES; CLOSED_CLOSURE] THEN
  SUBGOAL_THEN
   `closure s UNION closure ((:real^N) DIFF s) = (:real^N)`
   (fun th -> REWRITE_TAC[th; LOCALLY_CONNECTED_UNIV]) THEN
  MATCH_MP_TAC(SET_RULE
   `s SUBSET closure s /\ (:real^N) DIFF s SUBSET closure((:real^N) DIFF s)
    ==> closure s UNION closure ((:real^N) DIFF s) = (:real^N)`) THEN
  REWRITE_TAC[CLOSURE_SUBSET]);;

let PATH_CONNECTED_FROM_CLOSED_UNION_AND_INTER_LOCAL,
    PATH_CONNECTED_FROM_OPEN_UNION_AND_INTER_LOCAL = (CONJ_PAIR o prove)
 (`(!u s t:real^N->bool.
        closed_in (subtopology euclidean u) s /\
        closed_in (subtopology euclidean u) t /\
        path_connected (s UNION t) /\
        path_connected (s INTER t)
        ==> path_connected s /\ path_connected t) /\
   (!u s t:real^N->bool.
        open_in (subtopology euclidean u) s /\
        open_in (subtopology euclidean u) t /\
        path_connected (s UNION t) /\
        path_connected (s INTER t)
        ==> path_connected s /\ path_connected t)`,
  let lemma0 = prove
   (`!g u s:real^N->bool.
          closed_in (subtopology euclidean u) s /\
          path g /\ path_image g SUBSET u /\ ~DISJOINT (path_image g) s
          ==> ?p. p IN interval[vec 0,vec 1] /\ g p IN s /\
                  !x. x IN interval[vec 0,vec 1] /\ drop x < drop p
                      ==> ~(g x IN s)`,
    REPEAT STRIP_TAC THEN MP_TAC(ISPECL
     [`{x | x IN interval[vec 0,vec 1] /\ (g:real^1->real^N) x IN s}`;
      `vec 0:real^1`] DISTANCE_ATTAINS_INF) THEN
    ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
     [CONJ_TAC THENL
       [MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN
        EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
        REWRITE_TAC[CLOSED_INTERVAL] THEN
        MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN
        EXISTS_TAC `u:real^N->bool` THEN
        ASM_REWRITE_TAC[GSYM path; GSYM path_image] THEN
        REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN
        ASM SET_TAC[];
        RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN ASM SET_TAC[]];
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC  `x:real^1` THEN
      REWRITE_TAC[IN_ELIM_THM; DIST_0; NORM_1; IN_INTERVAL_1; DROP_VEC] THEN
      DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
      ASM_SIMP_TAC[real_abs] THEN MATCH_MP_TAC MONO_FORALL THEN
      X_GEN_TAC `y:real^1` THEN
      ASM_CASES_TAC `(g:real^1->real^N) y IN s` THEN ASM_REWRITE_TAC[] THEN
      REAL_ARITH_TAC]) in
  let lemma1 = prove
   (`!g s t u:real^N->bool.
          (closed_in (subtopology euclidean u) s /\
           closed_in (subtopology euclidean u) t \/
           open_in (subtopology euclidean u) s /\
           open_in (subtopology euclidean u) t) /\
          path g /\ pathstart g IN s /\
          path_image g SUBSET s UNION t /\ ~(path_image g SUBSET s)
          ==> ?p. p IN interval[vec 0,vec 1] /\ g p IN t /\
                  !x. x IN interval[vec 0,p] ==> g x IN s`,
    REPEAT STRIP_TAC THENL
     [SUBGOAL_THEN `(s:real^N->bool) SUBSET u /\ (t:real^N->bool) SUBSET u`
      STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]; ALL_TAC] THEN
      MP_TAC(ISPECL [`g:real^1->real^N`; `u:real^N->bool`; `t:real^N->bool`]
            lemma0) THEN
      ASM_REWRITE_TAC[] THEN
      ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN
      X_GEN_TAC `p:real^1` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
      X_GEN_TAC `q:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
      STRIP_TAC THEN ASM_CASES_TAC `q:real^1 = vec 0` THENL
       [ASM_MESON_TAC[pathstart]; ALL_TAC] THEN
      ASM_CASES_TAC `p:real^1 = vec 0` THENL
       [RULE_ASSUM_TAC(REWRITE_RULE[GSYM DROP_EQ; DROP_VEC]) THEN
        ASM_REAL_ARITH_TAC;
        ALL_TAC] THEN
      SUBGOAL_THEN `&0 < drop p` ASSUME_TAC THENL
       [ASM_REWRITE_TAC[REAL_LT_LE; GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN
        ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC];
        ALL_TAC] THEN
      ASM_CASES_TAC `q:real^1 = p` THEN ASM_REWRITE_TAC[] THENL
       [ALL_TAC;
        RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
        FIRST_X_ASSUM(MP_TAC o SPEC `q:real^1`) THEN ANTS_TAC THENL
         [ASM_REWRITE_TAC[REAL_LT_LE; GSYM LIFT_EQ; LIFT_DROP];
          FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
           `p SUBSET s UNION t ==> y IN p ==> ~(y IN t) ==> y IN s`)) THEN
          REWRITE_TAC[path_image; IN_IMAGE] THEN EXISTS_TAC `q:real^1`] THEN
        REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC] THEN
      SUBGOAL_THEN
       `p IN {x | x IN interval[vec 0,vec 1] /\ (g:real^1->real^N) x IN s}`
      MP_TAC THENL [ALL_TAC; SET_TAC[]] THEN
      MATCH_MP_TAC(SET_RULE
       `!s. x IN closure s /\ closure s SUBSET t ==> x IN t`) THEN
      EXISTS_TAC `interval(vec 0:real^1,p)` THEN CONJ_TAC THENL
       [ASM_SIMP_TAC[CLOSURE_OPEN_INTERVAL; INTERVAL_NE_EMPTY_1;
                     DROP_VEC; ENDS_IN_INTERVAL; REAL_LT_IMP_LE];
        MATCH_MP_TAC CLOSURE_MINIMAL] THEN
      CONJ_TAC THENL
       [REWRITE_TAC[SUBSET; IN_INTERVAL_1; IN_ELIM_THM; DROP_VEC] THEN
        X_GEN_TAC `r:real^1` THEN STRIP_TAC THEN
        RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
        CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
        FIRST_X_ASSUM(MP_TAC o SPEC `r:real^1`) THEN
        ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
           `p SUBSET s UNION t ==> y IN p ==> ~(y IN t) ==> y IN s`)) THEN
        REWRITE_TAC[path_image; IN_IMAGE] THEN EXISTS_TAC `r:real^1` THEN
        ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC;
        MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN
        EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
        REWRITE_TAC[CLOSED_INTERVAL] THEN
        MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN
        EXISTS_TAC `u:real^N->bool` THEN
        ASM_REWRITE_TAC[GSYM path; GSYM path_image] THEN
        REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN
        ASM SET_TAC[]];
      SUBGOAL_THEN `(s:real^N->bool) SUBSET u /\ (t:real^N->bool) SUBSET u`
      STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]; ALL_TAC] THEN
      MP_TAC(ISPECL [`g:real^1->real^N`; `u:real^N->bool`;
                     `u DIFF s:real^N->bool`] lemma0) THEN
      ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN
      ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      DISCH_THEN(X_CHOOSE_THEN `p:real^1` STRIP_ASSUME_TAC) THEN
      SUBGOAL_THEN `(g:real^1->real^N) p IN t` ASSUME_TAC THENL
       [RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN ASM SET_TAC[];
        ALL_TAC] THEN
      ASM_CASES_TAC `p:real^1 = vec 0` THENL
       [EXISTS_TAC `vec 0:real^1` THEN
        REWRITE_TAC[INTERVAL_SING; ENDS_IN_UNIT_INTERVAL] THEN
        RULE_ASSUM_TAC(REWRITE_RULE[pathstart]) THEN ASM SET_TAC[];
        ALL_TAC] THEN
      SUBGOAL_THEN `&0 < drop p` ASSUME_TAC THENL
       [ASM_REWRITE_TAC[REAL_LT_LE; GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN
        ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC];
        ALL_TAC] THEN
      FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
      REWRITE_TAC[DROP_VEC] THEN STRIP_TAC THEN
      MP_TAC(ISPECL
       [`interval[vec 0:real^1,vec 1]`;
        `{x | x IN interval[vec 0,vec 1] /\ (g:real^1->real^N) x IN t}`;
        `interval(vec 0:real^1,p)`] OPEN_IN_INTER_CLOSURE_EQ_EMPTY) THEN
      ASM_SIMP_TAC[CLOSURE_OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; DROP_VEC] THEN
      ASM_REWRITE_TAC[SUBSET_INTERVAL_1; DROP_VEC; REAL_LE_REFL] THEN
      ANTS_TAC THENL
       [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
        EXISTS_TAC `u:real^N->bool` THEN
        ASM_REWRITE_TAC[GSYM path; GSYM path_image] THEN ASM SET_TAC[];
        DISCH_THEN(MP_TAC o MATCH_MP (TAUT `(p <=> q) ==> ~p ==> ~q`))] THEN
      REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM; IN_INTER] THEN
      ANTS_TAC THENL
       [EXISTS_TAC `p:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN
        REWRITE_TAC[INTERVAL_NE_EMPTY_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC;
        MATCH_MP_TAC MONO_EXISTS] THEN
      X_GEN_TAC `q:real^1` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
      X_GEN_TAC `r:real^1` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `r:real^1`) THEN ANTS_TAC THENL
       [ALL_TAC;
        MATCH_MP_TAC(SET_RULE `x IN u ==> ~(x IN u DIFF s) ==> x IN s`) THEN
        RULE_ASSUM_TAC(REWRITE_RULE[path_image; SUBSET; FORALL_IN_IMAGE]) THEN
        FIRST_X_ASSUM(MP_TAC o SPEC `r:real^1`) THEN
        ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]]] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
      REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC]) in
  REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN
  ONCE_REWRITE_TAC[CONJ_ASSOC] THEN
  REWRITE_TAC[TAUT `(p1 /\ q ==> r) /\ (p2 /\ q ==> r) <=>
                    (p1 \/ p2) /\ q ==> r`] THEN
  MATCH_MP_TAC(MESON[]
   `(!x y. R x y ==> R y x) /\ (!x y. R x y ==> P x)
    ==> !x y. R x y ==> P x /\ P y`) THEN
  CONJ_TAC THENL [REWRITE_TAC[INTER_COMM; UNION_COMM; CONJ_ACI]; ALL_TAC] THEN
  REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
  REWRITE_TAC[path_connected] THEN
  MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN
  UNDISCH_TAC `path_connected (s UNION t:real^N->bool)` THEN
  REWRITE_TAC[path_connected] THEN
  DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
  ASM_REWRITE_TAC[IN_UNION] THEN
  DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
  ASM_CASES_TAC `(path_image g:real^N->bool) SUBSET s` THENL
   [ASM_MESON_TAC[]; ALL_TAC] THEN
  SUBGOAL_THEN
   `?p q. p IN interval[vec 0,vec 1] /\ q IN interval[vec 0,vec 1] /\
          (g:real^1->real^N) p IN s /\ g p IN t /\ g q IN s /\ g q IN t /\
          (!x. &0 <= drop x /\ drop x <= &1 /\
               (drop x <= drop p \/ drop q <= drop x)
               ==> g x IN s)`
  STRIP_ASSUME_TAC THENL
   [MP_TAC(ISPECL [`g:real^1->real^N`; `s:real^N->bool`;
                   `t:real^N->bool`; `u:real^N->bool`] lemma1) THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `p:real^1` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    MP_TAC(ISPECL [`reversepath g:real^1->real^N`; `s:real^N->bool`;
                   `t:real^N->bool`; `u:real^N->bool`] lemma1) THEN
    ASM_REWRITE_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH] THEN
    ASM_REWRITE_TAC[PATHSTART_REVERSEPATH] THEN
    REWRITE_TAC[reversepath; o_THM] THEN
    DISCH_THEN(X_CHOOSE_THEN `q:real^1` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `vec 1 - q:real^1` THEN
    ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
    CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[CONJ_ASSOC]] THEN
    MATCH_MP_TAC(TAUT `(q ==> p) /\ q ==> p /\ q`) THEN CONJ_TAC THENL
     [DISCH_THEN(fun th -> CONJ_TAC THEN MATCH_MP_TAC th);
      X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN
      SUBST1_TAC(VECTOR_ARITH `x:real^1 = vec 1 - (vec 1 - x)`) THEN
      FIRST_X_ASSUM MATCH_MP_TAC] THEN
    ASM_REWRITE_TAC[DROP_VEC; DROP_SUB] THEN ASM_REAL_ARITH_TAC;
    ALL_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
  DISCH_THEN(MP_TAC o SPECL
   [`(g:real^1->real^N) p`; `(g:real^1->real^N) q`]) THEN
  ASM_REWRITE_TAC[IN_INTER; SUBSET_INTER] THEN
  DISCH_THEN(X_CHOOSE_THEN `h:real^1->real^N` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC
   `subpath (vec 0) p g ++ (h:real^1->real^N) ++ subpath q (vec 1) g` THEN
  ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_SUBPATH;
               PATHFINISH_SUBPATH; PATH_JOIN; PATH_SUBPATH;
               IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN
  CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[pathstart; pathfinish]] THEN
  REPEAT(MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN CONJ_TAC) THEN
  ASM_REWRITE_TAC[] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
   `g SUBSET s UNION t
    ==> g' SUBSET g /\ (!x. x IN g' ==> x IN s)
        ==> g' SUBSET s`)) THEN
  ASM_SIMP_TAC[PATH_IMAGE_SUBPATH_SUBSET; IN_INTERVAL_1; DROP_VEC;
               REAL_LE_REFL; REAL_POS] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
  ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; DROP_VEC; FORALL_IN_IMAGE] THEN
  REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC);;

let PATH_CONNECTED_FROM_CLOSED_UNION_AND_INTER = prove
 (`!s t:real^N->bool.
        closed s /\
        closed t /\
        path_connected (s UNION t) /\
        path_connected (s INTER t)
        ==> path_connected s /\ path_connected t`,
  REWRITE_TAC[CLOSED_IN] THEN
  ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
  REWRITE_TAC[PATH_CONNECTED_FROM_CLOSED_UNION_AND_INTER_LOCAL]);;

let PATH_CONNECTED_CLOSURE_FROM_FRONTIER = prove
 (`!s:real^N->bool. path_connected(frontier s) ==> path_connected(closure s)`,
  REPEAT STRIP_TAC THEN  MATCH_MP_TAC(TAUT `!q. p /\ q ==> p`) THEN
  EXISTS_TAC `path_connected(closure((:real^N) DIFF s))` THEN
  MATCH_MP_TAC PATH_CONNECTED_FROM_CLOSED_UNION_AND_INTER THEN
  ASM_REWRITE_TAC[CLOSED_CLOSURE; GSYM FRONTIER_CLOSURES] THEN
  SUBGOAL_THEN
   `closure s UNION closure ((:real^N) DIFF s) = (:real^N)`
   (fun th -> REWRITE_TAC[th; PATH_CONNECTED_UNIV]) THEN
  MATCH_MP_TAC(SET_RULE
   `s SUBSET closure s /\ (:real^N) DIFF s SUBSET closure((:real^N) DIFF s)
    ==> closure s UNION closure ((:real^N) DIFF s) = (:real^N)`) THEN
  REWRITE_TAC[CLOSURE_SUBSET]);;

let LOCALLY_PATH_CONNECTED_SUBREGION = prove
 (`!s t c:real^N->bool.
        locally path_connected s /\ t SUBSET s /\
        path_connected c /\ open_in (subtopology euclidean t) c
        ==> ?c'. path_connected c' /\ open_in (subtopology euclidean s) c' /\
                 c = t INTER c'`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
  DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN
  ASM_CASES_TAC `s INTER u:real^N->bool = {}` THENL
   [EXISTS_TAC `{}:real^N->bool` THEN
    ASM_REWRITE_TAC[PATH_CONNECTED_EMPTY; OPEN_IN_EMPTY] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  ASM_CASES_TAC `t INTER u:real^N->bool = {}` THENL
   [EXISTS_TAC `{}:real^N->bool` THEN
    ASM_REWRITE_TAC[PATH_CONNECTED_EMPTY; OPEN_IN_EMPTY; INTER_EMPTY];
    ALL_TAC] THEN
  SUBGOAL_THEN `?a:real^N. a IN t /\ a IN u` STRIP_ASSUME_TAC THENL
   [ASM SET_TAC[]; ALL_TAC] THEN
  EXISTS_TAC `path_component (s INTER u) (a:real^N)` THEN
  REWRITE_TAC[PATH_CONNECTED_PATH_COMPONENT] THEN CONJ_TAC THENL
   [MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `s INTER u:real^N->bool` THEN
    ASM_SIMP_TAC[OPEN_IN_OPEN_INTER] THEN
    MATCH_MP_TAC OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        LOCALLY_OPEN_SUBSET)) THEN
    ASM_SIMP_TAC[OPEN_IN_OPEN_INTER];
    ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_INTER; INTER_SUBSET] THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN
      ASM_REWRITE_TAC[IN_INTER] THEN ASM SET_TAC[];
      MP_TAC(ISPECL [`s INTER u:real^N->bool`; `a:real^N`]
        PATH_COMPONENT_SUBSET) THEN ASM SET_TAC[]]]);;

let LOCALLY_PATH_CONNECTED_FROM_UNION_AND_INTER_GEN = prove
 (`!s t u:real^N->bool.
        closed_in (subtopology euclidean u) s /\
        closed_in (subtopology euclidean u) t /\
        locally path_connected (s UNION t) /\ locally path_connected (s INTER t)
        ==> locally path_connected s`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `closed_in (subtopology euclidean (s UNION t)) (s:real^N->bool) /\
    closed_in (subtopology euclidean (s UNION t)) (t:real^N->bool)`
  MP_TAC THENL
   [CONJ_TAC THEN
    FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        CLOSED_IN_SUBSET_TRANS)) THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN
    SET_TAC[];
    REPEAT(FIRST_X_ASSUM(K ALL_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN
    REPEAT STRIP_TAC] THEN
  REWRITE_TAC[LOCALLY_PATH_CONNECTED] THEN
  MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN
  ASM_CASES_TAC `(x:real^N) IN t` THENL
   [ALL_TAC;
    SUBGOAL_THEN `locally path_connected (s DIFF t:real^N->bool)` MP_TAC THENL
     [MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
      EXISTS_TAC `s UNION t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
      ONCE_REWRITE_TAC[SET_RULE `s DIFF t = (s UNION t) DIFF t`] THEN
      MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[OPEN_IN_REFL];
      REWRITE_TAC[LOCALLY_PATH_CONNECTED] THEN
      DISCH_THEN(MP_TAC o SPECL [`u DIFF t:real^N->bool`; `x:real^N`]) THEN
      ASM_REWRITE_TAC[IN_DIFF] THEN ANTS_TAC THENL
       [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
        REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[];
        MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN
        CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
        MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] OPEN_IN_TRANS) THEN
        MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN
        EXISTS_TAC `s UNION t:real^N->bool` THEN
        CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
        ONCE_REWRITE_TAC[SET_RULE `s DIFF t = (s UNION t) DIFF t`] THEN
        MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[OPEN_IN_REFL]]]] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
  DISCH_THEN(X_CHOOSE_THEN `g:real^N->bool` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM SUBST_ALL_TAC THEN
  FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC o REWRITE_RULE[IN_INTER]) THEN
  ABBREV_TAC `c = path_component (s INTER t INTER g) (x:real^N)` THEN
  MP_TAC(ISPECL [`(s UNION t) INTER g:real^N->bool`;
                 `s INTER t INTER g:real^N->bool`;
                 `c:real^N->bool`] LOCALLY_PATH_CONNECTED_SUBREGION) THEN
  ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
   [REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
      EXISTS_TAC `s UNION t:real^N->bool` THEN
      ASM_SIMP_TAC[OPEN_IN_OPEN_INTER];
      SET_TAC[];
      ASM_MESON_TAC[PATH_CONNECTED_PATH_COMPONENT];
      EXPAND_TAC "c" THEN
      MATCH_MP_TAC OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED THEN
      MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
      EXISTS_TAC `s INTER t:real^N->bool` THEN
      ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; GSYM INTER_ASSOC]];
    DISCH_THEN(X_CHOOSE_THEN `h:real^N->bool` (STRIP_ASSUME_TAC o GSYM))] THEN
  EXISTS_TAC `s INTER h:real^N->bool` THEN REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN
    EXISTS_TAC `s UNION t:real^N->bool` THEN REWRITE_TAC[SUBSET_UNION] THEN
    MATCH_MP_TAC OPEN_IN_TRANS THEN
    EXISTS_TAC `(s UNION t) INTER g:real^N->bool` THEN
    ASM_SIMP_TAC[OPEN_IN_OPEN_INTER] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
    REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[];
    ALL_TAC;
    SUBGOAL_THEN `(x:real^N) IN c` MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    ASM_MESON_TAC[PATH_COMPONENT_REFL_EQ; IN; IN_INTER];
    FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
    ASM SET_TAC[]] THEN
  MATCH_MP_TAC(TAUT `!q. p /\ q ==> p`) THEN
  EXISTS_TAC `path_connected(t INTER h:real^N->bool)` THEN
  MATCH_MP_TAC PATH_CONNECTED_FROM_CLOSED_UNION_AND_INTER_LOCAL THEN
  EXISTS_TAC `h:real^N->bool` THEN
  ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
   [CONJ_TAC THENL
     [UNDISCH_TAC
       `closed_in (subtopology euclidean (s UNION t)) (s:real^N->bool)`;
      UNDISCH_TAC
       `closed_in (subtopology euclidean (s UNION t)) (t:real^N->bool)`] THEN
    REWRITE_TAC[CLOSED_IN_CLOSED] THEN MATCH_MP_TAC MONO_EXISTS THEN
    FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
    ASM SET_TAC[];
    SUBGOAL_THEN `s INTER h UNION t INTER h:real^N->bool = h`
    SUBST1_TAC THENL
     [FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
      ASM SET_TAC[];
      ASM_REWRITE_TAC[]] THEN
    SUBGOAL_THEN `(s INTER h) INTER t INTER h:real^N->bool = c`
    SUBST1_TAC THENL
     [FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
      ASM SET_TAC[];
      ASM_MESON_TAC[PATH_CONNECTED_PATH_COMPONENT]]]);;

let LOCALLY_PATH_CONNECTED_FROM_UNION_AND_INTER = prove
 (`!s t:real^N->bool.
        closed s /\ closed t /\
        locally path_connected (s UNION t) /\
        locally path_connected (s INTER t)
        ==> locally path_connected s`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC LOCALLY_PATH_CONNECTED_FROM_UNION_AND_INTER_GEN THEN
  MAP_EVERY EXISTS_TAC [`t:real^N->bool`; `s UNION t:real^N->bool`] THEN
  ASM_SIMP_TAC[CLOSED_SUBSET; SUBSET_UNION]);;

(* ------------------------------------------------------------------------- *)
(* Two uniform variants of local connectedness. ULC is an abbreviation for   *)
(* "uniformly locally connected"; FCCOVERABLE ("fine connected coverable")   *)
(* is more usually called "Property S" (Whyburn, Hocking & Young etc.)       *)
(* ------------------------------------------------------------------------- *)

let FCCOVERABLE_IMP_LOCALLY_CONNECTED = prove
 (`!s:real^N->bool.
        (!e. &0 < e ==> ?c. FINITE c /\ UNIONS c = s /\
                            !t. t IN c ==> connected t /\ bounded t /\
                                           diameter t <= e)
        ==> locally connected s`,
  GEN_TAC THEN REWRITE_TAC[locally] THEN DISCH_TAC THEN
  MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  GEN_REWRITE_TAC LAND_CONV [OPEN_IN_CONTAINS_BALL] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:real^N`)) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN `c:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
  ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
  EXISTS_TAC `UNIONS {t | t IN c /\ (x:real^N) IN closure t}` THEN
  ONCE_REWRITE_TAC[TAUT
   `p /\ q /\ r /\ s /\ t <=> q /\ t /\ p /\ r /\ s`] THEN
  REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC CONNECTED_UNIONS_STRONG THEN
    ASM_SIMP_TAC[IN_ELIM_THM; GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
    EXISTS_TAC `x:real^N` THEN
    SIMP_TAC[INTERS_GSPEC; IN_ELIM_THM; UNIONS_GSPEC; GSYM CONJ_ASSOC] THEN
    MATCH_MP_TAC(MESON[]
     `(!t. R t ==> Q t) /\ (?t. P t /\ R t) ==> (?t. P t /\ Q t /\ R t)`) THEN
    REWRITE_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN ASM SET_TAC[];
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
             SUBSET_TRANS)) THEN
    REWRITE_TAC[SUBSET_INTER] THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN
    X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
    TRANS_TAC SUBSET_TRANS `closure t:real^N->bool` THEN
    REWRITE_TAC[CLOSURE_SUBSET] THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN
    STRIP_TAC THEN REWRITE_TAC[SUBSET; IN_BALL] THEN
    X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
    MATCH_MP_TAC REAL_LET_TRANS THEN
    EXISTS_TAC `diameter(t:real^N->bool)` THEN
    CONJ_TAC THENL [REWRITE_TAC[dist]; ASM_REAL_ARITH_TAC] THEN
    ONCE_REWRITE_TAC[GSYM DIAMETER_CLOSURE] THEN
    MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN
    ASM_SIMP_TAC[BOUNDED_CLOSURE];
    ALL_TAC] THEN
  EXISTS_TAC `s INTER ball(x:real^N,e) INTER
              interior ((:real^N) DIFF
                        (s DIFF UNIONS {t | t IN c /\ x IN closure t}))` THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN
    SIMP_TAC[OPEN_INTER; OPEN_BALL; OPEN_INTERIOR];
    ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    REWRITE_TAC[INTERIOR_COMPLEMENT; IN_DIFF; IN_UNIV] THEN
    DISCH_THEN(MP_TAC o
      SPEC `closure(UNIONS {t | t IN c /\ ~((x:real^N) IN closure t)})` o
      MATCH_MP(SET_RULE `x IN s ==> !t. s SUBSET t ==> x IN t`)) THEN
    REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
     [MATCH_MP_TAC SUBSET_CLOSURE THEN ASM SET_TAC[];
      ASM_SIMP_TAC[CLOSURE_UNIONS; FINITE_RESTRICT] THEN ASM SET_TAC[]];
    MATCH_MP_TAC(SET_RULE
     `interior t SUBSET t /\ s INTER t SUBSET u
      ==> s INTER b INTER interior t SUBSET u`) THEN
    REWRITE_TAC[INTERIOR_SUBSET] THEN SET_TAC[]]);;

let ULC_IMP_LOCALLY_CONNECTED = prove
 (`!s:real^N->bool.
        (!e. &0 < e
             ==> ?d. &0 < d /\
                     !x y. x IN s /\ y IN s /\ dist(x,y) < d
                           ==> ?c. x IN c /\ y IN c /\ c SUBSET s /\
                                    connected c /\ bounded c /\ diameter c <= e)
        ==> locally connected s`,
  GEN_TAC THEN
  REWRITE_TAC[LOCALLY_CONNECTED_IM_KLEINEN] THEN
  DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `p:real^N`] THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  GEN_REWRITE_TAC LAND_CONV [OPEN_IN_CONTAINS_BALL] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `p:real^N`)) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `s INTER ball(p:real^N,min d e)` THEN
  ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
  ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_MIN; IN_INTER] THEN
  REWRITE_TAC[BALL_MIN_INTER; CONJ_ASSOC] THEN
  CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[GSYM CONJ_ASSOC]] THEN
  X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTER; IN_BALL] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`p:real^N`; `x:real^N`]) THEN
  ASM_REWRITE_TAC[] THEN
  ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN
  X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
   `b INTER s SUBSET u ==> c SUBSET s /\ c SUBSET b ==> c SUBSET u`)) THEN
  ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_BALL] THEN
  X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
   `c <= e / &2 ==> &0 < e /\ d <= c ==> d < e`)) THEN
  ASM_REWRITE_TAC[dist] THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN
  ASM_REWRITE_TAC[]);;

let FCCOVERABLE_INTERMEDIATE_CLOSURE = prove
 (`!s t:real^N->bool.
        s SUBSET t /\ t SUBSET closure s /\
        (!e. &0 < e ==> ?c. FINITE c /\ UNIONS c = s /\
                           !t. t IN c ==> connected t /\ bounded t /\
                                          diameter t <= e)
        ==> (!e. &0 < e ==> ?c. FINITE c /\ UNIONS c = t /\
                                !t. t IN c ==> connected t /\ bounded t /\
                                               diameter t <= e)`,
  REPEAT GEN_TAC THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
  ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `c:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `{t INTER closure k:real^N->bool | k IN c}` THEN
  ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; UNIONS_IMAGE; FORALL_IN_IMAGE] THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC SUBSET_ANTISYM THEN
    CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
    SIMP_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `t SUBSET c ==> (!x. x IN c ==> P x) ==> (!x. x IN t ==> P x)`)) THEN
    FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
    ASM_SIMP_TAC[CLOSURE_UNIONS] THEN SET_TAC[];
    X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `k:real^N->bool`) THEN
    ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL
     [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
      EXISTS_TAC `k:real^N->bool` THEN ASM_REWRITE_TAC[INTER_SUBSET] THEN
      REWRITE_TAC[SUBSET_INTER; CLOSURE_SUBSET] THEN ASM SET_TAC[];
      ASM_MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET; BOUNDED_CLOSURE];
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        REAL_LE_TRANS)) THEN
      GEN_REWRITE_TAC RAND_CONV [GSYM DIAMETER_CLOSURE] THEN
      MATCH_MP_TAC DIAMETER_SUBSET THEN
      ASM_SIMP_TAC[INTER_SUBSET; BOUNDED_CLOSURE]]]);;

let COMPACT_LOCALLY_CONNECTED_IMP_ULC = prove
 (`!s:real^N->bool.
     compact s /\ locally connected s
     ==> (!e. &0 < e
              ==> ?d. &0 < d /\
                      !x y. x IN s /\ y IN s /\ dist(x,y) < d
                            ==> ?c. x IN c /\ y IN c /\ c SUBSET s /\
                                    connected c /\
                                    bounded c /\ diameter c <= e)`,
  GEN_TAC THEN STRIP_TAC THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  MATCH_MP_TAC(MESON[] `((!x. ~P x) ==> F) ==> ?x. P x`) THEN
  DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&2 pow n)`) THEN
  REWRITE_TAC[REAL_LT_INV_EQ; REAL_LT_POW2; RIGHT_AND_FORALL_THM] THEN
  GEN_REWRITE_TAC (RAND_CONV o TOP_DEPTH_CONV) [NOT_FORALL_THM] THEN
  REWRITE_TAC[SKOLEM_THM; NOT_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`x:num->real^N`; `y:num->real^N`] THEN
  REWRITE_TAC[NOT_IMP; FORALL_AND_THM] THEN STRIP_TAC THEN
  MP_TAC(ISPEC `(s:real^N->bool) PCROSS s` compact) THEN
  ASM_REWRITE_TAC[COMPACT_PCROSS_EQ] THEN
  DISCH_THEN(MP_TAC o SPEC `\n:num. pastecart(x n:real^N) (y n:real^N)`) THEN
  ASM_REWRITE_TAC[PASTECART_IN_PCROSS; NOT_IMP] THEN
  ASM_REWRITE_TAC[NOT_EXISTS_THM; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
  MAP_EVERY X_GEN_TAC [`w:real^N`; `z:real^N`; `r:num->num`] THEN
  REWRITE_TAC[o_DEF; LIM_PASTECART_EQ] THEN STRIP_TAC THEN
  SUBGOAL_THEN `w:real^N = z` SUBST_ALL_TAC THENL
   [ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
    MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
    EXISTS_TAC `(\n. x((r:num->num) n) - y(r n)):num->real^N` THEN
    ASM_SIMP_TAC[LIM_SUB; TRIVIAL_LIMIT_SEQUENTIALLY] THEN
    REWRITE_TAC[LIM_SEQUENTIALLY; DIST_0] THEN X_GEN_TAC `d:real` THEN
    DISCH_TAC THEN MP_TAC(ISPEC `max (inv d) (inv e)` REAL_ARCH_POW2) THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN
    REWRITE_TAC[REAL_MAX_LT] THEN STRIP_TAC THEN
    X_GEN_TAC `m:num` THEN DISCH_TAC THEN
    MATCH_MP_TAC REAL_LET_TRANS THEN
    EXISTS_TAC `inv(&2 pow ((r:num->num) m))` THEN
    ASM_SIMP_TAC[GSYM dist; REAL_LT_IMP_LE] THEN
    GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN
    MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN
    TRANS_TAC REAL_LTE_TRANS `&2 pow n` THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
    TRANS_TAC LE_TRANS `m:num` THEN ASM_MESON_TAC[MONOTONE_BIGGER];
    ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_CONNECTED]) THEN
  DISCH_THEN(MP_TAC o SPECL [`s INTER ball(z:real^N,e / &2)`; `z:real^N`]) THEN
  ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; IN_INTER; CENTRE_IN_BALL;
               REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN
   `?d. &0 < d /\ ball(z:real^N,d) INTER s SUBSET u`
  STRIP_ASSUME_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_in]) THEN
    DISCH_THEN(MP_TAC o SPEC `z:real^N` o CONJUNCT2) THEN
    ASM_REWRITE_TAC[SUBSET; IN_INTER; IN_BALL] THEN MESON_TAC[DIST_SYM];
    ALL_TAC] THEN
  MAP_EVERY UNDISCH_TAC
   [`((\m:num. (y:num->real^N) (r m)) --> z) sequentially`;
    `((\m:num. (x:num->real^N) (r m)) --> z) sequentially`] THEN
  REWRITE_TAC[TAUT `p ==> ~q <=> ~(p /\ q)`; tendsto; AND_FORALL_THM] THEN
  DISCH_THEN(MP_TAC o SPEC `min d (e / &2)`) THEN
  ASM_REWRITE_TAC[REAL_HALF; REAL_LT_MIN; GSYM EVENTUALLY_AND] THEN
  REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
  DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
  REWRITE_TAC[LE_REFL] THEN STRIP_TAC THEN
  RULE_ASSUM_TAC(REWRITE_RULE[NOT_EXISTS_THM; RIGHT_AND_FORALL_THM;
                RIGHT_IMP_FORALL_THM]) THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`(r:num->num) n`; `u:real^N->bool`]) THEN
  ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
   [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN
    ASM_REWRITE_TAC[IN_BALL; IN_INTER] THEN ASM_MESON_TAC[DIST_SYM];
    FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN
    ASM_REWRITE_TAC[IN_BALL; IN_INTER] THEN ASM_MESON_TAC[DIST_SYM];
    ASM SET_TAC[];
    MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(z:real^N,e / &2)` THEN
    REWRITE_TAC[BOUNDED_BALL] THEN ASM SET_TAC[];
    TRANS_TAC REAL_LE_TRANS `diameter(ball(z:real^N,e / &2))` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC DIAMETER_SUBSET THEN REWRITE_TAC[BOUNDED_BALL] THEN
      ASM SET_TAC[];
      REWRITE_TAC[DIAMETER_BALL] THEN ASM_REAL_ARITH_TAC]]);;

let COMPACT_LOCALLY_CONNECTED_IMP_ULC_ALT = prove
 (`!s:real^N->bool.
     compact s /\ locally connected s
     ==> !e. &0 < e
             ==> ?d. &0 < d /\ d < e /\
                     !x y. x IN s /\ y IN s /\ dist(x,y) < d
                           ==> ?c. connected c /\ x IN c /\ y IN c /\
                                   c SUBSET s INTER ball(x,e) INTER ball(y,e)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC `s:real^N->bool` COMPACT_LOCALLY_CONNECTED_IMP_ULC) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `min d e / &2` THEN
  REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
  MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN
  ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N->bool` THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_INTER] THEN
  CONJ_TAC THEN REWRITE_TAC[SUBSET; IN_BALL] THEN
  X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN
  TRANS_TAC REAL_LET_TRANS `diameter(c:real^N->bool)` THEN
  REWRITE_TAC[dist] THEN ASM_SIMP_TAC[DIAMETER_BOUNDED_BOUND] THEN
  ASM_REAL_ARITH_TAC);;

let BOUNDED_ULC_IMP_FCCOVERABLE = prove
 (`!s:real^N->bool.
        bounded s /\
        (!e. &0 < e
            ==> ?d. &0 < d /\
                    !x y. x IN s /\ y IN s /\ dist(x,y) < d
                          ==> ?c. x IN c /\ y IN c /\ c SUBSET s /\
                                  connected c /\ bounded c /\ diameter c <= e)
        ==> (!e. &0 < e ==> ?c. FINITE c /\ UNIONS c = s /\
                           !t. t IN c ==> connected t /\ bounded t /\
                                          diameter t <= e)`,
  REPEAT GEN_TAC THEN
  STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
  ASM_REWRITE_TAC[REAL_HALF] THEN
  DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
  ABBREV_TAC
   `M = \p. {x | x IN s /\
                 ?c. (p:real^N) IN c /\ (x:real^N) IN c /\ c SUBSET s /\
                     connected c /\ bounded c /\ diameter c <= e / &2}` THEN
  SUBGOAL_THEN `!p:real^N. p IN s ==> ball(p,d) INTER s SUBSET M p`
  ASSUME_TAC THENL
   [X_GEN_TAC `p:real^N` THEN DISCH_TAC THEN EXPAND_TAC "M" THEN
    REWRITE_TAC[SUBSET; IN_INTER; IN_BALL; IN_ELIM_THM] THEN
    X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[GSYM SUBSET] THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`p:real^N`; `x:real^N`]) THEN
    ASM_MESON_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `?k. FINITE k /\ k SUBSET s /\
        UNIONS(IMAGE (M:real^N->real^N->bool) k) = s`
  STRIP_ASSUME_TAC THENL
   [ONCE_REWRITE_TAC[MESON[]
     `(?x. P x /\ Q x /\ R x) <=> ~(!x. P x /\ Q x ==> ~R x)`] THEN
    DISCH_TAC THEN
    SUBGOAL_THEN
     `?f:num->real^N.
        !n. f n IN s DIFF UNIONS(IMAGE ((M:real^N->real^N->bool) o f)
                                       {m | m < n})`
    STRIP_ASSUME_TAC THENL
     [SUBGOAL_THEN
       `?f:num->real^N.
          !n. f n = @x. x IN s DIFF UNIONS(IMAGE ((M:real^N->real^N->bool) o f)
                                                 {m | m < n})`
      MP_TAC THENL
       [MATCH_MP_TAC(MATCH_MP WF_REC WF_num) THEN REPEAT STRIP_TAC THEN
        REWRITE_TAC[IMAGE_o] THEN
        AP_TERM_TAC THEN ABS_TAC THEN REPLICATE_TAC 4 AP_TERM_TAC THEN
        ASM SET_TAC[];
        MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:num->real^N` THEN
        DISCH_TAC THEN MATCH_MP_TAC num_WF THEN
        X_GEN_TAC `n:num` THEN DISCH_TAC THEN
        ONCE_ASM_REWRITE_TAC[] THEN CONV_TAC SELECT_CONV THEN
        FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (f:num->real^N) {m | m < n}`) THEN
        SIMP_TAC[FINITE_NUMSEG_LT; FINITE_IMAGE] THEN
        ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IMAGE_o]] THEN
        MATCH_MP_TAC(SET_RULE
         `t SUBSET s ==> ~(t = s) ==> ?x. x IN s DIFF t`) THEN
        REWRITE_TAC[UNIONS_SUBSET] THEN ONCE_REWRITE_TAC[FORALL_IN_IMAGE] THEN
        EXPAND_TAC "M" THEN SET_TAC[]];
      MP_TAC(ISPECL [`IMAGE (f:num->real^N) (:num)`; `d:real`]
        DISCRETE_BOUNDED_IMP_FINITE) THEN
      ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
      REWRITE_TAC[IN_UNIV; NOT_IMP] THEN
      SUBGOAL_THEN `!m n. norm((f:num->real^N) m - f n) < d ==> m = n`
      ASSUME_TAC THENL
       [MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN
        CONJ_TAC THENL [MESON_TAC[NORM_SUB]; ALL_TAC] THEN
        MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN REPEAT DISCH_TAC THEN
        FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN
        MATCH_MP_TAC(SET_RULE `x IN t ==> x IN s DIFF t ==> P`) THEN
        REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE; o_THM; IN_ELIM_THM] THEN
        EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[] THEN
        UNDISCH_THEN `!p:real^N. p IN s ==> ball(p,d) INTER s SUBSET M p`
         (MP_TAC o SPEC `(f:num->real^N) m`) THEN
        ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[SUBSET]] THEN
        DISCH_THEN MATCH_MP_TAC THEN
        ASM_REWRITE_TAC[IN_BALL; IN_INTER; dist] THEN
        ASM SET_TAC[];
        ALL_TAC] THEN
      REPEAT CONJ_TAC THENL
       [ASM_MESON_TAC[];
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
           BOUNDED_SUBSET)) THEN ASM SET_TAC[];
        W(MP_TAC o PART_MATCH (lhand o rand) FINITE_IMAGE_INJ_EQ o
          rand o snd) THEN
        REWRITE_TAC[REWRITE_RULE[INFINITE] num_INFINITE] THEN
        DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_UNIV] THEN
        ASM_MESON_TAC[VECTOR_SUB_REFL; NORM_0]]];
    EXISTS_TAC `IMAGE (M:real^N->real^N->bool) k` THEN
    ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN
    X_GEN_TAC `p:real^N` THEN EXPAND_TAC "M" THEN REWRITE_TAC[] THEN
    REPEAT STRIP_TAC THENL
     [GEN_REWRITE_TAC I [CONNECTED_IFF_CONNECTED_COMPONENT] THEN
      MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
      REWRITE_TAC[IN_ELIM_THM] THEN
      DISCH_THEN(CONJUNCTS_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
      DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
      DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN
      REWRITE_TAC[connected_component] THEN
      EXISTS_TAC `c UNION d:real^N->bool` THEN
      ASM_REWRITE_TAC[IN_UNION; UNION_SUBSET] THEN CONJ_TAC THENL
       [MATCH_MP_TAC CONNECTED_UNION THEN ASM SET_TAC[]; ASM SET_TAC[]];
      MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN
      ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
      MATCH_MP_TAC DIAMETER_LE THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN
      MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
      REWRITE_TAC[IN_ELIM_THM] THEN
      DISCH_THEN(CONJUNCTS_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
      DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
      DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN
      MATCH_MP_TAC(NORM_ARITH
       `!p:real^N. norm(x - p) <= e / &2 /\ norm(y - p) <= e / &2
                   ==> norm(x - y) <= e`) THEN
      EXISTS_TAC `p:real^N` THEN CONJ_TAC THENL
       [TRANS_TAC REAL_LE_TRANS `diameter(d:real^N->bool)`;
        TRANS_TAC REAL_LE_TRANS `diameter(c:real^N->bool)`] THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN
      ASM_REWRITE_TAC[]]]);;

let COMPACT_LOCALLY_CONNECTED_IMP_FCCOVERABLE = prove
 (`!s:real^N->bool.
        compact s /\ locally connected s
        ==> !e. &0 < e ==> ?c. FINITE c /\ UNIONS c = s /\
                           !t. t IN c ==> connected t /\ bounded t /\
                                          diameter t <= e`,
  GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_LOCALLY_CONNECTED_IMP_ULC) THEN
  FIRST_X_ASSUM STRIP_ASSUME_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN
  GEN_REWRITE_TAC I [IMP_IMP] THEN
  DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_ULC_IMP_FCCOVERABLE) THEN
  REWRITE_TAC[]);;

let COMPACT_LOCALLY_CONNECTED_EQ_FCCCOVERABLE = prove
 (`!s:real^N->bool.
       compact s /\ locally connected s <=>
       !e. &0 < e
           ==> ?c. FINITE c /\ UNIONS c = s /\
                   !t. t IN c ==> connected t /\ compact t /\ diameter t <= e`,
  GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL
   [FIRST_ASSUM(MP_TAC o
      MATCH_MP COMPACT_LOCALLY_CONNECTED_IMP_FCCOVERABLE) THEN
    MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
    DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `c:(real^N->bool)->bool` THEN STRIP_TAC THEN
    EXISTS_TAC `IMAGE closure (c:(real^N->bool)->bool)` THEN
    ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE; CONNECTED_CLOSURE;
                 COMPACT_CLOSURE; DIAMETER_CLOSURE] THEN
    ASM_SIMP_TAC[GSYM SIMPLE_IMAGE; GSYM CLOSURE_UNIONS] THEN
    ASM_SIMP_TAC[CLOSURE_EQ; COMPACT_IMP_CLOSED];
    CONJ_TAC THENL [ASM_MESON_TAC[COMPACT_UNIONS; REAL_LT_01]; ALL_TAC] THEN
    MATCH_MP_TAC FCCOVERABLE_IMP_LOCALLY_CONNECTED THEN
    ASM_MESON_TAC[COMPACT_IMP_BOUNDED]]);;

(* ------------------------------------------------------------------------- *)
(* Localization of "property S"                                              *)
(* ------------------------------------------------------------------------- *)

let LOCALLY_FCCOVERABLE = prove
 (`!s u a:real^N.
      (!e. &0 < e
           ==> ?c. FINITE c /\ UNIONS c = s /\
                   !t. t IN c
                       ==> connected t /\ bounded t /\ diameter t <= e) /\
      open_in (subtopology euclidean s) u /\ a IN u
      ==> ?v. open_in (subtopology euclidean s) v /\ connected v /\
              a IN v /\ v SUBSET u /\
              !e. &0 < e
                  ==> ?c. FINITE c /\ UNIONS c = v /\
                          !t. t IN c
                              ==> connected t /\ bounded t /\ diameter t <= e`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_CBALL]) THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `a:real^N`)) THEN
  ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP
   (MESON[REAL_ARITH `&0 < e ==> &0 < e / &2 /\ &2 * e / &2 = e`]
       `(?e. &0 < e /\ P e) ==> ?r. &0 < r /\ P(&2 * r)`)) THEN
  DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
  ABBREV_TAC
   `t = \k. {x | ?f. (!i. i <= k
                          ==> connected(f i) /\ f i SUBSET s /\
                              bounded(f i) /\ diameter(f i) < r / &2 pow i) /\
                     a IN f 0 /\ (x:real^N) IN f k /\
                     (!i. i < k ==> ~(f i INTER f(SUC i) = {}))}` THEN
  EXISTS_TAC `UNIONS {t k | k IN (:num)}:real^N->bool` THEN
  SUBGOAL_THEN `!k. a IN (t:num->real^N->bool) k` ASSUME_TAC THENL
   [X_GEN_TAC `k:num` THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN
    EXISTS_TAC `\i:num. {a:real^N}` THEN
    ASM_REWRITE_TAC[CONNECTED_SING; SING_SUBSET; BOUNDED_SING] THEN
    REWRITE_TAC[IN_SING; DIAMETER_SING] THEN
    ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN `!k. (t:num->real^N->bool) k SUBSET s` ASSUME_TAC THENL
   [X_GEN_TAC `k:num` THEN EXPAND_TAC "t" THEN
    REWRITE_TAC[IN_ELIM_THM; SUBSET] THEN X_GEN_TAC `x:real^N` THEN
    DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2
     (MP_TAC o SPEC `k:num`) ASSUME_TAC)) THEN
    REWRITE_TAC[LE_REFL] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN `!k. (t:num->real^N->bool) k SUBSET ball(a,&2 * r)`
  ASSUME_TAC THENL
   [SUBGOAL_THEN
     `!k. (t:num->real^N->bool) k SUBSET ball(a,(&2 - inv(&2 pow k)) * r)`
    MP_TAC THENL
     [ALL_TAC;
      MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN
      MATCH_MP_TAC SUBSET_BALL THEN
      ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_ARITH `x - a <= x <=> &0 <= a`] THEN
      SIMP_TAC[REAL_POW_LE; REAL_POS; REAL_LE_INV_EQ]] THEN
    MATCH_MP_TAC num_INDUCTION THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
    EXPAND_TAC "t" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; REAL_MUL_LID] THEN
    CONJ_TAC THENL
     [REWRITE_TAC[LE; LT; FORALL_UNWIND_THM2] THEN
      X_GEN_TAC `b:real^N` THEN
      DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN
      REWRITE_TAC[IN_BALL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
       (REAL_ARITH `x < r / &2 pow 0 ==> a <= x ==> a < r`)) THEN
      MATCH_MP_TAC DIST_LE_DIAMETER THEN ASM_REWRITE_TAC[];
      X_GEN_TAC `k:num` THEN DISCH_TAC THEN X_GEN_TAC `c:real^N` THEN
      DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN
      SUBGOAL_THEN `~(f k INTER f(SUC k):real^N->bool = {})` MP_TAC THENL
       [FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC;
        REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER]] THEN
      DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `b:real^N`) THEN ANTS_TAC THENL
       [EXISTS_TAC `f:num->real^N->bool` THEN
        ASM_REWRITE_TAC[] THEN CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN
        FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
        REWRITE_TAC[IN_BALL]] THEN
      MATCH_MP_TAC(NORM_ARITH
       `!u. dist(b,c) <= u /\ x + u <= y
            ==> dist(a:real^N,b) < x ==> dist(a,c) < y`) THEN
      EXISTS_TAC `diameter((f:num->real^N->bool) (SUC k))` THEN
      ASM_SIMP_TAC[DIST_LE_DIAMETER; LE_REFL] THEN MATCH_MP_TAC(REAL_ARITH
       `r * k = r * &2 * k' /\ d < r * k'
        ==> (&2 - k) * r + d <= (&2 - k') * r`) THEN
      ASM_SIMP_TAC[GSYM real_div; LE_REFL] THEN
      REWRITE_TAC[real_pow; real_div; REAL_INV_MUL] THEN REAL_ARITH_TAC];
    ALL_TAC] THEN
  SUBGOAL_THEN `!k. (t:num->real^N->bool) k SUBSET t(SUC k)` ASSUME_TAC THENL
   [X_GEN_TAC `k:num` THEN EXPAND_TAC "t" THEN
    REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `b:real^N` THEN
    DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `\i. if i <= k then (f:num->real^N->bool) i else {b}` THEN
    ASM_REWRITE_TAC[LE_0; ARITH_RULE `~(SUC k <= k)`; IN_SING] THEN
    CONJ_TAC THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i:num <= k` THEN
    ASM_SIMP_TAC[LT_SUC_LE] THENL
     [ASM_MESON_TAC[];
      REWRITE_TAC[CONNECTED_SING; IN_SING; BOUNDED_SING] THEN
      DISCH_TAC THEN ASM_REWRITE_TAC[FORALL_UNWIND_THM2; DIAMETER_SING] THEN
      ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2] THEN ASM_MESON_TAC[LE_REFL];
      ASM_SIMP_TAC[ARITH_RULE `i <= k ==> (SUC i <= k <=> ~(i = k))`] THEN
      REWRITE_TAC[COND_SWAP] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
       [ASM SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]];
    ALL_TAC] THEN
  SUBGOAL_THEN `!k. connected((t:num->real^N->bool) k)` ASSUME_TAC THENL
   [X_GEN_TAC `k:num` THEN
    REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
    MATCH_MP_TAC(MESON[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS]
     `!a. (!x. x IN s ==> connected_component s a x)
          ==> (!x y. x IN s /\ y IN s ==> connected_component s x y)`) THEN
    EXISTS_TAC `a:real^N` THEN SPEC_TAC(`k:num`,`k:num`) THEN
    MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
     [X_GEN_TAC `x:real^N` THEN EXPAND_TAC "t" THEN
      REWRITE_TAC[IN_ELIM_THM] THEN
      DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN
      SUBGOAL_THEN `connected_component (f 0) (a:real^N) x` MP_TAC THENL
       [REWRITE_TAC[connected_component] THEN
        EXISTS_TAC `f 0:real^N->bool` THEN
        ASM_SIMP_TAC[LE_REFL; SUBSET_REFL];
        MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s x ==> t x`) THEN
        REWRITE_TAC[ETA_AX]] THEN
      MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN
      REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
      X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN
      EXISTS_TAC `f:num->real^N->bool` THEN
      ASM_REWRITE_TAC[GSYM SUBSET];
      ALL_TAC] THEN
    X_GEN_TAC `k:num` THEN DISCH_TAC THEN X_GEN_TAC `c:real^N` THEN
    FIRST_ASSUM(fun th ->
      GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN
    REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN
    SUBGOAL_THEN `~(f k INTER f(SUC k):real^N->bool = {})` MP_TAC THENL
     [FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC;
      REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER]] THEN
    DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `b:real^N`) THEN ANTS_TAC THENL
     [EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN
      EXISTS_TAC `f:num->real^N->bool` THEN
      ASM_REWRITE_TAC[] THEN CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
      MATCH_MP_TAC(SET_RULE
       `connected_component k a SUBSET connected_component k' a /\
        (connected_component k' a b ==> connected_component k' a c)
        ==> connected_component k a b ==> connected_component k' a c`)] THEN
    ASM_SIMP_TAC[CONNECTED_COMPONENT_MONO] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONNECTED_COMPONENT_TRANS) THEN
    REWRITE_TAC[connected_component] THEN
    EXISTS_TAC `f(SUC k):real^N->bool` THEN
    ASM_SIMP_TAC[LE_REFL] THEN EXPAND_TAC "t" THEN
    REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    EXISTS_TAC `f:num->real^N->bool` THEN
    ASM_REWRITE_TAC[GSYM SUBSET];
    ALL_TAC] THEN
  REPEAT CONJ_TAC THENL
   [ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
    REWRITE_TAC[FORALL_IN_UNIONS; FORALL_IN_GSPEC;
                IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
    X_GEN_TAC `k:num` THEN DISCH_THEN(K ALL_TAC) THEN
    X_GEN_TAC `x:real^N` THEN FIRST_ASSUM(fun th ->
      GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN
    REWRITE_TAC[IN_ELIM_THM] THEN
    DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP FCCOVERABLE_IMP_LOCALLY_CONNECTED) THEN
    REWRITE_TAC[LOCALLY_CONNECTED] THEN
    DISCH_THEN(MP_TAC o SPECL
     [`s INTER ball(x:real^N,r / &2 pow (k + 3))`; `x:real^N`]) THEN
    SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
    ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL] THEN
    ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2] THEN ANTS_TAC THENL
     [ASM_MESON_TAC[SUBSET; LE_REFL]; ALL_TAC] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN
    REWRITE_TAC[SUBSET_INTER; UNIONS_GSPEC] THEN STRIP_TAC THEN
    ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIV] THEN
    X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN EXISTS_TAC `SUC k` THEN
    EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN
    EXISTS_TAC `\i. if i <= k then (f:num->real^N->bool) i else v` THEN
    ASM_REWRITE_TAC[LE_0; ARITH_RULE `~(SUC k <= k)`; IN_SING] THEN
    CONJ_TAC THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i:num <= k` THEN
    ASM_SIMP_TAC[LT_SUC_LE] THENL
     [DISCH_TAC THEN CONJ_TAC THENL
       [ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL]; ALL_TAC] THEN
      TRANS_TAC REAL_LET_TRANS `r / &2 pow (k + 2)` THEN CONJ_TAC THENL
       [TRANS_TAC REAL_LE_TRANS
         `diameter(ball(x:real^N,r / &2 pow (k + 3)))` THEN
        ASM_SIMP_TAC[DIAMETER_SUBSET; BOUNDED_BALL] THEN
        ASM_SIMP_TAC[DIAMETER_BALL; REAL_LT_DIV; REAL_LT_POW2;
                     REAL_ARITH `&0 < x ==> ~(x < &0)`] THEN
        REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN
        REAL_ARITH_TAC;
        ASM_SIMP_TAC[real_div; REAL_LT_LMUL_EQ] THEN
        MATCH_MP_TAC REAL_LT_INV2 THEN REWRITE_TAC[REAL_LT_POW2] THEN
        MATCH_MP_TAC REAL_POW_MONO_LT THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN
        ASM_ARITH_TAC];
      ASM_SIMP_TAC[ARITH_RULE `i <= k ==> (SUC i <= k <=> ~(i = k))`] THEN
      REWRITE_TAC[COND_SWAP] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
       [ASM SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]];
    MATCH_MP_TAC CONNECTED_UNIONS THEN
    ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM SET_TAC[];
    ASM SET_TAC[];
    REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC; IN_UNIV] THEN
    X_GEN_TAC `k:num` THEN
    TRANS_TAC SUBSET_TRANS `s INTER cball(a:real^N,&2 * r)` THEN
    ASM_REWRITE_TAC[SUBSET_INTER] THEN
    ASM_MESON_TAC[SUBSET_TRANS; INTER_COMM; BALL_SUBSET_CBALL];
    X_GEN_TAC `e:real` THEN DISCH_TAC] THEN
  SUBGOAL_THEN `?k. r / &2 pow k < e / &4` STRIP_ASSUME_TAC THENL
   [REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN
    ASM_SIMP_TAC[REAL_INV_POW; GSYM REAL_LT_RDIV_EQ] THEN
    MATCH_MP_TAC REAL_ARCH_POW_INV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
    REWRITE_TAC[REAL_ARITH `&0 < (&1 / &4 * x) / y <=> &0 < x / y`] THEN
    ASM_SIMP_TAC[REAL_LT_DIV];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `?ws. FINITE ws /\ (t:num->real^N->bool) k SUBSET UNIONS ws /\
         !w. w IN ws
             ==> w SUBSET s /\ ~(t k INTER w = {}) /\
                 connected w /\ bounded w /\ diameter w < r / &2 pow (k + 1)`
  STRIP_ASSUME_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o SPEC `r / &2 pow (k + 2)`) THEN
    ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2] THEN
    DISCH_THEN(X_CHOOSE_THEN `ws:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `{w:real^N->bool | w IN ws /\ ~(t(k:num) INTER w = {})}` THEN
    ASM_SIMP_TAC[FINITE_RESTRICT; FORALL_IN_GSPEC] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    X_GEN_TAC `w:real^N->bool` THEN REPEAT STRIP_TAC THENL
     [ASM SET_TAC[]; ALL_TAC] THEN
    TRANS_TAC REAL_LET_TRANS `r / &2 pow (k + 2)` THEN
    ASM_SIMP_TAC[] THEN
    REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN
    MATCH_MP_TAC(REAL_ARITH
     `&0 < r / k
      ==> r * inv k * inv(&2 pow 2) < r * inv k * inv(&2 pow 1)`) THEN
    ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2];
    ALL_TAC] THEN
  SUBGOAL_THEN `!w:real^N->bool. w IN ws ==> w SUBSET t(SUC k)`
  ASSUME_TAC THENL
   [X_GEN_TAC `w:real^N->bool` THEN DISCH_TAC THEN
    REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `w:real^N->bool`) THEN
    ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
    UNDISCH_TAC `~((t:num->real^N->bool) k INTER w = {})` THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `y:real^N` THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
    EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `f:num->real^N->bool` THEN STRIP_TAC THEN
    EXISTS_TAC `\i. if i <= k then (f:num->real^N->bool) i else w` THEN
    ASM_REWRITE_TAC[LE_0; ARITH_RULE `~(SUC k <= k)`] THEN
    CONJ_TAC THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i:num <= k` THEN
    ASM_SIMP_TAC[LT_SUC_LE] THENL
     [DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
       (REWRITE_RULE[IMP_CONJ] REAL_LTE_TRANS)) THEN
      ASM_SIMP_TAC[real_div; REAL_LE_LMUL_EQ] THEN
      MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_LT_POW2] THEN
      MATCH_MP_TAC REAL_POW_MONO THEN
      REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC;
      ASM_SIMP_TAC[ARITH_RULE `i <= k ==> (SUC i <= k <=> ~(i = k))`] THEN
      REWRITE_TAC[COND_SWAP] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
       [ASM SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]];
    ALL_TAC] THEN
  ABBREV_TAC
   `q = \w. {x | ?c. connected c /\ c SUBSET UNIONS {t k | k IN (:num)} /\
                     bounded c /\ diameter c < e / &4 /\
                     ~(w INTER c = {}) /\ (x:real^N) IN c}` THEN
  EXISTS_TAC `IMAGE (q:(real^N->bool)->(real^N->bool)) ws` THEN
  ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN CONJ_TAC THENL
   [ALL_TAC;
    X_GEN_TAC `w:real^N->bool` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `w:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN
    STRIP_TAC THEN CONJ_TAC THENL
     [SUBGOAL_THEN `?b:real^N. b IN w` CHOOSE_TAC THENL
       [ASM SET_TAC[]; ALL_TAC] THEN
      REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
      MATCH_MP_TAC(MESON[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS]
       `!a. (!x. x IN s ==> connected_component s a x)
            ==> (!x y. x IN s /\ y IN s ==> connected_component s x y)`) THEN
      EXISTS_TAC `b:real^N` THEN X_GEN_TAC `x:real^N` THEN
      FIRST_ASSUM(fun th ->
        GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN
      REWRITE_TAC[IN_ELIM_THM] THEN
      DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
      REWRITE_TAC[connected_component] THEN
      EXISTS_TAC `w UNION c:real^N->bool` THEN
      ASM_SIMP_TAC[IN_UNION; CONNECTED_UNION] THEN EXPAND_TAC "q" THEN
      REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION] THEN X_GEN_TAC `y:real^N` THEN
      REWRITE_TAC[GSYM SUBSET] THEN STRIP_TAC THENL
       [EXISTS_TAC `{y:real^N}` THEN
        REWRITE_TAC[BOUNDED_SING; IN_SING; CONNECTED_SING] THEN
        CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
        CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
        REWRITE_TAC[DIAMETER_SING] THEN ASM_REAL_ARITH_TAC;
        EXISTS_TAC `c:real^N->bool` THEN ASM_REWRITE_TAC[]];
      ALL_TAC] THEN
    SUBGOAL_THEN
     `q w SUBSET {x + y:real^N | x IN w /\ y IN ball(vec 0,e / &4)}`
    ASSUME_TAC THENL
     [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN
      EXPAND_TAC "q" THEN REWRITE_TAC[IN_ELIM_THM] THEN
      DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
      UNDISCH_TAC `~(w INTER c:real^N->bool = {})` THEN
      REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN
      STRIP_TAC THEN ASM_REWRITE_TAC[IN_BALL_0] THEN
      ONCE_REWRITE_TAC[CONJ_SYM] THEN
      REWRITE_TAC[VECTOR_ARITH `x:real^N = y + z <=> z = x - y`] THEN
      REWRITE_TAC[UNWIND_THM2; GSYM dist] THEN
      TRANS_TAC REAL_LET_TRANS `diameter(c:real^N->bool)` THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIST_LE_DIAMETER THEN
      ASM_REWRITE_TAC[];
      CONJ_TAC THENL
       [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
          BOUNDED_SUBSET));
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
         (MESON[DIAMETER_SUBSET; REAL_LE_TRANS]
            `s SUBSET t
             ==> bounded t /\ diameter t <= e ==> diameter s <= e`))] THEN
      ASM_SIMP_TAC[BOUNDED_SUMS; BOUNDED_BALL] THEN
      W(MP_TAC o PART_MATCH (lhand o rand) DIAMETER_SUMS o lhand o snd) THEN
      ASM_SIMP_TAC[BOUNDED_BALL; DIAMETER_BALL] THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
      ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> ~(e / &4 < &0)`] THEN
      REWRITE_TAC[REAL_ARITH `d + &2 * e / &4 <= e <=> d <= e / &2`] THEN
      TRANS_TAC REAL_LE_TRANS `r / &2 pow (k + 1)` THEN
      ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN
      REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN
      ASM_REAL_ARITH_TAC]] THEN
  REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; UNIONS_SUBSET] THEN
  REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN CONJ_TAC THENL
   [X_GEN_TAC `w:real^N->bool` THEN DISCH_TAC THEN
    REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_UNION] THEN
    X_GEN_TAC `x:real^N` THEN EXPAND_TAC "q" THEN
    REWRITE_TAC[IN_ELIM_THM; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN SET_TAC[];
    REWRITE_TAC[IN_UNIV]] THEN
  X_GEN_TAC `n:num` THEN
  DISJ_CASES_TAC(ARITH_RULE `n:num <= k \/ k < n`) THENL
   [TRANS_TAC SUBSET_TRANS `(t:num->real^N->bool) k` THEN CONJ_TAC THENL
     [UNDISCH_TAC `n:num <= k` THEN
      MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`k:num`; `n:num`] THEN
      MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
      ASM_REWRITE_TAC[] THEN SET_TAC[];
      TRANS_TAC SUBSET_TRANS `UNIONS ws:real^N->bool` THEN
      ASM_REWRITE_TAC[] THEN
      GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM IMAGE_ID] THEN
      MATCH_MP_TAC UNIONS_MONO_IMAGE THEN
      X_GEN_TAC `w:real^N->bool` THEN DISCH_TAC THEN
      REWRITE_TAC[SUBSET] THEN EXPAND_TAC "q" THEN
      REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
      EXISTS_TAC `{x:real^N}` THEN
      REWRITE_TAC[BOUNDED_SING; CONNECTED_SING; IN_SING] THEN
      CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
      REWRITE_TAC[DIAMETER_SING] THEN ASM_REAL_ARITH_TAC];
    ALL_TAC] THEN
  REWRITE_TAC[SUBSET] THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN
  X_GEN_TAC `x:real^N` THEN
  DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN
  REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM] THEN
  EXPAND_TAC "q" THEN REWRITE_TAC[IN_ELIM_THM] THEN
  SUBGOAL_THEN `?b:real^N. b IN f k /\ b IN f(SUC k)` STRIP_ASSUME_TAC THENL
   [ASM_MESON_TAC[IN_INTER; MEMBER_NOT_EMPTY]; ALL_TAC] THEN
  SUBGOAL_THEN `b IN (t:num->real^N->bool) k` ASSUME_TAC THENL
   [EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN
    EXISTS_TAC `f:num->real^N->bool` THEN
    ASM_MESON_TAC[LT_TRANS; LE_TRANS; LT_IMP_LE];
    ALL_TAC] THEN
  SUBGOAL_THEN `(b:real^N) IN UNIONS ws` MP_TAC THENL
   [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `w:real^N->bool` THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  EXISTS_TAC `UNIONS (IMAGE f (k+1..n)):real^N->bool` THEN
  REPEAT CONJ_TAC THENL
   [SUBGOAL_THEN
     `!i. i <= n ==> connected(UNIONS(IMAGE f (k+1..i)):real^N->bool)`
     (fun th -> SIMP_TAC[th; LE_REFL]) THEN
    MATCH_MP_TAC num_INDUCTION THEN
    SUBGOAL_THEN `k+1..0 = {}` SUBST1_TAC THENL
     [REWRITE_TAC[NUMSEG_EMPTY] THEN ARITH_TAC;
      REWRITE_TAC[IMAGE_CLAUSES; UNIONS_0; CONNECTED_EMPTY]] THEN
    X_GEN_TAC `i:num` THEN
    DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
    ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
    ASM_CASES_TAC `i:num = k` THENL
     [ASM_REWRITE_TAC[ADD1; NUMSEG_SING; IMAGE_CLAUSES; UNIONS_1] THEN
      ASM_MESON_TAC[ADD1];
      REWRITE_TAC[NUMSEG_CLAUSES] THEN
      COND_CASES_TAC THEN REWRITE_TAC[] THEN DISCH_TAC THEN
      REWRITE_TAC[IMAGE_CLAUSES; UNIONS_INSERT] THEN
      MATCH_MP_TAC CONNECTED_UNION THEN ASM_SIMP_TAC[] THEN
      REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN
      REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN
      DISCH_THEN(MP_TAC o SPEC `i:num`) THEN
      REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
       [ASM_ARITH_TAC;
        ONCE_REWRITE_TAC[INTER_COMM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
        ASM_ARITH_TAC]];
    MATCH_MP_TAC(SET_RULE
     `(!x. x IN s ==> f x SUBSET g x) /\ s SUBSET t
      ==> UNIONS(IMAGE f s) SUBSET UNIONS {g x | x IN t}`) THEN
    REWRITE_TAC[IN_NUMSEG; SUBSET_UNIV] THEN X_GEN_TAC `i:num` THEN
    STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN EXPAND_TAC "t" THEN
    REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN
    DISCH_TAC THEN EXISTS_TAC `f:num->real^N->bool` THEN
    ASM_REWRITE_TAC[] THEN
    CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
    MATCH_MP_TAC BOUNDED_UNIONS THEN
    ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE; IN_NUMSEG];
    ALL_TAC;
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `b:real^N` THEN
    ASM_REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; IN_NUMSEG; IN_INTER] THEN
    EXISTS_TAC `SUC k` THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC;
    REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `n:num` THEN
    ASM_REWRITE_TAC[IN_NUMSEG] THEN ASM_ARITH_TAC] THEN
  SUBGOAL_THEN
   `!d j. j + d = n
          ==> diameter (UNIONS (IMAGE f (j..n)):real^N->bool)
              < &2 * r / &2 pow j`
   (MP_TAC o SPECL [`n - (k + 1)`; `k + 1`])
  THENL
   [ALL_TAC;
    ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LTE_TRANS) THEN
    REWRITE_TAC[real_div; REAL_INV_MUL; REAL_POW_ADD] THEN
    ASM_REAL_ARITH_TAC] THEN
  MATCH_MP_TAC num_INDUCTION THEN
  REWRITE_TAC[ADD_CLAUSES; FORALL_UNWIND_THM2] THEN
  REWRITE_TAC[NUMSEG_SING; UNIONS_1; IMAGE_CLAUSES] THEN
  ASM_SIMP_TAC[REAL_ARITH `&0 <= x /\ x < n ==> x < &2 * n`;
               DIAMETER_POS_LE; LE_REFL] THEN
  X_GEN_TAC `d:num` THEN DISCH_THEN(LABEL_TAC "*") THEN
  X_GEN_TAC `j:num` THEN DISCH_TAC THEN
  SUBGOAL_THEN `j:num < n` ASSUME_TAC THENL
   [ASM_ARITH_TAC; ASM_SIMP_TAC[LT_IMP_LE; GSYM NUMSEG_LREC]] THEN
  REWRITE_TAC[IMAGE_CLAUSES; UNIONS_INSERT] THEN
  W(MP_TAC o PART_MATCH (lhand o rand) DIAMETER_UNION_LE o lhand o snd) THEN
  ANTS_TAC THENL
   [ASM_SIMP_TAC[BOUNDED_UNIONS; FINITE_IMAGE; FINITE_NUMSEG;
                 FORALL_IN_IMAGE; IN_NUMSEG; LT_IMP_LE] THEN
    REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN
    REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN
    DISCH_THEN(MP_TAC o SPEC `SUC j`) THEN
    REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
     [ASM_ARITH_TAC;
      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC];
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS)] THEN
  REMOVE_THEN "*" (MP_TAC o SPEC `j + 1`) THEN
  ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH
   `d1 < rj /\ &2 * rj' = rj ==> d2 < &2 * rj' ==> d1 + d2 < &2 * rj`) THEN
  ASM_SIMP_TAC[LT_IMP_LE] THEN
  REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN REAL_ARITH_TAC);;

let LOCALLY_FCCOVERABLE_ALT = prove
 (`!s u a:real^N.
      locally compact s /\ locally connected s /\
      open_in (subtopology euclidean s) u /\ a IN u
      ==> ?v. open_in (subtopology euclidean s) v /\ connected v /\
              a IN v /\ v SUBSET u /\
              !e. &0 < e
                  ==> ?c. FINITE c /\ UNIONS c = v /\
                          !t. t IN c
                              ==> connected t /\ bounded t /\ diameter t <= e`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `?r. &0 < r /\ s INTER cball(a,&2 * r) SUBSET u /\
        compact(s INTER cball(a:real^N,&2 * r))`
  STRIP_ASSUME_TAC THENL
   [ONCE_REWRITE_TAC[INTER_COMM] THEN
    FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_CBALL]) THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `a:real^N`)) THEN
    ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
      [LOCALLY_COMPACT_INTER_CBALLS]) THEN
    DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN
    ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `min d e / &2` THEN
    ASM_REWRITE_TAC[REAL_HALF; REAL_LT_MIN] THEN CONJ_TAC THENL
     [REWRITE_TAC[CBALL_MIN_INTER] THEN ASM SET_TAC[]; ALL_TAC] THEN
    REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL
     [MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET; BOUNDED_CBALL];
      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC];
    FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)] THEN
  ABBREV_TAC
   `t = \k. {x | ?f. (!i. i <= k
                          ==> connected(f i) /\ f i SUBSET s /\
                              bounded(f i) /\ diameter(f i) < r / &2 pow i) /\
                     a IN f 0 /\ (x:real^N) IN f k /\
                     (!i. i < k ==> ~(f i INTER f(SUC i) = {}))}` THEN
  EXISTS_TAC `UNIONS {t k | k IN (:num)}:real^N->bool` THEN
  SUBGOAL_THEN `!k. a IN (t:num->real^N->bool) k` ASSUME_TAC THENL
   [X_GEN_TAC `k:num` THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN
    EXISTS_TAC `\i:num. {a:real^N}` THEN
    ASM_REWRITE_TAC[CONNECTED_SING; SING_SUBSET; BOUNDED_SING] THEN
    REWRITE_TAC[IN_SING; DIAMETER_SING] THEN
    ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN `!k. (t:num->real^N->bool) k SUBSET s` ASSUME_TAC THENL
   [X_GEN_TAC `k:num` THEN EXPAND_TAC "t" THEN
    REWRITE_TAC[IN_ELIM_THM; SUBSET] THEN X_GEN_TAC `x:real^N` THEN
    DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2
     (MP_TAC o SPEC `k:num`) ASSUME_TAC)) THEN
    REWRITE_TAC[LE_REFL] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN `!k. (t:num->real^N->bool) k SUBSET ball(a,&2 * r)`
  ASSUME_TAC THENL
   [SUBGOAL_THEN
     `!k. (t:num->real^N->bool) k SUBSET ball(a,(&2 - inv(&2 pow k)) * r)`
    MP_TAC THENL
     [ALL_TAC;
      MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN
      MATCH_MP_TAC SUBSET_BALL THEN
      ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_ARITH `x - a <= x <=> &0 <= a`] THEN
      SIMP_TAC[REAL_POW_LE; REAL_POS; REAL_LE_INV_EQ]] THEN
    MATCH_MP_TAC num_INDUCTION THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
    EXPAND_TAC "t" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; REAL_MUL_LID] THEN
    CONJ_TAC THENL
     [REWRITE_TAC[LE; LT; FORALL_UNWIND_THM2] THEN
      X_GEN_TAC `b:real^N` THEN
      DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN
      REWRITE_TAC[IN_BALL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
       (REAL_ARITH `x < r / &2 pow 0 ==> a <= x ==> a < r`)) THEN
      MATCH_MP_TAC DIST_LE_DIAMETER THEN ASM_REWRITE_TAC[];
      X_GEN_TAC `k:num` THEN DISCH_TAC THEN X_GEN_TAC `c:real^N` THEN
      DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN
      SUBGOAL_THEN `~(f k INTER f(SUC k):real^N->bool = {})` MP_TAC THENL
       [FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC;
        REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER]] THEN
      DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `b:real^N`) THEN ANTS_TAC THENL
       [EXISTS_TAC `f:num->real^N->bool` THEN
        ASM_REWRITE_TAC[] THEN CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN
        FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
        REWRITE_TAC[IN_BALL]] THEN
      MATCH_MP_TAC(NORM_ARITH
       `!u. dist(b,c) <= u /\ x + u <= y
            ==> dist(a:real^N,b) < x ==> dist(a,c) < y`) THEN
      EXISTS_TAC `diameter((f:num->real^N->bool) (SUC k))` THEN
      ASM_SIMP_TAC[DIST_LE_DIAMETER; LE_REFL] THEN MATCH_MP_TAC(REAL_ARITH
       `r * k = r * &2 * k' /\ d < r * k'
        ==> (&2 - k) * r + d <= (&2 - k') * r`) THEN
      ASM_SIMP_TAC[GSYM real_div; LE_REFL] THEN
      REWRITE_TAC[real_pow; real_div; REAL_INV_MUL] THEN REAL_ARITH_TAC];
    ALL_TAC] THEN
  SUBGOAL_THEN `!k. (t:num->real^N->bool) k SUBSET t(SUC k)` ASSUME_TAC THENL
   [X_GEN_TAC `k:num` THEN EXPAND_TAC "t" THEN
    REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `b:real^N` THEN
    DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `\i. if i <= k then (f:num->real^N->bool) i else {b}` THEN
    ASM_REWRITE_TAC[LE_0; ARITH_RULE `~(SUC k <= k)`; IN_SING] THEN
    CONJ_TAC THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i:num <= k` THEN
    ASM_SIMP_TAC[LT_SUC_LE] THENL
     [ASM_MESON_TAC[];
      REWRITE_TAC[CONNECTED_SING; IN_SING; BOUNDED_SING] THEN
      DISCH_TAC THEN ASM_REWRITE_TAC[FORALL_UNWIND_THM2; DIAMETER_SING] THEN
      ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2] THEN ASM_MESON_TAC[LE_REFL];
      ASM_SIMP_TAC[ARITH_RULE `i <= k ==> (SUC i <= k <=> ~(i = k))`] THEN
      REWRITE_TAC[COND_SWAP] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
       [ASM SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]];
    ALL_TAC] THEN
  SUBGOAL_THEN `!k. connected((t:num->real^N->bool) k)` ASSUME_TAC THENL
   [X_GEN_TAC `k:num` THEN
    REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
    MATCH_MP_TAC(MESON[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS]
     `!a. (!x. x IN s ==> connected_component s a x)
          ==> (!x y. x IN s /\ y IN s ==> connected_component s x y)`) THEN
    EXISTS_TAC `a:real^N` THEN SPEC_TAC(`k:num`,`k:num`) THEN
    MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
     [X_GEN_TAC `x:real^N` THEN EXPAND_TAC "t" THEN
      REWRITE_TAC[IN_ELIM_THM] THEN
      DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN
      SUBGOAL_THEN `connected_component (f 0) (a:real^N) x` MP_TAC THENL
       [REWRITE_TAC[connected_component] THEN
        EXISTS_TAC `f 0:real^N->bool` THEN
        ASM_SIMP_TAC[LE_REFL; SUBSET_REFL];
        MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s x ==> t x`) THEN
        REWRITE_TAC[ETA_AX]] THEN
      MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN
      REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
      X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN
      EXISTS_TAC `f:num->real^N->bool` THEN
      ASM_REWRITE_TAC[GSYM SUBSET];
      ALL_TAC] THEN
    X_GEN_TAC `k:num` THEN DISCH_TAC THEN X_GEN_TAC `c:real^N` THEN
    FIRST_ASSUM(fun th ->
      GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN
    REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN
    SUBGOAL_THEN `~(f k INTER f(SUC k):real^N->bool = {})` MP_TAC THENL
     [FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC;
      REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER]] THEN
    DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `b:real^N`) THEN ANTS_TAC THENL
     [EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN
      EXISTS_TAC `f:num->real^N->bool` THEN
      ASM_REWRITE_TAC[] THEN CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
      MATCH_MP_TAC(SET_RULE
       `connected_component k a SUBSET connected_component k' a /\
        (connected_component k' a b ==> connected_component k' a c)
        ==> connected_component k a b ==> connected_component k' a c`)] THEN
    ASM_SIMP_TAC[CONNECTED_COMPONENT_MONO] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONNECTED_COMPONENT_TRANS) THEN
    REWRITE_TAC[connected_component] THEN
    EXISTS_TAC `f(SUC k):real^N->bool` THEN
    ASM_SIMP_TAC[LE_REFL] THEN EXPAND_TAC "t" THEN
    REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    EXISTS_TAC `f:num->real^N->bool` THEN
    ASM_REWRITE_TAC[GSYM SUBSET];
    ALL_TAC] THEN
  REPEAT CONJ_TAC THENL
   [ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
    REWRITE_TAC[FORALL_IN_UNIONS; FORALL_IN_GSPEC;
                IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
    X_GEN_TAC `k:num` THEN DISCH_THEN(K ALL_TAC) THEN
    X_GEN_TAC `x:real^N` THEN FIRST_ASSUM(fun th ->
      GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN
    REWRITE_TAC[IN_ELIM_THM] THEN
    DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_CONNECTED]) THEN
    DISCH_THEN(MP_TAC o SPECL
     [`s INTER ball(x:real^N,r / &2 pow (k + 3))`; `x:real^N`]) THEN
    SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
    ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL] THEN
    ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2] THEN ANTS_TAC THENL
     [ASM_MESON_TAC[SUBSET; LE_REFL]; ALL_TAC] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN
    REWRITE_TAC[SUBSET_INTER; UNIONS_GSPEC] THEN STRIP_TAC THEN
    ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIV] THEN
    X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN EXISTS_TAC `SUC k` THEN
    EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN
    EXISTS_TAC `\i. if i <= k then (f:num->real^N->bool) i else v` THEN
    ASM_REWRITE_TAC[LE_0; ARITH_RULE `~(SUC k <= k)`; IN_SING] THEN
    CONJ_TAC THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i:num <= k` THEN
    ASM_SIMP_TAC[LT_SUC_LE] THENL
     [DISCH_TAC THEN CONJ_TAC THENL
       [ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL]; ALL_TAC] THEN
      TRANS_TAC REAL_LET_TRANS `r / &2 pow (k + 2)` THEN CONJ_TAC THENL
       [TRANS_TAC REAL_LE_TRANS
         `diameter(ball(x:real^N,r / &2 pow (k + 3)))` THEN
        ASM_SIMP_TAC[DIAMETER_SUBSET; BOUNDED_BALL] THEN
        ASM_SIMP_TAC[DIAMETER_BALL; REAL_LT_DIV; REAL_LT_POW2;
                     REAL_ARITH `&0 < x ==> ~(x < &0)`] THEN
        REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN
        REAL_ARITH_TAC;
        ASM_SIMP_TAC[real_div; REAL_LT_LMUL_EQ] THEN
        MATCH_MP_TAC REAL_LT_INV2 THEN REWRITE_TAC[REAL_LT_POW2] THEN
        MATCH_MP_TAC REAL_POW_MONO_LT THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN
        ASM_ARITH_TAC];
      ASM_SIMP_TAC[ARITH_RULE `i <= k ==> (SUC i <= k <=> ~(i = k))`] THEN
      REWRITE_TAC[COND_SWAP] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
       [ASM SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]];
    MATCH_MP_TAC CONNECTED_UNIONS THEN
    ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM SET_TAC[];
    ASM SET_TAC[];
    REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC; IN_UNIV] THEN
    X_GEN_TAC `k:num` THEN
    TRANS_TAC SUBSET_TRANS `s INTER cball(a:real^N,&2 * r)` THEN
    ASM_REWRITE_TAC[SUBSET_INTER] THEN
    ASM_MESON_TAC[SUBSET_TRANS; BALL_SUBSET_CBALL];
    X_GEN_TAC `e:real` THEN DISCH_TAC] THEN
  SUBGOAL_THEN `?k. r / &2 pow k < e / &4` STRIP_ASSUME_TAC THENL
   [REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN
    ASM_SIMP_TAC[REAL_INV_POW; GSYM REAL_LT_RDIV_EQ] THEN
    MATCH_MP_TAC REAL_ARCH_POW_INV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
    REWRITE_TAC[REAL_ARITH `&0 < (&1 / &4 * x) / y <=> &0 < x / y`] THEN
    ASM_SIMP_TAC[REAL_LT_DIV];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `?ws. FINITE ws /\ (t:num->real^N->bool) k SUBSET UNIONS ws /\
         !w. w IN ws
             ==> w SUBSET s /\ ~(t k INTER w = {}) /\
                 connected w /\ bounded w /\ diameter w < r / &2 pow (k + 1)`
  STRIP_ASSUME_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_CONNECTED]) THEN
    DISCH_THEN(MP_TAC o GEN `x:real^N` o
     SPECL [`s INTER ball(x:real^N,r / &2 pow (k + 3))`; `x:real^N`]) THEN
    SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
    REWRITE_TAC[IN_INTER; CENTRE_IN_BALL] THEN
    ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2; SUBSET_INTER] THEN
    GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN
    REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `uu:real^N->real^N->bool` THEN DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_GEN]) THEN
    DISCH_THEN(MP_TAC o SPECL
     [`IMAGE (uu:real^N->real^N->bool) s`; `s:real^N->bool`]) THEN
    ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN
    ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
    REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN
    DISCH_THEN(X_CHOOSE_THEN `ws:real^N->bool` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `{w:real^N->bool | w IN IMAGE (uu:real^N->real^N->bool) ws /\
                                  ~(t(k:num) INTER w = {})}` THEN
    ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_IMAGE] THEN CONJ_TAC THENL
     [REWRITE_TAC[SET_RULE
        `s SUBSET UNIONS {k | k IN f /\ ~(s INTER k = {})} <=>
         s SUBSET UNIONS f`] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        SUBSET_TRANS)) THEN
      ASM_REWRITE_TAC[SUBSET_INTER] THEN
      ASM_MESON_TAC[SUBSET_TRANS; BALL_SUBSET_CBALL];
      REWRITE_TAC[IN_ELIM_THM; IMP_CONJ; FORALL_IN_IMAGE] THEN
      X_GEN_TAC `x:real^N` THEN REPEAT DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
      ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN ASM_REWRITE_TAC[] THEN
      CONJ_TAC THENL
       [ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL]; ALL_TAC] THEN
      TRANS_TAC REAL_LET_TRANS `r / &2 pow (k + 2)` THEN CONJ_TAC THENL
       [TRANS_TAC REAL_LE_TRANS
         `diameter(ball(x:real^N,r / &2 pow (k + 3)))` THEN
        ASM_SIMP_TAC[DIAMETER_SUBSET; BOUNDED_BALL] THEN
        ASM_SIMP_TAC[DIAMETER_BALL; REAL_LT_DIV; REAL_LT_POW2;
                     REAL_ARITH `&0 < x ==> ~(x < &0)`] THEN
        REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN
        REAL_ARITH_TAC;
        ASM_SIMP_TAC[real_div; REAL_LT_LMUL_EQ] THEN
        MATCH_MP_TAC REAL_LT_INV2 THEN REWRITE_TAC[REAL_LT_POW2] THEN
        MATCH_MP_TAC REAL_POW_MONO_LT THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN
        ASM_ARITH_TAC]];
    ALL_TAC] THEN
  SUBGOAL_THEN `!w:real^N->bool. w IN ws ==> w SUBSET t(SUC k)`
  ASSUME_TAC THENL
   [X_GEN_TAC `w:real^N->bool` THEN DISCH_TAC THEN
    REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `w:real^N->bool`) THEN
    ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
    UNDISCH_TAC `~((t:num->real^N->bool) k INTER w = {})` THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `y:real^N` THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
    EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `f:num->real^N->bool` THEN STRIP_TAC THEN
    EXISTS_TAC `\i. if i <= k then (f:num->real^N->bool) i else w` THEN
    ASM_REWRITE_TAC[LE_0; ARITH_RULE `~(SUC k <= k)`] THEN
    CONJ_TAC THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i:num <= k` THEN
    ASM_SIMP_TAC[LT_SUC_LE] THENL
     [DISCH_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
       (REWRITE_RULE[IMP_CONJ] REAL_LTE_TRANS)) THEN
      ASM_SIMP_TAC[real_div; REAL_LE_LMUL_EQ] THEN
      MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_LT_POW2] THEN
      MATCH_MP_TAC REAL_POW_MONO THEN
      REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC;
      ASM_SIMP_TAC[ARITH_RULE `i <= k ==> (SUC i <= k <=> ~(i = k))`] THEN
      REWRITE_TAC[COND_SWAP] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
       [ASM SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]];
    ALL_TAC] THEN
  ABBREV_TAC
   `q = \w. {x | ?c. connected c /\ c SUBSET UNIONS {t k | k IN (:num)} /\
                     bounded c /\ diameter c < e / &4 /\
                     ~(w INTER c = {}) /\ (x:real^N) IN c}` THEN
  EXISTS_TAC `IMAGE (q:(real^N->bool)->(real^N->bool)) ws` THEN
  ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN CONJ_TAC THENL
   [ALL_TAC;
    X_GEN_TAC `w:real^N->bool` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `w:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN
    STRIP_TAC THEN CONJ_TAC THENL
     [SUBGOAL_THEN `?b:real^N. b IN w` CHOOSE_TAC THENL
       [ASM SET_TAC[]; ALL_TAC] THEN
      REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
      MATCH_MP_TAC(MESON[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS]
       `!a. (!x. x IN s ==> connected_component s a x)
            ==> (!x y. x IN s /\ y IN s ==> connected_component s x y)`) THEN
      EXISTS_TAC `b:real^N` THEN X_GEN_TAC `x:real^N` THEN
      FIRST_ASSUM(fun th ->
        GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN
      REWRITE_TAC[IN_ELIM_THM] THEN
      DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
      REWRITE_TAC[connected_component] THEN
      EXISTS_TAC `w UNION c:real^N->bool` THEN
      ASM_SIMP_TAC[IN_UNION; CONNECTED_UNION] THEN EXPAND_TAC "q" THEN
      REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION] THEN X_GEN_TAC `y:real^N` THEN
      REWRITE_TAC[GSYM SUBSET] THEN STRIP_TAC THENL
       [EXISTS_TAC `{y:real^N}` THEN
        REWRITE_TAC[BOUNDED_SING; IN_SING; CONNECTED_SING] THEN
        CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
        CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
        REWRITE_TAC[DIAMETER_SING] THEN ASM_REAL_ARITH_TAC;
        EXISTS_TAC `c:real^N->bool` THEN ASM_REWRITE_TAC[]];
      ALL_TAC] THEN
    SUBGOAL_THEN
     `q w SUBSET {x + y:real^N | x IN w /\ y IN ball(vec 0,e / &4)}`
    ASSUME_TAC THENL
     [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN
      EXPAND_TAC "q" THEN REWRITE_TAC[IN_ELIM_THM] THEN
      DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
      UNDISCH_TAC `~(w INTER c:real^N->bool = {})` THEN
      REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN
      STRIP_TAC THEN ASM_REWRITE_TAC[IN_BALL_0] THEN
      ONCE_REWRITE_TAC[CONJ_SYM] THEN
      REWRITE_TAC[VECTOR_ARITH `x:real^N = y + z <=> z = x - y`] THEN
      REWRITE_TAC[UNWIND_THM2; GSYM dist] THEN
      TRANS_TAC REAL_LET_TRANS `diameter(c:real^N->bool)` THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIST_LE_DIAMETER THEN
      ASM_REWRITE_TAC[];
      CONJ_TAC THENL
       [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
          BOUNDED_SUBSET));
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
         (MESON[DIAMETER_SUBSET; REAL_LE_TRANS]
            `s SUBSET t
             ==> bounded t /\ diameter t <= e ==> diameter s <= e`))] THEN
      ASM_SIMP_TAC[BOUNDED_SUMS; BOUNDED_BALL] THEN
      W(MP_TAC o PART_MATCH (lhand o rand) DIAMETER_SUMS o lhand o snd) THEN
      ASM_SIMP_TAC[BOUNDED_BALL; DIAMETER_BALL] THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
      ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> ~(e / &4 < &0)`] THEN
      REWRITE_TAC[REAL_ARITH `d + &2 * e / &4 <= e <=> d <= e / &2`] THEN
      TRANS_TAC REAL_LE_TRANS `r / &2 pow (k + 1)` THEN
      ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN
      REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN
      ASM_REAL_ARITH_TAC]] THEN
  REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; UNIONS_SUBSET] THEN
  REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN CONJ_TAC THENL
   [X_GEN_TAC `w:real^N->bool` THEN DISCH_TAC THEN
    REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_UNION] THEN
    X_GEN_TAC `x:real^N` THEN EXPAND_TAC "q" THEN
    REWRITE_TAC[IN_ELIM_THM; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN SET_TAC[];
    REWRITE_TAC[IN_UNIV]] THEN
  X_GEN_TAC `n:num` THEN
  DISJ_CASES_TAC(ARITH_RULE `n:num <= k \/ k < n`) THENL
   [TRANS_TAC SUBSET_TRANS `(t:num->real^N->bool) k` THEN CONJ_TAC THENL
     [UNDISCH_TAC `n:num <= k` THEN
      MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`k:num`; `n:num`] THEN
      MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
      ASM_REWRITE_TAC[] THEN SET_TAC[];
      TRANS_TAC SUBSET_TRANS `UNIONS ws:real^N->bool` THEN
      ASM_REWRITE_TAC[] THEN
      GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM IMAGE_ID] THEN
      MATCH_MP_TAC UNIONS_MONO_IMAGE THEN
      X_GEN_TAC `w:real^N->bool` THEN DISCH_TAC THEN
      REWRITE_TAC[SUBSET] THEN EXPAND_TAC "q" THEN
      REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
      EXISTS_TAC `{x:real^N}` THEN
      REWRITE_TAC[BOUNDED_SING; CONNECTED_SING; IN_SING] THEN
      CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
      REWRITE_TAC[DIAMETER_SING] THEN ASM_REAL_ARITH_TAC];
    ALL_TAC] THEN
  REWRITE_TAC[SUBSET] THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN
  X_GEN_TAC `x:real^N` THEN
  DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN
  REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM] THEN
  EXPAND_TAC "q" THEN REWRITE_TAC[IN_ELIM_THM] THEN
  SUBGOAL_THEN `?b:real^N. b IN f k /\ b IN f(SUC k)` STRIP_ASSUME_TAC THENL
   [ASM_MESON_TAC[IN_INTER; MEMBER_NOT_EMPTY]; ALL_TAC] THEN
  SUBGOAL_THEN `b IN (t:num->real^N->bool) k` ASSUME_TAC THENL
   [EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN
    EXISTS_TAC `f:num->real^N->bool` THEN
    ASM_MESON_TAC[LT_TRANS; LE_TRANS; LT_IMP_LE];
    ALL_TAC] THEN
  SUBGOAL_THEN `(b:real^N) IN UNIONS ws` MP_TAC THENL
   [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `w:real^N->bool` THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  EXISTS_TAC `UNIONS (IMAGE f (k+1..n)):real^N->bool` THEN
  REPEAT CONJ_TAC THENL
   [SUBGOAL_THEN
     `!i. i <= n ==> connected(UNIONS(IMAGE f (k+1..i)):real^N->bool)`
     (fun th -> SIMP_TAC[th; LE_REFL]) THEN
    MATCH_MP_TAC num_INDUCTION THEN
    SUBGOAL_THEN `k+1..0 = {}` SUBST1_TAC THENL
     [REWRITE_TAC[NUMSEG_EMPTY] THEN ARITH_TAC;
      REWRITE_TAC[IMAGE_CLAUSES; UNIONS_0; CONNECTED_EMPTY]] THEN
    X_GEN_TAC `i:num` THEN
    DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
    ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
    ASM_CASES_TAC `i:num = k` THENL
     [ASM_REWRITE_TAC[ADD1; NUMSEG_SING; IMAGE_CLAUSES; UNIONS_1] THEN
      ASM_MESON_TAC[ADD1];
      REWRITE_TAC[NUMSEG_CLAUSES] THEN
      COND_CASES_TAC THEN REWRITE_TAC[] THEN DISCH_TAC THEN
      REWRITE_TAC[IMAGE_CLAUSES; UNIONS_INSERT] THEN
      MATCH_MP_TAC CONNECTED_UNION THEN ASM_SIMP_TAC[] THEN
      REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN
      REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN
      DISCH_THEN(MP_TAC o SPEC `i:num`) THEN
      REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
       [ASM_ARITH_TAC;
        ONCE_REWRITE_TAC[INTER_COMM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
        ASM_ARITH_TAC]];
    MATCH_MP_TAC(SET_RULE
     `(!x. x IN s ==> f x SUBSET g x) /\ s SUBSET t
      ==> UNIONS(IMAGE f s) SUBSET UNIONS {g x | x IN t}`) THEN
    REWRITE_TAC[IN_NUMSEG; SUBSET_UNIV] THEN X_GEN_TAC `i:num` THEN
    STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN EXPAND_TAC "t" THEN
    REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN
    DISCH_TAC THEN EXISTS_TAC `f:num->real^N->bool` THEN
    ASM_REWRITE_TAC[] THEN
    CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
    MATCH_MP_TAC BOUNDED_UNIONS THEN
    ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE; IN_NUMSEG];
    ALL_TAC;
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `b:real^N` THEN
    ASM_REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; IN_NUMSEG; IN_INTER] THEN
    EXISTS_TAC `SUC k` THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC;
    REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `n:num` THEN
    ASM_REWRITE_TAC[IN_NUMSEG] THEN ASM_ARITH_TAC] THEN
  SUBGOAL_THEN
   `!d j. j + d = n
          ==> diameter (UNIONS (IMAGE f (j..n)):real^N->bool)
              < &2 * r / &2 pow j`
   (MP_TAC o SPECL [`n - (k + 1)`; `k + 1`])
  THENL
   [ALL_TAC;
    ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LTE_TRANS) THEN
    REWRITE_TAC[real_div; REAL_INV_MUL; REAL_POW_ADD] THEN
    ASM_REAL_ARITH_TAC] THEN
  MATCH_MP_TAC num_INDUCTION THEN
  REWRITE_TAC[ADD_CLAUSES; FORALL_UNWIND_THM2] THEN
  REWRITE_TAC[NUMSEG_SING; UNIONS_1; IMAGE_CLAUSES] THEN
  ASM_SIMP_TAC[REAL_ARITH `&0 <= x /\ x < n ==> x < &2 * n`;
               DIAMETER_POS_LE; LE_REFL] THEN
  X_GEN_TAC `d:num` THEN DISCH_THEN(LABEL_TAC "*") THEN
  X_GEN_TAC `j:num` THEN DISCH_TAC THEN
  SUBGOAL_THEN `j:num < n` ASSUME_TAC THENL
   [ASM_ARITH_TAC; ASM_SIMP_TAC[LT_IMP_LE; GSYM NUMSEG_LREC]] THEN
  REWRITE_TAC[IMAGE_CLAUSES; UNIONS_INSERT] THEN
  W(MP_TAC o PART_MATCH (lhand o rand) DIAMETER_UNION_LE o lhand o snd) THEN
  ANTS_TAC THENL
   [ASM_SIMP_TAC[BOUNDED_UNIONS; FINITE_IMAGE; FINITE_NUMSEG;
                 FORALL_IN_IMAGE; IN_NUMSEG; LT_IMP_LE] THEN
    REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN
    REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN
    DISCH_THEN(MP_TAC o SPEC `SUC j`) THEN
    REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
     [ASM_ARITH_TAC;
      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC];
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS)] THEN
  REMOVE_THEN "*" (MP_TAC o SPEC `j + 1`) THEN
  ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC(REAL_ARITH
   `d1 < rj /\ &2 * rj' = rj ==> d2 < &2 * rj' ==> d1 + d2 < &2 * rj`) THEN
  ASM_SIMP_TAC[LT_IMP_LE] THEN
  REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN REAL_ARITH_TAC);;

let LOCALLY_CONNECTED_CONTINUUM = prove
 (`!s:real^N->bool.
        locally (\c. compact c /\ connected c /\ locally connected c) s <=>
        locally compact s /\ locally connected s`,
  GEN_TAC THEN EQ_TAC THENL
   [DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_MONO) THEN SIMP_TAC[];
    STRIP_TAC THEN GEN_REWRITE_TAC I [locally] THEN
    MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN
    MP_TAC(ASSUME `locally compact (s:real^N->bool)`) THEN
    GEN_REWRITE_TAC LAND_CONV [locally] THEN
    DISCH_THEN(MP_TAC o SPECL [`u:real^N->bool`; `a:real^N`]) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `c:real^N->bool`] THEN
    STRIP_TAC THEN
    MP_TAC(ISPECL [`s:real^N->bool`; `v:real^N->bool`; `a:real^N`]
              LOCALLY_FCCOVERABLE_ALT) THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `w:real^N->bool` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    EXISTS_TAC `closure w:real^N->bool` THEN REPEAT CONJ_TAC THENL
     [ASM_MESON_TAC[COMPACT_CLOSURE; COMPACT_IMP_BOUNDED; BOUNDED_SUBSET;
                    SUBSET_TRANS];
      ASM_SIMP_TAC[CONNECTED_CLOSURE];
      MATCH_MP_TAC FCCOVERABLE_IMP_LOCALLY_CONNECTED THEN
      MATCH_MP_TAC FCCOVERABLE_INTERMEDIATE_CLOSURE THEN
      EXISTS_TAC `w:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
      REWRITE_TAC[CLOSURE_SUBSET];
      REWRITE_TAC[CLOSURE_SUBSET];
      TRANS_TAC SUBSET_TRANS `c:real^N->bool` THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN
      ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM SET_TAC[]]]);;

let COMPACT_LOCALLY_CONNECTED_EQ_FCCCOVERABLE_ALT = prove
 (`!s:real^N->bool.
        compact s /\ locally connected s <=>
        !e. &0 < e
            ==> ?c. FINITE c /\ UNIONS c = s /\
                    !t. t IN c
                        ==> connected t /\ compact t /\ locally connected t /\
                            diameter t <= e`,
  GEN_TAC THEN EQ_TAC THENL
   [REPEAT STRIP_TAC THEN
    REWRITE_TAC[MESON[COMPACT_IMP_BOUNDED]
     `P c /\ compact c /\ Q c /\ R c <=>
      (compact c /\ P c /\ Q c) /\ bounded c /\ R c`] THEN
    MATCH_MP_TAC LOCALLY_FINE_COVERING_COMPACT THEN
    ASM_REWRITE_TAC[LOCALLY_CONNECTED_CONTINUUM] THEN
    ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_IMP_LOCALLY_COMPACT];
    REWRITE_TAC[COMPACT_LOCALLY_CONNECTED_EQ_FCCCOVERABLE] THEN
    MESON_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* Sufficient conditions for "semi-local connectedness"                      *)
(* ------------------------------------------------------------------------- *)

let SEMI_LOCALLY_CONNECTED = prove
 (`!s:real^N->bool.
        connected s /\ locally compact s /\ locally connected s
        ==> !x v. open_in (subtopology euclidean s) v /\ x IN v
                  ==> ?u. open_in (subtopology euclidean s) u /\
                          x IN u /\ u SUBSET v /\
                          FINITE(components(s DIFF u))`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ASSUME `locally compact (s:real^N->bool)`) THEN
  REWRITE_TAC[locally] THEN
  DISCH_THEN(MP_TAC o SPECL [`v:real^N->bool`; `x:real^N`]) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`d:real^N->bool`; `c:real^N->bool`] THEN STRIP_TAC THEN
  SUBGOAL_THEN
   `?u k:real^N->bool.
        x IN u /\ u SUBSET k /\ k SUBSET d /\
        open_in (subtopology euclidean s) u /\
        closed_in (subtopology euclidean s) k`
  STRIP_ASSUME_TAC THENL
   [UNDISCH_TAC `locally compact (s:real^N->bool)` THEN
    REWRITE_TAC[locally] THEN
    DISCH_THEN(MP_TAC o SPECL [`d:real^N->bool`; `x:real^N`]) THEN
    ASM_REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    ASM_MESON_TAC[CLOSED_SUBSET; COMPACT_IMP_CLOSED; OPEN_IN_IMP_SUBSET;
                  SUBSET_TRANS];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `!x:real^N. x IN c DIFF d
               ==> ?t. open_in (subtopology euclidean s) t /\
                       connected t /\
                       x IN t /\ t SUBSET s DIFF k`
  MP_TAC THENL
   [X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE [LOCALLY_CONNECTED]) THEN
    ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
    ASM SET_TAC[];
    ALL_TAC] THEN
  GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV)
   [RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN `t:real^N->real^N->bool` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN `compact(c DIFF d:real^N->bool)` MP_TAC THENL
   [UNDISCH_TAC `open_in (subtopology euclidean s) (d:real^N->bool)` THEN
    REWRITE_TAC[OPEN_IN_OPEN] THEN
    DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool` STRIP_ASSUME_TAC) THEN
    SUBGOAL_THEN `c DIFF d:real^N->bool = c DIFF w`
     (fun th -> ASM_SIMP_TAC[th; COMPACT_DIFF]) THEN
    ASM SET_TAC[];
    GEN_REWRITE_TAC LAND_CONV [COMPACT_EQ_HEINE_BOREL_GEN]] THEN
  DISCH_THEN(MP_TAC o SPECL
   [`IMAGE (t:real^N->real^N->bool) (c DIFF d)`; `s:real^N->bool`]) THEN
  ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[] THEN
  ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV)
   [TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
  REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN
  DISCH_THEN(X_CHOOSE_THEN `q:real^N->bool` STRIP_ASSUME_TAC) THEN
  ABBREV_TAC
    `r = (s DIFF d) UNION
        UNIONS(IMAGE (\x. s INTER closure((t:real^N->real^N->bool) x)) q)` THEN
  EXISTS_TAC `s DIFF r:real^N->bool` THEN REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[OPEN_IN_REFL] THEN
    EXPAND_TAC "r" THEN MATCH_MP_TAC CLOSED_IN_UNION THEN
    ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN
    MATCH_MP_TAC CLOSED_IN_UNIONS THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN
    REWRITE_TAC[FORALL_IN_IMAGE] THEN
    SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_CLOSURE];
    ASM_REWRITE_TAC[IN_DIFF] THEN EXPAND_TAC "r" THEN
    REWRITE_TAC[IN_UNION; UNIONS_IMAGE; IN_DIFF; IN_ELIM_THM] THEN
    SUBGOAL_THEN `(x:real^N) IN s` ASSUME_TAC THENL
     [REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
      ASM SET_TAC[];
      ASM_REWRITE_TAC[IN_INTER; NOT_EXISTS_THM]] THEN
    X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN
    SUBGOAL_THEN `s INTER closure((t:real^N->real^N->bool) y)
                  SUBSET s DIFF u`
    MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    MATCH_MP_TAC CLOSURE_MINIMAL_LOCAL THEN
    ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN ASM SET_TAC[];
    ASM SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN `(r:real^N->bool) SUBSET s` ASSUME_TAC THENL
   [EXPAND_TAC "r" THEN MATCH_MP_TAC(SET_RULE
     `t SUBSET s ==> (s DIFF d) UNION t SUBSET s`) THEN
    REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN SET_TAC[];
    ASM_SIMP_TAC[SET_RULE `r SUBSET s ==> s DIFF (s DIFF r) = r`]] THEN
  MATCH_MP_TAC FINITE_SUBSET THEN
  EXISTS_TAC `IMAGE (\x:real^N. connected_component r x) q` THEN
  ASM_SIMP_TAC[FINITE_IMAGE] THEN
  REWRITE_TAC[components; SUBSET; FORALL_IN_GSPEC] THEN
  X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE] THEN
  ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EQ] THEN
  MP_TAC(ASSUME `(y:real^N) IN r`) THEN EXPAND_TAC "r" THEN
  GEN_REWRITE_TAC LAND_CONV [IN_UNION] THEN ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[IN_DIFF; UNIONS_IMAGE; IN_ELIM_THM] THEN
  MATCH_MP_TAC(TAUT
   `(q ==> r) /\ (~q /\ p ==> r) ==> p \/ q ==> r`) THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN
    REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[connected_component]] THEN
    EXISTS_TAC `s INTER closure ((t:real^N->real^N->bool) z)` THEN
    REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
      EXISTS_TAC `(t:real^N->real^N->bool) z` THEN
      REWRITE_TAC[INTER_SUBSET] THEN
      CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[SUBSET_INTER]] THEN
      REWRITE_TAC[CLOSURE_SUBSET] THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N`) THEN REWRITE_TAC[open_in] THEN
      ASM SET_TAC[];
      EXPAND_TAC "r" THEN REWRITE_TAC[UNIONS_IMAGE] THEN ASM SET_TAC[];
      ASM SET_TAC[];
      ASM_REWRITE_TAC[IN_INTER] THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N`) THEN REWRITE_TAC[open_in] THEN
      MP_TAC(ISPEC `(t:real^N->real^N->bool) z` CLOSURE_SUBSET) THEN
      ASM SET_TAC[]];
    ALL_TAC] THEN
  ASM_CASES_TAC `(y:real^N) IN d` THEN ASM_REWRITE_TAC[] THEN
  ASM_CASES_TAC `(y:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN
  ASM_CASES_TAC `(y:real^N) IN c` THENL
   [MATCH_MP_TAC(TAUT `p ==> ~p ==> r`) THEN
    SUBGOAL_THEN `y IN UNIONS (IMAGE (t:real^N->real^N->bool) q)`
    MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM]] THEN
    REWRITE_TAC[IN_INTER] THEN ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET];
    DISCH_THEN(K ALL_TAC)] THEN
  SUBGOAL_THEN
   `~((s INTER closure(connected_component (s DIFF c) y)) INTER c
      :real^N->bool = {})`
  MP_TAC THENL
   [MATCH_MP_TAC(SET_RULE
     `~(s INTER l SUBSET s DIFF c) ==> ~((s INTER l) INTER c = {})`) THEN
    DISCH_TAC THEN MP_TAC(ISPEC `s:real^N->bool` CONNECTED_CLOPEN) THEN
    ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC
     `connected_component (s DIFF c) y:real^N->bool`) THEN
    ASM_REWRITE_TAC[NOT_IMP; CONNECTED_COMPONENT_EQ_EMPTY; IN_DIFF] THEN
    REPEAT CONJ_TAC THENL
     [TRANS_TAC OPEN_IN_TRANS `s DIFF c:real^N->bool` THEN CONJ_TAC THENL
       [MATCH_MP_TAC OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED THEN
        MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
        EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[];
        ALL_TAC] THEN
      MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[OPEN_IN_REFL] THEN
      ASM_MESON_TAC[CLOSED_SUBSET; COMPACT_IMP_CLOSED; OPEN_IN_IMP_SUBSET;
                    SUBSET_TRANS];
      REWRITE_TAC[CLOSED_IN_INTER_CLOSURE] THEN
      MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
       [MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
        ASM_REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL
         [MATCH_MP_TAC(SET_RULE
           `c y /\ c SUBSET closure c ==> y IN closure c`) THEN
          ASM_REWRITE_TAC[CLOSURE_SUBSET; CONNECTED_COMPONENT_REFL_EQ] THEN
          ASM_REWRITE_TAC[IN_DIFF];
          MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
          EXISTS_TAC `connected_component (s DIFF c) y:real^N->bool` THEN
          REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; INTER_SUBSET]];
        ALL_TAC] THEN
      REWRITE_TAC[SUBSET_INTER; CLOSURE_SUBSET] THEN
      TRANS_TAC SUBSET_TRANS `s DIFF c:real^N->bool` THEN
      REWRITE_TAC[CONNECTED_COMPONENT_SUBSET] THEN SET_TAC[];
      MATCH_MP_TAC(SET_RULE
       `connected_component (s DIFF c) y SUBSET s DIFF c /\
        c SUBSET s /\ ~(c = {})
        ==> ~(connected_component (s DIFF c) y = s)`) THEN
      REWRITE_TAC[CONNECTED_COMPONENT_SUBSET] THEN
      REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
      ASM SET_TAC[]];
    ALL_TAC] THEN
  REWRITE_TAC[closure] THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
   `~((s INTER (cl UNION l)) INTER c = {})
    ==> cl SUBSET s DIFF c ==> ?x. x IN c /\ x IN s /\ x IN l`)) THEN
  REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; IN_ELIM_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN
  ASM_CASES_TAC `(z:real^N) IN d` THENL
   [MP_TAC(ISPECL [`s:real^N->bool`;
                   `connected_component (s DIFF c) (y:real^N)`;
                   `d:real^N->bool`; `z:real^N`]
        LIMIT_POINT_OF_LOCAL_IMP) THEN
    ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
     [TRANS_TAC SUBSET_TRANS `s DIFF c:real^N->bool` THEN
      REWRITE_TAC[CONNECTED_COMPONENT_SUBSET] THEN SET_TAC[];
      DISCH_THEN(X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC) THEN
      MP_TAC(ISPECL [`s DIFF c:real^N->bool`; `y:real^N`]
        CONNECTED_COMPONENT_SUBSET) THEN
      ASM SET_TAC[]];
    ALL_TAC] THEN
  SUBGOAL_THEN `z IN UNIONS (IMAGE (t:real^N->real^N->bool) q)` MP_TAC THENL
   [ASM SET_TAC[]; ALL_TAC] THEN
  REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL [`s:real^N->bool`;
                 `connected_component (s DIFF c) (y:real^N)`;
                 `(t:real^N->real^N->bool) w`; `z:real^N`]
        LIMIT_POINT_OF_LOCAL_IMP) THEN
  ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
   [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    TRANS_TAC SUBSET_TRANS `s DIFF c:real^N->bool` THEN
    REWRITE_TAC[CONNECTED_COMPONENT_SUBSET] THEN SET_TAC[];
    ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `t:real^N` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `w:real^N` THEN ASM_REWRITE_TAC[] THEN
  CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[connected_component]] THEN
  EXISTS_TAC
   `connected_component (s DIFF c) y UNION (t:real^N->real^N->bool) w` THEN
  REPEAT STRIP_TAC THENL
   [MATCH_MP_TAC CONNECTED_UNION THEN
    REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN ASM SET_TAC[];
    EXPAND_TAC "r" THEN MATCH_MP_TAC(SET_RULE
     `s SUBSET s' /\ t SUBSET t' ==> s UNION t SUBSET s' UNION t'`) THEN
    CONJ_TAC THENL
     [TRANS_TAC SUBSET_TRANS `s DIFF c:real^N->bool` THEN
      REWRITE_TAC[CONNECTED_COMPONENT_SUBSET] THEN ASM SET_TAC[];
      REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; SUBSET] THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `w:real^N`) THEN
      REWRITE_TAC[open_in] THEN
      MP_TAC(ISPEC `(t:real^N->real^N->bool) w` CLOSURE_SUBSET) THEN
      ASM SET_TAC[]];
    MATCH_MP_TAC(SET_RULE `c y ==> y IN c UNION s`) THEN
    ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ; IN_DIFF];
    ASM SET_TAC[]]);;

let SEMI_LOCALLY_CONNECTED_GEN = prove
 (`!s:real^N->bool.
        FINITE(components s) /\ locally compact s /\ locally connected s
        ==> !x v. open_in (subtopology euclidean s) v /\ x IN v
                  ==> ?u. open_in (subtopology euclidean s) u /\
                          x IN u /\ u SUBSET v /\
                          FINITE(components(s DIFF u))`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o REWRITE_RULE[open_in]) THEN
  SUBGOAL_THEN `(x:real^N) IN s` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MP_TAC(ISPEC `connected_component s (x:real^N)`
        SEMI_LOCALLY_CONNECTED) THEN
  ANTS_TAC THENL
   [REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN
    ASM_SIMP_TAC[LOCALLY_CONNECTED_CONNECTED_COMPONENT] THEN
    MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
    EXISTS_TAC `s:real^N->bool` THEN
    ASM_SIMP_TAC[OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED];
    ALL_TAC] THEN
  DISCH_THEN(MP_TAC o SPECL
   [`x:real^N`; `connected_component s (x:real^N) INTER v`]) THEN
  ASM_REWRITE_TAC[IN_INTER] THEN ANTS_TAC THENL
   [CONJ_TAC THENL
     [MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN
      EXISTS_TAC `s:real^N->bool` THEN
      REWRITE_TAC[CONNECTED_COMPONENT_SUBSET] THEN
      ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_REFL];
      REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ]];
    ALL_TAC] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN
  REWRITE_TAC[SUBSET_INTER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  CONJ_TAC THENL
   [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        OPEN_IN_TRANS)) THEN
    ASM_SIMP_TAC[OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED];
    ALL_TAC] THEN
  MATCH_MP_TAC FINITE_SUBSET THEN
  EXISTS_TAC `components(connected_component s (x:real^N) DIFF u) UNION
              components s` THEN
  ASM_REWRITE_TAC[FINITE_UNION] THEN
  REWRITE_TAC[components; SUBSET; FORALL_IN_GSPEC] THEN
  X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
  ASM_CASES_TAC `(y:real^N) IN connected_component s x` THEN
  REWRITE_TAC[IN_UNION] THENL [DISJ1_TAC; DISJ2_TAC] THEN
  REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `y:real^N` THEN
  ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `z:real^N` THENL
   [SUBGOAL_THEN `connected_component s (x:real^N) = connected_component s y`
    SUBST1_TAC THENL
     [ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EQ] THEN ASM_MESON_TAC[IN];
      ALL_TAC];
    ALL_TAC] THEN
  ONCE_REWRITE_TAC[connected_component] THEN
  AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN
  X_GEN_TAC `c:real^N->bool` THEN
  REWRITE_TAC[SET_RULE `s SUBSET t DIFF u <=> s SUBSET t /\ DISJOINT s u`] THEN
  EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
   [MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[];
    ASM_MESON_TAC[SUBSET_TRANS; CONNECTED_COMPONENT_SUBSET];
    MP_TAC(ISPECL [`s:real^N->bool`; `y:real^N`; `x:real^N`]
        CONNECTED_COMPONENT_DISJOINT) THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE
     `s' SUBSET s /\ t' SUBSET t ==> DISJOINT s t ==> DISJOINT s' t'`) THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
    ASM_REWRITE_TAC[]]);;

let SEMI_LOCALLY_CONNECTED_COMPACT = prove
 (`!s:real^N->bool.
        compact s /\ locally connected s
        ==> !x v. open_in (subtopology euclidean s) v /\ x IN v
                  ==> ?u. open_in (subtopology euclidean s) u /\
                          x IN u /\ u SUBSET v /\
                          FINITE(components(s DIFF u))`,
  GEN_TAC THEN STRIP_TAC THEN
  MATCH_MP_TAC SEMI_LOCALLY_CONNECTED_GEN THEN
  ASM_SIMP_TAC[FINITE_COMPONENTS; CLOSED_IMP_LOCALLY_COMPACT;
               COMPACT_IMP_CLOSED]);;

(* ------------------------------------------------------------------------- *)
(* Locally convex sets.                                                      *)
(* ------------------------------------------------------------------------- *)

let LOCALLY_CONVEX = prove
 (`!s:real^N->bool.
        locally convex s <=>
        !x. x IN s ==> ?u v. x IN u /\ u SUBSET v /\ v SUBSET s /\
                             open_in (subtopology euclidean s) u /\
                             convex v`,
  GEN_TAC THEN REWRITE_TAC[locally] THEN EQ_TAC THEN DISCH_TAC THENL
   [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM
     (MP_TAC o SPECL [`s INTER ball(x:real^N,&1)`; `x:real^N`]) THEN
    ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
    ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_LT_01] THEN
    MESON_TAC[SUBSET_INTER];
    MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN
    REWRITE_TAC[IMP_CONJ] THEN GEN_REWRITE_TAC LAND_CONV [OPEN_IN_OPEN] THEN
    DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
    ASM_REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
    STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
    DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `(s INTER ball(x:real^N,e)) INTER u` THEN
    EXISTS_TAC `cball(x:real^N,e) INTER v` THEN
    ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_OPEN_INTER; OPEN_BALL; CENTRE_IN_BALL;
                 CONVEX_INTER; CONVEX_CBALL; IN_INTER] THEN
    MP_TAC(ISPECL [`x:real^N`; `e:real`] BALL_SUBSET_CBALL) THEN
    ASM SET_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* Various sufficient conditions for continuity. These are mainly from the   *)
(* papers by Klee & Utz, Pervin & Levine, and Tanaka.                        *)
(* ------------------------------------------------------------------------- *)

let PROPER_MAP_TO_COMPACT = prove
 (`!f:real^M->real^N s t.
        (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) /\
        compact t /\ IMAGE f s SUBSET t
        ==> f continuous_on s`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^N->bool`]
        CONTINUOUS_ON_CLOSED_GEN) THEN
  ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN
  X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        CLOSED_IN_COMPACT)) THEN
  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
  FIRST_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN
  ASM_SIMP_TAC[CLOSED_SUBSET_EQ; COMPACT_IMP_CLOSED; SUBSET_RESTRICT]);;

let CONTINUOUS_WITHIN_SEQUENTIALLY_COMPACT_MAP = prove
 (`!f:real^M->real^N s x.
        (!c. c SUBSET s /\ compact c ==> compact(IMAGE f c)) /\ x IN s
        ==> (f continuous (at x within s) <=>
             !p y. (!n. p n IN s) /\ (p --> x) sequentially /\ (!n. f(p n) = y)
                   ==> f x = y)`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY] THEN
    MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `p:num->real^M` THEN
    DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN
    ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
    MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
    EXISTS_TAC `(f:real^M->real^N) o (p:num->real^M)` THEN
    ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN
    ASM_REWRITE_TAC[o_DEF; LIM_CONST];
    ALL_TAC] THEN
  ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
  REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY_ALT] THEN
  REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; IN_DELETE; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`e:real`; `p:num->real^M`] THEN STRIP_TAC THEN
  ASM_CASES_TAC `?y. INFINITE {n:num | (f:real^M->real^N) (p n) = y}` THENL
   [FIRST_X_ASSUM(X_CHOOSE_TAC `y:real^N`) THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP INFINITE_ENUMERATE) THEN
    DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN
    MAP_EVERY EXISTS_TAC [`(p:num->real^M) o (r:num->num)`; `y:real^N`] THEN
    ASM_SIMP_TAC[o_THM; LIM_SUBSEQUENCE] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    FIRST_ASSUM(UNDISCH_TAC o check is_neg o concl) THEN
    REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN SUBST1_TAC THEN
    FIRST_X_ASSUM(MP_TAC o MATCH_MP (MESON[INFINITE; FINITE_EMPTY]
      `INFINITE s ==> ~(s = {})`)) THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN
    MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[DIST_REFL];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `?r. (!n m. m < n ==> (r:num->num) m < r n) /\
        (!n m. m < n ==> ~((f:real^M->real^N)(p(r m)) = f(p(r n))))`
  STRIP_ASSUME_TAC THENL
   [SUBGOAL_THEN
     `?r. !n. r n = @y.
                    !m. m < n
                        ==> (r:num->num) m < y /\
                           ~((f:real^M->real^N)(p(r m)) = f(p y))`
    MP_TAC THENL
     [MATCH_MP_TAC(MATCH_MP WF_REC WF_num) THEN
      REPEAT STRIP_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[];
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN
      REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN
      X_GEN_TAC `n:num` THEN DISCH_THEN SUBST1_TAC THEN
      REWRITE_TAC[TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN
      CONV_TAC SELECT_CONV THEN
      MP_TAC(ISPECL
       [`\i:num. i`;
        `UNIONS {{i | (f:real^M->real^N)(p i) = f(p(r m:num))}
                | m |
                 m IN {m:num | m < n}}`]
        UPPER_BOUND_FINITE_SET) THEN
      RULE_ASSUM_TAC(REWRITE_RULE[NOT_EXISTS_THM; INFINITE]) THEN
      ASM_REWRITE_TAC[FINITE_UNIONS; FORALL_IN_GSPEC] THEN
      ASM_SIMP_TAC[FINITE_IMAGE; SIMPLE_IMAGE; FINITE_NUMSEG_LT] THEN
      REWRITE_TAC[FORALL_IN_UNIONS; FORALL_IN_IMAGE; IMP_CONJ;
                  RIGHT_FORALL_IMP_THM; IN_ELIM_THM] THEN
      DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N + 1` THEN
      X_GEN_TAC `m:num` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN
      REWRITE_TAC[ARITH_RULE `m < N + 1 <=> m <= N`] THEN
      MESON_TAC[ARITH_RULE `~(N + 1 <= N)`]];
    ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o SPEC
   `(x:real^M) INSERT IMAGE (p o (r:num->num)) (:num)`) THEN
  ANTS_TAC THENL
   [ASM_SIMP_TAC[COMPACT_SEQUENCE_WITH_LIMIT; LIM_SUBSEQUENCE] THEN
    REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  DISCH_THEN(MP_TAC o SPEC `ball((f:real^M->real^N) x,e)` o
    MATCH_MP (REWRITE_RULE[IMP_CONJ] COMPACT_DIFF)) THEN
  REWRITE_TAC[OPEN_BALL] THEN
  ASM_SIMP_TAC[CENTRE_IN_BALL; SET_RULE
   `f x IN b ==> IMAGE f (x INSERT s) DIFF b = IMAGE f s DIFF b`] THEN
  REWRITE_TAC[IMAGE_o] THEN
  RULE_ASSUM_TAC(REWRITE_RULE
   [ONCE_REWRITE_RULE[DIST_SYM] (GSYM IN_BALL); NOT_EXISTS_THM]) THEN
  ASM_SIMP_TAC[SET_RULE
   `(!n. ~(f(p n) IN s))
    ==> IMAGE f (IMAGE p t) DIFF s = IMAGE f (IMAGE p t)`] THEN
  GEN_REWRITE_TAC LAND_CONV [COMPACT_EQ_BOLZANO_WEIERSTRASS] THEN
  SUBGOAL_THEN
   `!m n. (f:real^M->real^N) (p ((r:num->num) m)) = f (p (r n)) <=> m = n`
  ASSUME_TAC THENL [MATCH_MP_TAC WLOG_LT THEN ASM_MESON_TAC[]; ALL_TAC] THEN
  DISCH_THEN(MP_TAC o SPEC
    `IMAGE (f:real^M->real^N) (IMAGE p (IMAGE (r:num->num) (:num)))`) THEN
  REWRITE_TAC[SUBSET_REFL] THEN ANTS_TAC THENL
   [REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC INFINITE_IMAGE THEN
    REWRITE_TAC[num_INFINITE; IN_UNIV; o_THM] THEN ASM_MESON_TAC[];
    ALL_TAC] THEN
  REWRITE_TAC[EXISTS_IN_IMAGE; IN_UNIV] THEN
  DISCH_THEN(X_CHOOSE_TAC `i:num`) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC
    `(x:real^M) INSERT (IMAGE (p o (r:num->num)) (:num) DELETE p(r i))`) THEN
  ANTS_TAC THENL
   [CONJ_TAC THENL [REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; ALL_TAC] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        COMPACT_SEQUENCE_WITH_LIMIT_GEN)) THEN
    REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  REWRITE_TAC[IMAGE_CLAUSES] THEN
  W(MP_TAC o PART_MATCH (lhand o rand)
   (SET_RULE `(!i. i IN s /\ f i = f a ==> i = a)
              ==> IMAGE f (s DELETE a) = IMAGE f s DELETE f a`) o
   rand o rand o lhand o snd) THEN
  ANTS_TAC THENL
   [REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN
  DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_CLOSED) THEN
  REWRITE_TAC[CLOSED_LIMPT] THEN
  DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) (p((r:num->num) i))`) THEN
  ASM_SIMP_TAC[LIMPT_INSERT; LIMPT_DELETE; IMAGE_o; IN_DELETE; IN_INSERT] THEN
  ASM_MESON_TAC[CENTRE_IN_BALL]);;

let COMPACT_CLOSED_POINTIMAGES_IMP_CONTINUOUS_ON = prove
 (`!f:real^M->real^N s.
        (!c. c SUBSET s /\ compact c ==> compact(IMAGE f c)) /\
        (!y. closed_in (subtopology euclidean s) {x | x IN s /\ f x = y})
        ==> f continuous_on s`,
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
  X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
  ONCE_REWRITE_TAC[TAUT `p <=> ~ ~p`] THEN DISCH_TAC THEN
  MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `x:real^M`]
        CONTINUOUS_WITHIN_SEQUENTIALLY_COMPACT_MAP) THEN
  ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`p:num->real^M`; `y:real^N`] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN
  REWRITE_TAC[CLOSED_IN_LIMPT] THEN
  DISCH_THEN(MP_TAC o SPEC `x:real^M` o CONJUNCT2) THEN
  ASM_REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[LIMPT_SEQUENTIAL] THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  DISCH_THEN(MP_TAC o SPEC `p:num->real^M`) THEN
  ASM_REWRITE_TAC[IN_ELIM_THM; IN_DELETE] THEN ASM_MESON_TAC[]);;

let COMPACT_CONTINUOUS_IMAGE_EQ = prove
 (`!f:real^M->real^N s.
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
        ==> (f continuous_on s <=>
             !t. compact t /\ t SUBSET s ==> compact(IMAGE f t))`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [MESON_TAC[COMPACT_CONTINUOUS_IMAGE; CONTINUOUS_ON_SUBSET]; DISCH_TAC] THEN
  MATCH_MP_TAC COMPACT_CLOSED_POINTIMAGES_IMP_CONTINUOUS_ON THEN
  CONJ_TAC THENL [ASM_MESON_TAC[]; X_GEN_TAC `y:real^N`] THEN
  SUBGOAL_THEN
   `{x | x IN s /\ (f:real^M->real^N) x = y} = {} \/
    ?x. x IN s /\ {x | x IN s /\ (f:real^M->real^N) x = y} = {x}`
  STRIP_ASSUME_TAC THENL
   [ASM SET_TAC[];
    ASM_REWRITE_TAC[CLOSED_IN_EMPTY];
    ASM_REWRITE_TAC[CLOSED_IN_SING]]);;

let CONTINUOUS_EQ_COMPACT_CONNECTED_PRESERVING_GEN = prove
 (`!P f:real^M->real^N s.
     locally P s /\ (!c. P c ==> connected c)
     ==> (f continuous_on s <=>
          (!c. c SUBSET s /\ compact c ==> compact(IMAGE f c)) /\
          (!c. c SUBSET s /\ P c ==> connected(IMAGE f c)))`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [ASM_MESON_TAC[COMPACT_CONTINUOUS_IMAGE; CONNECTED_CONTINUOUS_IMAGE;
                  CONTINUOUS_ON_SUBSET];
    STRIP_TAC] THEN
  REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
  X_GEN_TAC `a:real^M` THEN DISCH_TAC THEN
  ASM_SIMP_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY_COMPACT_MAP] THEN
  MAP_EVERY X_GEN_TAC [`p:num->real^M`; `b:real^N`] THEN STRIP_TAC THEN
  MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `!n. ?c x. a IN c /\ x IN c /\ (f:real^M->real^N) x = b /\
              P c /\ c SUBSET s /\ c SUBSET ball(a,inv(&n + &1))`
  MP_TAC THENL
   [X_GEN_TAC `n:num` THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [locally]) THEN
    DISCH_THEN(MP_TAC o SPECL
     [`s INTER ball(a:real^M,inv(&n + &1))`; `a:real^M`]) THEN
    SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; IN_INTER; CENTRE_IN_BALL] THEN
    ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
    DISCH_THEN(X_CHOOSE_THEN `d:real^M->bool` MP_TAC) THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^M->bool` THEN
    REWRITE_TAC[SUBSET_INTER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN
    FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I
     [OPEN_IN_CONTAINS_BALL]) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `a:real^M`) THEN
    ASM_REWRITE_TAC[INTER_SUBSET] THEN
    DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
    DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `m:num` (MP_TAC o SPEC `m:num`)) THEN
    REWRITE_TAC[LE_REFL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN
    REWRITE_TAC[GSYM IN_BALL] THEN DISCH_TAC THEN
    EXISTS_TAC `(p:num->real^M) m` THEN ASM SET_TAC[];
    PURE_REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN
    MAP_EVERY X_GEN_TAC [`c:num->real^M->bool`; `x:num->real^M`] THEN
    STRIP_TAC] THEN
  SUBGOAL_THEN
   `!n. ?u. u IN c n /\ (f:real^M->real^N) u IN ball(b,inv(&n + &1)) DELETE b`
  MP_TAC THENL
   [X_GEN_TAC `n:num` THEN
    SUBGOAL_THEN `connected (IMAGE (f:real^M->real^N) (c(n:num)))`
    MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    DISCH_THEN(MP_TAC o SPEC `b:real^N` o
     MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] CONNECTED_IMP_PERFECT)) THEN
    ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[limit_point_of]] THEN
    DISCH_THEN(MP_TAC o SPEC `ball(b:real^N,inv(&n + &1))`) THEN
    ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; REAL_LT_INV_EQ] THEN
    ANTS_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN
    ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
    REWRITE_TAC[EXISTS_IN_IMAGE] THEN
    MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[];
    PURE_REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN
    X_GEN_TAC `u:num->real^M` THEN
    REWRITE_TAC[FORALL_AND_THM; IN_DELETE] THEN STRIP_TAC] THEN
  SUBGOAL_THEN
   `compact(IMAGE (f:real^M->real^N) (a INSERT IMAGE u (:num)))`
  MP_TAC THENL
   [FIRST_X_ASSUM MATCH_MP_TAC THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC COMPACT_SEQUENCE_WITH_LIMIT THEN
    REWRITE_TAC[LIM_SEQUENTIALLY] THEN MATCH_MP_TAC FORALL_POS_MONO_1 THEN
    CONJ_TAC THENL [MESON_TAC[REAL_LT_TRANS]; ONCE_REWRITE_TAC[DIST_SYM]] THEN
    REWRITE_TAC[GSYM IN_BALL] THEN
    X_GEN_TAC `n:num` THEN EXISTS_TAC `n:num` THEN
    X_GEN_TAC `m:num` THEN DISCH_TAC THEN
    SUBGOAL_THEN `ball(a:real^M,inv(&m + &1)) SUBSET ball(a,inv(&n + &1))`
      (fun th -> ASM SET_TAC[th]) THEN
    MATCH_MP_TAC SUBSET_BALL THEN MATCH_MP_TAC REAL_LE_INV2 THEN
    REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN
    ASM_ARITH_TAC;
   DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_CLOSED) THEN
   REWRITE_TAC[CLOSED_LIMPT] THEN DISCH_THEN(MP_TAC o SPEC `b:real^N`) THEN
   REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
   REWRITE_TAC[LIMPT_APPROACHABLE; EXISTS_IN_IMAGE] THEN
   MATCH_MP_TAC FORALL_POS_MONO_1 THEN
   CONJ_TAC THENL [MESON_TAC[REAL_LT_TRANS]; ONCE_REWRITE_TAC[DIST_SYM]] THEN
   REWRITE_TAC[GSYM IN_BALL] THEN ASM SET_TAC[]]);;

let CONTINUOUS_EQ_COMPACT_CONNECTED_PRESERVING = prove
 (`!f:real^M->real^N s.
        locally connected s
        ==> (f continuous_on s <=>
             (!c. c SUBSET s /\ compact c ==> compact(IMAGE f c)) /\
             (!c. c SUBSET s /\ connected c ==> connected(IMAGE f c)))`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC CONTINUOUS_EQ_COMPACT_CONNECTED_PRESERVING_GEN THEN
  ASM_REWRITE_TAC[]);;

let CONTINUOUS_EQ_COMPACT_PATH_CONNECTED_PRESERVING = prove
 (`!f:real^M->real^N s.
     locally path_connected s
     ==> (f continuous_on s <=>
          (!c. c SUBSET s /\ compact c ==> compact(IMAGE f c)) /\
          (!c. c SUBSET s /\ path_connected c ==> path_connected(IMAGE f c)))`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [MESON_TAC[COMPACT_CONTINUOUS_IMAGE; PATH_CONNECTED_CONTINUOUS_IMAGE;
                  CONTINUOUS_ON_SUBSET];
    STRIP_TAC THEN FIRST_ASSUM(MP_TAC o ISPEC `f:real^M->real^N` o  MATCH_MP
     (ONCE_REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_EQ_COMPACT_CONNECTED_PRESERVING_GEN)) THEN
    ASM_MESON_TAC[PATH_CONNECTED_IMP_CONNECTED]]);;

let CONNECTED_CLOSED_POINTIMAGES_IMP_CONTINUOUS_ON = prove
 (`!f:real^N->real^1 s t.
        IMAGE f s SUBSET t /\
        locally connected s /\
        (!c. c SUBSET s /\ connected c ==> connected(IMAGE f c)) /\
        (!y. closed_in (subtopology euclidean s) {x | x IN s /\ f x = y})
        ==> f continuous_on s`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_on] THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_CONNECTED]) THEN
  DISCH_THEN(MP_TAC o SPECL
   [`s DIFF {y:real^N | y IN s /\ f y IN sphere(f x:real^1,e)}`;
    `x:real^N`]) THEN
  ANTS_TAC THENL
   [CONJ_TAC THENL
     [MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
      ASM_SIMP_TAC[SPHERE_1; REAL_ARITH `&0 < e ==> ~(e < &0)`] THEN
      ASM_SIMP_TAC[CLOSED_IN_UNION; SET_RULE
       `{x | x IN s /\ f x IN {a,b}} =
        {x | x IN s /\ f x = a} UNION {x | x IN s /\ f x = b}`];
      ASM_REWRITE_TAC[IN_DIFF; IN_ELIM_THM; IN_SPHERE; DIST_REFL] THEN
      ASM_SIMP_TAC[REAL_LT_IMP_NZ]];
    DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_in]) THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:real^N`)) THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `d:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    SUBGOAL_THEN `IMAGE (f:real^N->real^1) u SUBSET ball(f x,e)` MP_TAC THENL
     [MP_TAC(ISPECL
       [`IMAGE (f:real^N->real^1) u`; `ball((f:real^N->real^1) x,e)`]
       CONNECTED_INTER_FRONTIER) THEN
      ASM_SIMP_TAC[FRONTIER_BALL] THEN
      SUBGOAL_THEN `(f:real^N->real^1) x IN ball(f x,e)` MP_TAC THENL
       [ASM_REWRITE_TAC[CENTRE_IN_BALL]; ASM SET_TAC[]];
      REWRITE_TAC[IN_BALL; FORALL_IN_IMAGE; SUBSET] THEN
      ASM_MESON_TAC[DIST_SYM]]]);;

let CONNECTED_CONNECTED_IMP_CLOSED_POINTIMAGES = prove
 (`!f:real^M->real^N s.
        (!c. c SUBSET s /\ connected c ==> connected(IMAGE f c)) /\
        (!y. connected {x | x IN s /\ f x = y})
        ==> !y. closed_in (subtopology euclidean s) {x | x IN s /\ f x = y}`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `b:real^N` THEN
  ABBREV_TAC `t = {x | x IN s /\ (f:real^M->real^N) x = b}` THEN
  ASM_CASES_TAC `t:real^M->bool = {}` THEN ASM_SIMP_TAC[CLOSED_IN_EMPTY] THEN
  REWRITE_TAC[CLOSED_IN_LIMPT] THEN
  CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `a:real^M`] THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `b:real^N`) THEN ASM_REWRITE_TAC[] THEN
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `connected(IMAGE (f:real^M->real^N) (a INSERT t))`
  MP_TAC THENL
   [FIRST_X_ASSUM MATCH_MP_TAC THEN
    ASM_SIMP_TAC[CONNECTED_INSERT_LIMPT] THEN ASM SET_TAC[];
    REWRITE_TAC[CONNECTED_CLOSED_IN; NOT_EXISTS_THM] THEN
    DISCH_THEN(MP_TAC o SPECL [`{b:real^N}`; `{(f:real^M->real^N) a}`]) THEN
    REWRITE_TAC[CLOSED_IN_SING] THEN ASM SET_TAC[]]);;

let CONNECTED_CONNECTED_POINTIMAGES_IMP_CONTINUOUS_ON = prove
 (`!f:real^N->real^1 s t.
        IMAGE f s SUBSET t /\
        locally connected s /\
        (!c. c SUBSET s /\ connected c ==> connected(IMAGE f c)) /\
        (!y. connected {x | x IN s /\ f x = y})
        ==> f continuous_on s`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC CONNECTED_CLOSED_POINTIMAGES_IMP_CONTINUOUS_ON THEN
  EXISTS_TAC `t:real^1->bool` THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC CONNECTED_CONNECTED_IMP_CLOSED_POINTIMAGES THEN
  ASM_REWRITE_TAC[]);;

let CLOSED_CLOSED_PREIMAGES_IMP_CONTINUOUS_ON = prove
 (`!f:real^M->real^N s t.
        compact t /\
        (!y. closed_in (subtopology euclidean s) {x | x IN s /\ f x = y}) /\
        (!c. closed_in (subtopology euclidean s) c
             ==> closed_in (subtopology euclidean t) (IMAGE f c))
        ==> f continuous_on s`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC COMPACT_CLOSED_POINTIMAGES_IMP_CONTINUOUS_ON THEN
  ASM_REWRITE_TAC[] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_IN_COMPACT THEN
  EXISTS_TAC `t:real^N->bool` THEN
  ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
  ASM_SIMP_TAC[CLOSED_SUBSET_EQ; COMPACT_IMP_CLOSED]);;

let CLOSED_CONNECTED_PREIMAGES_IMP_CONTINUOUS_ON = prove
 (`!f:real^M->real^N s t.
        compact t /\
        (!y. connected {x | x IN s /\ f x = y}) /\
        (!c. closed_in (subtopology euclidean s) c
             ==> closed_in (subtopology euclidean t) (IMAGE f c)) /\
        (!c. c SUBSET s /\ connected c ==> connected(IMAGE f c))
        ==> f continuous_on s`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC CLOSED_CLOSED_PREIMAGES_IMP_CONTINUOUS_ON THEN
  EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC CONNECTED_CONNECTED_IMP_CLOSED_POINTIMAGES THEN
  ASM_REWRITE_TAC[]);;

let BICONNECTED_IMP_CONTINUOUS_ON = prove
 (`!f:real^M->real^N s t.
        FINITE (components t) /\ locally compact t /\ locally connected t /\
        IMAGE f s = t /\
        (!c. c SUBSET s /\ connected c ==> connected(IMAGE f c)) /\
        (!c. c SUBSET t /\ connected c ==> connected {x | x IN s /\ f x IN c})
        ==> f continuous_on s`,
  let lemma = prove
   (`{n | f n IN UNIONS a} = UNIONS {{n | f n IN s} | s IN a}`,
    REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
  X_GEN_TAC `p:real^M` THEN DISCH_TAC THEN
  REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY_INJ] THEN
  X_GEN_TAC `x:num->real^M` THEN STRIP_TAC THEN
  REWRITE_TAC[TENDSTO_ALT; EVENTUALLY_SEQUENTIALLY; o_DEF] THEN
  X_GEN_TAC `v:real^N->bool` THEN STRIP_TAC THEN
  ASM_CASES_TAC `FINITE {n:num | (f:real^M->real^N) (x n) IN (t DIFF v)}` THENL
   [FIRST_ASSUM(MP_TAC o ISPEC `\n:num. n` o
      MATCH_MP UPPER_BOUND_FINITE_SET) THEN
    REWRITE_TAC[FORALL_IN_GSPEC; IN_DIFF] THEN MATCH_MP_TAC(MESON[]
     `(!n. P n ==> Q(SUC n)) ==> (?n. P n) ==> (?n. Q n)`) THEN
    X_GEN_TAC `N:num` THEN DISCH_TAC THEN
    X_GEN_TAC `n:num` THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN
    REWRITE_TAC[ARITH_RULE `~(SUC m <= n) <=> n <= m`] THEN ASM SET_TAC[];
    MATCH_MP_TAC(TAUT `F ==> p`)] THEN
  SUBGOAL_THEN
   `?u. open_in (subtopology euclidean t) u /\
        (f:real^M->real^N) p IN u /\
        u SUBSET v /\
        INFINITE {n:num | (f:real^M->real^N) (x n) IN t DIFF u} /\
        FINITE(components(t DIFF u))`
  STRIP_ASSUME_TAC THENL
   [MP_TAC(ISPEC `t:real^N->bool` SEMI_LOCALLY_CONNECTED_GEN) THEN
    ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPECL
     [`(f:real^M->real^N) p`; `t INTER v:real^N->bool`]) THEN
    ASM_SIMP_TAC[OPEN_IN_OPEN_INTER] THEN
    ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[GSYM INFINITE]) THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        INFINITE_SUPERSET)) THEN
    ASM SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN `?c. c IN components (t DIFF u) /\
                    INFINITE {n:num | (f:real^M->real^N)(x n) IN c}`
  STRIP_ASSUME_TAC THENL
   [UNDISCH_TAC `INFINITE {n:num | (f:real^M->real^N)(x n) IN t DIFF u}` THEN
    MP_TAC(ISPEC `t DIFF u:real^N->bool` UNIONS_COMPONENTS) THEN
    DISCH_THEN(fun th ->
      GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN
    REWRITE_TAC[lemma; INFINITE; FINITE_UNIONS] THEN
    ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN
    MESON_TAC[];
    ALL_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o SPEC
   `(p:real^M) INSERT {x | x IN s /\ (f:real^M->real^N) x IN c}`) THEN
  REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL
   [ASM SET_TAC[];
    MATCH_MP_TAC CONNECTED_INSERT_LIMPT THEN CONJ_TAC THENL
     [FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL
       [TRANS_TAC SUBSET_TRANS `t DIFF u:real^N->bool` THEN
        REWRITE_TAC[SUBSET_DIFF] THEN ASM_MESON_TAC[IN_COMPONENTS_SUBSET];
        ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]];
      FIRST_ASSUM(MP_TAC o MATCH_MP INFINITE_ENUMERATE) THEN
      DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN
      REWRITE_TAC[LIMPT_SEQUENTIAL] THEN
      EXISTS_TAC `(x:num->real^M) o (r:num->num)` THEN
      ASM_SIMP_TAC[LIM_SUBSEQUENCE] THEN
      REWRITE_TAC[o_DEF; IN_ELIM_THM] THEN ASM SET_TAC[]];
    SUBGOAL_THEN
     `IMAGE f (p INSERT {x | x IN s /\ f x IN c}) =
      (f:real^M->real^N)(p) INSERT c`
    SUBST1_TAC THENL
     [MP_TAC(ISPECL [`t DIFF u:real^N->bool`; `c:real^N->bool`]
        IN_COMPONENTS_SUBSET) THEN
      ASM SET_TAC[];
      ALL_TAC] THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
    ASM_SIMP_TAC[CONNECTED_INSERT] THEN
    REWRITE_TAC[closure; IN_UNION; DE_MORGAN_THM; IN_ELIM_THM] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN
    MP_TAC(ISPECL [`t:real^N->bool`; `c:real^N->bool`; `(f:real^M->real^N) p`]
        LIMIT_POINT_OF_LOCAL) THEN
    ASM SET_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* Topological characterizations of non-strict monotonicity.                 *)
(* ------------------------------------------------------------------------- *)

let MONOTONE_TOPOLOGICALLY_IMP = prove
 (`!f s. (!c. connected c ==> connected {x | x IN s /\ f x IN c})
         ==> (!x y. x IN s /\ y IN s /\ drop x <= drop y
                     ==> drop(f x) <= drop(f y)) \/
              (!x y. x IN s /\ y IN s /\ drop x <= drop y
                     ==> drop(f y) <= drop(f x))`,
   REPEAT STRIP_TAC THEN
   REWRITE_TAC[FORALL_LIFT; REAL_NON_MONOTONE; LIFT_DROP] THEN
    REWRITE_TAC[NOT_EXISTS_THM; FORALL_DROP; LIFT_DROP] THEN
    MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`; `c:real^1`] THEN
    STRIP_TAC THENL
     [FIRST_X_ASSUM(MP_TAC o SPEC `{y | drop y < drop(f(b:real^1))}`);
      FIRST_X_ASSUM(MP_TAC o SPEC `{y | drop(f(b:real^1)) < drop y}`)] THEN
    REWRITE_TAC[NOT_IMP; GSYM IS_INTERVAL_CONNECTED_1] THEN
    (CONJ_TAC THENL
      [REWRITE_TAC[IS_INTERVAL_1_CASES] THEN SET_TAC[]; ALL_TAC]) THEN
    REWRITE_TAC[IS_INTERVAL_1; IN_ELIM_THM] THEN
    DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `c:real^1`; `b:real^1`]) THEN
    ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_REFL]);;

let MONOTONE_TOPOLOGICALLY_EQ = prove
 (`!f s. (!c. connected c ==> connected {x | x IN s /\ f x IN c}) <=>
         is_interval s /\
         ((!x y. x IN s /\ y IN s /\ drop x <= drop y
                 ==> drop(f x) <= drop(f y)) \/
          (!x y. x IN s /\ y IN s /\ drop x <= drop y
                 ==> drop(f y) <= drop(f x)))`,
  REPEAT GEN_TAC THEN EQ_TAC THEN
  SIMP_TAC[MONOTONE_TOPOLOGICALLY_IMP] THENL
   [DISCH_THEN(MP_TAC o SPEC `(:real^1)`) THEN
    REWRITE_TAC[SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN
    REWRITE_TAC[CONNECTED_UNIV; GSYM IS_INTERVAL_CONNECTED_1];
    REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_1] THEN SET_TAC[]]);;

let MONOTONE_TOPOLOGICALLY = prove
 (`!f s. is_interval s
         ==> ((!x y. x IN s /\ y IN s /\ drop x <= drop y
                     ==> drop(f x) <= drop(f y)) \/
              (!x y. x IN s /\ y IN s /\ drop x <= drop y
                     ==> drop(f y) <= drop(f x)) <=>
              !c. connected c ==> connected {x | x IN s /\ f x IN c})`,
  SIMP_TAC[MONOTONE_TOPOLOGICALLY_EQ]);;

let MONOTONE_TOPOLOGICALLY_INTO_1D_EQ = prove
 (`!f:real^N->real^1 s.
        f continuous_on s
        ==> ((!k. connected k ==> connected {x | x IN s /\ f x IN k}) <=>
             connected s /\ (!y. connected {x | x IN s /\ f x = y}))`,
  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM CONTINUOUS_MAP_EUCLIDEAN] THEN
  REWRITE_TAC[CONTINUOUS_MAP_EQ_DROP] THEN
  DISCH_THEN(MP_TAC o MATCH_MP MONOTONE_MAP_INTO_EUCLIDEANREAL_ALT) THEN
  REWRITE_TAC[MONOTONE_MAP; CONNECTED_SPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  REWRITE_TAC[CONNECTED_IN_SUBTOPOLOGY; TOPSPACE_EUCLIDEANREAL; SUBSET_UNIV;
              TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_RESTRICT] THEN
  REWRITE_TAC[CONNECTED_IN_EUCLIDEAN; o_THM; FORALL_DROP; DROP_EQ] THEN
  DISCH_THEN(SUBST1_TAC o SYM) THEN
  REWRITE_TAC[FORALL_DROP_IMAGE; DROP_IN_IMAGE_DROP] THEN
  REWRITE_TAC[IS_REALINTERVAL_IS_INTERVAL] THEN
  REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_ID] THEN
  REWRITE_TAC[IS_INTERVAL_CONNECTED_1]);;

let MONOTONE_TOPOLOGICALLY_INTO_1D = prove
 (`!f:real^N->real^1 s.
        connected s /\ f continuous_on s /\
        (!y. connected {x | x IN s /\ f x = y})
        ==> (!k. connected k ==> connected {x | x IN s /\ f x IN k})`,
  MESON_TAC[MONOTONE_TOPOLOGICALLY_INTO_1D_EQ]);;

let MONOTONE_TOPOLOGICALLY_POINTS = prove
 (`!f:real^1->real^1 s.
        is_interval s /\ f continuous_on s
        ==> ((!x y. x IN s /\ y IN s /\ drop x <= drop y
                    ==> drop(f x) <= drop(f y)) \/
             (!x y. x IN s /\ y IN s /\ drop x <= drop y
                    ==> drop(f y) <= drop(f x)) <=>
             !a. connected {x | x IN s /\ f x = a})`,
  SIMP_TAC[MONOTONE_TOPOLOGICALLY; MONOTONE_TOPOLOGICALLY_INTO_1D_EQ] THEN
  SIMP_TAC[IS_INTERVAL_CONNECTED]);;

let MONOTONE_TOPOLOGICALLY_POINTS_IMP = prove
 (`!f s. f continuous_on s /\ is_interval s /\
         (!y. connected {x | x IN s /\ f x = y})
         ==> (!x y. x IN s /\ y IN s /\ drop x <= drop y
                    ==> drop(f x) <= drop(f y)) \/
             (!x y. x IN s /\ y IN s /\ drop x <= drop y
                    ==> drop(f y) <= drop(f x))`,
  SIMP_TAC[MONOTONE_TOPOLOGICALLY_POINTS]);;

let MONOTONE_IMP_HOMEOMORPHISM_1D = prove
 (`!f s t.
        is_interval s /\ is_interval t /\ IMAGE f s = t /\
        ((!x y. x IN s /\ y IN s /\ drop x < drop y
                ==> drop(f x) < drop(f y)) \/
         (!x y. x IN s /\ y IN s /\ drop x < drop y
                ==> drop(f x) < drop(f y)))
        ==> ?g. homeomorphism(s,t) (f,g)`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
  SUBGOAL_THEN
   `!x y. x IN s /\ y IN s ==> ((f:real^1->real^1) x = f y <=> x = y)`
  ASSUME_TAC THENL
   [REWRITE_TAC[GSYM INJECTIVE_ON_ALT] THEN
    REWRITE_TAC[GSYM DROP_EQ; GSYM REAL_LE_ANTISYM] THEN
    ASM_MESON_TAC[REAL_NOT_LE];
    ALL_TAC] THEN
  EXPAND_TAC "t" THEN
  W(MP_TAC o PART_MATCH (rand o rand) INJECTIVE_INTO_1D_EQ_HOMEOMORPHISM o
        snd) THEN
  ASM_REWRITE_TAC[INJECTIVE_ON_ALT] THEN
  DISCH_THEN MATCH_MP_TAC THEN
  ASM_SIMP_TAC[IS_INTERVAL_PATH_CONNECTED] THEN
  MATCH_MP_TAC CONNECTED_CONNECTED_POINTIMAGES_IMP_CONTINUOUS_ON THEN
  EXISTS_TAC `t:real^1->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
  ASM_SIMP_TAC[CONVEX_IMP_LOCALLY_CONNECTED; GSYM IS_INTERVAL_CONVEX_1] THEN
  CONJ_TAC THENL
   [MP_TAC(ISPECL [`f:real^1->real^1`; `s:real^1->bool`]
        INJECTIVE_ON_LEFT_INVERSE) THEN
    ASM_REWRITE_TAC[INJECTIVE_ON_ALT] THEN
    DISCH_THEN(X_CHOOSE_TAC `g:real^1->real^1`) THEN
    MP_TAC(ISPECL [`g:real^1->real^1`; `t:real^1->bool`]
        MONOTONE_TOPOLOGICALLY) THEN
    ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
    EXPAND_TAC "t" THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN
    ASM_SIMP_TAC[GSYM REAL_NOT_LT; CONTRAPOS_THM] THEN
    DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN
    ANTS_TAC THENL [ASM_MESON_TAC[]; MATCH_MP_TAC MONO_FORALL] THEN
    X_GEN_TAC `c:real^1->bool` THEN
    DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN
    ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[];
    X_GEN_TAC `y:real^1` THEN
    SUBGOAL_THEN `{x | x IN s /\ (f:real^1->real^1) x = y} = {} \/
                  ?a. {x | x IN s /\ f x = y} = {a}`
    MP_TAC THENL
     [MATCH_MP_TAC(SET_RULE `(!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
          ==> {x | x IN s /\ f x = a} = {} \/
              ?b. {x | x IN s /\ f x = a} = {b}`) THEN
      ASM_MESON_TAC[];
      STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_EMPTY; CONNECTED_SING]]]);;

let MONOTONE_CONNECTED_PREIMAGES_IMP_PROPER_MAP = prove
 (`!f:real^M->real^N s t.
        IMAGE f s = t /\ locally compact s /\ locally connected t /\
        f continuous_on s /\
        (!y. compact {x | x IN s /\ f x = y}) /\
        (!c. c SUBSET t /\ connected c ==> connected {x | x IN s /\ f x IN c})
        ==> (!k. k SUBSET t /\ compact k
                 ==> compact {x | x IN s /\ f x IN k})`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[PROPER_MAP; SUBSET_REFL] THEN
  X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
  REWRITE_TAC[CLOSED_IN_LIMPT] THEN
  CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  X_GEN_TAC `y:real^N` THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q ==> r <=> q /\ ~r ==> ~p`] THEN
  STRIP_TAC THEN
  MP_TAC(ISPECL [`s:real^M->bool`; `s DIFF k:real^M->bool`]
        LOCALLY_COMPACT_OPEN_IN) THEN
  ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN
  REWRITE_TAC[LOCALLY_COMPACT_COMPACT] THEN
  DISCH_THEN(MP_TAC o SPEC `{x | x IN s /\ (f:real^M->real^N) x = y}`) THEN
  ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^M->bool`] THEN STRIP_TAC THEN
  ABBREV_TAC `b:real^M->bool = closure u DIFF u` THEN
  SUBGOAL_THEN `(b:real^M->bool) SUBSET v` ASSUME_TAC THENL
   [EXPAND_TAC "b" THEN MATCH_MP_TAC(SET_RULE
     `s SUBSET u ==> s DIFF t SUBSET u`) THEN
    MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED];
    ALL_TAC] THEN
  SUBGOAL_THEN `compact(b:real^M->bool)` ASSUME_TAC THENL
   [MATCH_MP_TAC CLOSED_IN_COMPACT THEN EXISTS_TAC `v:real^M->bool` THEN
    ASM_REWRITE_TAC[] THEN
    EXPAND_TAC "b" THEN MATCH_MP_TAC CLOSED_IN_DIFF THEN CONJ_TAC THENL
     [MATCH_MP_TAC CLOSED_SUBSET THEN REWRITE_TAC[CLOSED_CLOSURE] THEN
      ASM SET_TAC[];
      MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN
      EXISTS_TAC `s DIFF k:real^M->bool` THEN ASM SET_TAC[]];
    ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_CONNECTED]) THEN
  DISCH_THEN(MP_TAC o SPECL
   [`t DIFF IMAGE (f:real^M->real^N) b`; `y:real^N`]) THEN
  ANTS_TAC THENL
   [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
    MATCH_MP_TAC CLOSED_SUBSET THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
    MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
    ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
     (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN
    ASM SET_TAC[];
    DISCH_THEN(X_CHOOSE_THEN `r:real^N->bool` STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPECL
     [`t:real^N->bool`; `IMAGE (f:real^M->real^N) k`; `y:real^N`]
        LIMIT_POINT_OF_LOCAL) THEN
    ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN
    DISCH_THEN(MP_TAC o SPEC `r:real^N->bool`) THEN
    ASM_REWRITE_TAC[] THEN
  MP_TAC(ISPEC `{x | x IN s /\ (f:real^M->real^N) x IN r}`
        CONNECTED_OPEN_IN) THEN
  MATCH_MP_TAC(TAUT `p /\ (r ==> q) ==> (p <=> ~q) ==> ~r`) THEN CONJ_TAC THENL
   [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]; DISCH_TAC] THEN
  MAP_EVERY EXISTS_TAC
   [`{x | x IN s /\ (f:real^M->real^N) x IN r} INTER u`;
    `{x | x IN s /\ (f:real^M->real^N) x IN r} DIFF closure u`] THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN
    EXISTS_TAC `s:real^M->bool` THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    MATCH_MP_TAC OPEN_IN_INTER THEN REWRITE_TAC[OPEN_IN_REFL] THEN
    MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `s DIFF k:real^M->bool` THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN
    ASM_REWRITE_TAC[OPEN_IN_REFL];
    SIMP_TAC[OPEN_IN_DIFF_CLOSED; CLOSED_CLOSURE];
    ASM SET_TAC[];
    MP_TAC(ISPEC `u:real^M->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[];
    ASM SET_TAC[];
    ASM SET_TAC[]]]);;

let MONOTONE_INTO_1D_IMP_PROPER_MAP = prove
 (`!f:real^N->real^1 s t.
      connected s /\ locally compact s /\
      f continuous_on s /\ IMAGE f s = t /\
      (!y. compact {x | x IN s /\ f x = y}) /\
      (!y. connected {x | x IN s /\ f x = y})
      ==> (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k})`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  MATCH_MP_TAC MONOTONE_CONNECTED_PREIMAGES_IMP_PROPER_MAP THEN
  ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
   [MATCH_MP_TAC CONVEX_IMP_LOCALLY_CONNECTED THEN
    REWRITE_TAC[CONVEX_CONNECTED_1] THEN
    ASM_MESON_TAC[CONNECTED_CONTINUOUS_IMAGE];
    ASM_MESON_TAC[MONOTONE_TOPOLOGICALLY_INTO_1D]]);;

let MONOTONE_CONNECTED_PREIMAGES_IMP_PROPER_MAP_GEN = prove
 (`!f:real^M->real^N s t.
        IMAGE f s = t /\ locally compact s /\ locally connected t /\
        (!c. c SUBSET s /\ compact c ==> compact(IMAGE f c)) /\
        (!y. compact {x | x IN s /\ f x = y}) /\
        (!c. c SUBSET t /\ connected c ==> connected {x | x IN s /\ f x IN c})
        ==> (!k. k SUBSET t /\ compact k
                 ==> compact {x | x IN s /\ f x IN k})`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  MATCH_MP_TAC MONOTONE_CONNECTED_PREIMAGES_IMP_PROPER_MAP THEN
  ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC COMPACT_CLOSED_POINTIMAGES_IMP_CONTINUOUS_ON THEN
  ASM_REWRITE_TAC[] THEN GEN_TAC THEN
  MATCH_MP_TAC CLOSED_SUBSET THEN REWRITE_TAC[SUBSET_RESTRICT] THEN
  ASM_SIMP_TAC[COMPACT_IMP_CLOSED]);;

(* ------------------------------------------------------------------------- *)
(* Sura-Bura's results about compact components of sets.                     *)
(* ------------------------------------------------------------------------- *)

let SURA_BURA_COMPACT = prove
 (`!s c:real^N->bool.
        compact s /\ c IN components s
        ==> c = INTERS {t | c SUBSET t /\
                            open_in (subtopology euclidean s) t /\
                            closed_in (subtopology euclidean s) t}`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`subtopology euclidean (s:real^N->bool)`; `c:real^N->bool`]
        COMPACT_QUASI_EQ_CONNECTED_COMPONENTS_OF) THEN
  ASM_REWRITE_TAC[LOCALLY_COMPACT_SPACE_SUBTOPOLOGY_EUCLIDEAN] THEN
  ASM_REWRITE_TAC[COMPACT_IN_SUBTOPOLOGY; COMPACT_IN_EUCLIDEAN] THEN
  ASM_SIMP_TAC[EUCLIDEAN_CONNECTED_COMPONENTS_OF; IN_COMPONENTS_SUBSET] THEN
  ASM_SIMP_TAC[HAUSDORFF_SPACE_EUCLIDEAN; HAUSDORFF_SPACE_SUBTOPOLOGY] THEN
  ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_IMP_LOCALLY_COMPACT] THEN
  ANTS_TAC THENL [ASM_MESON_TAC[COMPACT_COMPONENTS]; ALL_TAC] THEN
  DISCH_THEN(fun th -> GEN_REWRITE_TAC LAND_CONV
   [GSYM(MATCH_MP QUASI_COMPONENTS_OF_SET th)]) THEN
  REWRITE_TAC[CONJ_ACI]);;

let SURA_BURA_CLOPEN_SUBSET = prove
 (`!s c u:real^N->bool.
        locally compact s /\
        c IN components s /\ compact c /\
        open u /\ c SUBSET u
        ==> ?k. open_in (subtopology euclidean s) k /\ compact k /\
                c SUBSET k /\ k SUBSET u`,
  REPEAT STRIP_TAC THEN FIRST_X_ASSUM
   (MP_TAC o GEN_REWRITE_RULE I [LOCALLY_COMPACT_COMPACT_SUBOPEN]) THEN
  DISCH_THEN(MP_TAC o SPECL [`c:real^N->bool`; `u:real^N->bool`]) THEN
  ASM_SIMP_TAC[IN_COMPONENTS_SUBSET; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `k:real^N->bool`] THEN
  STRIP_TAC THEN
  MP_TAC(ISPECL [`k:real^N->bool`; `c:real^N->bool`]
       SURA_BURA_COMPACT) THEN
  ASM_SIMP_TAC[CLOSED_IN_COMPACT_EQ] THEN ANTS_TAC THENL
   [MATCH_MP_TAC COMPONENTS_INTERMEDIATE_SUBSET THEN
    EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
    DISCH_THEN(ASSUME_TAC o SYM)] THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
  DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN
  MP_TAC(ISPECL
   [`(:real^N) DIFF (u INTER w)`;
    `{t:real^N->bool | c SUBSET t /\ open_in (subtopology euclidean k) t /\
                       compact t /\ t SUBSET k}`]
   CLOSED_IMP_FIP_COMPACT) THEN
  ASM_SIMP_TAC[GSYM OPEN_CLOSED; OPEN_INTER; FORALL_IN_GSPEC] THEN
  GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN
  ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SUBSET] THEN
  REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; IN_ELIM_THM; SET_RULE
    `(UNIV DIFF u) INTER s = {} <=> s SUBSET u`] THEN
  DISCH_THEN(X_CHOOSE_THEN `f:(real^N->bool)->bool` MP_TAC) THEN
  ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL
   [ASM_REWRITE_TAC[NOT_IN_EMPTY; INTERS_0; FINITE_EMPTY] THEN
    REWRITE_TAC[SET_RULE `UNIV SUBSET s INTER t <=> s = UNIV /\ t = UNIV`] THEN
    DISCH_THEN(CONJUNCTS_THEN SUBST_ALL_TAC) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[INTER_UNIV]) THEN
    UNDISCH_THEN `s:real^N->bool = v` (SUBST_ALL_TAC o SYM) THEN
    SUBGOAL_THEN `k:real^N->bool = s` SUBST_ALL_TAC THENL
     [ASM SET_TAC[]; REWRITE_TAC[SUBSET_UNIV]] THEN
    EXISTS_TAC `s:real^N->bool` THEN
    ASM_SIMP_TAC[IN_COMPONENTS_SUBSET; OPEN_IN_REFL];
    STRIP_TAC THEN EXISTS_TAC `INTERS f:real^N->bool` THEN
    ASM_SIMP_TAC[COMPACT_INTERS] THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `v:real^N->bool` THEN
    ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN
    EXISTS_TAC `k:real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
     [MATCH_MP_TAC OPEN_IN_INTERS THEN ASM_SIMP_TAC[];
      EXPAND_TAC "v" THEN REWRITE_TAC[SUBSET_INTER] THEN
      CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
      MATCH_MP_TAC(SET_RULE
       `(!t. t IN f ==> t SUBSET s) /\ ~(f = {}) ==> INTERS f SUBSET s`) THEN
      ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET_TRANS]]]);;

let SURA_BURA_CLOPEN_SUBSET_ALT = prove
 (`!s c u:real^N->bool.
        locally compact s /\
        c IN components s /\ compact c /\
        open_in (subtopology euclidean s) u /\ c SUBSET u
        ==> ?k. open_in (subtopology euclidean s) k /\ compact k /\
                c SUBSET k /\ k SUBSET u`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
  DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N->bool`; `v:real^N->bool`]
        SURA_BURA_CLOPEN_SUBSET) THEN
  ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
  ASM SET_TAC[]);;

let SURA_BURA = prove
 (`!s c:real^N->bool.
        locally compact s /\ c IN components s /\ compact c
        ==> c = INTERS {k | c SUBSET k /\ compact k /\
                            open_in (subtopology euclidean s) k}`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
   [SET_TAC[]; ALL_TAC] THEN
  REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN
  ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
  MP_TAC(ISPECL [`{x:real^N}`; `c:real^N->bool`] SEPARATION_NORMAL) THEN
  ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_SING] THEN
  ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
  MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
  STRIP_TAC THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N->bool`; `v:real^N->bool`]
        SURA_BURA_CLOPEN_SUBSET) THEN
  ASM_REWRITE_TAC[IN_INTERS; NOT_FORALL_THM; IN_ELIM_THM; NOT_IMP] THEN
  MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM SET_TAC[]);;

let COMPONENT_CLOPEN_HAUSDIST_EXPLICIT = prove
 (`!s c:real^N->bool e.
        &0 < e /\
        locally compact s /\
        c IN components s /\
        compact c
        ==> ?k. open_in (subtopology euclidean s) k /\
                compact k /\ c SUBSET k /\
                k SUBSET {x + d | x IN c /\ d IN ball(vec 0,e)}`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SURA_BURA_CLOPEN_SUBSET THEN
  ASM_SIMP_TAC[OPEN_SUMS; OPEN_BALL] THEN
  REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN
  ASM_REWRITE_TAC[CENTRE_IN_BALL; VECTOR_ADD_RID]);;

let COMPONENT_CLOPEN_HAUSDIST = prove
 (`!s c:real^N->bool e.
        &0 < e /\
        locally compact s /\
        c IN components s /\
        compact c
        ==> ?k. open_in (subtopology euclidean s) k /\
                compact k /\ c SUBSET k /\ hausdist(c,k) < e`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N->bool`; `e / &2`]
        COMPONENT_CLOPEN_HAUSDIST_EXPLICIT) THEN
  ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN
  X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  MAP_EVERY ASM_CASES_TAC [`c:real^N->bool = {}`; `k:real^N->bool = {}`] THEN
  ASM_REWRITE_TAC[HAUSDIST_EMPTY] THEN
  MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_HAUSDIST_LE_SUMS THEN
  ASM_REWRITE_TAC[] THEN CONJ_TAC THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
     SUBSET_TRANS))
  THENL
   [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN
    ASM_REWRITE_TAC[CENTRE_IN_CBALL; VECTOR_ADD_RID] THEN ASM_REAL_ARITH_TAC;
    MATCH_MP_TAC(SET_RULE
     `t SUBSET u
      ==> {f x y | x IN s /\ y IN t} SUBSET {f x y | x IN s /\ y IN u}`) THEN
    REWRITE_TAC[BALL_SUBSET_CBALL]]);;

let COMPONENT_INTERMEDIATE_CLOPEN = prove
 (`!s t u:real^N->bool.
        t IN components s /\
        open_in (subtopology euclidean s) u /\
        t SUBSET u /\
        (dimindex(:N) = 1 \/ (?r:real^1->bool. s homeomorphic r) \/
         locally connected s \/
         (locally compact s /\ compact t))
        ==> ?c. closed_in (subtopology euclidean s) c /\
                open_in (subtopology euclidean s) c /\
                t SUBSET c /\ c SUBSET u`,
  let lemma = prove
   (`!s t u:real^1->bool.
          bounded s /\ t IN components s /\
          open_in (subtopology euclidean s) u /\
          t SUBSET u
          ==> ?c. closed_in (subtopology euclidean s) c /\
                  open_in (subtopology euclidean s) c /\
                  t SUBSET c /\ c SUBSET u`,
    REPEAT STRIP_TAC THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_COMPONENT) THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN
    REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1] THEN DISCH_TAC THEN
    SUBGOAL_THEN `?a b:real^1. s INTER interval[a,b] = t`
    STRIP_ASSUME_TAC THENL
     [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN
      DISCH_THEN(X_CHOOSE_THEN `d:real^1->bool` (STRIP_ASSUME_TAC o GSYM)) THEN
      MP_TAC(ISPECL [`d:real^1->bool`; `t:real^1->bool`]
       EXISTS_COMPONENT_SUPERSET) THEN
      ASM_REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1] THEN
      ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      DISCH_THEN(X_CHOOSE_THEN `c:real^1->bool` STRIP_ASSUME_TAC) THEN
      FIRST_ASSUM(X_CHOOSE_TAC `b:real^1` o MATCH_MP
       BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC) THEN
      MP_TAC(ISPEC `c INTER interval[--b:real^1,b]`
        CONNECTED_COMPACT_INTERVAL_1) THEN
      MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN
      CONJ_TAC THENL
       [CONJ_TAC THENL
         [REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1] THEN
          MATCH_MP_TAC IS_INTERVAL_INTER THEN
          REWRITE_TAC[IS_INTERVAL_INTERVAL] THEN
          ASM_MESON_TAC[IS_INTERVAL_CONNECTED_1; IN_COMPONENTS_CONNECTED];
          MATCH_MP_TAC CLOSED_INTER_COMPACT THEN
          ASM_MESON_TAC[CLOSED_COMPONENTS; COMPACT_INTERVAL]];
        REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
        FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN ASM SET_TAC[]];
      ALL_TAC] THEN
    SUBGOAL_THEN `drop a <= drop b` ASSUME_TAC THENL
     [REWRITE_TAC[GSYM INTERVAL_NE_EMPTY_1] THEN ASM SET_TAC[]; ALL_TAC] THEN
    SUBGOAL_THEN
     `?a'. drop a' <= drop a /\ ~(a' IN s) /\
           s INTER interval[a',b] SUBSET u`
    STRIP_ASSUME_TAC THENL
     [ASM_CASES_TAC `(a:real^1) IN s` THENL
       [ALL_TAC; ASM_MESON_TAC[REAL_LE_REFL]] THEN
      FIRST_ASSUM(STRIP_ASSUME_TAC o
        GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_CBALL]) THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `a:real^1`) THEN ANTS_TAC THENL
       [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
        EXPAND_TAC "t" THEN REWRITE_TAC[IN_INTER] THEN
        ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN ASM SET_TAC[];
        REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
        X_GEN_TAC `r:real` THEN STRIP_TAC] THEN
      SUBGOAL_THEN `~(interval[a - lift r,a] SUBSET s)` MP_TAC THENL
       [DISCH_TAC THEN
        MP_TAC(ISPECL [`s:real^1->bool`; `t UNION interval [a - lift r,a]`;
                       `t:real^1->bool`] COMPONENTS_MAXIMAL) THEN
        ASM_REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL
         [MATCH_MP_TAC CONNECTED_UNION THEN
          ASM_REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_INTERVAL;
                          GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
          EXISTS_TAC `a:real^1` THEN EXPAND_TAC "t" THEN
          REWRITE_TAC[IN_INTER; ENDS_IN_INTERVAL] THEN
          ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
          REWRITE_TAC[INTERVAL_NE_EMPTY_1; DROP_SUB; LIFT_DROP] THEN
          ASM_REAL_ARITH_TAC;
          ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET; UNION_SUBSET];
          ASM SET_TAC[];
          EXPAND_TAC "t" THEN REWRITE_TAC[UNION_SUBSET; SUBSET_INTER] THEN
          DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN
          REWRITE_TAC[SUBSET_INTERVAL_1; DROP_SUB; LIFT_DROP] THEN
          ASM_REAL_ARITH_TAC];
        REWRITE_TAC[SUBSET; NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
        X_GEN_TAC `a':real^1` THEN
        REWRITE_TAC[NOT_IMP; IN_INTERVAL_1; DROP_SUB; LIFT_DROP] THEN
        STRIP_TAC THEN ASM_REWRITE_TAC[GSYM SUBSET] THEN
        MP_TAC(ISPECL [`a':real^1`; `b:real^1`; `a:real^1`]
          UNION_INTERVAL_1) THEN
        ASM_REWRITE_TAC[IN_INTERVAL_1; GSYM INTERVAL_NE_EMPTY_1] THEN
        DISCH_THEN(SUBST1_TAC o SYM) THEN
        ASM_REWRITE_TAC[UNION_OVER_INTER; UNION_SUBSET] THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
          `b INTER s SUBSET u ==> i SUBSET b ==> s INTER i SUBSET u`)) THEN
        REWRITE_TAC[CBALL_INTERVAL; SUBSET_INTERVAL_1] THEN
        REWRITE_TAC[DROP_ADD; DROP_SUB; LIFT_DROP] THEN
        ASM_REAL_ARITH_TAC];
      ALL_TAC] THEN
    SUBGOAL_THEN
     `?b'. drop b <= drop b' /\ ~(b' IN s) /\
           s INTER interval[a',b'] SUBSET u`
    STRIP_ASSUME_TAC THENL
     [ASM_CASES_TAC `(b:real^1) IN s` THENL
       [ALL_TAC; ASM_MESON_TAC[REAL_LE_REFL]] THEN
      FIRST_ASSUM(STRIP_ASSUME_TAC o
        GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_CBALL]) THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `b:real^1`) THEN ANTS_TAC THENL
       [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
        EXPAND_TAC "t" THEN REWRITE_TAC[IN_INTER] THEN
        ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN
        REWRITE_TAC[INTERVAL_NE_EMPTY_1] THEN ASM_REAL_ARITH_TAC;
        REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
        X_GEN_TAC `r:real` THEN STRIP_TAC] THEN
      SUBGOAL_THEN `~(interval[b,b + lift r] SUBSET s)` MP_TAC THENL
       [DISCH_TAC THEN
        MP_TAC(ISPECL [`s:real^1->bool`; `t UNION interval [b,b + lift r]`;
                       `t:real^1->bool`] COMPONENTS_MAXIMAL) THEN
        ASM_REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL
         [MATCH_MP_TAC CONNECTED_UNION THEN
          ASM_REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_INTERVAL;
                          GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
          EXISTS_TAC `b:real^1` THEN EXPAND_TAC "t" THEN
          REWRITE_TAC[IN_INTER; ENDS_IN_INTERVAL] THEN
          ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
          REWRITE_TAC[INTERVAL_NE_EMPTY_1; DROP_ADD; LIFT_DROP] THEN
          ASM_REAL_ARITH_TAC;
          ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET; UNION_SUBSET];
          ASM SET_TAC[];
          EXPAND_TAC "t" THEN REWRITE_TAC[UNION_SUBSET; SUBSET_INTER] THEN
          DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN
          REWRITE_TAC[SUBSET_INTERVAL_1; DROP_ADD; LIFT_DROP] THEN
          ASM_REAL_ARITH_TAC];
        REWRITE_TAC[SUBSET; NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
        X_GEN_TAC `b':real^1` THEN
        REWRITE_TAC[NOT_IMP; IN_INTERVAL_1; DROP_ADD; LIFT_DROP] THEN
        STRIP_TAC THEN ASM_REWRITE_TAC[GSYM SUBSET] THEN
        MP_TAC(ISPECL [`a':real^1`; `b':real^1`; `b:real^1`]
          UNION_INTERVAL_1) THEN
        ASM_REWRITE_TAC[IN_INTERVAL_1] THEN
        ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN
        ASM_REWRITE_TAC[UNION_OVER_INTER; UNION_SUBSET] THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
          `b INTER s SUBSET u ==> i SUBSET b ==> s INTER i SUBSET u`)) THEN
        REWRITE_TAC[CBALL_INTERVAL; SUBSET_INTERVAL_1] THEN
        REWRITE_TAC[DROP_ADD; DROP_SUB; LIFT_DROP] THEN
        ASM_REAL_ARITH_TAC];
      ALL_TAC] THEN
    EXISTS_TAC `s INTER interval[a':real^1,b']` THEN
    ASM_SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_INTERVAL] THEN CONJ_TAC THENL
     [REWRITE_TAC[OPEN_IN_OPEN] THEN EXISTS_TAC `interval(a':real^1,b')` THEN
      REWRITE_TAC[OPEN_INTERVAL] THEN
      MP_TAC(ISPECL [`a':real^1`; `b':real^1`] CLOSED_OPEN_INTERVAL_1) THEN
      ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
      SUBGOAL_THEN `~(interval[a:real^1,b] = {})` MP_TAC THENL
       [ASM SET_TAC[];
        REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN ASM_REAL_ARITH_TAC];
      EXPAND_TAC "t" THEN
      MATCH_MP_TAC(SET_RULE `s SUBSET t ==> a INTER s SUBSET a INTER t`) THEN
      REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]) in
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[DISJ_ASSOC] THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_COMPONENT) THEN
  DISCH_THEN DISJ_CASES_TAC THENL
   [SUBGOAL_THEN
     `?r:real^1->bool. bounded r /\ (s:real^N->bool) homeomorphic r`
    STRIP_ASSUME_TAC THENL
     [FIRST_X_ASSUM(MP_TAC o MATCH_MP (MESON[]
       `p \/ q ==> (p ==> q) ==> q`)) THEN
      ANTS_TAC THENL
       [REWRITE_TAC[GSYM DIMINDEX_1; GSYM DIM_UNIV] THEN
        DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
         (REWRITE_RULE[CONJ_ASSOC] HOMEOMORPHIC_SUBSPACES))) THEN
        REWRITE_TAC[SUBSPACE_UNIV; homeomorphic] THEN
        GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN
        MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^1` THEN
        ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
        MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^1->real^N` THEN
        DISCH_TAC THEN EXISTS_TAC `IMAGE (f:real^N->real^1) s` THEN
        FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
          HOMEOMORPHISM_OF_SUBSETS)) THEN
        RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
        DISCH_THEN(X_CHOOSE_TAC `r:real^1->bool`) THEN
        SUBGOAL_THEN
         `?r'. bounded r' /\ (r:real^1->bool) homeomorphic (r':real^1->bool)`
        MP_TAC THENL
         [ALL_TAC;
          MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
          MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN
          MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_TRANS) THEN
          ASM_REWRITE_TAC[]] THEN
        MP_TAC(ISPECL [`vec 0:real^1`; `vec 1:real^1`]
          HOMEOMORPHIC_OPEN_INTERVAL_UNIV) THEN
        REWRITE_TAC[UNIT_INTERVAL_NONEMPTY] THEN
        GEN_REWRITE_TAC LAND_CONV [HOMEOMORPHIC_SYM] THEN
        REWRITE_TAC[homeomorphic; RIGHT_AND_EXISTS_THM] THEN
        GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN
        MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^1->real^1` THEN
        ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
        MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^1->real^1` THEN
        DISCH_TAC THEN EXISTS_TAC `IMAGE (f:real^1->real^1) r` THEN
        CONJ_TAC THENL
         [MATCH_MP_TAC BOUNDED_SUBSET THEN
          EXISTS_TAC `interval(vec 0:real^1,vec 1)` THEN
          REWRITE_TAC[BOUNDED_INTERVAL];
          FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
            HOMEOMORPHISM_OF_SUBSETS))] THEN
        RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]];
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
      REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
      MAP_EVERY X_GEN_TAC [`f:real^N->real^1`; `g:real^1->real^N`] THEN
      STRIP_TAC THEN
      FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN
      MP_TAC(ISPECL
        [`IMAGE (f:real^N->real^1) s`; `IMAGE (f:real^N->real^1) t`;
         `IMAGE (f:real^N->real^1) u`] lemma) THEN
      ASM_SIMP_TAC[IMAGE_SUBSET] THEN ANTS_TAC THENL
       [CONJ_TAC THENL
         [FIRST_ASSUM(SUBST1_TAC o MATCH_MP HOMEOMORPHISM_COMPONENTS) THEN
          MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_REWRITE_TAC[];
          EXPAND_TAC "r" THEN
          FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
            HOMEOMORPHISM_OPEN_IN_EQ)) THEN
          DISCH_THEN(MP_TAC o SPECL [`s:real^N->bool`; `u:real^N->bool`]) THEN
          ASM_MESON_TAC[SUBSET_REFL; OPEN_IN_IMP_SUBSET]];
        DISCH_THEN(X_CHOOSE_THEN `c:real^1->bool` STRIP_ASSUME_TAC) THEN
        EXISTS_TAC `IMAGE (g:real^1->real^N) c` THEN REPEAT CONJ_TAC THENL
       [MATCH_MP_TAC HOMEOMORPHISM_IMP_CLOSED_MAP;
        MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP;
        REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN
        RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
        REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
        RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]] THEN
      MAP_EVERY EXISTS_TAC
       [`f:real^N->real^1`; `IMAGE (f:real^N->real^1) s`] THEN
      ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMEOMORPHISM_SYM] THEN
      FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        HOMEOMORPHISM_OF_SUBSETS)) THEN
      RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]]];
    FIRST_X_ASSUM(DISJ_CASES_THEN STRIP_ASSUME_TAC) THENL
     [EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
      ASM_MESON_TAC[OPEN_IN_COMPONENTS_LOCALLY_CONNECTED];
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
      DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN
      MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`; `v:real^N->bool`]
        SURA_BURA_CLOPEN_SUBSET) THEN
      ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^N->bool` THEN
      STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
      FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
      CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
      MATCH_MP_TAC CLOSED_SUBSET THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED]]]);;

let COMPONENTS_SUBSETS_CLOPEN_PARTITION = prove
 (`!u s:real^N->bool.
        locally compact s /\
        FINITE u /\ ~(u = {}) /\ u SUBSET components s /\
        (!c. c IN u ==> compact c)
        ==> ?f. (!c. c IN u
                     ==> open_in (subtopology euclidean s) (f c) /\
                         closed_in (subtopology euclidean s) (f c) /\
                         c SUBSET f(c)) /\
                pairwise (\c c'. ~(f(c) = f(c'))) u /\
                pairwise (\c c'. DISJOINT (f c) (f c')) u /\
                UNIONS (IMAGE f u) = s`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `?l. !c. c IN u
          ==> closed_in (subtopology euclidean s) (l c) /\
              open_in (subtopology euclidean s) (l c) /\
              (c:real^N->bool) SUBSET l c /\
              (!c'. c' IN u /\ ~(c' = c) ==> DISJOINT (l c) (l c'))`
  STRIP_ASSUME_TAC THENL
   [SUBGOAL_THEN
     `!c. c IN u
          ==> ?l. closed_in (subtopology euclidean s) l /\
                  open_in (subtopology euclidean s) l /\
                  c SUBSET l /\
                  (!c':real^N->bool. c' IN u /\ ~(c' = c) ==> DISJOINT c' l)`
    MP_TAC THENL
     [X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN
      MP_TAC(ISPECL
       [`s:real^N->bool`; `c:real^N->bool`;
        `s DIFF UNIONS (u DELETE c):real^N->bool`]
          COMPONENT_INTERMEDIATE_CLOPEN) THEN
      ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
       [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]] THEN
      REPEAT CONJ_TAC THENL
       [ASM SET_TAC[];
        MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
        MATCH_MP_TAC CLOSED_IN_UNIONS THEN ASM_REWRITE_TAC[FINITE_DELETE] THEN
        ASM_SIMP_TAC[IN_DELETE; COMPACT_IMP_CLOSED; CLOSED_SUBSET_EQ] THEN
        ASM_MESON_TAC[IN_COMPONENTS_SUBSET; SUBSET];
        MATCH_MP_TAC(SET_RULE
         `c SUBSET s /\ (!d. d IN u ==> DISJOINT c d)
          ==> c SUBSET s DIFF UNIONS u`) THEN
        CONJ_TAC THENL
         [ASM_MESON_TAC[IN_COMPONENTS_SUBSET; SUBSET];
          REWRITE_TAC[IN_DELETE] THEN
          ASM_MESON_TAC[REWRITE_RULE[pairwise] PAIRWISE_DISJOINT_COMPONENTS;
                        SUBSET]];
        ASM SET_TAC[]];
      GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
      REWRITE_TAC[SKOLEM_THM] THEN
      DISCH_THEN(X_CHOOSE_TAC `l:(real^N->bool)->(real^N->bool)`) THEN
      EXISTS_TAC `\c. (l:(real^N->bool)->(real^N->bool)) c DIFF
                      UNIONS (IMAGE l (u DELETE c))` THEN
      X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN REWRITE_TAC[] THEN
      REPEAT CONJ_TAC THENL
       [MATCH_MP_TAC CLOSED_IN_DIFF THEN ASM_SIMP_TAC[] THEN
        MATCH_MP_TAC OPEN_IN_UNIONS THEN ASM SET_TAC[];
        MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_SIMP_TAC[] THEN
        MATCH_MP_TAC CLOSED_IN_UNIONS THEN
        ASM_SIMP_TAC[FINITE_DELETE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN
        ASM SET_TAC[];
        MATCH_MP_TAC(SET_RULE
         `c SUBSET s /\ (!d. d IN u ==> DISJOINT c d)
          ==> c SUBSET s DIFF UNIONS u`) THEN
        CONJ_TAC THENL
         [ASM_MESON_TAC[IN_COMPONENTS_SUBSET; SUBSET];
          REWRITE_TAC[IN_DELETE; FORALL_IN_IMAGE] THEN
          ASM_MESON_TAC[REWRITE_RULE[pairwise] PAIRWISE_DISJOINT_COMPONENTS;
                        SUBSET]];
        SET_TAC[]]];
    ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  DISCH_THEN(X_CHOOSE_TAC `d:real^N->bool`) THEN
  EXISTS_TAC `\c. if c = d then s DIFF UNIONS (IMAGE l (u DELETE d))
                  else (l:(real^N->bool)->(real^N->bool)) c` THEN
  REWRITE_TAC[] THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> p /\ (q /\ r) /\ s`] THEN
  REWRITE_TAC[PAIRWISE_AND] THEN REPEAT CONJ_TAC THENL
   [X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN
    COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
      MATCH_MP_TAC CLOSED_IN_UNIONS THEN
      ASM_SIMP_TAC[FINITE_DELETE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN
      ASM SET_TAC[];
      MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN
      MATCH_MP_TAC OPEN_IN_UNIONS THEN ASM SET_TAC[];
      MATCH_MP_TAC(SET_RULE
       `c SUBSET s /\ (!d. d IN u ==> DISJOINT c d)
        ==> c SUBSET s DIFF UNIONS u`) THEN
      CONJ_TAC THENL
       [ASM_MESON_TAC[IN_COMPONENTS_SUBSET; SUBSET]; ALL_TAC] THEN
      REWRITE_TAC[IN_DELETE; FORALL_IN_IMAGE] THEN
      ASM_MESON_TAC[SET_RULE `c SUBSET c' /\ DISJOINT c' d ==> DISJOINT c d`]];
    FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE
     `a IN s ==> s = a INSERT (s DELETE a)`)) THEN
    REWRITE_TAC[PAIRWISE_INSERT] THEN
    ASM_SIMP_TAC[SET_RULE `a IN s ==> a INSERT (s DELETE a) = s`] THEN
    SUBGOAL_THEN
     `!c:real^N->bool. c IN u ==> ~(l c:real^N->bool = {})`
    ASSUME_TAC THENL
     [ASM_MESON_TAC[SUBSET_EMPTY; IN_COMPONENTS_NONEMPTY; SUBSET];
      ALL_TAC] THEN
    ASM_SIMP_TAC[IN_DELETE; pairwise; SET_RULE
      `~(c' = {}) ==> ((~(c = c') /\ DISJOINT c c') /\
                       (~(c' = c) /\ DISJOINT c' c) <=> DISJOINT c c')`] THEN
    ASM SET_TAC[];
    FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE
     `a IN s ==> s = a INSERT (s DELETE a)`)) THEN
    REWRITE_TAC[IMAGE_CLAUSES; UNIONS_INSERT] THEN
    ASM_SIMP_TAC[SET_RULE `a IN s ==> a INSERT (s DELETE a) = s`] THEN
    REWRITE_TAC[SET_RULE
     `IMAGE (\x. if x = a then f x else g x) (s DELETE a) =
      IMAGE g (s DELETE a)`] THEN
    MATCH_MP_TAC(SET_RULE `u SUBSET s ==> (s DIFF u) UNION u = s`) THEN
    REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE; IN_DELETE] THEN
    ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]]);;

(* ------------------------------------------------------------------------- *)
(* Relations between components and path components.                         *)
(* ------------------------------------------------------------------------- *)

let OPEN_CONNECTED_COMPONENT = prove
 (`!s x:real^N. open s ==> open(connected_component s x)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
  DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN
  ANTS_TAC THENL
   [ASM_MESON_TAC[SUBSET; CONNECTED_COMPONENT_SUBSET]; ALL_TAC] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN
  ASM_REWRITE_TAC[] THEN
  SUBGOAL_THEN `connected_component s (x:real^N) = connected_component s y`
  SUBST1_TAC THENL
   [ASM_MESON_TAC[CONNECTED_COMPONENT_EQ];
    MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
    ASM_REWRITE_TAC[CENTRE_IN_BALL; CONNECTED_BALL]]);;

let IN_CLOSURE_CONNECTED_COMPONENT = prove
 (`!x y:real^N.
        x IN s /\ open s
        ==> (x IN closure(connected_component s y) <=>
             x IN connected_component s y)`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN
  REWRITE_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN
  DISCH_TAC THEN SUBGOAL_THEN
   `~((connected_component s (x:real^N)) INTER
      closure(connected_component s y) = {})`
  MP_TAC THENL
   [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^N` THEN
    ASM_REWRITE_TAC[IN_INTER] THEN
    ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ];
    ASM_SIMP_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_CONNECTED_COMPONENT] THEN
    REWRITE_TAC[CONNECTED_COMPONENT_OVERLAP] THEN
    STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
    ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ]]);;

let PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT = prove
 (`!s x:real^N. (path_component s x) SUBSET (connected_component s x)`,
  REWRITE_TAC[GSYM PATH_COMPONENT_OF_EUCLIDEAN;
              GSYM CONNECTED_COMPONENT_OF_EUCLIDEAN] THEN
  REWRITE_TAC[PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT_OF]);;

let PATH_COMPONENT_EQ_CONNECTED_COMPONENT = prove
 (`!s x:real^N.
        locally path_connected s
        ==> (path_component s x = connected_component s x)`,
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[GSYM PATH_COMPONENT_OF_EUCLIDEAN;
              GSYM CONNECTED_COMPONENT_OF_EUCLIDEAN] THEN
  MATCH_MP_TAC PATH_COMPONENT_EQ_CONNECTED_COMPONENT_OF THEN
  ASM_REWRITE_TAC[LOCALLY_PATH_CONNECTED_SPACE_SUBTOPOLOGY_EUCLIDEAN]);;

let PATH_COMPONENT_IMP_CONNECTED_COMPONENT = prove
 (`!s a b:real^N. path_component s a b ==> connected_component s a b`,
  REWRITE_TAC[SET_RULE `(!x. P x ==> Q x) <=> P SUBSET Q`] THEN
  REWRITE_TAC[PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT; ETA_AX]);;

let LOCALLY_PATH_CONNECTED_PATH_COMPONENT = prove
 (`!s x:real^N.
        locally path_connected s
        ==> locally path_connected (path_component s x)`,
  MESON_TAC[LOCALLY_PATH_CONNECTED_CONNECTED_COMPONENT;
            PATH_COMPONENT_EQ_CONNECTED_COMPONENT]);;

let OPEN_PATH_CONNECTED_COMPONENT = prove
 (`!s x:real^N. open s ==> path_component s x = connected_component s x`,
  SIMP_TAC[PATH_COMPONENT_EQ_CONNECTED_COMPONENT;
  OPEN_IMP_LOCALLY_PATH_CONNECTED]);;

let PATH_CONNECTED_EQ_CONNECTED_LPC = prove
 (`!s. locally path_connected s ==> (path_connected s <=> connected s)`,
  REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT;
              CONNECTED_IFF_CONNECTED_COMPONENT] THEN
  SIMP_TAC[PATH_COMPONENT_EQ_CONNECTED_COMPONENT]);;

let PATH_CONNECTED_EQ_CONNECTED = prove
 (`!s. open s ==> (path_connected s <=> connected s)`,
  SIMP_TAC[PATH_CONNECTED_EQ_CONNECTED_LPC; OPEN_IMP_LOCALLY_PATH_CONNECTED]);;

let CONNECTED_OPEN_PATH_CONNECTED = prove
 (`!s:real^N->bool. open s /\ connected s ==> path_connected s`,
  SIMP_TAC[PATH_CONNECTED_EQ_CONNECTED]);;

let CONNECTED_OPEN_ARC_CONNECTED = prove
 (`!s:real^N->bool.
      open s /\ connected s
      ==> !x y. x IN s /\ y IN s
                ==> x = y \/
                    ?g. arc g /\
                        path_image g SUBSET s /\
                        pathstart g = x /\
                        pathfinish g = y`,
  GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_OPEN_PATH_CONNECTED) THEN
  REWRITE_TAC[PATH_CONNECTED_ARCWISE] THEN
  REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MESON_TAC[]);;

let OPEN_COMPONENTS = prove
 (`!u:real^N->bool s. open u /\ s IN components u ==> open s`,
  REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC (MESON[IN_COMPONENTS;
  ASSUME `s:real^N->bool IN components u`] `?x. s:real^N->bool =
  connected_component u x`) THEN ASM_SIMP_TAC [OPEN_CONNECTED_COMPONENT]);;

let COMPONENTS_OPEN_UNIQUE = prove
 (`!f:(real^N->bool)->bool s.
        (!c. c IN f ==> open c /\ connected c /\ ~(c = {})) /\
        pairwise DISJOINT f /\ UNIONS f = s
        ==> components s = f`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC CONNECTED_DISJOINT_UNIONS_OPEN_UNIQUE THEN
  ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; PAIRWISE_DISJOINT_COMPONENTS] THEN
  ASM_MESON_TAC[OPEN_COMPONENTS; IN_COMPONENTS_NONEMPTY;
                IN_COMPONENTS_CONNECTED; OPEN_UNIONS]);;

let COUNTABLE_OPEN_COMPONENTS = prove
 (`!s:real^N->bool. open s ==> COUNTABLE(components s)`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC COUNTABLE_DISJOINT_OPEN_SUBSETS THEN
  REWRITE_TAC[PAIRWISE_DISJOINT_COMPONENTS] THEN
  ASM_MESON_TAC[OPEN_COMPONENTS]);;

let COUNTABLE_OPEN_CONNECTED_COMPONENTS = prove
 (`!s t:real^N->bool.
        open s ==> COUNTABLE {connected_component s x | x IN t}`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC COUNTABLE_SUBSET THEN
  EXISTS_TAC `{} INSERT components(s:real^N->bool)` THEN
  ASM_SIMP_TAC[COUNTABLE_INSERT; COUNTABLE_OPEN_COMPONENTS] THEN
  REWRITE_TAC[SUBSET; IN_INSERT; components; FORALL_IN_GSPEC] THEN
  REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY] THEN SET_TAC[]);;

let CONTINUOUS_ON_COMPONENTS = prove
 (`!f:real^M->real^N s.
        locally connected s /\ (!c. c IN components s ==> f continuous_on c)
        ==> f continuous_on s`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPONENTS_GEN THEN
  REPEAT STRIP_TAC THEN ASM_SIMP_TAC[OPEN_IN_COMPONENTS_LOCALLY_CONNECTED]);;

let CONTINUOUS_ON_COMPONENTS_EQ = prove
 (`!f s. locally connected s
         ==> (f continuous_on s <=>
              !c. c IN components s ==> f continuous_on c)`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [MESON_TAC[CONTINUOUS_ON_SUBSET; IN_COMPONENTS_SUBSET];
    ASM_MESON_TAC[CONTINUOUS_ON_COMPONENTS]]);;

let CONTINUOUS_ON_COMPONENTS_OPEN = prove
 (`!f:real^M->real^N s.
        open s /\ (!c. c IN components s ==> f continuous_on c)
        ==> f continuous_on s`,
  ASM_MESON_TAC[CONTINUOUS_ON_COMPONENTS; OPEN_IMP_LOCALLY_CONNECTED]);;

let CONTINUOUS_ON_COMPONENTS_OPEN_EQ = prove
 (`!f s. open s
         ==> (f continuous_on s <=>
              !c. c IN components s ==> f continuous_on c)`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [MESON_TAC[CONTINUOUS_ON_SUBSET; IN_COMPONENTS_SUBSET];
    ASM_MESON_TAC[CONTINUOUS_ON_COMPONENTS_OPEN]]);;

let CLOSED_IN_UNION_COMPLEMENT_COMPONENTS = prove
 (`!u s:real^N->bool c.
        locally connected u /\
        closed_in (subtopology euclidean u) s /\ c SUBSET components(u DIFF s)
        ==> closed_in (subtopology euclidean u) (s UNION UNIONS c)`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `s UNION UNIONS c:real^N->bool =
    u DIFF (UNIONS(components(u DIFF s) DIFF c))`
  SUBST1_TAC THENL
   [MATCH_MP_TAC(SET_RULE
     `s SUBSET u /\ u DIFF s = c UNION c' /\ DISJOINT c c'
      ==> s UNION c = u DIFF c'`) THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
    ASM_SIMP_TAC[GSYM UNIONS_UNION; GSYM UNIONS_COMPONENTS; SET_RULE
     `s SUBSET t ==> s UNION (t DIFF s) = t`] THEN
    MATCH_MP_TAC(SET_RULE
     `(!s t. s IN c /\ t IN c' ==> DISJOINT s t)
      ==> DISJOINT (UNIONS c) (UNIONS c')`) THEN
    REWRITE_TAC[IN_DIFF] THEN REPEAT STRIP_TAC THEN
    MP_TAC(ISPEC `(u:real^N->bool) DIFF s`
       PAIRWISE_DISJOINT_COMPONENTS) THEN
    REWRITE_TAC[pairwise] THEN DISCH_THEN MATCH_MP_TAC THEN
    REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN ASM_MESON_TAC[];
    REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_DIFF] THEN
    MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
    MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN
    MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[IN_DIFF] THEN
    X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN
    MATCH_MP_TAC OPEN_IN_TRANS THEN
    EXISTS_TAC `u DIFF s:real^N->bool` THEN CONJ_TAC THENL
     [MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
      EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[];
      ALL_TAC] THEN
    MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_SIMP_TAC[OPEN_IN_REFL]]);;

let CLOSED_UNION_COMPLEMENT_COMPONENTS = prove
 (`!s c. closed s /\ c SUBSET components((:real^N) DIFF s)
         ==> closed(s UNION UNIONS c)`,
  ONCE_REWRITE_TAC[CLOSED_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENTS THEN
  ASM_REWRITE_TAC[LOCALLY_CONNECTED_UNIV]);;

let CLOSED_IN_UNION_COMPLEMENT_COMPONENT = prove
 (`!u s c:real^N->bool.
        locally connected u /\
        closed_in (subtopology euclidean u) s /\
        c IN components(u DIFF s)
        ==> closed_in (subtopology euclidean u) (s UNION c)`,
  REPEAT STRIP_TAC THEN
  GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM UNIONS_1] THEN
  MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENTS THEN
  ASM_REWRITE_TAC[SING_SUBSET]);;

let CLOSED_UNION_COMPLEMENT_COMPONENT = prove
 (`!s c. closed s /\ c IN components((:real^N) DIFF s) ==> closed(s UNION c)`,
  ONCE_REWRITE_TAC[CLOSED_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENT THEN
  ASM_REWRITE_TAC[LOCALLY_CONNECTED_UNIV]);;

let NONSEPARATED_CLOSED_COMPLEMENT_COMPONENTS = prove
 (`!u s:real^N->bool c.
        connected u /\ locally connected u /\
        closed_in (subtopology euclidean u) s /\ ~(s = {}) /\
        c SUBSET components(u DIFF s) /\ ~(c = {})
        ==> ~(s INTER closure(UNIONS c) = {})`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`u:real^N->bool`; `s:real^N->bool`; `c:(real^N->bool)->bool`]
        CLOSED_IN_UNION_COMPLEMENT_COMPONENTS) THEN
  ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[GSYM CLOSURE_OF_SUBSET_EQ] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; UNION_SUBSET] THEN
  DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
  REWRITE_TAC[CLOSURE_OF_UNION] THEN
  MATCH_MP_TAC(SET_RULE
   `DISJOINT t u /\ ~(t SUBSET v) ==> ~(s UNION t SUBSET u UNION v)`) THEN
  CONJ_TAC THENL
   [REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF] THEN
    ASM_SIMP_TAC[SET_RULE `c SUBSET u ==> u INTER c = c`] THEN
    ASM SET_TAC[];
    W(MP_TAC o PART_MATCH (rand o lhand) CLOSURE_OF_SUBSET_EQ o
      rand o snd) THEN
    ASM_REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
    DISCH_THEN SUBST1_TAC THEN DISCH_TAC] THEN
  FIRST_ASSUM(MP_TAC o SPEC `UNIONS c:real^N->bool` o
    GEN_REWRITE_RULE I [CONNECTED_CLOPEN]) THEN
  ASM_REWRITE_TAC[NOT_IMP; DE_MORGAN_THM] THEN REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC OPEN_IN_UNIONS THEN REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I
      [LOCALLY_CONNECTED_OPEN_COMPONENT]) THEN
    EXISTS_TAC `u DIFF (s:real^N->bool)` THEN
    ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN
    ASM SET_TAC[];
    REWRITE_TAC[EMPTY_UNIONS] THEN
    ASM_MESON_TAC[MEMBER_NOT_EMPTY; IN_COMPONENTS_NONEMPTY; SUBSET];
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `s INTER closure c = {}
      ==> c SUBSET closure c /\ s SUBSET u /\ ~(s = {})
          ==>  ~(c = u)`)) THEN
    ASM_SIMP_TAC[CLOSURE_SUBSET; CLOSED_IN_SUBSET]]);;

let COUNTABLE_CONNECTED_COMPONENTS = prove
 (`!s:real^N->bool t.
    locally connected s ==> COUNTABLE {connected_component s x | x IN t}`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`{connected_component s (x:real^N) |x| x IN s}`;
                `s:real^N->bool`] LINDELOF_OPEN_IN) THEN
  ASM_SIMP_TAC[FORALL_IN_GSPEC; OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED;
               UNIONS_CONNECTED_COMPONENT] THEN
  DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
  MATCH_MP_TAC COUNTABLE_SUBSET THEN
  EXISTS_TAC `({}:real^N->bool) INSERT u` THEN
  ASM_REWRITE_TAC[COUNTABLE_INSERT] THEN
  REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_INSERT] THEN
  X_GEN_TAC `x:real^N` THEN REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY] THEN
  DISCH_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`]
    COMPLEMENT_CONNECTED_COMPONENT_UNIONS) THEN
  ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
  REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
  ASM_REWRITE_TAC[IN_DIFF] THEN
  ASM_CASES_TAC `(x:real^N) IN connected_component s x` THENL
   [ALL_TAC; ASM_MESON_TAC[IN; CONNECTED_COMPONENT_REFL]] THEN
  ASM_REWRITE_TAC[] THEN
  SUBGOAL_THEN `(x:real^N) IN UNIONS u` MP_TAC THENL
   [ASM_MESON_TAC[]; ALL_TAC] THEN
  MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN
  MATCH_MP_TAC SUBSET_UNIONS THEN ASM SET_TAC[]);;

let COUNTABLE_PATH_COMPONENTS = prove
 (`!s:real^N->bool t.
    locally path_connected s ==> COUNTABLE {path_component s x | x IN t}`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`{path_component s (x:real^N) |x| x IN s}`;
                `s:real^N->bool`] LINDELOF_OPEN_IN) THEN
  ASM_SIMP_TAC[FORALL_IN_GSPEC; OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED;
               UNIONS_PATH_COMPONENT] THEN
  DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
  MATCH_MP_TAC COUNTABLE_SUBSET THEN
  EXISTS_TAC `({}:real^N->bool) INSERT u` THEN
  ASM_REWRITE_TAC[COUNTABLE_INSERT] THEN
  REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_INSERT] THEN
  X_GEN_TAC `x:real^N` THEN REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY] THEN
  DISCH_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`]
    COMPLEMENT_PATH_COMPONENT_UNIONS) THEN
  ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
  REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
  ASM_REWRITE_TAC[IN_DIFF] THEN
  ASM_CASES_TAC `(x:real^N) IN path_component s x` THENL
   [ALL_TAC; ASM_MESON_TAC[IN; PATH_COMPONENT_REFL]] THEN
  ASM_REWRITE_TAC[] THEN
  SUBGOAL_THEN `(x:real^N) IN UNIONS u` MP_TAC THENL
   [ASM_MESON_TAC[]; ALL_TAC] THEN
  MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN
  MATCH_MP_TAC SUBSET_UNIONS THEN ASM SET_TAC[]);;

let COUNTABLE_COMPONENTS = prove
 (`!s:real^N->bool. locally connected s ==> COUNTABLE(components s)`,
  SIMP_TAC[components; COUNTABLE_CONNECTED_COMPONENTS]);;

let FRONTIER_MINIMAL_SEPARATING_CLOSED = prove
 (`!s c. closed s /\ ~connected((:real^N) DIFF s) /\
         (!t. closed t /\ t PSUBSET s ==> connected((:real^N) DIFF t)) /\
         c IN components ((:real^N) DIFF s)
         ==> frontier c = s`,
  REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o
    GEN_REWRITE_RULE RAND_CONV [CONNECTED_EQ_CONNECTED_COMPONENTS_EQ]) THEN
  DISCH_THEN(MP_TAC o MATCH_MP (MESON[]
   `~(!x x'. x IN s /\ x' IN s ==> x = x')
    ==> !x. x IN s ==> ?y. y IN s /\ ~(y = x)`)) THEN
  DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `frontier c:real^N->bool`) THEN
  REWRITE_TAC[SET_RULE `s PSUBSET t <=> s SUBSET t /\ ~(t SUBSET s)`;
              GSYM SUBSET_ANTISYM_EQ] THEN
  ASM_SIMP_TAC[FRONTIER_OF_COMPONENTS_CLOSED_COMPLEMENT; FRONTIER_CLOSED] THEN
  MATCH_MP_TAC(TAUT `~r ==> (~p ==> r) ==> p`) THEN
  REWRITE_TAC[connected] THEN
  MAP_EVERY EXISTS_TAC [`c:real^N->bool`; `(:real^N) DIFF closure c`] THEN
  REPEAT CONJ_TAC THENL
   [ASM_MESON_TAC[OPEN_COMPONENTS; closed];
    REWRITE_TAC[GSYM closed; CLOSED_CLOSURE];
    MP_TAC(ISPEC `c:real^N->bool` INTERIOR_SUBSET) THEN
    REWRITE_TAC[frontier] THEN SET_TAC[];
    MATCH_MP_TAC(SET_RULE
     `c SUBSET c' ==> c INTER (UNIV DIFF c') INTER s = {}`) THEN
    REWRITE_TAC[GSYM INTERIOR_COMPLEMENT; CLOSURE_SUBSET];
    REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE
     `ci = c /\ ~(c = {})
      ==> ~(c INTER (UNIV DIFF (cc DIFF ci)) = {})`) THEN
    ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY; INTERIOR_OPEN; closed;
                  OPEN_COMPONENTS];
    REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE
     `~(UNIV DIFF c = {})
      ==> ~((UNIV DIFF c) INTER (UNIV DIFF (c DIFF i)) = {})`) THEN
    REWRITE_TAC[GSYM INTERIOR_COMPLEMENT] THEN
    MATCH_MP_TAC(SET_RULE `!t. t SUBSET s /\ ~(t = {}) ==> ~(s = {})`) THEN
    EXISTS_TAC `d:real^N->bool` THEN CONJ_TAC THENL
     [ALL_TAC; ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]] THEN
    MATCH_MP_TAC INTERIOR_MAXIMAL THEN
    REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN
    ASM_MESON_TAC[COMPONENTS_NONOVERLAP; OPEN_COMPONENTS; GSYM closed]]);;

let FRONTIER_MINIMAL_SEPARATING_CLOSED_POINTWISE = prove
 (`!s a b. closed s /\ ~(a IN s) /\
           ~connected_component ((:real^N) DIFF s) a b /\
           (!t. closed t /\ t PSUBSET s
                ==> connected_component((:real^N) DIFF t) a b)
           ==> frontier(connected_component ((:real^N) DIFF s) a) = s`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC(SET_RULE `s SUBSET t /\ ~(s PSUBSET t) ==> s = t`) THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC FRONTIER_OF_COMPONENTS_CLOSED_COMPLEMENT THEN
    ASM_REWRITE_TAC[IN_COMPONENTS; IN_UNIV; IN_DIFF] THEN ASM SET_TAC[];
    DISCH_TAC THEN  FIRST_X_ASSUM(MP_TAC o SPEC
     `frontier (connected_component ((:real^N) DIFF s) a)`) THEN
    ASM_REWRITE_TAC[FRONTIER_CLOSED] THEN
    GEN_REWRITE_TAC RAND_CONV [connected_component] THEN
    DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `t SUBSET UNIV DIFF f ==> ~(t INTER f = {}) ==> F`)) THEN
    MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN
    ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_DIFF] THEN
    CONJ_TAC THENL [EXISTS_TAC `a:real^N`; EXISTS_TAC `b:real^N`] THEN
    ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[IN] THEN
    ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ; IN_UNIV; IN_DIFF]]);;

(* ------------------------------------------------------------------------- *)
(* "Boundary bumping theorems" and relatives.                                *)
(* ------------------------------------------------------------------------- *)

let CONNECTED_COMPONENT_DIFF_NONSEPARATED = prove
 (`!s t c:real^N->bool.
        compact s /\ connected s /\ t SUBSET s /\ ~(t = {}) /\
        c IN components(s DIFF t)
        ==> ~(closure(c) INTER closure(t) = {})`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`s DIFF {x + d | (x:real^N) IN t /\
                                  d IN ball(vec 0,setdist(c,t) / &2)}`;
                 `c:real^N->bool`; `setdist(c:real^N->bool,t) / &2`]
        COMPONENT_CLOPEN_HAUSDIST_EXPLICIT) THEN
  REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; REAL_HALF] THEN
  ABBREV_TAC `t' = {x + d | (x:real^N) IN t /\
                            d IN ball(vec 0,setdist(c,t) / &2)}` THEN
  SUBGOAL_THEN `open(t':real^N->bool)` ASSUME_TAC THENL
   [EXPAND_TAC "t'" THEN SIMP_TAC[OPEN_SUMS; OPEN_BALL]; ALL_TAC] THEN
  SUBGOAL_THEN `compact(s DIFF t':real^N->bool)` ASSUME_TAC THENL
   [MATCH_MP_TAC COMPACT_DIFF THEN ASM_REWRITE_TAC[];
    ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_IMP_LOCALLY_COMPACT]] THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
  MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
   [REWRITE_TAC[SETDIST_POS_LT] THEN
    MP_TAC(ISPECL [`closure c:real^N->bool`; `closure t:real^N->bool`]
        SETDIST_EQ_0_COMPACT_CLOSED) THEN
    ASM_REWRITE_TAC[SETDIST_CLOSURE; CLOSED_CLOSURE; CLOSURE_EQ_EMPTY] THEN
    DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[COMPACT_CLOSURE] THEN
    MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN
    ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN ASM SET_TAC[];
    DISCH_TAC] THEN
  MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
   [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        COMPONENTS_INTERMEDIATE_SUBSET)) THEN
    CONJ_TAC THENL
     [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
       `c SUBSET s DIFF t
        ==> (!x. x IN t' ==> ~(x IN c))
        ==> c SUBSET s DIFF t'`)) THEN
      EXPAND_TAC "t'" THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_BALL_0] THEN
      MAP_EVERY X_GEN_TAC [`x:real^N`; `d:real^N`] THEN
      DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
      ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LT] THEN
      DISCH_TAC THEN
      SUBST1_TAC(NORM_ARITH `norm(d:real^N) = dist(x + d,x)`) THEN
      MATCH_MP_TAC(NORM_ARITH
        `a <= dist(p:real^N,q) ==> a / &2 <= dist(p,q)`) THEN
      MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[];
      MATCH_MP_TAC(SET_RULE `t SUBSET t' ==> s DIFF t' SUBSET s DIFF t`) THEN
      EXPAND_TAC "t'" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
      X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
      MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN
      ASM_REWRITE_TAC[CENTRE_IN_BALL; VECTOR_ADD_RID; REAL_HALF]];
    DISCH_TAC] THEN
  SUBGOAL_THEN `compact(c:real^N->bool)` ASSUME_TAC THENL
   [ASM_MESON_TAC[COMPACT_COMPONENTS]; ASM_REWRITE_TAC[]] THEN
  DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_CLOPEN]) THEN
  DISCH_THEN(MP_TAC o SPEC `k:real^N->bool`) THEN
  ASM_REWRITE_TAC[NOT_IMP; DE_MORGAN_THM] THEN REPEAT CONJ_TAC THENL
   [ALL_TAC;
    MATCH_MP_TAC CLOSED_SUBSET THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SET_TAC[];
    ASM SET_TAC[];
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `t SUBSET s ==> ~(t = {}) /\ DISJOINT t k ==> ~(k = s)`)) THEN
    ASM_REWRITE_TAC[] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `k SUBSET k' ==> (!x. x IN k' ==> ~(x IN t)) ==> DISJOINT t k`)) THEN
    REWRITE_TAC[FORALL_IN_GSPEC; IN_BALL_0] THEN
    MAP_EVERY X_GEN_TAC [`x:real^N`; `d:real^N`] THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LT] THEN
    DISCH_TAC THEN
    SUBST1_TAC(NORM_ARITH `norm(d:real^N) = dist(x,x + d)`) THEN
    MATCH_MP_TAC(NORM_ARITH
      `a <= dist(p:real^N,q) ==> a / &2 <= dist(p,q)`) THEN
    MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[]] THEN
  MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC
   `s INTER {x + d:real^N | x IN c /\ d IN ball(vec 0,setdist(c,t) / &2)}` THEN
  ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_SUMS; OPEN_BALL] THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        OPEN_IN_SUBSET_TRANS)) THEN
  CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MATCH_MP_TAC(SET_RULE
   `(!x. x IN u ==> !y. y IN t ==> ~(x = y))
    ==> s INTER u SUBSET s DIFF t`) THEN
  EXPAND_TAC "t'" THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_BALL_0] THEN
  REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
  MAP_EVERY X_GEN_TAC [`x:real^N`; `d:real^N`; `x':real^N`; `d':real^N`] THEN
  MAP_EVERY ASM_CASES_TAC [`(x:real^N) IN c`; `(x':real^N) IN t`] THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH
   `k <= dist(x:real^N,x')
    ==> norm d < k / &2 ==> norm d' < k / &2 ==> ~(x + d = x' + d')`) THEN
  MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[]);;

let CONNECTED_COMPONENT_DIFF_NONSEPARATED_ALT = prove
 (`!s t c:real^N->bool.
        compact s /\ connected s /\ t PSUBSET s /\ c IN components t
        ==> ~(closure(c) INTER closure(s DIFF t) = {})`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  MATCH_MP_TAC CONNECTED_COMPONENT_DIFF_NONSEPARATED THEN
  EXISTS_TAC `s:real^N->bool` THEN
  ASM_SIMP_TAC[SET_RULE `t PSUBSET s ==> s DIFF (s DIFF t) = t`] THEN
  ASM SET_TAC[]);;

let CONNECTED_COMPONENT_DIFF_CLOSED_NONSEPARATED = prove
 (`!s t c:real^N->bool.
        compact s /\ connected s /\ closed t /\ t SUBSET s /\ ~(t = {}) /\
        c IN components(s DIFF t)
        ==> ~(closure(c) INTER t = {})`,
  MESON_TAC[CONNECTED_COMPONENT_DIFF_NONSEPARATED; CLOSURE_CLOSED]);;

let NONSEPARATED_CLOSED_COMPLEMENT_COMPONENT = prove
 (`!u s c:real^N->bool.
        (compact u \/ locally connected u) /\
        connected u /\
        closed_in (subtopology euclidean u) s /\ ~(s = {}) /\
        c IN components(u DIFF s)
        ==> ~(s INTER closure c = {})`,
  REPEAT GEN_TAC THEN STRIP_TAC THENL
   [ONCE_REWRITE_TAC[INTER_COMM] THEN
    MATCH_MP_TAC CONNECTED_COMPONENT_DIFF_CLOSED_NONSEPARATED THEN
    EXISTS_TAC `u:real^N->bool` THEN
    ASM_REWRITE_TAC[] THEN
    ASM_MESON_TAC[COMPACT_IMP_CLOSED; CLOSED_IN_CLOSED_EQ; CLOSED_IN_SUBSET];
    GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV o RAND_CONV)
     [GSYM UNIONS_1] THEN
    MATCH_MP_TAC NONSEPARATED_CLOSED_COMPLEMENT_COMPONENTS THEN
    EXISTS_TAC `u:real^N->bool` THEN
    ASM_REWRITE_TAC[NOT_INSERT_EMPTY; SING_SUBSET]]);;

let CONNECTED_EQ_NONSEPARATED_CLOSED_COMPLEMENT_COMPONENT = prove
 (`!u s:real^N->bool.
        (compact u \/ locally connected u) /\
        closed_in (subtopology euclidean u) s /\
        connected s /\
        ~(s = {})
        ==> (connected u <=>
             !c. c IN components(u DIFF s) ==> ~(s INTER closure c = {}))`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
  ASM_CASES_TAC `u:real^N->bool = s` THEN
  ASM_REWRITE_TAC[DIFF_EQ_EMPTY; COMPONENTS_EMPTY; NOT_IN_EMPTY] THEN
  EQ_TAC THEN DISCH_TAC THENL
   [ASM_MESON_TAC[NONSEPARATED_CLOSED_COMPLEMENT_COMPONENT]; ALL_TAC] THEN
  SUBGOAL_THEN
   `u = UNIONS {c UNION s:real^N->bool |c| c IN components(u DIFF s)}`
  SUBST1_TAC THENL
   [FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
    TRANS_TAC EQ_TRANS `UNIONS(components(u DIFF s)) UNION s:real^N->bool` THEN
    CONJ_TAC THENL
     [REWRITE_TAC[GSYM UNIONS_COMPONENTS] THEN ASM SET_TAC[];
      SUBGOAL_THEN `~(components(u DIFF s:real^N->bool) = {})` MP_TAC THENL
       [REWRITE_TAC[COMPONENTS_EQ_EMPTY] THEN ASM SET_TAC[]; ALL_TAC] THEN
      ONCE_REWRITE_TAC[EXTENSION] THEN
      REWRITE_TAC[NOT_IN_EMPTY; UNIONS_GSPEC] THEN
      REWRITE_TAC[IN_UNION; IN_UNIONS; IN_ELIM_THM] THEN MESON_TAC[]];
    MATCH_MP_TAC CONNECTED_UNIONS THEN CONJ_TAC THENL
     [REWRITE_TAC[FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN
      MATCH_MP_TAC CONNECTED_UNION_STRONG THEN
      ASM_MESON_TAC[IN_COMPONENTS_CONNECTED; INTER_COMM];
      REWRITE_TAC[INTERS_GSPEC] THEN ASM SET_TAC[]]]);;

let CONNECTED_EQ_COMPONENT_DIFF_CLOSED_NONSEPARATED = prove
 (`!s:real^N->bool t.
        compact s /\ closed t /\ connected t /\ t SUBSET s /\ ~(t = {})
        ==> (connected s <=>
             !c. c IN components (s DIFF t) ==> ~(closure c INTER t = {}))`,
  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[INTER_COMM] THEN
  MATCH_MP_TAC CONNECTED_EQ_NONSEPARATED_CLOSED_COMPLEMENT_COMPONENT THEN
  ASM_MESON_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED]);;

let CONNECTED_EQ_COMPONENT_DELETE_NONSEPARATED = prove
 (`!s:real^N->bool a:real^N.
        (compact s \/ locally connected s \/ FINITE(components(s DELETE a))) /\
        a IN s
        ==> (connected s <=>
             !c. c IN components (s DELETE a) ==> a IN closure c)`,
  REWRITE_TAC[DISJ_ASSOC] THEN REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN EQ_TAC THEN DISCH_TAC THENL
   [FIRST_X_ASSUM DISJ_CASES_TAC THENL
     [MP_TAC(ISPECL [`s:real^N->bool`; `{a:real^N}`]
        CONNECTED_EQ_NONSEPARATED_CLOSED_COMPLEMENT_COMPONENT) THEN
      ASM_REWRITE_TAC[CLOSED_IN_SING; CONNECTED_SING; NOT_INSERT_EMPTY] THEN
      REWRITE_TAC[SET_RULE `s DIFF {a} = s DELETE a`] THEN
      REWRITE_TAC[SET_RULE `~({a} INTER s = {}) <=> a IN s`];
      REPEAT STRIP_TAC THEN UNDISCH_TAC `connected(s:real^N->bool)` THEN
      GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
      REWRITE_TAC[GSYM CONNECTED_IN_EUCLIDEAN] THEN
      REWRITE_TAC[CONNECTED_IN_EQ_NOT_SEPARATED] THEN
      REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN MAP_EVERY EXISTS_TAC
       [`c:real^N->bool`;
        `{a:real^N} UNION UNIONS (components(s DELETE a) DELETE c)`] THEN
      REWRITE_TAC[NOT_INSERT_EMPTY; EMPTY_UNION] THEN REPEAT CONJ_TAC THENL
       [ASM_SIMP_TAC[GSYM IN_COMPONENTS_UNIONS_COMPLEMENT] THEN
        FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
        ASM SET_TAC[];
        ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY];
        REWRITE_TAC[SEPARATED_IN_UNION] THEN
        ASM_SIMP_TAC[SEPARATED_IN_UNIONS; FINITE_DELETE] THEN
        ASM_SIMP_TAC[SEPARATED_IN_SING; T1_SPACE_EUCLIDEAN] THEN
        REWRITE_TAC[TOPSPACE_EUCLIDEAN; IN_UNIV; SUBSET_UNIV] THEN
        ASM_REWRITE_TAC[IN_DELETE; EUCLIDEAN_CLOSURE_OF] THEN
        MP_TAC(ISPEC `s DELETE (a:real^N)` PAIRWISE_SEPARATED_COMPONENTS) THEN
        REWRITE_TAC[pairwise] THEN ASM_SIMP_TAC[]]];
    SUBGOAL_THEN
     `s = {a} UNION
          UNIONS {(a:real^N) INSERT c |c| c IN components(s DELETE a)}`
    SUBST1_TAC THENL
     [MP_TAC(ISPEC `s DELETE (a:real^N)` UNIONS_COMPONENTS) THEN
      REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[];
      REWRITE_TAC[GSYM UNIONS_INSERT]] THEN
    MATCH_MP_TAC CONNECTED_UNIONS THEN
    REWRITE_TAC[FORALL_IN_INSERT; CONNECTED_SING] THEN
    REWRITE_TAC[FORALL_IN_GSPEC; GSYM MEMBER_NOT_EMPTY] THEN
    CONJ_TAC THENL
     [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED; CONNECTED_INSERT];
      EXISTS_TAC `a:real^N` THEN
      REWRITE_TAC[INTERS_INSERT; IN_INTER; IN_SING] THEN
      REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM] THEN ASM SET_TAC[]]]);;

let CONNECTED_INSERT_COMPACT = prove
 (`!s:real^N->bool a:real^N.
        compact(a INSERT s)
        ==> (connected(a INSERT s) <=>
             !c. c IN components s ==> a IN closure c)`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THENL
   [FIRST_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE `a IN s ==> ~(s = {})`)) THEN
    ASM_SIMP_TAC[SET_RULE `a IN s ==> a INSERT s = s`] THEN EQ_TAC THENL
     [DISCH_TAC THEN
      MP_TAC(ISPEC `s:real^N->bool` COMPONENTS_EQ_SING) THEN
      ASM_SIMP_TAC[IN_SING; CLOSURE_INC];
      DISCH_TAC THEN GEN_REWRITE_TAC RAND_CONV [UNIONS_COMPONENTS] THEN
      MATCH_MP_TAC CONNECTED_UNIONS THEN
      REWRITE_TAC[IN_COMPONENTS_CONNECTED] THEN
      REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTERS] THEN
      EXISTS_TAC `a:real^N` THEN
      X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN
      FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_COMPONENT) THEN
      ASM_REWRITE_TAC[CLOSED_IN_INTER_CLOSURE] THEN ASM SET_TAC[]];
    MP_TAC(ISPECL [`(a:real^N) INSERT s`; `a:real^N`]
        CONNECTED_EQ_COMPONENT_DELETE_NONSEPARATED) THEN
    ASM_REWRITE_TAC[IN_INSERT] THEN
    ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> (a INSERT s) DELETE a = s`]]);;

let BOUNDARY_BUMPING_THEOREM_EUCLIDEAN = prove
 (`!s t c:real^N->bool.
        compact s /\ connected s /\ t PSUBSET s /\ c IN components t
        ==> ~(closure(c) INTER closure(t) INTER closure(s DIFF t) = {})`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  MATCH_MP_TAC(SET_RULE
   `~(c INTER s = {}) /\ c SUBSET t
    ==> ~(c INTER t INTER s = {})`) THEN
  ASM_SIMP_TAC[CONNECTED_COMPONENT_DIFF_NONSEPARATED_ALT;
               SUBSET_CLOSURE; IN_COMPONENTS_SUBSET]);;

let BOUNDARY_BUMPING_THEOREM_EUCLIDEAN_CLOSED = prove
 (`!s t c:real^N->bool.
      compact s /\ connected s /\ closed t /\ t PSUBSET s /\ c IN components t
      ==> ~(c INTER closure t INTER closure(s DIFF t) = {})`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`; `c:real^N->bool`]
        BOUNDARY_BUMPING_THEOREM_EUCLIDEAN) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        CLOSED_COMPONENTS)) THEN
  ASM_SIMP_TAC[CLOSURE_CLOSED]);;

let BOUNDARY_BUMPING_THEOREM_EUCLIDEAN_ALT = prove
 (`!s t c:real^N->bool.
      compact s /\ connected s /\ open_in (subtopology euclidean s) t /\
      t PSUBSET s /\ c IN components(closure t)
      ==> ~(c INTER (s DIFF t) = {})`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `closure t:real^N->bool = s` THENL
   [REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    MP_TAC(snd(EQ_IMP_RULE(ISPEC `s:real^N->bool` COMPONENTS_EQ_SING))) THEN
    ASM_REWRITE_TAC[] THEN
    ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN
    REWRITE_TAC[IN_SING] THEN ASM SET_TAC[];
    STRIP_TAC] THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `closure t:real^N->bool`; `c:real^N->bool`]
        BOUNDARY_BUMPING_THEOREM_EUCLIDEAN_CLOSED) THEN
  ASM_REWRITE_TAC[CLOSED_CLOSURE] THEN ANTS_TAC THENL
   [ASM_REWRITE_TAC[PSUBSET] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN
    ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  MATCH_MP_TAC(SET_RULE
   `s SUBSET u ==> ~(c INTER t INTER s = {}) ==> ~(c INTER u = {})`) THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
  DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
  ASM_REWRITE_TAC[SET_RULE
   `k SUBSET s DIFF (s INTER u) <=> k SUBSET s /\ u INTER k = {}`] THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN
    SET_TAC[];
    ASM_SIMP_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY] THEN
    MP_TAC(ISPEC `s INTER u:real^N->bool` CLOSURE_SUBSET) THEN
    SET_TAC[]]);;

let BOUNDARY_BUMPING_THEOREM_EUCLIDEAN_OPEN = prove
 (`!s t c:real^N->bool.
      (compact s \/ locally connected s) /\
      connected s /\
      open_in (subtopology euclidean s) t /\
      t PSUBSET s /\ c IN components t
      ==> ~(closure c INTER (s DIFF t) = {})`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
  ONCE_REWRITE_TAC[INTER_COMM] THEN
  MATCH_MP_TAC NONSEPARATED_CLOSED_COMPLEMENT_COMPONENT THEN
  EXISTS_TAC `s:real^N->bool` THEN
  ASM_SIMP_TAC[ISPEC `euclidean` OPEN_IN_IMP_SUBSET;
               CLOSED_IN_DIFF; CLOSED_IN_REFL;
               SET_RULE `t SUBSET s ==> (s DIFF t = {} <=> ~(t PSUBSET s))`;
               SET_RULE `t SUBSET s ==> s DIFF (s DIFF t) = t`]);;

let BOUNDARY_BUMPING_THEOREM_EUCLIDEAN_OPEN_ALT = prove
 (`!s t c:real^N->bool.
      (compact s \/ locally connected s) /\
      connected s /\ open_in (subtopology euclidean s) t /\
      t PSUBSET s /\ c IN components t
      ==> ~(closure c INTER (closure t DIFF t) = {})`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDARY_BUMPING_THEOREM_EUCLIDEAN_OPEN) THEN
  MATCH_MP_TAC(SET_RULE
   `c SUBSET t'
    ==> ~(c INTER (s DIFF t) = {}) ==> ~(c INTER (t' DIFF t) = {})`) THEN
  ASM_SIMP_TAC[SUBSET_CLOSURE; IN_COMPONENTS_SUBSET]);;

let CONTINUUM_UNION_COMPONENTS_INTERMEDIATE_COMPLEMENT = prove
 (`!s t u c:real^N->bool.
        compact s /\ connected s /\ compact t /\ s SUBSET t /\
        compact u /\ connected u /\ t SUBSET u /\
        c IN components(u DIFF t) /\ closure c DIFF c SUBSET s
        ==> compact(c UNION s) /\ connected(c UNION s)`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL
   [ASM_SIMP_TAC[DIFF_EMPTY; SUBSET_EMPTY; UNION_EMPTY] THEN
    MESON_TAC[COMPACT_COMPONENTS; IN_COMPONENTS_CONNECTED];
    STRIP_TAC] THEN
  MP_TAC(ISPECL [`u:real^N->bool`; `u DIFF t:real^N->bool`; `c:real^N->bool`]
        BOUNDARY_BUMPING_THEOREM_EUCLIDEAN_OPEN) THEN
  ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
   [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
    MATCH_MP_TAC CLOSED_SUBSET THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN
    ASM SET_TAC[];
    ASM_SIMP_TAC[SET_RULE `t SUBSET u ==> u DIFF (u DIFF t) = t`]] THEN
  DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
  SUBGOAL_THEN `c UNION s:real^N->bool = closure c UNION s` SUBST1_TAC THENL
   [MP_TAC(ISPEC `c:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[];
    ALL_TAC] THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC COMPACT_UNION THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[COMPACT_CLOSURE] THEN MATCH_MP_TAC BOUNDED_SUBSET THEN
    EXISTS_TAC `u:real^N->bool` THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN
    ASM SET_TAC[];
    MATCH_MP_TAC CONNECTED_UNION THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN
    ASM_SIMP_TAC[CONNECTED_CLOSURE] THEN ASM SET_TAC[]]);;

let CONTINUUM_UNION_COMPONENTS_COMPLEMENT = prove
 (`!s u c:real^N->bool.
        compact s /\ connected s /\ compact u /\ connected u /\ s SUBSET u /\
        c IN components(u DIFF s) /\ closure c DIFF c SUBSET s
        ==> compact(c UNION s) /\ connected(c UNION s)`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  MATCH_MP_TAC CONTINUUM_UNION_COMPONENTS_INTERMEDIATE_COMPLEMENT THEN
  MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `u:real^N->bool`] THEN
  ASM_REWRITE_TAC[SUBSET_REFL]);;

(* ------------------------------------------------------------------------- *)
(* More compact component properties via the notion of "well-chained".       *)
(* ------------------------------------------------------------------------- *)

let WELLCHAINED_ELEMENTS = prove
 (`!s:real^N->bool a b e.
        (?p n. p 0 = a /\ p n = b /\
               (!i. i <= n ==> p i IN s) /\
               (!i. i < n ==> dist(p i,p(SUC i)) < e)) <=>
        a IN s /\ b IN s /\
        (!c. c SUBSET s /\ a IN c /\
             (!x y. x IN c /\ y IN s /\ dist(x,y) < e ==> y IN c)
             ==> b IN c)`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `(a:real^N) IN s` THENL
   [ALL_TAC; ASM_MESON_TAC[LE_0]] THEN
  ASM_CASES_TAC `(b:real^N) IN s` THENL
   [ALL_TAC; ASM_MESON_TAC[LE_REFL]] THEN
  ASM_REWRITE_TAC[] THEN EQ_TAC THENL
   [REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`p:num->real^N`; `n:num`] THEN STRIP_TAC THEN
    X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN
    SUBGOAL_THEN `!k. k <= n ==> (p:num->real^N) k IN c`
     (fun th -> ASM_MESON_TAC[th; LE_REFL]) THEN
    INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `(p:num->real^N) k` THEN
    REPEAT CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
    DISCH_THEN(MP_TAC o SPEC
     `{x:real^N | ?p n. p 0 = a /\ p n = x /\
                        (!i. i <= n ==> p i IN s) /\
                        (!i. i < n ==> dist(p i,p(SUC i)) < e)}`) THEN
    ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[IN_ELIM_THM]] THEN
    REPEAT CONJ_TAC THENL
     [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[LE_REFL];
      REWRITE_TAC[IN_ELIM_THM] THEN
      MAP_EVERY EXISTS_TAC [`(\n. a):num->real^N`; `0`] THEN
      ASM_REWRITE_TAC[LT];
      MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
      DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
      REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
      MAP_EVERY X_GEN_TAC [`p:num->real^N`; `n:num`] THEN STRIP_TAC THEN
      EXISTS_TAC `\i. if i <= n then (p:num->real^N) i else y` THEN
      EXISTS_TAC `SUC n` THEN
      ASM_REWRITE_TAC[LE_0; ARITH_RULE `~(SUC n <= n)`] THEN
      REWRITE_TAC[LE; LT; TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`;
                  FORALL_AND_THM; FORALL_UNWIND_THM2] THEN
      REWRITE_TAC[LE_REFL; LE_SUC_LT; LT_REFL] THEN
      ASM_SIMP_TAC[LT_IMP_LE]]]);;

let WELLCHAINED_SETS = prove
 (`!s:real^N->bool e.
     (!a b. a IN s /\ b IN s
            ==> ?p n. p 0 = a /\ p n = b /\
                      (!i. i <= n ==> p i IN s) /\
                      (!i. i < n ==> dist(p i,p(SUC i)) < e)) <=>
     (!c. c SUBSET s /\ ~(c = {}) /\
          (!x y. x IN c /\ y IN s /\ dist(x,y) < e ==> y IN c) ==> c = s)`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[WELLCHAINED_ELEMENTS] THEN SIMP_TAC[] THEN
  REWRITE_TAC[MESON[]
   `(!a b. P a /\ P b ==> !c. Q a b c ==> R a b c) <=>
    (!c a b. Q a b c /\ P a /\ P b ==> R a b c)`] THEN
  AP_TERM_TAC THEN ABS_TAC THEN
  SIMP_TAC[GSYM MEMBER_NOT_EMPTY; GSYM SUBSET_ANTISYM_EQ] THEN
  REWRITE_TAC[SUBSET] THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
  MESON_TAC[]);;

let CONNECTED_IMP_WELLCHAINED = prove
 (`!s e a b:real^N.
        connected s /\ &0 < e /\ a IN s /\ b IN s
        ==> ?p n. p 0 = a /\ p n = b /\
                  (!i. i <= n ==> p i IN s) /\
                  (!i. i < n ==> dist(p i,p(SUC i)) < e)`,
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
  REPLICATE_TAC 2 (GEN_TAC THEN DISCH_TAC) THEN
  REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN
  REWRITE_TAC[WELLCHAINED_SETS] THEN
  REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SET_RULE
    `c SUBSET s /\ ~(c = {})
     ==> (c = s <=> !a b. a IN s /\ b IN s /\ a IN c ==> b IN c)`] THEN
  MATCH_MP_TAC CONNECTED_INDUCTION_SIMPLE THEN ASM_REWRITE_TAC[] THEN
  X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
  EXISTS_TAC `s INTER ball(a:real^N,e / &2)` THEN
  ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL; REAL_HALF] THEN
  ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN REWRITE_TAC[IN_BALL] THEN
  ASM_MESON_TAC[NORM_ARITH
   `dist(a:real^N,x) < e / &2 /\ dist(a,y) < e / &2 ==> dist(x,y) < e`]);;

let CONNECTED_EQ_WELLCHAINED = prove
 (`!s:real^N->bool.
        compact s
        ==> (connected s <=>
             !e a b. &0 < e /\ a IN s /\ b IN s
                     ==> ?p n. p 0 = a /\ p n = b /\
                               (!i. i <= n ==> p i IN s) /\
                               (!i. i < n ==> dist(p i,p(SUC i)) < e))`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_IMP_WELLCHAINED THEN
    ASM_MESON_TAC[];
    ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM]] THEN
  REWRITE_TAC[WELLCHAINED_SETS] THEN DISCH_TAC THEN
  ASM_CASES_TAC `connected(s:real^N->bool)` THENL
   [ASM_REWRITE_TAC[]; REWRITE_TAC[CONNECTED_CLOSED_IN_EQ]] THEN
  UNDISCH_TAC `compact(s:real^N->bool)` THEN
  SIMP_TAC[CLOSED_IN_COMPACT_EQ] THEN
  DISCH_TAC THEN REWRITE_TAC[NOT_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`k1:real^N->bool`; `k2:real^N->bool`] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN `?a:real^N. a IN k1` STRIP_ASSUME_TAC THENL
   [ASM SET_TAC[]; ALL_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `setdist(k1:real^N->bool,k2)`) THEN
  REWRITE_TAC[NOT_IMP; SETDIST_POS_LT] THEN
  ASM_SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; COMPACT_IMP_CLOSED] THEN
  DISCH_THEN(MP_TAC o SPEC `k1:real^N->bool`) THEN
  ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> p /\ q /\ ~s ==> ~r`] THEN
  REWRITE_TAC[REAL_NOT_LT; GSYM IN_DIFF] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SETDIST_LE_DIST THEN ASM SET_TAC[]);;

let WELLCHAINED_INTERS = prove
 (`!s:num->(real^N->bool) d e.
      d < e /\
      (!m. compact (s m)) /\
      (!m. s(SUC m) SUBSET s m) /\
      (!m a b.
           a IN s m /\ b IN s m
           ==> ?p n. p 0 = a /\ p n = b /\
                      (!i. i <= n ==> p i IN s m) /\
                      (!i. i < n ==> dist(p i,p (SUC i)) < d))
      ==> !a b. a IN INTERS {s m | m IN (:num)} /\
                b IN INTERS {s m | m IN (:num)}
                ==> ?p n. p 0 = a /\ p n = b /\
                          (!i. i <= n ==> p i IN INTERS {s m | m IN (:num)}) /\
                          (!i. i < n ==> dist(p i,p (SUC i)) < e)`,
  REWRITE_TAC[WELLCHAINED_SETS] THEN
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  ABBREV_TAC `k:real^N->bool = INTERS {s m | m IN (:num)}` THEN
  ASM_CASES_TAC `k:real^N->bool = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN
  SUBGOAL_THEN `compact(k:real^N->bool)` ASSUME_TAC THENL
   [EXPAND_TAC "k" THEN MATCH_MP_TAC COMPACT_INTERS THEN ASM SET_TAC[];
    ALL_TAC] THEN
  REWRITE_TAC[GSYM WELLCHAINED_SETS] THEN
  MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN
  MP_TAC(ISPEC `s:num->real^N->bool` HAUSDIST_COMPACT_INTERS_LIMIT) THEN
  ASM_REWRITE_TAC[LIM_SEQUENTIALLY; DIST_0] THEN
  DISCH_THEN(MP_TAC o SPEC `(e - d) / &2`) THEN
  ASM_REWRITE_TAC[REAL_SUB_LT; REAL_HALF; NORM_LIFT] THEN
  DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
  REWRITE_TAC[LE_REFL; real_abs; HAUSDIST_POS_LE] THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `a:real^N`; `b:real^N`] o
    GEN_REWRITE_RULE BINDER_CONV [GSYM WELLCHAINED_SETS]) THEN
  ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
  X_GEN_TAC `m:num` THEN
  DISCH_THEN(X_CHOOSE_THEN `p:num->real^N` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN
   `!i. ?y. i <= m ==> y IN k /\ dist((p:num->real^N) i,y) <= (e - d) / &2`
  MP_TAC THENL
   [X_GEN_TAC `j:num` THEN
    REWRITE_TAC[RIGHT_EXISTS_IMP_THM] THEN DISCH_TAC THEN
    MP_TAC(ISPECL [`(s:num->real^N->bool) n`; `k:real^N->bool`]
        HAUSDIST_COMPACT_EXISTS) THEN
    ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN
    DISCH_THEN(MP_TAC o SPEC `(p:num->real^N) j`) THEN ASM_SIMP_TAC[] THEN
    MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN ASM_REAL_ARITH_TAC;
    REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN
  X_GEN_TAC `q:num->real^N` THEN DISCH_TAC THEN
  EXISTS_TAC `\i. if 0 < i /\ i < m then (q:num->real^N) i else p i` THEN
  ASM_SIMP_TAC[LT_REFL] THEN CONJ_TAC THEN X_GEN_TAC `i:num` THENL
   [ASM_CASES_TAC `i = 0` THEN ASM_REWRITE_TAC[LT_REFL] THEN
    ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[LT_REFL] THEN
    REPEAT DISCH_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[]) THEN
    ASM_ARITH_TAC;
    ASM_CASES_TAC `i = 0` THEN ASM_SIMP_TAC[LE_1; LT_0; LT_REFL] THEN
    SIMP_TAC[ARITH_RULE `i < m ==> (SUC i < m <=> ~(SUC i = m))`] THEN
    REWRITE_TAC[COND_SWAP] THEN DISCH_TAC THEN COND_CASES_TAC THEN
    ASM_REWRITE_TAC[] THENL
     [ASM_MESON_TAC[REAL_LT_TRANS];
      MATCH_MP_TAC(NORM_ARITH
       `dist(a:real^N,p(SUC 0)) < d /\ dist(p(SUC 0),q(SUC 0)) <= (e - d) / &2
        ==> dist(a,q(SUC 0)) < e`) THEN
      ASM_MESON_TAC[ARITH_RULE `0 < m ==> SUC 0 <= m`];
      MATCH_MP_TAC(NORM_ARITH
       `dist((p:num->real^N) i,b) < d /\ dist(p i,q i) <= (e - d) / &2
        ==> dist(q i,b) < e`) THEN
      ASM_MESON_TAC[LT_IMP_LE];
      MATCH_MP_TAC(NORM_ARITH
       `dist(p i:real^N,p(SUC i)) < d /\
        dist(p i,q i) <= (e - d) / &2 /\
        dist(p(SUC i),q(SUC i)) <= (e - d) / &2
        ==> dist(q i,q(SUC i)) < e`) THEN
      ASM_MESON_TAC[LT_IMP_LE; ARITH_RULE
       `i < m /\ ~(SUC i = m) ==> SUC i <= m`]]]);;

let CONNECTED_COMPONENT_IMP_WELLCHAINED = prove
 (`!s a b:real^N e.
        &0 < e /\ connected_component s a b
        ==> ?p n. p 0 = a /\ p n = b /\
                  (!i. i <= n ==> p i IN s) /\
                  (!i. i < n ==> dist(p i,p (SUC i)) < e)`,
  REPEAT STRIP_TAC THEN MP_TAC(ISPECL
   [`connected_component s (a:real^N)`; `e:real`; `a:real^N`; `b:real^N`]
   CONNECTED_IMP_WELLCHAINED) THEN
  ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN ANTS_TAC THENL
   [REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
    ASM_MESON_TAC[CONNECTED_COMPONENT_IN];
    REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN MP_TAC
     (ISPECL [`s:real^N->bool`; `a:real^N`] CONNECTED_COMPONENT_SUBSET) THEN
    ASM SET_TAC[]]);;

let CONNECTED_COMPONENT_EQ_WELLCHAINED = prove
 (`!s a b:real^N.
        compact s
        ==> (connected_component s a b <=>
             a IN s /\ b IN s /\
             !e. &0 < e
                 ==> ?p n. p 0 = a /\ p n = b /\
                           (!i. i <= n ==> p i IN s) /\
                           (!i. i < n ==> dist(p i,p (SUC i)) < e))`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL
   [FIRST_ASSUM(ASSUME_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN
    ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
    MATCH_MP_TAC CONNECTED_COMPONENT_IMP_WELLCHAINED THEN ASM_MESON_TAC[];
    ALL_TAC] THEN
  ABBREV_TAC
  `t = \k. {x | (x:real^N) IN s /\
                ?p n. p 0 = a /\ p n = x /\
                      (!i. i <= n ==> p i IN s) /\
                      (!i. i < n ==> dist(p i,p(SUC i)) < inv(&k + &1))}` THEN
  REWRITE_TAC[connected_component] THEN
  EXISTS_TAC `INTERS {t k | k IN (:num)}:real^N->bool` THEN
  REPEAT CONJ_TAC THENL
   [ALL_TAC;
    EXPAND_TAC "t" THEN REWRITE_TAC[INTERS_GSPEC] THEN SET_TAC[];
    EXPAND_TAC "t" THEN REWRITE_TAC[INTERS_GSPEC] THEN
    ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN X_GEN_TAC `j:num` THEN
    EXISTS_TAC `(\n. a):num->real^N` THEN
    ASM_REWRITE_TAC[DIST_REFL; REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`];
    EXPAND_TAC "t" THEN REWRITE_TAC[INTERS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN
    X_GEN_TAC `j:num` THEN ASM_REWRITE_TAC[] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    ASM_REWRITE_TAC[DIST_REFL; REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`]] THEN
  W(MP_TAC o PART_MATCH (lhand o rand) CONNECTED_EQ_WELLCHAINED o snd) THEN
  SUBGOAL_THEN `!n. compact((t:num->real^N->bool) n)` ASSUME_TAC THENL
   [GEN_TAC THEN MATCH_MP_TAC CLOSED_IN_COMPACT THEN
    EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
    EXPAND_TAC "t" THEN REWRITE_TAC[SUBSET_RESTRICT] THEN
    REWRITE_TAC[open_in; SET_RULE `s DIFF t SUBSET s`] THEN
    X_GEN_TAC `x:real^N` THEN REWRITE_TAC[DIFF; IN_ELIM_THM] THEN
    ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN
    DISCH_TAC THEN EXISTS_TAC `inv(&n + &1)` THEN
    REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
    X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN
    REWRITE_TAC[CONTRAPOS_THM; LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`p:num->real^N`; `m:num`] THEN STRIP_TAC THEN
    EXISTS_TAC `\j. if j <= m then (p:num->real^N) j else x` THEN
    EXISTS_TAC `SUC m` THEN
    ASM_REWRITE_TAC[LE_0; ARITH_RULE `~(SUC m <= m)`] THEN
    REWRITE_TAC[LE_SUC_LT; LT; LE] THEN
    CONJ_TAC THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN
    ASM_SIMP_TAC[LT_IMP_LE; ARITH_RULE `~(SUC m <= m)`; LE_REFL; LT_REFL];
    ALL_TAC] THEN
  ANTS_TAC THENL
   [MATCH_MP_TAC COMPACT_INTERS THEN
    ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN SET_TAC[];
    DISCH_THEN SUBST1_TAC] THEN
  SUBGOAL_THEN `!n. t(SUC n):real^N->bool SUBSET t n` ASSUME_TAC THENL
   [EXPAND_TAC "t" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
    REPEAT GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN
    REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
    REPEAT(MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[]) THEN
    MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
    MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LT_TRANS) THEN
    MATCH_MP_TAC REAL_LT_INV2 THEN
    REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN ARITH_TAC;
    ALL_TAC] THEN
  X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
  MP_TAC(SPEC `e / &2` ARCH_EVENTUALLY_INV1) THEN
  ASM_REWRITE_TAC[REAL_HALF; EVENTUALLY_SEQUENTIALLY] THEN
  DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN
  SUBGOAL_THEN
   `INTERS {t n | n IN (:num)}:real^N->bool =
    INTERS {t(N + n) | n IN (:num)}`
  SUBST1_TAC THENL
   [REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN CONJ_TAC THENL
     [SET_TAC[]; ALL_TAC] THEN
    REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN
    SUBGOAL_THEN
     `!m n. m <= n ==> (t:num->real^N->bool) n SUBSET t m`
     (fun th -> MESON_TAC[th; LE_ADD; ADD_SYM; SUBSET]) THEN
    MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN SET_TAC[];
    ALL_TAC] THEN
  MATCH_MP_TAC WELLCHAINED_INTERS THEN EXISTS_TAC `e / &2` THEN
  CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[ADD_CLAUSES]] THEN
  MAP_EVERY X_GEN_TAC [`m:num`; `x:real^N`; `y:real^N`] THEN
  EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN
  MAP_EVERY ASM_CASES_TAC [`(x:real^N) IN s`; `(y:real^N) IN s`] THEN
  ASM_REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`p1:num->real^N`; `n1:num`] THEN REPEAT DISCH_TAC THEN
  MAP_EVERY X_GEN_TAC [`p2:num->real^N`; `n2:num`] THEN REPEAT DISCH_TAC THEN
  EXISTS_TAC
   `\j. if j <= n1 then (p1:num->real^N) (n1 - j) else p2(j - n1)` THEN
  EXISTS_TAC `n1 + n2:num` THEN
  ASM_REWRITE_TAC[LE_0; SUB_0; ADD_SUB2; ARITH_RULE `n - (n + m) = 0`] THEN
  REPEAT CONJ_TAC THENL
   [REWRITE_TAC[ARITH_RULE `n1 + n2 <= n1 <=> n2 = 0`] THEN ASM_MESON_TAC[];
    X_GEN_TAC `i:num` THEN DISCH_TAC THEN
    ASM_CASES_TAC `(i:num) <= n1` THEN ASM_REWRITE_TAC[] THEN
    (CONJ_TAC THENL
      [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC])
    THENL
     [MAP_EVERY EXISTS_TAC [`p1:num->real^N`; `n1 - i:num`];
      MAP_EVERY EXISTS_TAC [`p2:num->real^N`; `i - n1:num`]] THEN
    ASM_REWRITE_TAC[] THEN
    REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
    X_GEN_TAC `i:num` THEN DISCH_TAC THEN
    ASM_CASES_TAC `SUC i <= n1` THEN
    ASM_SIMP_TAC[ARITH_RULE `SUC i <= n ==> i <= n`] THENL
     [ASM_SIMP_TAC[ARITH_RULE `SUC i <= n ==> n - i = SUC(n - SUC i)`] THEN
      TRANS_TAC REAL_LT_TRANS `inv(&(N + m) + &1)` THEN
      ASM_SIMP_TAC[LE_ADD] THEN
      ONCE_REWRITE_TAC[DIST_SYM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      ASM_ARITH_TAC;
      ASM_SIMP_TAC[ARITH_RULE `~(SUC i <= n) ==> (i <= n <=> i = n)`] THEN
      COND_CASES_TAC THENL
       [ASM_REWRITE_TAC[SUB_REFL; ARITH_RULE `SUC n - n = SUC 0`] THEN
        SUBGOAL_THEN `a:real^N = p2 0` SUBST1_TAC THENL
         [ASM_REWRITE_TAC[]; ALL_TAC];
        ASM_SIMP_TAC[ARITH_RULE
         `~(SUC i <= n) ==> SUC i - n = SUC(i - n)`]] THEN
      (TRANS_TAC REAL_LT_TRANS `inv(&(N + m) + &1)` THEN CONJ_TAC THENL
        [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
         ASM_SIMP_TAC[LE_ADD]])]]);;

let COMPACT_PARTITION_CONTAINING_CLOSED = prove
 (`!s t t':real^N->bool.
        compact s /\ closed t /\ closed t' /\ t SUBSET s /\ t' SUBSET s /\
        (!c. c IN components s ==> c INTER t = {} \/ c INTER t' = {})
        ==> ?k k'. compact k /\ compact k' /\ t SUBSET k /\ t' SUBSET k' /\
                   DISJOINT k k' /\ k UNION k' = s`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL
   [MAP_EVERY EXISTS_TAC [`{}:real^N->bool`; `s:real^N->bool`] THEN
    ASM_REWRITE_TAC[COMPACT_EMPTY] THEN SET_TAC[];
    ALL_TAC] THEN
  ASM_CASES_TAC `t':real^N->bool = {}` THENL
   [MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `{}:real^N->bool`] THEN
    ASM_REWRITE_TAC[COMPACT_EMPTY] THEN SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `compact(t:real^N->bool) /\ compact(t':real^N->bool)`
  STRIP_ASSUME_TAC THENL
   [ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET]; ALL_TAC] THEN
  SUBGOAL_THEN
   `?e. &0 < e /\
        !x y. x IN t /\ (y:real^N) IN t'
              ==> ~(?p n. p 0 = x /\ p n = y /\
                          (!i. i <= n ==> p i IN s) /\
                          (!i. i < n ==> dist(p i,p (SUC i)) < e))`
  STRIP_ASSUME_TAC THENL
   [ONCE_REWRITE_TAC[MESON[] `(?e. P e /\ Q e) <=> ~(!e. P e ==> ~Q e)`] THEN
    DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`) THEN
    REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
    GEN_REWRITE_TAC (RAND_CONV o TOP_DEPTH_CONV) [NOT_FORALL_THM] THEN
    REWRITE_TAC[SKOLEM_THM] THEN REWRITE_TAC[NOT_EXISTS_THM; NOT_IMP] THEN
    MAP_EVERY X_GEN_TAC [`x:num->real^N`; `y:num->real^N`] THEN
    REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN
    MP_TAC(ISPECL [`(t:real^N->bool) PCROSS (t':real^N->bool)`]
        compact) THEN
    ASM_REWRITE_TAC[COMPACT_PCROSS_EQ] THEN
    DISCH_THEN(MP_TAC o SPEC
     `\n. pastecart((x:num->real^N) n) (y n:real^N)`) THEN
    ASM_REWRITE_TAC[PASTECART_IN_PCROSS; o_DEF; EXISTS_PASTECART] THEN
    REWRITE_TAC[NOT_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `r:num->num`] THEN
    STRIP_TAC THEN
    SUBGOAL_THEN `(a:real^N) IN s /\ b IN s` STRIP_ASSUME_TAC THENL
     [ASM SET_TAC[]; ALL_TAC] THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `connected_component s (a:real^N)`) THEN
    REWRITE_TAC[NOT_IMP; components; IN_ELIM_THM] THEN
    CONJ_TAC THENL [ASM_MESON_TAC[SUBSET]; REWRITE_TAC[DE_MORGAN_THM]] THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN CONJ_TAC THENL
     [EXISTS_TAC `a:real^N`; EXISTS_TAC `b:real^N`] THEN
    ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN] THEN
    ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
    ASM_SIMP_TAC[CONNECTED_COMPONENT_EQ_WELLCHAINED] THEN
    X_GEN_TAC `e:real` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_PASTECART_EQ]) THEN
    REWRITE_TAC[tendsto; AND_FORALL_THM] THEN
    DISCH_THEN(MP_TAC o SPEC `e:real`) THEN
    SUBGOAL_THEN `eventually ((\n. inv(&n + &1) < e) o r) sequentially`
    MP_TAC THENL
     [MATCH_MP_TAC EVENTUALLY_SUBSEQUENCE THEN
      ASM_REWRITE_TAC[ARCH_EVENTUALLY_INV1];
      ASM_REWRITE_TAC[o_DEF; GSYM EVENTUALLY_AND; IMP_IMP]] THEN
    REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
    DISCH_THEN(X_CHOOSE_THEN `NN:num` (MP_TAC o SPEC `NN:num`)) THEN
    REWRITE_TAC[LE_REFL] THEN ABBREV_TAC `N = (r:num->num) NN` THEN
    STRIP_TAC THEN
    FIRST_X_ASSUM(X_CHOOSE_THEN `p:num->real^N` MP_TAC o SPEC `N:num`) THEN
    DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC
     `\i. if i = 0 then a:real^N else if i <= SUC n then p(i - 1) else b` THEN
    EXISTS_TAC `n + 2` THEN
    ASM_REWRITE_TAC[ADD_EQ_0; ARITH_EQ; ARITH_RULE `~(n + 2 <= SUC n)`] THEN
    MATCH_MP_TAC num_INDUCTION THEN CONV_TAC NUM_REDUCE_CONV THEN
    ASM_REWRITE_TAC[ARITH_RULE `1 <= SUC n`; NOT_SUC; LE_SUC] THEN
    CONJ_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN
    X_GEN_TAC `i:num` THEN DISCH_THEN(K ALL_TAC) THEN CONJ_TAC THENL
     [DISCH_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
      SIMP_TAC[LE_SUC_LT; ARITH_RULE `SUC i < n + 2 <=> i = n \/ i < n`] THEN
      STRIP_TAC THEN ASM_SIMP_TAC[LT_IMP_LE; LE_REFL; LT_REFL; SUC_SUB1] THEN
      TRANS_TAC REAL_LT_TRANS `inv(&N + &1)` THEN ASM_REWRITE_TAC[] THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC];
    ALL_TAC] THEN
  EXISTS_TAC
   `{x | (x:real^N) IN s /\
         ?p n. p 0 IN t /\
               p n = x /\
               (!i. i <= n ==> p i IN s) /\
               (!i. i < n ==> dist (p i,p (SUC i)) < e)}` THEN
  EXISTS_TAC
   `{x | (x:real^N) IN s /\
         ~(?p n. p 0 IN t /\
                 p n = x /\
                 (!i. i <= n ==> p i IN s) /\
                 (!i. i < n ==> dist (p i,p (SUC i)) < e))}` THEN
  ONCE_REWRITE_TAC[CONJ_ASSOC] THEN
  MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN
  CONJ_TAC THENL
   [ALL_TAC; STRIP_TAC THEN MATCH_MP_TAC COMPACT_IN_SEPARATED_UNION] THEN
  ASM_SIMP_TAC[SET_RULE `{x | x IN s /\ P x} UNION {x | x IN s /\ ~P x} = s`;
    SET_RULE `DISJOINT {x | x IN s /\ P x} {x | x IN s /\ ~P x}`]
  THENL
   [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN CONJ_TAC THENL
     [ALL_TAC; RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM MESON_TAC[]] THEN
    X_GEN_TAC `x:real^N` THEN REPEAT STRIP_TAC THENL
     [ASM SET_TAC[]; ALL_TAC] THEN
    MAP_EVERY EXISTS_TAC [`(\i. x):num->real^N`; `0`] THEN
    ASM_REWRITE_TAC[LT; LE] THEN ASM SET_TAC[];
    TRANS_TAC REAL_LTE_TRANS `e:real` THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC REAL_LE_SETDIST THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC(SET_RULE
       `!t u. t SUBSET t' /\ u SUBSET u' /\ ~(t = {}) /\ ~(u = {})
                ==> ~(t' = {}) /\ ~(u' = {})`) THEN
      MAP_EVERY EXISTS_TAC [`t:real^N->bool`; `t':real^N->bool`] THEN
      ASM_REWRITE_TAC[];
      MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
      REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN
      DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`p:num->real^N`; `n:num`] THEN
      REPLICATE_TAC 5 DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
      REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC
       [`\i. if i <= n then (p:num->real^N) i else y`; `SUC n`] THEN
      ASM_REWRITE_TAC[LE_0; ARITH_RULE `~(SUC n <= n)`] THEN
      REWRITE_TAC[LE; LT; TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`;
                  FORALL_AND_THM; FORALL_UNWIND_THM2] THEN
      REWRITE_TAC[LE_REFL; LE_SUC_LT; LT_REFL] THEN
      ASM_SIMP_TAC[LT_IMP_LE]]]);;

let COMPACT_PARTITION_CONTAINING_POINTS = prove
 (`!s a b:real^N.
        compact s /\ a IN s /\ b IN s /\ ~(connected_component s a b)
        ==> ?k k'. compact k /\ compact k' /\ a IN k /\ b IN k' /\
                   DISJOINT k k' /\ k UNION k' = s`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SING_SUBSET] THEN
  MATCH_MP_TAC COMPACT_PARTITION_CONTAINING_CLOSED THEN
  ASM_REWRITE_TAC[SING_SUBSET; CLOSED_SING] THEN
  X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [connected_component]) THEN
  REWRITE_TAC[NOT_EXISTS_THM] THEN
  DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
  ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);;

let CONNECTED_COMPONENT_LIMIT = prove
 (`!s x y a b:real^N.
        compact s /\ (x --> a) sequentially /\ (y --> b) sequentially /\
        eventually (\n. connected_component s (x n) (y n)) sequentially
        ==> connected_component s a b`,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  ASM_SIMP_TAC[CONNECTED_COMPONENT_EQ_WELLCHAINED] THEN
  DISCH_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN
  MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
   [FIRST_X_ASSUM(CONJUNCTS_THEN STRIP_ASSUME_TAC) THEN
    CONJ_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_IN_CLOSED_SET) THENL
     [EXISTS_TAC `x:num->real^N`; EXISTS_TAC `y:num->real^N`] THEN
    ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; COMPACT_IMP_CLOSED] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        EVENTUALLY_MONO)) THEN
    SIMP_TAC[];
    STRIP_TAC] THEN
  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o check (is_conj o concl)) THEN
  REWRITE_TAC[tendsto; CONJ_ASSOC; AND_FORALL_THM] THEN
  REWRITE_TAC[LEFT_AND_FORALL_THM] THEN
  DISCH_THEN(MP_TAC o SPEC `e:real`) THEN
  ASM_REWRITE_TAC[GSYM EVENTUALLY_AND; GSYM CONJ_ASSOC] THEN
  REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
  DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N:num`)) THEN
  REWRITE_TAC[LE_REFL] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`p:num->real^N`; `n:num`] THEN STRIP_TAC THEN
  EXISTS_TAC
     `\i. if i = 0 then a:real^N else if i <= SUC n then p(i - 1) else b` THEN
  EXISTS_TAC `n + 2` THEN
  ASM_REWRITE_TAC[ADD_EQ_0; ARITH_EQ; ARITH_RULE `~(n + 2 <= SUC n)`] THEN
  CONJ_TAC THENL
   [REPEAT STRIP_TAC THEN
    REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
    MATCH_MP_TAC num_INDUCTION THEN CONV_TAC NUM_REDUCE_CONV THEN
    ASM_REWRITE_TAC[ARITH_RULE `1 <= SUC n`; NOT_SUC; LE_SUC] THEN
    CONJ_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN
    X_GEN_TAC `i:num` THEN DISCH_THEN(K ALL_TAC) THEN
    SIMP_TAC[LE_SUC_LT; ARITH_RULE `SUC i < n + 2 <=> i = n \/ i < n`] THEN
    STRIP_TAC THEN ASM_SIMP_TAC[LT_IMP_LE; LE_REFL; LT_REFL; SUC_SUB1]]);;

let CLOSED_UNIONS_COMPONENTS_MEETING_CLOSED = prove
 (`!s t:real^N->bool.
        compact s /\ closed t
        ==> closed (UNIONS {c | c IN components s /\ ~(c INTER t = {})})`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS] THEN
  MAP_EVERY X_GEN_TAC [`x:num->real^N`; `a:real^N`] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [IN_UNIONS]) THEN
  REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN
  X_GEN_TAC `c:num->real^N->bool` THEN REWRITE_TAC[FORALL_AND_THM] THEN
  STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o
    GEN_REWRITE_RULE BINDER_CONV [GSYM MEMBER_NOT_EMPTY]) THEN
  REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; IN_INTER] THEN
  X_GEN_TAC `y:num->real^N` THEN
  REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN
  SUBGOAL_THEN `(!n. (x:num->real^N) n IN s) /\ (!n. (y:num->real^N) n IN s)`
  STRIP_ASSUME_TAC THENL
   [ASM_MESON_TAC[SUBSET; IN_COMPONENTS_SUBSET]; ALL_TAC] THEN
  SUBGOAL_THEN `(a:real^N) IN s` ASSUME_TAC THENL
   [ASM_MESON_TAC[CLOSED_SEQUENTIAL_LIMITS; COMPACT_IMP_CLOSED]; ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o SPEC `y:num->real^N` o REWRITE_RULE[compact]) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`b:real^N`; `r:num->num`] THEN STRIP_TAC THEN
  MP_TAC(ISPECL
   [`s:real^N->bool`; `(x:num->real^N) o (r:num->num)`;
    `(y:num->real^N) o (r:num->num)`; `a:real^N`; `b:real^N`]
   CONNECTED_COMPONENT_LIMIT) THEN
  ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
   [ASM_SIMP_TAC[LIM_SUBSEQUENCE] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN
    X_GEN_TAC `n:num` THEN REWRITE_TAC[o_THM] THEN
    REWRITE_TAC[connected_component] THEN
    EXISTS_TAC `(c:num->real^N->bool)(r(n:num))` THEN
    ASM_MESON_TAC[IN_COMPONENTS_CONNECTED; IN_COMPONENTS_SUBSET];
    DISCH_TAC THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN
    EXISTS_TAC `connected_component s (a:real^N)` THEN
    CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[IN; CONNECTED_COMPONENT_REFL]] THEN
    FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP (REWRITE_RULE[IN]
        CONNECTED_COMPONENT_EQ)) THEN
    REWRITE_TAC[components; IN_ELIM_THM] THEN
    CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
    EXISTS_TAC `b:real^N` THEN CONJ_TAC THENL
     [ASM_MESON_TAC[CONNECTED_COMPONENT_REFL; IN]; ALL_TAC] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I
     [CLOSED_SEQUENTIAL_LIMITS]) THEN
    EXISTS_TAC `(y:num->real^N) o (r:num->num)` THEN ASM_REWRITE_TAC[o_THM]]);;

let ARBITRARILY_SMALL_CONTINUUM = prove
 (`!s u a:real^N.
        connected s /\ locally compact s /\ open u /\ {a} PSUBSET s /\ a IN u
        ==> ?c. {a} PSUBSET c /\ c SUBSET s /\ c SUBSET u /\
                compact c /\ connected c`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `(a:real^N) IN s` ASSUME_TAC THENL
   [ASM SET_TAC[]; ALL_TAC] THEN
  SUBGOAL_THEN `?b:real^N. b IN s /\ ~(b = a)` STRIP_ASSUME_TAC THENL
   [ASM SET_TAC[]; ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [locally]) THEN
  DISCH_THEN(MP_TAC o SPECL [`s INTER (u DELETE (b:real^N))`; `a:real^N`]) THEN
  ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_DELETE; SUBSET_INTER] THEN
  ASM_REWRITE_TAC[IN_DELETE; IN_INTER; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `k:real^N->bool`] THEN
  STRIP_TAC THEN EXISTS_TAC `connected_component k (a:real^N)` THEN
  REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN REPEAT CONJ_TAC THENL
   [ALL_TAC;
    TRANS_TAC SUBSET_TRANS `k:real^N->bool` THEN
    REWRITE_TAC[CONNECTED_COMPONENT_SUBSET] THEN ASM SET_TAC[];
    TRANS_TAC SUBSET_TRANS `k:real^N->bool` THEN
    REWRITE_TAC[CONNECTED_COMPONENT_SUBSET] THEN ASM SET_TAC[];
    MATCH_MP_TAC COMPACT_CONNECTED_COMPONENT THEN ASM_REWRITE_TAC[]] THEN
  MATCH_MP_TAC(SET_RULE `a IN s /\ ~(s = {a}) ==> {a} PSUBSET s`) THEN
  REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
  CONJ_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN
  MP_TAC(ISPECL [`k:real^N->bool`; `{a:real^N}`; `v:real^N->bool`]
        SURA_BURA_CLOPEN_SUBSET_ALT) THEN
  ASM_REWRITE_TAC[COMPACT_SING; SING_SUBSET; IN_INTER] THEN
  REWRITE_TAC[NOT_IMP; NOT_EXISTS_THM] THEN REPEAT CONJ_TAC THENL
   [ASM_SIMP_TAC[CLOSED_IMP_LOCALLY_COMPACT; COMPACT_IMP_CLOSED];
    FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
    REWRITE_TAC[components; IN_ELIM_THM] THEN
    EXISTS_TAC `a:real^N` THEN REWRITE_TAC[] THEN ASM SET_TAC[];
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        OPEN_IN_SUBSET_TRANS)) THEN
    ASM SET_TAC[];
    ALL_TAC] THEN
  X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_CLOPEN]) THEN
  DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN
  REWRITE_TAC[NOT_IMP; DE_MORGAN_THM; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL
   [MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `v:real^N->bool` THEN
    ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
      (ONCE_REWRITE_RULE[IMP_CONJ] OPEN_IN_SUBSET_TRANS)) THEN ASM SET_TAC[];
    ALL_TAC] THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC CLOSED_SUBSET THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED];
    ALL_TAC] THEN
  ASM SET_TAC[]);;

let BOUNDARY_BUMPING_THEOREM_EUCLIDEAN_INTER = prove
 (`!s u c:real^N->bool.
        connected s /\ locally compact s /\
        open u /\ ~(s SUBSET u) /\ compact(s INTER closure u) /\
        c IN components(s INTER closure u)
        ==> ~(c INTER frontier u = {})`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL
   [`s INTER closure u:real^N->bool`; `c:real^N->bool`;
    `s INTER frontier u:real^N->bool`]
        COMPACT_PARTITION_CONTAINING_CLOSED) THEN
  ASM_REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL
   [ASM_MESON_TAC[CLOSED_COMPONENTS; COMPACT_IMP_CLOSED];
    SUBGOAL_THEN
     `s INTER frontier u:real^N->bool = (s INTER closure u) INTER frontier u`
     (fun th -> ASM_SIMP_TAC[th; CLOSED_INTER; FRONTIER_CLOSED;
                             COMPACT_IMP_CLOSED]) THEN
    REWRITE_TAC[frontier] THEN SET_TAC[];
    ASM_SIMP_TAC[IN_COMPONENTS_SUBSET];
    REWRITE_TAC[frontier] THEN SET_TAC[];
    MP_TAC(ISPEC `s INTER closure u:real^N->bool`
        PAIRWISE_DISJOINT_COMPONENTS) THEN
    REWRITE_TAC[pairwise] THEN
    DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN
    MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `d:real^N->bool` THEN
    DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM SET_TAC[];
    REWRITE_TAC[NOT_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `l:real^N->bool`] THEN
    STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_CLOSED_IN]) THEN
    REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC
     [`k:real^N->bool`; `l UNION (s DIFF closure u):real^N->bool`] THEN
    ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC CLOSED_SUBSET THEN
      ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM SET_TAC[];
      SUBGOAL_THEN
       `l UNION s DIFF closure u:real^N->bool =
        s INTER (l UNION closure(s DIFF closure u))`
       (fun th -> ASM_SIMP_TAC[th; CLOSED_IN_CLOSED_INTER; CLOSED_UNION;
                              COMPACT_IMP_CLOSED; CLOSED_CLOSURE]) THEN
       MP_TAC(ISPECL [`u:real^N->bool`; `s DIFF closure u:real^N->bool`]
            OPEN_INTER_CLOSURE_EQ_EMPTY) THEN
       ASM_REWRITE_TAC[] THEN
       MP_TAC(ISPEC `u:real^N->bool` CLOSURE_UNION_FRONTIER) THEN MP_TAC
        (ISPEC `s DIFF closure u:real^N->bool` CLOSURE_UNION_FRONTIER) THEN
       ASM SET_TAC[];
      ASM SET_TAC[];
      ASM SET_TAC[];
      FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN
      ASM SET_TAC[];
      SUBGOAL_THEN `frontier u:real^N->bool = closure u DIFF u`
      SUBST_ALL_TAC THENL
       [ASM_SIMP_TAC[frontier; INTERIOR_OPEN]; ALL_TAC] THEN ASM SET_TAC[]]]);;

let BOUNDARY_BUMPING_THEOREM_EUCLIDEAN_INTER_ALT = prove
 (`!s u c:real^N->bool.
        connected s /\ locally compact s /\
        open u /\ ~(s INTER u = {}) /\ ~(s SUBSET u) /\
        compact(s INTER closure u) /\
        c IN components(s INTER u)
        ==> ?x. x IN frontier u /\ x limit_point_of c`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `~(closure c INTER frontier u:real^N->bool = {})` MP_TAC THENL
   [DISCH_TAC;
    REWRITE_TAC[closure] THEN MATCH_MP_TAC(SET_RULE
     `s INTER u = {}
      ==> ~((s UNION {x | P x}) INTER u = {}) ==> ?x. x IN u /\ P x`) THEN
    ASM_SIMP_TAC[frontier; INTERIOR_OPEN] THEN
    FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN SET_TAC[]] THEN
  SUBGOAL_THEN `closed(c:real^N->bool)` ASSUME_TAC THENL
   [MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN
    EXISTS_TAC `s INTER closure u:real^N->bool` THEN
    ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_COMPONENT) THEN
    REWRITE_TAC[CLOSED_IN_LIMPT] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
     [REWRITE_TAC[closure] THEN SET_TAC[]; ALL_TAC] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (LAND_CONV o LAND_CONV)
      [closure]) THEN
    ASM_SIMP_TAC[frontier; INTERIOR_OPEN] THEN SET_TAC[];
    ALL_TAC] THEN
  MP_TAC(ISPECL [`c:real^N->bool`; `(:real^N) DIFF u`]
        SEPARATION_NORMAL) THEN
  ASM_REWRITE_TAC[GSYM OPEN_CLOSED; NOT_IMP] THEN CONJ_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN SET_TAC[];
    REWRITE_TAC[NOT_EXISTS_THM]] THEN
  MAP_EVERY X_GEN_TAC [`h:real^N->bool`; `k:real^N->bool`] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN `closure(h:real^N->bool) SUBSET u` ASSUME_TAC THENL
   [TRANS_TAC SUBSET_TRANS `(:real^N) DIFF k` THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_REWRITE_TAC[GSYM OPEN_CLOSED] THEN
    ASM SET_TAC[];
    ALL_TAC] THEN
  MP_TAC(ISPECL [`s INTER closure h:real^N->bool`; `c:real^N->bool`]
        EXISTS_COMPONENT_SUPERSET) THEN
  REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN
  ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
   [FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
    REWRITE_TAC[closure] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `c':real^N->bool` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `h:real^N->bool`; `c':real^N->bool`]
        BOUNDARY_BUMPING_THEOREM_EUCLIDEAN_INTER) THEN
  ASM_REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN
  CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL
   [SUBGOAL_THEN
     `s INTER closure(h:real^N->bool) = (s INTER closure u) INTER closure h`
     (fun th -> ASM_SIMP_TAC[COMPACT_INTER_CLOSED; th; CLOSED_CLOSURE]) THEN
    MP_TAC(ISPEC `u:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN `c':real^N->bool = c` SUBST_ALL_TAC THENL
   [ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
    MATCH_MP_TAC COMPONENTS_MAXIMAL THEN
    EXISTS_TAC `s INTER u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
    CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN
    CONJ_TAC THENL
     [TRANS_TAC SUBSET_TRANS `s INTER closure h:real^N->bool` THEN
      ASM_SIMP_TAC[IN_COMPONENTS_SUBSET] THEN ASM SET_TAC[];
      REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY)) THEN
      ASM SET_TAC[]];
    ASM_SIMP_TAC[frontier; INTERIOR_OPEN] THEN ASM SET_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* Equivalence of LC and LPC for locally connected sets.                     *)
(* ------------------------------------------------------------------------- *)

let LOCALLY_COMPACT_CONNECTED_IMP_PATH_CONNECTED = prove
 (`!s:real^N->bool.
        locally compact s /\ locally connected s /\ connected s
        ==> path_connected s`,
  SUBGOAL_THEN
   `!s:real^N->bool.
        compact s /\ connected s /\ locally connected s
        ==> path_connected s`
  ASSUME_TAC THENL
   [ALL_TAC;
    REPEAT STRIP_TAC THEN
    W(MP_TAC o PART_MATCH (lhand o rand) PATH_CONNECTED_EQ_CONNECTED_LPC o
      snd) THEN
   ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN
   MATCH_MP_TAC LOCALLY_MONO THEN
   EXISTS_TAC
    `\c:real^N->bool. compact c /\ connected c /\ locally connected c` THEN
   ASM_SIMP_TAC[LOCALLY_CONNECTED_CONTINUUM]] THEN
  REPEAT STRIP_TAC THEN REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
  MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN
  SUBGOAL_THEN
   `?f:real^1->real^N.
        f(vec 0) = a /\ f(vec 1) = b /\
        (!x. x IN {lift(&m / &2 pow n) | 0 <= m /\ m <= 2 EXP n}
             ==> f x IN s) /\
        f uniformly_continuous_on
         {lift(&m / &2 pow n) | 0 <= m /\ m <= 2 EXP n}`
  STRIP_ASSUME_TAC THENL
   [ALL_TAC;
    SUBGOAL_THEN
     `interval[vec 0:real^1,vec 1] INTER
      {inv(&2 pow n) % m | n,m | !i. 1 <= i /\ i <= dimindex(:1)
                                     ==> integer(m$i)} =
      {lift (&m / &2 pow n) | 0 <= m /\ m <= 2 EXP n}`
    ASSUME_TAC THENL
     [REWRITE_TAC[FORALL_1; DIMINDEX_1; SET_RULE
       `s INTER t = u <=>
        (!x. x IN t ==> x IN s ==> x IN u) /\
        (!x. x IN u ==> x IN s /\ x IN t)`] THEN
      REWRITE_TAC[FORALL_IN_GSPEC; IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
      REWRITE_TAC[GSYM drop; FORALL_LIFT; LIFT_DROP; DROP_CMUL] THEN
      REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
      SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_POW2] THEN
      REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; IMP_CONJ] THEN
      REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LE; LE_0] THEN
      REWRITE_TAC[MESON[INTEGER_POS; REAL_POS]
       `(!m. integer m ==> &0 <= m ==> P m) <=> (!n. P(&n))`] THEN
      REWRITE_TAC[IN_ELIM_THM; ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN
      REWRITE_TAC[REAL_OF_NUM_LE; LIFT_CMUL; EXISTS_LIFT; LIFT_DROP] THEN
      MESON_TAC[INTEGER_CLOSED];
      ALL_TAC] THEN
    MP_TAC(ISPECL
     [`f:real^1->real^N`;
      `interval[vec 0:real^1,vec 1] INTER
       {inv(&2 pow n) % m | n,m | !i. 1 <= i /\ i <= dimindex(:1)
                                      ==> integer(m$i)}`]
     UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN
    SIMP_TAC[CLOSURE_DYADIC_RATIONALS_IN_CONVEX_SET; CONVEX_INTERVAL;
             INTERIOR_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN
    ASM_REWRITE_TAC[CLOSURE_INTERVAL] THEN
    REWRITE_TAC[path_component] THEN MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `g:real^1->real^N` THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o CONJUNCT1)) THEN
    ASM_SIMP_TAC[path; UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS] THEN CONJ_TAC THENL
     [MP_TAC(ISPECL
       [`g:real^1->real^N`;
        `interval[vec 0:real^1,vec 1] INTER
         {inv(&2 pow n) % m | n,m | !i. 1 <= i /\ i <= dimindex(:1)
                                        ==> integer(m$i)}`;
        `s:real^N->bool`] FORALL_IN_CLOSURE) THEN
      SIMP_TAC[CLOSURE_DYADIC_RATIONALS_IN_CONVEX_SET; CONVEX_INTERVAL;
             INTERIOR_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN
      ASM_REWRITE_TAC[CLOSURE_INTERVAL] THEN
      REWRITE_TAC[path_image; SUBSET; FORALL_IN_IMAGE] THEN
      DISCH_THEN MATCH_MP_TAC THEN
      ASM_SIMP_TAC[UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS] THEN
      ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM SET_TAC[];
      CONJ_TAC THEN
      FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
      REWRITE_TAC[pathstart; pathfinish] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      REWRITE_TAC[IN_ELIM_THM] THENL
       [EXISTS_TAC `0`; EXISTS_TAC `1`] THEN
      EXISTS_TAC `0` THEN
      CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
      REWRITE_TAC[LIFT_NUM]]] THEN
  SUBGOAL_THEN
   `?f:real->real^N.
        f(&0) = a /\ f(&1) = b /\
        (!m n. m <= 2 EXP n ==> f(&m / &2 pow n) IN s) /\
        (!j. ?d. &0 < d /\
                 !n m1 m2. m1 <= 2 EXP n /\ m2 <= 2 EXP n /\
                           abs(&m1 / &2 pow n - &m2 / &2 pow n) < d
                           ==> dist(f(&m1 / &2 pow n),f(&m2 / &2 pow n))
                               < inv(&2 pow j))`
  STRIP_ASSUME_TAC THENL
   [ALL_TAC;
    EXISTS_TAC `(f:real->real^N) o drop` THEN
    REWRITE_TAC[GSYM LIFT_NUM; uniformly_continuous_on; FORALL_IN_GSPEC;
                IMP_CONJ; RIGHT_FORALL_IMP_THM; DIST_LIFT; o_DEF] THEN
    ASM_REWRITE_TAC[LE_0; LIFT_DROP] THEN
    X_GEN_TAC `e:real` THEN DISCH_TAC THEN
    MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN
    REWRITE_TAC[REAL_POW_INV] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `j:num` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(fun th ->
      MP_TAC(SPEC `j:num` th) THEN MATCH_MP_TAC MONO_EXISTS) THEN
    X_GEN_TAC `d:real` THEN STRIP_TAC THEN
    ASM_REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
    ONCE_REWRITE_TAC[MESON[]
     `(!a b c d. P a b c d) <=> (!b d a c. P a b c d)`] THEN
    MATCH_MP_TAC WLOG_LE THEN
    CONJ_TAC THENL [MESON_TAC[DIST_SYM; REAL_ABS_SUB]; ALL_TAC] THEN
    MAP_EVERY X_GEN_TAC [`n1:num`; `n2:num`] THEN DISCH_TAC THEN
    MAP_EVERY X_GEN_TAC [`m1:num`; `m2:num`] THEN REPEAT DISCH_TAC THEN
    TRANS_TAC REAL_LT_TRANS `inv(&2 pow j)` THEN ASM_REWRITE_TAC[] THEN
    FIRST_X_ASSUM(MP_TAC o SPECL
     [`n2:num`; `m2:num`; `2 EXP (n2 - n1) * m1`]) THEN
    ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_MUL] THEN
    REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN
    ASM_SIMP_TAC[REAL_POW_SUB; REAL_OF_NUM_EQ; ARITH_EQ] THEN
    SIMP_TAC[REAL_LT_POW2; REAL_FIELD
     `&0 < n1 /\ &0 < n2 ==> (n2 / n1 * m) / n2 = m / n1`] THEN
    DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[REAL_ARITH `a / b * c <= a <=> a * c / b <= a * &1`] THEN
    SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_POW2; REAL_LE_LDIV_EQ] THEN
    REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_POW] THEN
    ASM_REWRITE_TAC[REAL_OF_NUM_LE]] THEN
  SUBGOAL_THEN
   `?p f. (!n. p n < p(SUC n)) /\
          f(&0):real^N = a /\ f(&1) = b /\
          (!k1 i1 k2 i2.
                k1 <= k2 /\ i1 <= 2 EXP (p k1) /\ i2 <= 2 EXP (p k2) /\
                abs(&i1 / &2 pow (p k1) - &i2 / &2 pow (p k2)) <
                inv(&2 pow (p k1))
                ==> ?c. connected c /\ c SUBSET s /\
                        c SUBSET ball(f(&i1 / &2 pow (p k1)),&2 / &2 pow k1) /\
                        f(&i1 / &2 pow (p k1)) IN c /\
                        f(&i2 / &2 pow (p k2)) IN c)`
  MP_TAC THENL
   [ALL_TAC;
    DISCH_THEN(X_CHOOSE_THEN `r:num->num` MP_TAC) THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real->real^N` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
     [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN
      MP_TAC(ISPEC `r:num->num` MONOTONE_BIGGER) THEN ANTS_TAC THENL
       [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_REWRITE_TAC[LT_TRANS];
        DISCH_THEN(MP_TAC o SPEC `n:num`) THEN DISCH_TAC] THEN
      FIRST_X_ASSUM(MP_TAC o SPECL
       [`n:num`; `2 EXP (r n - n) * m`; `n:num`; `2 EXP (r n - n) * m`]) THEN
      REWRITE_TAC[LE_REFL; REAL_SUB_REFL; REAL_ABS_NUM] THEN
      REWRITE_TAC[CONJ_ASSOC; REAL_LT_INV_EQ; REAL_LT_POW2] THEN
      REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_MUL] THEN
      REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN
      ASM_SIMP_TAC[REAL_POW_SUB; REAL_OF_NUM_EQ; ARITH_EQ] THEN
      REWRITE_TAC[REAL_ARITH `a / b * c <= a <=> a * c / b <= a * &1`] THEN
      SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_POW2; REAL_LE_LDIV_EQ] THEN
      SIMP_TAC[REAL_LT_POW2; REAL_FIELD
       `&0 < n1 /\ &0 < n2 ==> (n2 / n1 * m) / n2 = m / n1`] THEN
      ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_POW; REAL_OF_NUM_LE] THEN
      SET_TAC[];
      X_GEN_TAC `j:num` THEN EXISTS_TAC `inv(&2 pow (r(j + 2)))` THEN
      REWRITE_TAC[REAL_LT_INV_EQ; REAL_LT_POW2] THEN
      X_GEN_TAC `n:num` THEN MATCH_MP_TAC WLOG_LT THEN
      REWRITE_TAC[DIST_REFL; REAL_LT_INV_EQ; REAL_LT_POW2] THEN CONJ_TAC THENL
       [MESON_TAC[DIST_SYM; REAL_ABS_SUB]; ALL_TAC] THEN
      MAP_EVERY X_GEN_TAC [`m1:num`; `m2:num`] THEN REPEAT STRIP_TAC THEN
      SUBGOAL_THEN `r(j + 2):num < n` ASSUME_TAC THENL
       [REWRITE_TAC[GSYM NOT_LE] THEN DISCH_TAC THEN
        FIRST_X_ASSUM(MP_TAC o SPEC `inv(&2 pow n)` o MATCH_MP (REAL_ARITH
         `a < b ==> !x. x <= a ==> x < b`)) THEN
        REWRITE_TAC[REAL_NOT_LT; NOT_IMP] THEN
        ASM_SIMP_TAC[REAL_LE_INV2; REAL_LT_POW2; REAL_POW_MONO;
                     REAL_OF_NUM_LE; ARITH] THEN
        REWRITE_TAC[real_div; GSYM REAL_SUB_RDISTRIB; REAL_ABS_MUL] THEN
        REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW; REAL_ABS_NUM] THEN
        GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN
        SIMP_TAC[REAL_LE_RMUL_EQ; REAL_LT_POW2; REAL_LT_INV_EQ] THEN
        MATCH_MP_TAC REAL_ABS_INTEGER_LEMMA THEN
        SIMP_TAC[INTEGER_CLOSED; REAL_SUB_0; REAL_OF_NUM_EQ] THEN
        ASM_ARITH_TAC;
        ALL_TAC] THEN
      MP_TAC(ISPEC `r:num->num` MONOTONE_BIGGER) THEN ANTS_TAC THENL
       [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_REWRITE_TAC[LT_TRANS];
        DISCH_THEN(MP_TAC o SPEC `n:num`) THEN DISCH_TAC] THEN
      FIRST_X_ASSUM(MP_TAC o ISPECL
       [`j + 2`; `m2 DIV (2 EXP (n - r(j + 2)))`; `n:num`]) THEN
      REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN ANTS_TAC THENL
       [TRANS_TAC LE_TRANS `r(j + 2):num` THEN ASM_SIMP_TAC[LT_IMP_LE] THEN
        SPEC_TAC(`j + 2`,`i:num`) THEN MATCH_MP_TAC MONOTONE_BIGGER THEN
        MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_REWRITE_TAC[LT_TRANS];
        ALL_TAC] THEN
      ANTS_TAC THENL
       [SIMP_TAC[LE_LDIV_EQ; EXP_EQ_0; ARITH_EQ] THEN MATCH_MP_TAC
         (ARITH_RULE `~(b = 0) /\ a <= b * c ==> a < b * (c + 1)`) THEN
        REWRITE_TAC[EXP_EQ_0; ARITH_EQ] THEN
        ASM_SIMP_TAC[GSYM EXP_ADD; LT_IMP_LE; SUB_ADD];
        ALL_TAC] THEN
      DISCH_THEN(fun th ->
        MP_TAC(SPEC `2 EXP (r n - n) * m1` th) THEN
        MP_TAC(SPEC `2 EXP (r n - n) * m2` th)) THEN
      REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_MUL] THEN
      REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN
      ASM_SIMP_TAC[REAL_POW_SUB; REAL_OF_NUM_EQ; ARITH_EQ] THEN
      REWRITE_TAC[REAL_ARITH `a / b * c <= a <=> a * c / b <= a * &1`] THEN
      SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_POW2; REAL_LE_LDIV_EQ] THEN
      SIMP_TAC[REAL_LT_POW2; REAL_FIELD
       `&0 < n1 /\ &0 < n2 ==> (n2 / n1 * m) / n2 = m / n1`] THEN
      ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_POW; REAL_OF_NUM_LE] THEN
      REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN MATCH_MP_TAC(TAUT
       `(q1 /\ q2 ==> r) /\ (p1 /\ p2)
        ==> (p1 ==> q1) ==> (p2 ==> q2) ==> r`) THEN
      CONJ_TAC THENL
       [DISCH_THEN(CONJUNCTS_THEN (MP_TAC o MATCH_MP (SET_RULE
         `(?c. P c /\ c SUBSET s /\ c SUBSET b /\ x IN c /\ y IN c)
          ==> y IN b`))) THEN
        REWRITE_TAC[IN_BALL; IMP_IMP] THEN MATCH_MP_TAC(NORM_ARITH
         `inv(&2) * j = i
          ==> dist(x:real^N,a) < i /\ dist(x,b) < i ==> dist(a,b) < j`) THEN
        REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN
        REAL_ARITH_TAC;
        MATCH_MP_TAC(REAL_ARITH
         `a < b /\ x <= b /\ b - i < x /\ abs(a - b) < i
          ==> abs(x - b) < i /\ abs(x - a) < i`) THEN
        ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LT_POW2; REAL_OF_NUM_LT] THEN
        SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
        SIMP_TAC[REAL_LT_POW2; REAL_FIELD
         `&0 < n /\ &0 < j ==> (m / n - inv j) * j = m / (n / j) - &1`] THEN
        SIMP_TAC[REAL_LT_POW2; REAL_LT_SUB_RADD; REAL_FIELD
         `&0 < n /\ &0 < j ==> m / n * j = m / (n / j)`] THEN
        ASM_SIMP_TAC[GSYM REAL_POW_SUB; LT_IMP_LE; REAL_OF_NUM_EQ; ARITH] THEN
        SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN
        REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_MUL; REAL_OF_NUM_ADD] THEN
        REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
        ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[DIV_MUL_LE] THEN
        W(MP_TAC o PART_MATCH (lhand o lhand o rand o lhand o rand) DIVISION o
          lhand o rand o rand o snd) THEN
        REWRITE_TAC[EXP_EQ_0; ARITH_EQ] THEN
        ARITH_TAC]]] THEN
  SUBGOAL_THEN
   `?p f. (!n. p n < p(SUC n)) /\
          f(&0):real^N = a /\ f(&1) = b /\
          (!n m k. m <= 2 EXP (p n) /\ k <= 2 EXP (p(SUC n)) /\
                   abs(&m / &2 pow (p n) - &k / &2 pow (p(SUC n)))
                     < inv(&2 pow (p n))
                   ==> ?c. connected c /\ c SUBSET s /\
                           c SUBSET ball(f(&m / &2 pow (p n)),inv(&2 pow n)) /\
                           f(&m / &2 pow (p n)) IN c /\
                           f(&k / &2 pow (p(SUC n))) IN c)`
  MP_TAC THENL
   [ALL_TAC;
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real->real^N` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN
    ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
    ONCE_REWRITE_TAC[MESON[LE_EXISTS]
     `(!m n:num. m <= n ==> P m n) <=> !n d. P n (n + d)`] THEN
    GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN
    MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
     [MAP_EVERY X_GEN_TAC [`n:num`; `m1:num`; `m2:num`] THEN
      REWRITE_TAC[ADD_CLAUSES; real_div; GSYM REAL_SUB_RDISTRIB] THEN
      REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_POW; REAL_ABS_NUM] THEN
      SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ; REAL_LT_POW2;
               REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN
      SIMP_TAC[GSYM REAL_EQ_INTEGERS; INTEGER_CLOSED] THEN
      REWRITE_TAC[REAL_OF_NUM_EQ] THEN STRIP_TAC THEN
      EXISTS_TAC `{f(&m2 / &2 pow r(n:num)):real^N}` THEN
      ASM_REWRITE_TAC[SING_SUBSET; IN_SING; CENTRE_IN_BALL] THEN
      REWRITE_TAC[CONNECTED_SING] THEN
      SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
      FIRST_X_ASSUM(MP_TAC o SPECL
       [`n:num`; `m2:num`; `2 EXP (r(SUC n) - r n) * m2`]) THEN
      ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; SET_TAC[]] THEN
      REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_MUL] THEN
      REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN
      ASM_SIMP_TAC[REAL_POW_SUB; LT_IMP_LE; REAL_OF_NUM_EQ; ARITH_EQ] THEN
      SIMP_TAC[REAL_LT_POW2; REAL_FIELD
        `&0 < r /\ &0 < s ==> (r / s * m) / r = m / s`] THEN
      REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM; REAL_LT_INV_EQ] THEN
      REWRITE_TAC[REAL_LT_POW2] THEN
      ONCE_REWRITE_TAC[REAL_ARITH
       `a / b * c <= a <=> a * c / b <= a * &1`] THEN
      SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_POW2; REAL_LE_LDIV_EQ] THEN
      REWRITE_TAC[REAL_MUL_LID] THEN
      ASM_REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LE];
      ALL_TAC] THEN
    X_GEN_TAC `d:num` THEN DISCH_THEN(LABEL_TAC "*") THEN
    MAP_EVERY X_GEN_TAC [`n:num`; `m1:num`; `m2:num`] THEN
    REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN
    SUBGOAL_THEN
     `?k. k <= 2 EXP r(SUC n) /\
          abs(&m1 / &2 pow (r n) - &k / &2 pow r(SUC n)) < inv(&2 pow r n) /\
          abs(&k / &2 pow r(SUC n) - &m2 / &2 pow r(SUC(n + d))) <
                inv (&2 pow r (SUC n))`
    STRIP_ASSUME_TAC THENL
     [ALL_TAC;
      REMOVE_THEN "*" (MP_TAC o SPECL [`SUC n`; `k:num`; `m2:num`]) THEN
      FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `m1:num`; `k:num`]) THEN
      ASM_REWRITE_TAC[ADD_CLAUSES; LEFT_IMP_EXISTS_THM] THEN
      X_GEN_TAC `c1:real^N->bool` THEN STRIP_TAC THEN
      X_GEN_TAC `c2:real^N->bool` THEN STRIP_TAC THEN
      EXISTS_TAC `c1 UNION c2:real^N->bool` THEN
      ASM_REWRITE_TAC[UNION_SUBSET; IN_UNION] THEN CONJ_TAC THENL
       [MATCH_MP_TAC CONNECTED_UNION THEN ASM SET_TAC[]; ALL_TAC] THEN
      CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
        (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN
      REWRITE_TAC[SUBSET_BALLS; DIST_REFL;
                  REAL_ARITH `&0 + inv x <= &2 / x <=> &0 <= inv x`] THEN
      SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE; REAL_LT_POW2] THEN
      DISJ1_TAC THEN REWRITE_TAC[real_pow; real_div; REAL_INV_MUL] THEN
      MATCH_MP_TAC(REAL_ARITH `x < y ==> x + &2 * inv(&2) * y <= &2 * y`) THEN
      ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[GSYM IN_BALL] THEN
      REWRITE_TAC[GSYM real_div] THEN ASM SET_TAC[]] THEN
    SUBGOAL_THEN `!m n. m <= n ==> (r:num->num) m <= r n` ASSUME_TAC THENL
     [MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
      ASM_SIMP_TAC[LT_IMP_LE] THEN ARITH_TAC;
      ALL_TAC] THEN
    MATCH_MP_TAC(MESON[] `(?k. P k \/ P(k + 1)) ==> ?k. P k`) THEN
    EXISTS_TAC `m2 DIV 2 EXP (r(SUC(n + d)) - r(SUC n))` THEN
    REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD] THEN
    REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN
    ONCE_REWRITE_TAC[REAL_ARITH `x <= y <=> x <= &1 * y`] THEN
    SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN
    REWRITE_TAC[REAL_ARITH `(x + &1) / y = x / y + inv(y)`] THEN
    MATCH_MP_TAC(REAL_ARITH
     `x <= b /\ b < x + e /\ abs(a - b) < d /\ e <= d /\ a <= c /\ b <= c
      ==> x <= c /\ abs(a - x) < d /\ abs(x - b) < e \/
          x + e <= c /\ abs(a - (x + e)) < d /\ abs((x + e) - b) < e`) THEN
    ASM_SIMP_TAC[REAL_LE_INV2; REAL_POW_MONO; REAL_OF_NUM_LE; ARITH; LT_IMP_LE;
                 REAL_LT_POW2] THEN
    SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN
    ASM_REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LE] THEN
    REWRITE_TAC[REAL_ARITH `x / y + inv y = (x + &1) / y`] THEN
    SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_POW2; GSYM REAL_OF_NUM_POW] THEN
    SIMP_TAC[REAL_LT_POW2; REAL_FIELD
      `&0 < m /\ &0 < n ==> x / m * n = x / (m / n)`] THEN
    ASM_SIMP_TAC[GSYM REAL_POW_SUB; REAL_OF_NUM_EQ; ARITH_EQ;
                 ARITH_RULE `SUC n <= SUC(n + d)`] THEN
    SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN
    REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_MUL; REAL_OF_NUM_ADD] THEN
    REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN
    W(MP_TAC o PART_MATCH (lhand o lhand o rand o lhand o rand) DIVISION o
      lhand o lhand o lhand o snd) THEN
    REWRITE_TAC[EXP_EQ_0; ARITH_EQ] THEN ARITH_TAC] THEN
  SUBGOAL_THEN
   `?p f. (!n. p n < p(SUC n)) /\
          (!n. f n 0 = (a:real^N)) /\ (!n. f n (2 EXP (p n)) = b) /\
          (!n k. k <= 2 EXP (p n)
                 ==> f (SUC n) (2 EXP (p(SUC n) - p n) * k) = f n k) /\
          (!n m k. m <= 2 EXP (p n) /\ k <= 2 EXP (p(SUC n)) /\
                   abs(&m / &2 pow (p n) - &k / &2 pow (p(SUC n)))
                     < inv(&2 pow (p n))
                   ==> ?c. connected c /\ c SUBSET s /\
                           c SUBSET ball(f n m,inv(&2 pow n)) /\
                           f n m IN c /\ f (SUC n) k IN c)`
  MP_TAC THENL
   [ALL_TAC;
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN
    DISCH_THEN(X_CHOOSE_THEN `f:num->num->real^N` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `\x. let t = @t. &(SND t) / &2 pow (r(FST t)) = x in
                    (f:num->num->real^N) (FST t) (SND t)` THEN
    ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
     [LET_TAC THEN
      SUBGOAL_THEN `&(SND t) / &2 pow r(FST t:num) = &0` MP_TAC THENL
       [EXPAND_TAC "t" THEN CONV_TAC SELECT_CONV THEN
        EXISTS_TAC `0,0` THEN REWRITE_TAC[real_div; REAL_MUL_LZERO];
        REWRITE_TAC[REAL_DIV_EQ_0; REAL_POW_EQ_0] THEN
        CONV_TAC REAL_RAT_REDUCE_CONV THEN
        ASM_SIMP_TAC[REAL_OF_NUM_EQ]];
      LET_TAC THEN
      SUBGOAL_THEN `&(SND t) / &2 pow r(FST t:num) = &1` MP_TAC THENL
       [EXPAND_TAC "t" THEN CONV_TAC SELECT_CONV THEN
        EXISTS_TAC `0,2 EXP r 0` THEN
        SIMP_TAC[GSYM REAL_OF_NUM_POW; REAL_DIV_REFL; REAL_POW_EQ_0;
                 REAL_OF_NUM_EQ; ARITH_EQ];
        SIMP_TAC[REAL_EQ_LDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN
        ASM_SIMP_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_EQ]];
      MAP_EVERY X_GEN_TAC [`n:num`; `m:num`; `k:num`] THEN STRIP_TAC THEN
      ABBREV_TAC
       `t = @t. &(SND t) / &2 pow r (FST t:num) = &m / &2 pow r n` THEN
      ABBREV_TAC
       `u = @t. &(SND t) / &2 pow r (FST t) = &k / &2 pow r(SUC n)` THEN
      CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN
      SUBGOAL_THEN
       `(f:num->num->real^N) (FST t) (SND t) = f n m /\
        (f:num->num->real^N) (FST u) (SND u) = f (SUC n) k`
       (fun th -> ASM_SIMP_TAC[th]) THEN
      SUBGOAL_THEN
       `!n n' m m'. &m / &2 pow (r n) = &m' / &2 pow (r n') /\
                    m' <= 2 EXP (r n')
                    ==> (f:num->num->real^N) n m = f n' m'`
       (fun th -> CONJ_TAC THEN MATCH_MP_TAC th THEN ASM_REWRITE_TAC[] THEN
                  MAP_EVERY EXPAND_TAC ["t"; "u"] THEN
                  CONV_TAC SELECT_CONV THEN
                  REWRITE_TAC[EXISTS_PAIR_THM] THEN MESON_TAC[]) THEN
      REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN
      ONCE_REWRITE_TAC[REAL_ARITH `x <= y <=> x <= &1 * y`] THEN
      SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN
      MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
      REPEAT(FIRST_X_ASSUM(K ALL_TAC o check (fun t -> not(is_forall t)) o
        concl)) THEN
      X_GEN_TAC `n:num` THEN MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
       [SIMP_TAC[LE] THEN DISCH_THEN SUBST1_TAC THEN
        SIMP_TAC[REAL_OF_NUM_EQ; REAL_LT_POW2; REAL_FIELD
         `&0 < z ==> (x / z = y / z <=> x = y)`];
        ALL_TAC] THEN
      X_GEN_TAC `p:num` THEN ASM_CASES_TAC `SUC p = n` THEN
      ASM_SIMP_TAC[REAL_OF_NUM_EQ; REAL_LT_POW2; REAL_FIELD
                     `&0 < z ==> (x / z = y / z <=> x = y)`] THEN
      ASM_CASES_TAC `n <= SUC p` THEN ASM_REWRITE_TAC[] THEN
      ASM_CASES_TAC `n:num <= p` THENL [ALL_TAC; ASM_ARITH_TAC] THEN
      ASM_REWRITE_TAC[] THEN DISCH_THEN(LABEL_TAC "*") THEN
      MAP_EVERY X_GEN_TAC [`m1:num`; `m2:num`] THEN
      SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN
      SUBGOAL_THEN `!m n. m <= n ==> (r:num->num) m <= r n` ASSUME_TAC THENL
       [MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
        ASM_SIMP_TAC[LT_IMP_LE] THEN ARITH_TAC;
        ALL_TAC] THEN
      SIMP_TAC[REAL_LT_POW2; REAL_FIELD
       `&0 < m /\ &0 < n ==> (x / m = y / n <=> y = (n / m) * x)`] THEN
      ASM_SIMP_TAC[GSYM REAL_POW_SUB; REAL_OF_NUM_EQ; ARITH_EQ; LT_IMP_LE] THEN
      REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_MUL; REAL_OF_NUM_EQ] THEN
      ASM_SIMP_TAC[REAL_OF_NUM_LE] THEN STRIP_TAC THEN
      SUBGOAL_THEN `r(SUC p) - r n:num = (r(SUC p) - r p) + (r p - r n)`
      SUBST1_TAC THENL
       [MATCH_MP_TAC(ARITH_RULE
         `x <= y /\ y <= z ==> z - x:num = (z - y) + (y - x)`) THEN
        CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
        REWRITE_TAC[EXP_ADD; GSYM MULT_ASSOC]] THEN
      CONV_TAC SYM_CONV THEN
      TRANS_TAC EQ_TRANS
       `(f:num->num->real^N) p (2 EXP (r p - r(n:num)) * m1)` THEN
      CONJ_TAC THENL
       [FIRST_X_ASSUM MATCH_MP_TAC;
        CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
        SIMP_TAC[REAL_EQ_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN
        ONCE_REWRITE_TAC[REAL_ARITH `m / x * y:real = (y / x) * m`] THEN
        ASM_SIMP_TAC[GSYM REAL_POW_SUB; REAL_OF_NUM_EQ; ARITH_EQ] THEN
        REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_POW; MULT_CLAUSES]] THEN
      UNDISCH_TAC `m2 <= 2 EXP r (SUC p)` THEN
      ASM_REWRITE_TAC[] THEN
      REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_MUL] THEN
      REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN
      ASM_SIMP_TAC[REAL_POW_SUB; REAL_OF_NUM_EQ; ARITH_EQ] THEN
      REWRITE_TAC[REAL_ARITH `x / y * z <= x <=> x * (z / y) <= x * &1`] THEN
      SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_POW2]]] THEN
  SUBGOAL_THEN
  `?t. (!n. SND(t n) 0 = (a:real^N) /\
            (!i. 2 EXP (FST(t n)) <= i ==> SND(t n) i = b) /\
            !m. m <= 2 EXP (FST(t n))
                ==> ?c. connected c /\ c SUBSET s /\
                        c SUBSET ball(SND(t n) m,inv(&2 pow n)) /\
                        c SUBSET ball(SND(t n) (SUC m),inv(&2 pow n)) /\
                        SND(t n) m IN c /\ SND(t n) (SUC m) IN c) /\
       (!n.
         FST(t n) < FST(t(SUC n)) /\
         (!k. k <= 2 EXP (FST(t n))
                ==> SND(t(SUC n)) (2 EXP (FST(t(SUC n)) - FST(t n)) * k) =
                    SND(t n) k) /\
         (!m k. m <= 2 EXP (FST(t n)) /\ k <= 2 EXP (FST(t(SUC n))) /\
                  abs(&m / &2 pow (FST(t n)) - &k / &2 pow (FST(t(SUC n))))
                    < inv(&2 pow (FST(t n)))
                  ==> ?c. connected c /\ c SUBSET s /\
                          c SUBSET ball(SND(t n) m,inv(&2 pow n)) /\
                          SND(t n) m IN c /\ SND(t(SUC n)) k IN c))`
  MP_TAC THENL
   [MATCH_MP_TAC DEPENDENT_CHOICE THEN
    REWRITE_TAC[EXISTS_PAIR_THM; FORALL_PAIR_THM];
    DISCH_THEN(X_CHOOSE_THEN `t:num->num#(num->real^N)`
        STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `FST o (t:num->num#(num->real^N))` THEN
    EXISTS_TAC `SND o (t:num->num#(num->real^N))` THEN
    ASM_REWRITE_TAC[o_THM] THEN ASM_SIMP_TAC[LE_REFL]] THEN
  CONJ_TAC THENL
   [MP_TAC(ISPEC `s:real^N->bool` COMPACT_LOCALLY_CONNECTED_IMP_ULC_ALT) THEN
    ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
    DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN
    DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPECL [`s:real^N->bool`;
                   `d:real`; `a:real^N`; `b:real^N`]
        CONNECTED_IMP_WELLCHAINED) THEN
    ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `g:num->real^N` MP_TAC) THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:num` THEN STRIP_TAC THEN
    EXISTS_TAC `\i. if i <= l then (g:num->real^N) i else b:real^N` THEN
    ASM_REWRITE_TAC[LE_0] THEN CONJ_TAC THENL
     [X_GEN_TAC `i:num` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
      MP_TAC(ISPEC `l:num` LT_POW2_REFL) THEN ASM_ARITH_TAC;
      ALL_TAC] THEN
    X_GEN_TAC `i:num` THEN DISCH_TAC THEN ASM_CASES_TAC `l:num <= i` THENL
     [ASM_SIMP_TAC[ARITH_RULE `l <= i ==> ~(SUC i <= l)`] THEN
      ASM_SIMP_TAC[ARITH_RULE `l:num <= i ==> (i <= l <=> i = l)`] THEN
      EXISTS_TAC `{b:real^N}` THEN
      REWRITE_TAC[COND_ID; CONNECTED_SING; IN_SING; SING_SUBSET] THEN
      REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_01] THEN ASM SET_TAC[];
      RULE_ASSUM_TAC(REWRITE_RULE[NOT_LE])] THEN
    ASM_SIMP_TAC[LE_SUC_LT; LT_IMP_LE] THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`(g:num->real^N) i`; `g(SUC i):real^N`]) THEN
    ANTS_TAC THENL
     [ASM_SIMP_TAC[LE_SUC_LT; LT_IMP_LE];
      MATCH_MP_TAC MONO_EXISTS THEN
      SIMP_TAC[SUBSET_INTER; CONJ_ACI]];
    ALL_TAC] THEN
  MAP_EVERY X_GEN_TAC [`n:num`; `m:num`; `f:num->real^N`] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN
   `!r. r <= 2 EXP m
        ==> ?l g:num->real^N.
                g 0 = f r /\ (!i. l <= i ==> g i = f (SUC r)) /\
                (?c. connected c /\ f r IN c /\ f(SUC r) IN c /\
                     c SUBSET s /\
                     c SUBSET ball(f r,inv (&2 pow n)) /\
                     c SUBSET ball(f(SUC r),inv (&2 pow n)) /\
                     !i. g i IN c) /\
                (!i. ?c. connected c /\ c SUBSET s /\
                         c SUBSET ball(g i,inv(&2 pow (SUC n))) /\
                         c SUBSET ball(g(SUC i),inv(&2 pow (SUC n))) /\
                         g i IN c /\ g(SUC i) IN c)`
  MP_TAC THENL
   [X_GEN_TAC `r:num` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `r:num`) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPEC `s:real^N->bool` COMPACT_LOCALLY_CONNECTED_IMP_ULC_ALT) THEN
    ASM_REWRITE_TAC[] THEN
    DISCH_THEN(MP_TAC o SPEC `inv(&2 pow (SUC n))`) THEN
    REWRITE_TAC[REAL_LT_INV_EQ; REAL_LT_POW2] THEN
    DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPECL [`c:real^N->bool`;
                   `d:real`; `(f:num->real^N) r`; `(f:num->real^N) (SUC r)`]
        CONNECTED_IMP_WELLCHAINED) THEN
    ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `g:num->real^N` MP_TAC) THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:num` THEN STRIP_TAC THEN
    EXISTS_TAC `\i. if i <= l then (g:num->real^N) i else f(SUC r)` THEN
    ASM_REWRITE_TAC[LE_0] THEN
    CONJ_TAC THENL [ASM_MESON_TAC[LE_ANTISYM]; ALL_TAC] THEN CONJ_TAC THENL
     [EXISTS_TAC `c:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[];
      ALL_TAC] THEN
    X_GEN_TAC `i:num` THEN ASM_CASES_TAC `l:num <= i` THENL
     [ASM_SIMP_TAC[ARITH_RULE `l <= i ==> ~(SUC i <= l)`] THEN
      ASM_SIMP_TAC[ARITH_RULE `l:num <= i ==> (i <= l <=> i = l)`] THEN
      EXISTS_TAC `{f(SUC r):real^N}` THEN
      REWRITE_TAC[COND_ID; CONNECTED_SING; IN_SING; SING_SUBSET] THEN
      REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_INV_EQ; REAL_LT_POW2] THEN
      ASM SET_TAC[];
      RULE_ASSUM_TAC(REWRITE_RULE[NOT_LE])] THEN
    ASM_SIMP_TAC[LE_SUC_LT; LT_IMP_LE] THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`(g:num->real^N) i`; `g(SUC i):real^N`]) THEN
    ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[SUBSET_INTER; CONJ_ACI]] THEN
    REPEAT(FIRST_X_ASSUM(fun th ->
      MP_TAC(SPEC `i:num` th) THEN MP_TAC(SPEC `SUC i` th))) THEN
    ASM_SIMP_TAC[LE_SUC_LT; LT_IMP_LE] THEN ASM SET_TAC[];
    GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM]] THEN
  REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`l:num->num`; `g:num->num->real^N`] THEN
  DISCH_THEN(LABEL_TAC "*") THEN
  MP_TAC(ISPECL [`\n:num. n`;
                 `2 EXP 1 INSERT IMAGE (l:num->num) {r | r <= 2 EXP m}`]
        UPPER_BOUND_FINITE_SET) THEN
  SIMP_TAC[FINITE_INSERT; FINITE_IMAGE; FINITE_NUMSEG_LE] THEN
  DISCH_THEN(X_CHOOSE_THEN `p:num` (MP_TAC o MATCH_MP (MESON[LE_TRANS; LT_LE]
   `(!x. x IN s ==> x <= p)
    ==> p < 2 EXP p ==> (!x. x IN s ==> x <= 2 EXP p)`))) THEN
  ANTS_TAC THEN REWRITE_TAC[LT_POW2_REFL] THEN
  REWRITE_TAC[FORALL_IN_INSERT; LE_EXP] THEN
  CONV_TAC NUM_REDUCE_CONV THEN
  REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN STRIP_TAC THEN
  EXISTS_TAC `m + p:num` THEN
  EXISTS_TAC
   `\i. if i <= 2 EXP (m + p)
        then (g:num->num->real^N) (i DIV (2 EXP p)) (i MOD (2 EXP p))
        else b` THEN
  ASM_REWRITE_TAC[ARITH_RULE `m < m + p <=> 1 <= p`] THEN
  REWRITE_TAC[ADD_SUB2] THEN SIMP_TAC[] THEN
  SIMP_TAC[DIV_MULT; EXP_EQ_0; ARITH_EQ; EXP_ADD; MOD_MULT;
           ONCE_REWRITE_RULE[MULT_SYM] DIV_MULT;
           ONCE_REWRITE_RULE[MULT_SYM] MOD_MULT] THEN
  REPEAT CONJ_TAC THENL
   [SIMP_TAC[LE_0; DIV_0; MOD_0; EXP_EQ_0; ARITH_EQ] THEN
    ASM_SIMP_TAC[LE_0];
    SIMP_TAC[ARITH_RULE `m:num <= n ==> (n <= m <=> n = m)`] THEN
    SIMP_TAC[ONCE_REWRITE_RULE[MULT_SYM] DIV_MULT;
             ONCE_REWRITE_RULE[MULT_SYM] MOD_MULT;
             EXP_EQ_0; ARITH_EQ] THEN
    ASM_SIMP_TAC[LE_REFL; COND_ID];
    ALL_TAC;
    ASM_SIMP_TAC[] THEN
    ONCE_REWRITE_TAC[ARITH_RULE `p * k:num <= m * p <=> p * k <= p * m`] THEN
    SIMP_TAC[LE_MULT_LCANCEL];
    MAP_EVERY X_GEN_TAC [`r:num`; `k:num`] THEN
    MP_TAC(ISPECL [`k:num`; `2 EXP p`] DIVISION) THEN
    MAP_EVERY ABBREV_TAC [`k1 = k DIV 2 EXP p`; `k2 = k MOD 2 EXP p`] THEN
    REWRITE_TAC[EXP_EQ_0; ARITH_EQ] THEN
    DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC ASSUME_TAC) THEN
    STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE
     `k * p + k':num <= m ==> k * p <= m`)) THEN
    REWRITE_TAC[LE_MULT_RCANCEL; EXP_EQ_0; ARITH_EQ] THEN DISCH_TAC THEN
    REMOVE_THEN "*" (MP_TAC o SPEC `k1:num`) THEN
    ASM_REWRITE_TAC[] THEN
    REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    DISCH_THEN(MP_TAC o CONJUNCT1) THEN MATCH_MP_TAC MONO_EXISTS THEN
    SUBGOAL_THEN `r = k1 \/ r = SUC k1` MP_TAC THENL
     [ALL_TAC; ASM_MESON_TAC[]] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [REAL_ABS_SUB]) THEN
    GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_MUL_LID] THEN
    REWRITE_TAC[GSYM real_div; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN
    SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_POW2; GSYM REAL_OF_NUM_POW] THEN
    SIMP_TAC[REAL_POW_ADD; REAL_LT_POW2; REAL_FIELD
     `&0 < m /\ &0 < p
      ==> (k1 * p + k2) / (m * p) - r / m = ((k1 - r) * p + k2) / p / m`] THEN
    REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NUM] THEN
    SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN
    SIMP_TAC[REAL_LT_LDIV_EQ; REAL_MUL_LID; REAL_LT_POW2] THEN
    DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
     `abs(r + k2) < p
      ==> &0 <= k2 /\ k2 < p ==> -- &2 * p < r /\ r < &1 * p`)) THEN
    SIMP_TAC[REAL_LT_RMUL_EQ; REAL_LT_POW2] THEN
    ASM_REWRITE_TAC[REAL_POS; REAL_OF_NUM_POW; REAL_OF_NUM_LT] THEN
    SIMP_TAC[REAL_LT_INTEGERS; INTEGER_CLOSED; REAL_POS] THEN
    REWRITE_TAC[REAL_ARITH `-- &2 + &1:real <= k - r <=> r <= k + &1`;
                REAL_ARITH `k - r + &1:real <= &1 <=> k <= r`] THEN
    REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_ADD] THEN ARITH_TAC] THEN
  X_GEN_TAC `k:num` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
   [UNDISCH_TAC `SUC k <= 2 EXP m * 2 EXP p`;
    DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE
     `k <= n ==> ~(SUC k <= n) ==> k = n`)) THEN
    ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN
    SIMP_TAC[ONCE_REWRITE_RULE[MULT_SYM] DIV_MULT;
             ONCE_REWRITE_RULE[MULT_SYM] MOD_MULT;
             EXP_EQ_0; ARITH_EQ] THEN
    ASM_SIMP_TAC[LE_REFL] THEN EXISTS_TAC `{b:real^N}` THEN
    ASM_REWRITE_TAC[CONNECTED_SING; IN_SING; SING_SUBSET] THEN
    REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_INV_EQ; REAL_LT_POW2]] THEN
  MP_TAC(ISPECL [`k:num`; `2 EXP p`] DIVISION) THEN
  MAP_EVERY ABBREV_TAC [`k1 = k DIV 2 EXP p`; `k2 = k MOD 2 EXP p`] THEN
  REWRITE_TAC[EXP_EQ_0; ARITH_EQ] THEN
  DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC ASSUME_TAC) THEN
  REWRITE_TAC[LE_SUC_LT] THEN REPEAT DISCH_TAC THEN
  REWRITE_TAC[ARITH_RULE `SUC(a * b + c) = a * b + SUC c`] THEN
  SIMP_TAC[DIV_MULT_ADD; MOD_MULT_ADD; EXP_EQ_0; ARITH_EQ] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE
   `a + b:num < c ==> a < c`)) THEN
  REWRITE_TAC[LT_MULT_RCANCEL; EXP_EQ_0; ARITH_EQ] THEN DISCH_TAC THEN
  SUBGOAL_THEN `SUC k2 <= 2 EXP p` MP_TAC THENL
   [ASM_REWRITE_TAC[LE_SUC_LT]; REWRITE_TAC[LE_LT]] THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
   [ASM_SIMP_TAC[DIV_LT; MOD_LT; ADD_CLAUSES] THEN
    REMOVE_THEN "*" (MP_TAC o SPEC `k1:num`) THEN
    ASM_SIMP_TAC[LT_IMP_LE] THEN MESON_TAC[];
    ASM_SIMP_TAC[DIV_REFL; MOD_REFL; EXP_EQ_0; ARITH_EQ] THEN
    ASM_SIMP_TAC[ARITH_RULE `a < b ==> a + 1 <= b`] THEN
    REMOVE_THEN "*" (MP_TAC o SPEC `k1:num`) THEN
    ASM_SIMP_TAC[LT_IMP_LE] THEN
    REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[GSYM SKOLEM_THM] THEN
    DISCH_THEN(MP_TAC o SPEC `k2:num`) THEN REWRITE_TAC[GSYM ADD1] THEN
    SUBGOAL_THEN `(g:num->num->real^N) k1 (SUC k2) = f(SUC k1)`
     (fun th -> REWRITE_TAC[th]) THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[LT_IMP_LE]]);;

let LOCALLY_COMPACT_PATH_CONNECTED_EQ_CONNECTED = prove
 (`!s:real^N->bool.
        locally compact s /\ locally connected s
        ==> (path_connected s <=> connected s)`,
  MESON_TAC[LOCALLY_COMPACT_CONNECTED_IMP_PATH_CONNECTED;
            PATH_CONNECTED_IMP_CONNECTED]);;

let LOCALLY_COMPACT_LOCALLY_CONNECTED_IMP_LOCALLY_PATH_CONNECTED = prove
 (`!s:real^N->bool.
        locally compact s /\ locally connected s
        ==> locally path_connected s`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ASSUME `locally connected (s:real^N->bool)`) THEN
  REWRITE_TAC[LOCALLY_CONNECTED; LOCALLY_PATH_CONNECTED] THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `v:real^N->bool` THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `a:real^N` THEN
  DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
  X_GEN_TAC `u:real^N->bool` THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC LOCALLY_COMPACT_CONNECTED_IMP_PATH_CONNECTED THEN
  ASM_REWRITE_TAC[] THEN CONJ_TAC THEN
  MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
  EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[]);;

let LOCALLY_COMPACT_LOCALLY_PATH_CONNECTED_EQ_LOCALLY_CONNECTED = prove
 (`!s:real^N->bool.
     locally compact s ==> (locally path_connected s <=> locally connected s)`,
  MESON_TAC[LOCALLY_COMPACT_LOCALLY_CONNECTED_IMP_LOCALLY_PATH_CONNECTED;
            LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);;

let LOCALLY_PATH_CONNECTED_CLOSURE_FROM_FRONTIER = prove
 (`!s:real^N->bool.
        locally connected (frontier s)
        ==> locally path_connected (closure s)`,
  SIMP_TAC[LOCALLY_COMPACT_LOCALLY_PATH_CONNECTED_EQ_LOCALLY_CONNECTED;
           CLOSED_IMP_LOCALLY_COMPACT; CLOSED_CLOSURE; FRONTIER_CLOSED] THEN
  REWRITE_TAC[LOCALLY_CONNECTED_CLOSURE_FROM_FRONTIER]);;

(* ------------------------------------------------------------------------- *)
(* If two points are separated by a closed set, there's a minimal one.       *)
(* ------------------------------------------------------------------------- *)

let CLOSED_IRREDUCIBLE_SEPARATOR = prove
 (`!s a b:real^N.
      closed s /\ ~connected_component ((:real^N) DIFF s) a b
      ==> ?t. t SUBSET s /\ closed t /\ ~(t = {}) /\
              ~connected_component ((:real^N) DIFF t) a b /\
              !u. u PSUBSET t ==> connected_component ((:real^N) DIFF u) a b`,
  MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `a:real^N`; `b:real^N`] THEN
  STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN c` THENL
   [EXISTS_TAC `{a:real^N}` THEN ASM_REWRITE_TAC[CLOSED_SING; SING_SUBSET] THEN
    SIMP_TAC[SET_RULE `s PSUBSET {a} <=> s = {}`; NOT_INSERT_EMPTY] THEN
    REWRITE_TAC[DIFF_EMPTY; CONNECTED_COMPONENT_UNIV] THEN
    CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[UNIV]] THEN
    DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN SET_TAC[];
    ALL_TAC] THEN
  ASM_CASES_TAC `(b:real^N) IN c` THENL
   [EXISTS_TAC `{b:real^N}` THEN ASM_REWRITE_TAC[CLOSED_SING; SING_SUBSET] THEN
    SIMP_TAC[SET_RULE `s PSUBSET {a} <=> s = {}`; NOT_INSERT_EMPTY] THEN
    REWRITE_TAC[DIFF_EMPTY; CONNECTED_COMPONENT_UNIV] THEN
    CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[UNIV]] THEN
    DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN SET_TAC[];
    ALL_TAC] THEN
  MAP_EVERY ABBREV_TAC
   [`r = connected_component ((:real^N) DIFF c) a`;
    `s = connected_component ((:real^N) DIFF closure r) b`] THEN
  EXISTS_TAC `frontier s:real^N->bool` THEN REWRITE_TAC[FRONTIER_CLOSED] THEN
  SUBGOAL_THEN `(a:real^N) IN r` ASSUME_TAC THENL
   [EXPAND_TAC "r" THEN REWRITE_TAC[IN] THEN
    REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN `(b:real^N) IN s` ASSUME_TAC THENL
   [EXPAND_TAC "s" THEN
    REWRITE_TAC[IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
    ASM_REWRITE_TAC[IN_UNIV; IN_DIFF] THEN
    REWRITE_TAC[CLOSURE_UNION_FRONTIER; IN_UNION; DE_MORGAN_THM] THEN
    CONJ_TAC THENL [ASM_REWRITE_TAC[IN]; EXPAND_TAC "r"] THEN
    DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET]
      FRONTIER_OF_CONNECTED_COMPONENT_SUBSET)) THEN
    FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `~(b IN s) ==> t SUBSET s ==> b IN t ==> F`)) THEN
    ASM_REWRITE_TAC[FRONTIER_COMPLEMENT; FRONTIER_SUBSET_EQ];
    ALL_TAC] THEN
  SUBGOAL_THEN `frontier(s:real^N->bool) SUBSET frontier r` ASSUME_TAC THENL
   [EXPAND_TAC "s" THEN
    MATCH_MP_TAC(MESON[SUBSET_TRANS; FRONTIER_OF_CONNECTED_COMPONENT_SUBSET]
     `frontier s SUBSET t ==> frontier(connected_component s a) SUBSET t`) THEN
    REWRITE_TAC[FRONTIER_COMPLEMENT; FRONTIER_CLOSURE_SUBSET];
    ALL_TAC] THEN
  MATCH_MP_TAC(TAUT
   `(q ==> r) /\ p /\ ~r /\ s ==> p /\ ~q /\ ~r /\ s`) THEN
  CONJ_TAC THENL
   [SIMP_TAC[DIFF_EMPTY; CONNECTED_COMPONENT_UNIV] THEN REWRITE_TAC[UNIV];
    ALL_TAC] THEN
  REPEAT CONJ_TAC THENL
   [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
      SUBSET_TRANS)) THEN
    EXPAND_TAC "r" THEN
    MATCH_MP_TAC(MESON[SUBSET_TRANS; FRONTIER_OF_CONNECTED_COMPONENT_SUBSET]
     `frontier s SUBSET t ==>frontier (connected_component s a) SUBSET t`) THEN
    ASM_REWRITE_TAC[FRONTIER_COMPLEMENT; FRONTIER_SUBSET_EQ];
    REWRITE_TAC[connected_component; NOT_EXISTS_THM; SET_RULE
                  `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN
    X_GEN_TAC `t:real^N->bool` THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
     (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN
    REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN
    ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN CONJ_TAC THENL
     [EXISTS_TAC `b:real^N` THEN ASM_REWRITE_TAC[]; EXISTS_TAC `a:real^N`] THEN
    ASM_REWRITE_TAC[IN_DIFF] THEN EXPAND_TAC "s" THEN REWRITE_TAC[IN] THEN
    DISCH_THEN(MP_TAC o CONJUNCT2 o MATCH_MP CONNECTED_COMPONENT_IN) THEN
    REWRITE_TAC[IN_DIFF; IN_UNIV] THEN
    MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN
    ASM_REWRITE_TAC[];
    X_GEN_TAC `u:real^N->bool` THEN REWRITE_TAC[PSUBSET_ALT] THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    DISCH_THEN(X_CHOOSE_THEN `p:real^N` STRIP_ASSUME_TAC) THEN
    REWRITE_TAC[connected_component] THEN
    EXISTS_TAC `(p:real^N) INSERT (s UNION r)` THEN
    ASM_REWRITE_TAC[IN_INSERT; IN_UNION] THEN CONJ_TAC THENL
     [ONCE_REWRITE_TAC[SET_RULE
       `a INSERT (s UNION t) = (a INSERT s) UNION (a INSERT t)`] THEN
      MATCH_MP_TAC CONNECTED_UNION THEN REWRITE_TAC[CONJ_ASSOC] THEN
      CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
      CONJ_TAC THEN MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THENL
       [EXISTS_TAC `s:real^N->bool`; EXISTS_TAC `r:real^N->bool`] THEN
      (CONJ_TAC THENL
        [ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT]; ALL_TAC] THEN
       CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[INSERT_SUBSET]] THEN
       REWRITE_TAC[CLOSURE_SUBSET] THEN
       ASM_REWRITE_TAC[CLOSURE_UNION_FRONTIER; IN_UNION] THEN ASM SET_TAC[]);
      MATCH_MP_TAC(SET_RULE
       `s INTER u = {} /\ t INTER u = {} /\ ~(p IN u)
        ==> p INSERT (s UNION t) SUBSET UNIV DIFF u`) THEN
      ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
       [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
         `u SUBSET t ==> t INTER s = {} ==> s INTER u = {}`)) THEN
        REWRITE_TAC[FRONTIER_DISJOINT_EQ] THEN EXPAND_TAC "s";
        SUBGOAL_THEN `frontier(r:real^N->bool) INTER r = {}`
         (fun th -> ASM SET_TAC[th]) THEN
        REWRITE_TAC[FRONTIER_DISJOINT_EQ] THEN EXPAND_TAC "r"] THEN
      MATCH_MP_TAC OPEN_CONNECTED_COMPONENT THEN
      ASM_REWRITE_TAC[GSYM closed; CLOSED_CLOSURE]]]);;

(* ------------------------------------------------------------------------- *)
(* Lower bound on norms within segment between vectors.                      *)
(* Could have used these for connectedness results below, in fact.           *)
(* ------------------------------------------------------------------------- *)

let NORM_SEGMENT_LOWERBOUND = prove
 (`!a b x:real^N r d.
        &0 < r /\
        norm(a) = r /\ norm(b) = r /\ x IN segment[a,b] /\
        a dot b = d * r pow 2
        ==> sqrt((&1 - abs d) / &2) * r <= norm(x)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM real_ge] THEN
  REWRITE_TAC[NORM_GE_SQUARE] THEN DISJ2_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN
  DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN
  ASM_REWRITE_TAC[real_ge; DOT_LMUL; DOT_RMUL; REAL_MUL_RZERO; VECTOR_ARITH
   `(a + b) dot (a + b) = a dot a + b dot b + &2 * a dot b`] THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC `(&1 - u) * (&1 - u) * r pow 2 + u * u * r pow 2 -
              &2 * (&1 - u) * u * abs d * r pow 2` THEN
  CONJ_TAC THENL
   [REWRITE_TAC[REAL_POW_MUL; REAL_MUL_ASSOC] THEN
    REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN
    MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN
    REWRITE_TAC[GSYM REAL_POW_2; REAL_ARITH
     `(&1 - u) pow 2 + u pow 2 - ((&2 * (&1 - u)) * u) * d =
      (&1 + d) * (&1 - &2 * u + &2 * u pow 2) - d`] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC `(&1 + abs d) * &1 / &2 - abs d` THEN CONJ_TAC THENL
     [REWRITE_TAC[REAL_ARITH `(&1 + d) * &1 / &2 - d = (&1 - d) / &2`] THEN
      MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SQRT_POW_2 THEN
      MP_TAC(ISPECL [`a:real^N`; `b:real^N`] NORM_CAUCHY_SCHWARZ_ABS) THEN
      ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_POW2_ABS] THEN
      ASM_REWRITE_TAC[REAL_ARITH `r * r = &1 * r pow 2`] THEN
      ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_POW_LT] THEN REAL_ARITH_TAC;
      MATCH_MP_TAC(REAL_ARITH `x <= y ==> x - a <= y - a`) THEN
      MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL
       [REAL_ARITH_TAC;
        MATCH_MP_TAC(REAL_ARITH
         `&0 <= (u - &1 / &2) * (u - &1 / &2)
          ==> &1 / &2 <= &1 - &2 * u + &2 * u pow 2`) THEN
        REWRITE_TAC[REAL_LE_SQUARE]]];
    ASM_REWRITE_TAC[GSYM NORM_POW_2; REAL_LE_LADD; real_sub] THEN
    MATCH_MP_TAC(REAL_ARITH `abs(a) <= --x ==> x <= a`) THEN
    ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_MUL_LNEG; REAL_NEG_NEG] THEN
    REWRITE_TAC[REAL_ABS_POW; REAL_POW2_ABS; REAL_ABS_NUM] THEN
    REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN
    REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN
    ASM_REWRITE_TAC[real_abs; GSYM real_sub; REAL_SUB_LE; REAL_POS] THEN
    MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THEN
    REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN
          CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
    ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]);;

(* ------------------------------------------------------------------------- *)
(* Special case of orthogonality (could replace 2 by sqrt(2)).               *)
(* ------------------------------------------------------------------------- *)

let NORM_SEGMENT_ORTHOGONAL_LOWERBOUND = prove
 (`!a b:real^N x r.
        r <= norm(a) /\ r <= norm(b) /\ orthogonal a b /\ x IN segment[a,b]
        ==> r / &2 <= norm(x)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[GSYM real_ge] THEN
  REWRITE_TAC[NORM_GE_SQUARE] THEN REWRITE_TAC[real_ge] THEN
  ASM_CASES_TAC `r <= &0` THEN ASM_REWRITE_TAC[] THENL
   [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
  REWRITE_TAC[orthogonal] THEN STRIP_TAC THEN DISJ2_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN
  DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN
  ASM_REWRITE_TAC[DOT_LMUL; DOT_RMUL; REAL_MUL_RZERO; VECTOR_ARITH
   `(a + b) dot (a + b) = a dot a + b dot b + &2 * a dot b`] THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC `(&1 - u) * (&1 - u) * r pow 2 + u * u * r pow 2` THEN
  CONJ_TAC THENL
   [REWRITE_TAC[REAL_ARITH `(r / &2) pow 2 = &1 / &4 * r pow 2`] THEN
    REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; REAL_MUL_ASSOC] THEN
    MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN
    MATCH_MP_TAC(REAL_ARITH
     `&0 <= (u - &1 / &2) * (u - &1 / &2)
      ==> &1 / &4 <= (&1 - u) * (&1 - u) + u * u`) THEN
    REWRITE_TAC[REAL_LE_SQUARE];
    REWRITE_TAC[REAL_ADD_RID] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN
    CONJ_TAC THEN
    REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN
        CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
    ASM_REWRITE_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* Accessibility of frontier points.                                         *)
(* ------------------------------------------------------------------------- *)

let DENSE_ACCESSIBLE_FRONTIER_POINTS = prove
 (`!s:real^N->bool v.
        open s /\ open_in (subtopology euclidean (frontier s)) v /\ ~(v = {})
        ==> ?g. arc g /\
                IMAGE g (interval [vec 0,vec 1] DELETE vec 1) SUBSET s /\
                pathstart g IN s /\ pathfinish g IN v`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `z:real^N`)) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `r:real` THEN STRIP_TAC THEN
  SUBGOAL_THEN `(z:real^N) IN frontier s` MP_TAC THENL
   [ASM SET_TAC[];
    DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
    REWRITE_TAC[frontier] THEN ASM_SIMP_TAC[IN_DIFF; INTERIOR_OPEN]] THEN
  REWRITE_TAC[closure; IN_UNION; TAUT `(p \/ q) /\ ~p <=> ~p /\ q`] THEN
  REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_INFINITE_BALL]) THEN
  DISCH_THEN(MP_TAC o SPEC `r:real`) THEN ASM_REWRITE_TAC[] THEN
  ASM_CASES_TAC `s INTER ball(z:real^N,r) = {}` THENL
   [ASM_MESON_TAC[INFINITE; FINITE_EMPTY]; DISCH_THEN(K ALL_TAC)] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  REWRITE_TAC[IN_INTER] THEN
  DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN `~((y:real^N) IN frontier s)` ASSUME_TAC THENL
   [ASM_SIMP_TAC[IN_DIFF; INTERIOR_OPEN; frontier]; ALL_TAC] THEN
  SUBGOAL_THEN `path_connected(ball(z:real^N,r))` MP_TAC THENL
   [ASM_SIMP_TAC[CONVEX_BALL; CONVEX_IMP_PATH_CONNECTED]; ALL_TAC] THEN
  REWRITE_TAC[PATH_CONNECTED_ARCWISE] THEN
  DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `z:real^N`]) THEN
  ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN
  ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPEC
    `IMAGE drop {t | t IN interval[vec 0,vec 1] /\
                     (g:real^1->real^N) t IN frontier s}`
   COMPACT_ATTAINS_INF) THEN
  REWRITE_TAC[EXISTS_IN_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE; IMP_CONJ] THEN
  REWRITE_TAC[IMP_IMP; FORALL_IN_GSPEC; EXISTS_IN_GSPEC; GSYM IMAGE_o] THEN
  REWRITE_TAC[o_DEF; LIFT_DROP; IMAGE_ID] THEN
  ANTS_TAC THENL
   [CONJ_TAC THENL
     [REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL
       [MATCH_MP_TAC BOUNDED_SUBSET THEN
        EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
        REWRITE_TAC[BOUNDED_INTERVAL; SUBSET_RESTRICT];
        MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
        REWRITE_TAC[FRONTIER_CLOSED; CLOSED_INTERVAL; GSYM path] THEN
        ASM_MESON_TAC[arc]];
      REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `vec 1:real^1` THEN
      ASM_REWRITE_TAC[IN_ELIM_THM; ENDS_IN_UNIT_INTERVAL] THEN
      ASM_MESON_TAC[pathfinish; SUBSET]];
    DISCH_THEN(X_CHOOSE_THEN `t:real^1` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `subpath (vec 0) t (g:real^1->real^N)` THEN
    ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
    MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
     [MATCH_MP_TAC ARC_SUBPATH_ARC THEN
      ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
      ASM_MESON_TAC[pathstart];
      REWRITE_TAC[arc] THEN STRIP_TAC] THEN
    GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o LAND_CONV) [GSYM pathstart] THEN
    ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
     [ALL_TAC; RULE_ASSUM_TAC(SIMP_RULE[path_image]) THEN ASM SET_TAC[]] THEN
    MATCH_MP_TAC(SET_RULE
     `a IN s /\ IMAGE f s DELETE (f a) SUBSET t /\
      (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
      ==> IMAGE f (s DELETE a) SUBSET t`) THEN
    ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; GSYM path_image] THEN
    W(MP_TAC o PART_MATCH (lhand o rand) PATH_IMAGE_SUBPATH o lhand o lhand o
      snd) THEN
    ANTS_TAC THENL [ASM_MESON_TAC[IN_INTERVAL_1]; DISCH_THEN SUBST1_TAC] THEN
    REWRITE_TAC[REWRITE_RULE[pathfinish] PATHFINISH_SUBPATH] THEN
    MATCH_MP_TAC(SET_RULE
     `IMAGE f (s DELETE a) DIFF t = {}
      ==> IMAGE f s DELETE f a SUBSET t`) THEN
    MATCH_MP_TAC(REWRITE_RULE[TAUT
     `p /\ q /\ ~r ==> ~s <=> p /\ q /\ s ==> r`]
     CONNECTED_INTER_FRONTIER) THEN
    REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN CONJ_TAC THENL
       [FIRST_X_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [arc]) THEN
        REWRITE_TAC[path] THEN MATCH_MP_TAC
         (REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET) THEN
        FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
        REWRITE_TAC[SUBSET; IN_DELETE; GSYM DROP_EQ; IN_INTERVAL_1] THEN
        REAL_ARITH_TAC;
        MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
        EXISTS_TAC `interval(vec 0:real^1,t)` THEN
        REWRITE_TAC[CONNECTED_INTERVAL; CLOSURE_INTERVAL] THEN
        REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN
        FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
        COND_CASES_TAC THEN
        ASM_REWRITE_TAC[SUBSET; IN_DELETE; GSYM DROP_EQ; IN_INTERVAL_1] THEN
        REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_REAL_ARITH_TAC];
      REWRITE_TAC[SET_RULE
        `~(IMAGE f s INTER t = {}) <=> ?x. x IN s /\ f x IN t`] THEN
      EXISTS_TAC `vec 0:real^1` THEN
      REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; REAL_LE_REFL] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
      ASM SET_TAC[pathstart];
      REWRITE_TAC[SET_RULE
       `IMAGE g i INTER s = {} <=> !x. x IN i ==> ~(g x IN s)`] THEN
      REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE; IN_UNIV; IN_DIFF] THEN
      X_GEN_TAC `z:real^1` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
      REWRITE_TAC[GSYM DROP_EQ; IN_INTERVAL_1] THEN DISCH_TAC THEN
      DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
      ASM_REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
      ASM_REAL_ARITH_TAC]]);;

let DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED = prove
 (`!s:real^N->bool v x.
        open s /\ connected s /\ x IN s /\
        open_in (subtopology euclidean (frontier s)) v /\ ~(v = {})
        ==> ?g. arc g /\
                IMAGE g (interval [vec 0,vec 1] DELETE vec 1) SUBSET s /\
                pathstart g = x /\ pathfinish g IN v`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `v:real^N->bool`]
        DENSE_ACCESSIBLE_FRONTIER_POINTS) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN `path_connected(s:real^N->bool)` MP_TAC THENL
   [ASM_MESON_TAC[CONNECTED_OPEN_PATH_CONNECTED]; ALL_TAC] THEN
  REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
  DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `pathstart g:real^N`]) THEN
  ASM_REWRITE_TAC[path_component; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `f:real^1->real^N` THEN STRIP_TAC THEN
  MP_TAC(ISPECL [`f ++ g:real^1->real^N`; `x:real^N`; `pathfinish g:real^N`]
        PATH_CONTAINS_ARC) THEN
  ASM_SIMP_TAC[PATH_JOIN_EQ; ARC_IMP_PATH; PATH_IMAGE_JOIN;
               PATHSTART_JOIN; PATHFINISH_JOIN] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
  GEN_REWRITE_TAC LAND_CONV [SUBSET] THEN
  ASM_SIMP_TAC[frontier; INTERIOR_OPEN; IN_DIFF] THEN
  DISCH_TAC THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^1->real^N` THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE
   `a IN s /\ IMAGE f s DELETE (f a) SUBSET t /\
    (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
    ==> IMAGE f (s DELETE a) SUBSET t`) THEN
  REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
  CONJ_TAC THENL [REWRITE_TAC[GSYM path_image]; ASM_MESON_TAC[arc]] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
   `h SUBSET f UNION g
    ==> f SUBSET s /\ g DELETE a SUBSET s ==> h DELETE a SUBSET s`)) THEN
  ASM_REWRITE_TAC[] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[path_image; pathstart; pathfinish]) THEN
  REWRITE_TAC[path_image] THEN ASM SET_TAC[]);;

let DENSE_ACCESSIBLE_FRONTIER_POINT_PAIRS = prove
 (`!s u v:real^N->bool.
         open s /\ connected s /\
         open_in (subtopology euclidean (frontier s)) u /\
         open_in (subtopology euclidean (frontier s)) v /\
         ~(u = {}) /\ ~(v = {}) /\ ~(u = v)
         ==> ?g. arc g /\
                 pathstart g IN u /\ pathfinish g IN v /\
                 IMAGE g (interval(vec 0,vec 1)) SUBSET s`,
  GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN
  ONCE_REWRITE_TAC[IMP_CONJ_ALT] THEN
  GEN_REWRITE_TAC (funpow 2 BINDER_CONV o LAND_CONV o RAND_CONV)
    [GSYM SUBSET_ANTISYM_EQ] THEN
  REWRITE_TAC[DE_MORGAN_THM; GSYM CONJ_ASSOC] THEN
  MATCH_MP_TAC(MESON[]
   `(!u v. R u v ==> R v u) /\ (!u v. P u v ==> R u v)
    ==> !u v. P u v \/ P v u ==> R u v`) THEN
  CONJ_TAC THENL
   [REPEAT GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:real^1->real^N` THEN
    STRIP_TAC THEN EXISTS_TAC `reversepath g:real^1->real^N` THEN
    ASM_SIMP_TAC[ARC_REVERSEPATH; PATHSTART_REVERSEPATH;
                 PATHFINISH_REVERSEPATH] THEN
    REWRITE_TAC[reversepath] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN
    REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
     (SET_RULE `IMAGE f i SUBSET t
                ==> IMAGE r i SUBSET i ==> IMAGE f (IMAGE r i) SUBSET t`)) THEN
    SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN
    REAL_ARITH_TAC;
    ALL_TAC] THEN
  REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[FRONTIER_EMPTY; OPEN_IN_SUBTOPOLOGY_EMPTY] THENL
   [CONV_TAC TAUT; STRIP_TAC THEN UNDISCH_TAC `~(s:real^N->bool = {})`] THEN
  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  MP_TAC(ISPECL
   [`s:real^N->bool`; `v:real^N->bool`; `x:real^N`]
   DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `g:real^1->real^N` THEN STRIP_TAC THEN
  MP_TAC(ISPECL
   [`s:real^N->bool`; `(u DELETE pathfinish g):real^N->bool`; `x:real^N`]
   DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED) THEN
  ASM_SIMP_TAC[OPEN_IN_DELETE; IN_DELETE; LEFT_IMP_EXISTS_THM] THEN
  ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
  X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THEN
  MP_TAC(ISPECL [`(reversepath h ++ g):real^1->real^N`;
                 `pathfinish h:real^N`; `pathfinish g:real^N`]
        PATH_CONTAINS_ARC) THEN
  ASM_SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN;
               PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH;
               PATH_REVERSEPATH; ARC_IMP_PATH; PATH_IMAGE_JOIN;
               PATH_IMAGE_REVERSEPATH] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^1->real^N` THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN
  MATCH_MP_TAC(SET_RULE
   `(!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
    t SUBSET s /\ IMAGE f s SUBSET u UNION IMAGE f t
    ==> IMAGE f (s DIFF t) SUBSET u`) THEN
  REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; ENDS_IN_UNIT_INTERVAL] THEN
  CONJ_TAC THENL [ASM_MESON_TAC[arc]; REWRITE_TAC[GSYM path_image]] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        SUBSET_TRANS)) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish; path_image]) THEN
  REWRITE_TAC[path_image] THEN ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Some simple positive connection theorems.                                 *)
(* ------------------------------------------------------------------------- *)

let PATH_CONNECTED_CONVEX_DIFF_CARD_LT = prove
 (`!u s:real^N->bool.
    convex u /\ ~(collinear u) /\ s <_c (:real) ==> path_connected(u DIFF s)`,
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[path_connected; IN_DIFF; IN_UNIV] THEN
  MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN
  ASM_CASES_TAC `a:real^N = b` THENL
   [EXISTS_TAC `linepath(a:real^N,b)` THEN
    REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_LINEPATH] THEN
    ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  ABBREV_TAC `m:real^N = midpoint(a,b)` THEN
  SUBGOAL_THEN `~(m:real^N = a) /\ ~(m = b)` STRIP_ASSUME_TAC THENL
   [ASM_MESON_TAC[MIDPOINT_EQ_ENDPOINT]; ALL_TAC] THEN
  POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
  GEOM_ORIGIN_TAC `m:real^N` THEN REPEAT GEN_TAC THEN
  GEOM_NORMALIZE_TAC `b:real^N` THEN REWRITE_TAC[] THEN GEN_TAC THEN
  GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN X_GEN_TAC `bbb:real` THEN
  DISCH_TAC THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
  ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN
  DISCH_THEN SUBST1_TAC THEN POP_ASSUM(K ALL_TAC) THEN
  REPEAT GEN_TAC THEN REWRITE_TAC[midpoint; VECTOR_MUL_LID] THEN
  REWRITE_TAC[VECTOR_ARITH `inv(&2) % (a + b):real^N = vec 0 <=> a = --b`] THEN
  ASM_CASES_TAC `a:real^N = --(basis 1)` THEN ASM_REWRITE_TAC[] THEN
  POP_ASSUM(K ALL_TAC) THEN
  REPLICATE_TAC 7 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  DISCH_THEN(K ALL_TAC) THEN
  SUBGOAL_THEN `segment[--basis 1:real^N,basis 1] SUBSET u` ASSUME_TAC THENL
   [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
    ASM SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN `(vec 0:real^N) IN u` ASSUME_TAC THENL
   [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
    REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `&1 / &2` THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN VECTOR_ARITH_TAC;
    ALL_TAC] THEN
  SUBGOAL_THEN `?c:real^N k. 1 <= k /\ ~(k = 1) /\ k <= dimindex(:N) /\
                             c IN u /\ ~(c$k = &0)`
  STRIP_ASSUME_TAC THENL
   [REWRITE_TAC[GSYM NOT_FORALL_THM; TAUT
     `a /\ ~b /\ c /\ d /\ ~e <=> ~(d ==> a /\ c ==> ~b ==> e)`] THEN
    DISCH_TAC THEN UNDISCH_TAC `~collinear(u:real^N->bool)` THEN
    REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN
    MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `basis 1:real^N`] THEN
    SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT; SPAN_INSERT_0] THEN
    REWRITE_TAC[SPAN_SING; SUBSET; IN_ELIM_THM; IN_UNIV] THEN
    X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN EXISTS_TAC `(c:real^N)$1` THEN
    SIMP_TAC[CART_EQ; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN
    REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
    ASM_REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RZERO] THEN
    ASM_MESON_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN `~(c:real^N = vec 0)` ASSUME_TAC THENL
   [ASM_SIMP_TAC[CART_EQ; VEC_COMPONENT] THEN ASM_MESON_TAC[]; ALL_TAC] THEN
  SUBGOAL_THEN `segment[vec 0:real^N,c] SUBSET u` ASSUME_TAC THENL
   [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
    ASM SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `?z:real^N. z IN segment[vec 0,c] /\
               (segment[--basis 1,z] UNION segment[z,basis 1]) INTER s = {}`
  STRIP_ASSUME_TAC THENL
   [ALL_TAC;
    EXISTS_TAC `linepath(--basis 1:real^N,z) ++ linepath(z,basis 1)` THEN
    ASM_SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; PATH_LINEPATH;
                 PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_JOIN] THEN
    REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `(t UNION v) INTER s = {}
      ==> t SUBSET u /\ v SUBSET u
          ==> (t UNION v) SUBSET u DIFF s`)) THEN
    REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN
    CONJ_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM SET_TAC[]] THEN
  MATCH_MP_TAC(SET_RULE
   `~(s SUBSET {z | z IN s /\ ~P z}) ==> ?z. z IN s /\ P z`) THEN
  DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN
  REWRITE_TAC[CARD_NOT_LE; SET_RULE
   `~((b UNION c) INTER s = {}) <=>
    ~(b INTER s = {}) \/ ~(c INTER s = {})`] THEN
  REWRITE_TAC[SET_RULE
   `{x | P x /\ (Q x \/ R x)} = {x | P x /\ Q x} UNION {x | P x /\ R x}`] THEN
  W(MP_TAC o PART_MATCH lhand UNION_LE_ADD_C o lhand o snd) THEN
  MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] CARD_LET_TRANS) THEN
  TRANS_TAC CARD_LTE_TRANS `(:real)` THEN CONJ_TAC THENL
   [MATCH_MP_TAC CARD_ADD2_ABSORB_LT THEN REWRITE_TAC[real_INFINITE];
    MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
    ASM_SIMP_TAC[CARD_EQ_SEGMENT]] THEN
  REWRITE_TAC[MESON[SEGMENT_SYM] `segment[--a:real^N,b] = segment[b,--a]`] THEN
  SUBGOAL_THEN
   `!b:real^N.
       b IN u /\ ~(b IN s) /\ ~(b = vec 0) /\ b$k = &0
       ==> {z | z IN segment[vec 0,c] /\ ~(segment[z,b] INTER s = {})} <_c
           (:real)`
   (fun th -> CONJ_TAC THEN MATCH_MP_TAC th THEN
              REWRITE_TAC[VECTOR_NEG_EQ_0; VECTOR_NEG_COMPONENT] THEN
              ASM_SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL;
                           BASIS_COMPONENT] THEN
              REWRITE_TAC[REAL_NEG_0]) THEN
  REPEAT STRIP_TAC THEN TRANS_TAC CARD_LET_TRANS `s:real^N->bool` THEN
  ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; RIGHT_AND_EXISTS_THM] THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> r /\ p /\ q`] THEN
  MATCH_MP_TAC CARD_LE_RELATIONAL THEN
  MAP_EVERY X_GEN_TAC [`w:real^N`; `x1:real^N`; `x2:real^N`] THEN
  REWRITE_TAC[SEGMENT_SYM] THEN STRIP_TAC THEN
  ASM_CASES_TAC `x2:real^N = x1` THEN ASM_REWRITE_TAC[] THEN
  MP_TAC(ISPECL
   [`x1:real^N`; `b:real^N`; `x2:real^N`] INTER_SEGMENT) THEN
  REWRITE_TAC[NOT_IMP; SEGMENT_SYM] THEN
  CONJ_TAC THENL [DISJ2_TAC; REWRITE_TAC[SEGMENT_SYM] THEN ASM SET_TAC[]] THEN
  ONCE_REWRITE_TAC[SET_RULE `{x1,b,x2} = {x1,x2,b}`] THEN
  ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL] THEN STRIP_TAC THEN
  SUBGOAL_THEN `(b:real^N) IN affine hull {vec 0,c}` MP_TAC THENL
   [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `b IN s ==> s SUBSET t ==> b IN t`)) THEN
    MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[AFFINE_AFFINE_HULL] THEN
    MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `segment[c:real^N,vec 0]` THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ONCE_REWRITE_TAC[SEGMENT_SYM]] THEN
    REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_SUBSET_AFFINE_HULL];
    REWRITE_TAC[AFFINE_HULL_2_ALT; IN_ELIM_THM; IN_UNIV] THEN
    REWRITE_TAC[VECTOR_ADD_LID; VECTOR_SUB_RZERO; NOT_EXISTS_THM] THEN
    X_GEN_TAC `r:real` THEN
    ASM_CASES_TAC `r = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
    CONV_TAC(RAND_CONV SYM_CONV) THEN
    DISCH_THEN(MP_TAC o AP_TERM `\x:real^N. x$k`) THEN
    ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_ENTIRE]]);;

let CONNECTED_CONVEX_DIFF_CARD_LT = prove
 (`!u s. convex u /\ ~collinear u /\ s <_c (:real) ==> connected(u DIFF s)`,
  SIMP_TAC[PATH_CONNECTED_CONVEX_DIFF_CARD_LT; PATH_CONNECTED_IMP_CONNECTED]);;

let PATH_CONNECTED_CONVEX_DIFF_COUNTABLE = prove
 (`!u s. convex u /\ ~collinear u /\ COUNTABLE s ==> path_connected(u DIFF s)`,
  MESON_TAC[COUNTABLE_IMP_CARD_LT_REAL; PATH_CONNECTED_CONVEX_DIFF_CARD_LT]);;

let CONNECTED_CONVEX_DIFF_COUNTABLE = prove
 (`!u s. convex u /\ ~collinear u /\ COUNTABLE s ==> connected(u DIFF s)`,
  MESON_TAC[COUNTABLE_IMP_CARD_LT_REAL; CONNECTED_CONVEX_DIFF_CARD_LT]);;

let PATH_CONNECTED_PUNCTURED_CONVEX = prove
 (`!s a:real^N. convex s /\ ~(aff_dim s = &1) ==> path_connected(s DELETE a)`,
  REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (INT_ARITH
   `~(x:int = &1) ==> --(&1) <= x ==> x = -- &1 \/ x = &0 \/ &2 <= x`)) THEN
  ASM_REWRITE_TAC[AFF_DIM_GE; AFF_DIM_EQ_MINUS1; AFF_DIM_EQ_0] THEN
  DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN
  ASM_REWRITE_TAC[PATH_CONNECTED_EMPTY; SET_RULE `{} DELETE a = {}`] THENL
   [FIRST_X_ASSUM(X_CHOOSE_THEN `b:real^N` SUBST1_TAC) THEN
    ASM_CASES_TAC `b:real^N = a` THEN
    ASM_REWRITE_TAC[PATH_CONNECTED_EMPTY; SET_RULE `{a} DELETE a = {}`] THEN
    ASM_SIMP_TAC[SET_RULE `~(b = a) ==> {a} DELETE b = {a}`] THEN
    REWRITE_TAC[PATH_CONNECTED_SING];
    REPEAT STRIP_TAC THEN
    ONCE_REWRITE_TAC[SET_RULE `s DELETE a = s DIFF {a}`] THEN
    MATCH_MP_TAC PATH_CONNECTED_CONVEX_DIFF_COUNTABLE THEN
    ASM_REWRITE_TAC[COUNTABLE_SING; COLLINEAR_AFF_DIM] THEN
    ASM_INT_ARITH_TAC]);;

let CONNECTED_PUNCTURED_CONVEX = prove
 (`!s a:real^N. convex s /\ ~(aff_dim s = &1) ==> connected(s DELETE a)`,
  SIMP_TAC[PATH_CONNECTED_PUNCTURED_CONVEX; PATH_CONNECTED_IMP_CONNECTED]);;

let PATH_CONNECTED_COMPLEMENT_CARD_LT = prove
 (`!s. 2 <= dimindex(:N) /\ s <_c (:real)
       ==> path_connected((:real^N) DIFF s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_CONVEX_DIFF_CARD_LT THEN
  ASM_REWRITE_TAC[CONVEX_UNIV; COLLINEAR_AFF_DIM; AFF_DIM_UNIV] THEN
  REWRITE_TAC[INT_OF_NUM_LE] THEN ASM_ARITH_TAC);;

let PATH_CONNECTED_CONNECTED_DIFF = prove
 (`!s t:real^N->bool.
        connected s /\ s SUBSET closure(s DIFF t) /\
        (!x. x IN s
             ==> ?u. x IN u /\ open_in (subtopology euclidean s) u /\
                     path_connected(u DIFF t))
        ==> path_connected(s DIFF t)`,
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT; IN_DIFF] THEN
  REWRITE_TAC[TAUT `(p /\ q) /\ (r /\ s) <=> p /\ r /\ q /\ s`] THEN
  MATCH_MP_TAC CONNECTED_EQUIVALENCE_RELATION_GEN THEN
  ASM_REWRITE_TAC[PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS] THEN CONJ_TAC THENL
   [REWRITE_TAC[OPEN_IN_OPEN; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `x:real^N`; `u:real^N->bool`] THEN
    DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
    ASM_REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN
    ASM_REWRITE_TAC[CLOSURE_NONEMPTY_OPEN_INTER] THEN
    DISCH_THEN(MP_TAC o SPEC `u:real^N->bool`) THEN ASM SET_TAC[];
    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `u:real^N->bool` THEN
    ONCE_REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    ASM_REWRITE_TAC[IN_DIFF] THEN
    REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
    MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[] THEN MATCH_MP_TAC(SET_RULE
     `P SUBSET Q ==> P x ==> Q x`) THEN REWRITE_TAC[ETA_AX] THEN
    MATCH_MP_TAC PATH_COMPONENT_MONO THEN
    FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SET_TAC[]]);;

let PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT = prove
 (`!s t:real^N->bool.
        connected s /\ open_in (subtopology euclidean (affine hull s)) s /\
        ~collinear s /\ t <_c (:real)
        ==> path_connected(s DIFF t)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_CONNECTED_DIFF THEN
  ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
   [REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE; IN_DIFF] THEN
    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    X_GEN_TAC `d:real` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC o
       REWRITE_RULE[OPEN_IN_CONTAINS_BALL]) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
    SUBGOAL_THEN `~((ball(x:real^N,min d e) INTER affine hull s) DIFF t = {})`
    MP_TAC THENL
     [REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN
      DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN
      REWRITE_TAC[CARD_NOT_LE] THEN
      TRANS_TAC CARD_LTE_TRANS `(:real)` THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC(ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE) THEN
      MATCH_MP_TAC CARD_EQ_CONVEX THEN
      ASM_SIMP_TAC[CONVEX_BALL; CONVEX_INTER; AFFINE_IMP_CONVEX;
                   AFFINE_AFFINE_HULL] THEN
      EXISTS_TAC `x:real^N` THEN
      ASM_SIMP_TAC[CENTRE_IN_BALL; REAL_LT_MIN; IN_INTER; HULL_INC] THEN
      MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`]
        CONNECTED_IMP_PERFECT) THEN
      ANTS_TAC THENL [ASM_MESON_TAC[COLLINEAR_SING]; ALL_TAC] THEN
      REWRITE_TAC[LIMPT_APPROACHABLE] THEN
      DISCH_THEN(MP_TAC o SPEC `min d e:real`) THEN
      ASM_REWRITE_TAC[REAL_LT_MIN; IN_BALL] THEN
      ASM_MESON_TAC[HULL_INC; DIST_SYM];
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
      REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; BALL_MIN_INTER; IN_DIFF;
                  IN_BALL; REAL_LT_MIN] THEN MESON_TAC[DIST_SYM]];
    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC o
       REWRITE_RULE[OPEN_IN_CONTAINS_BALL]) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `ball(x:real^N,r) INTER affine hull s` THEN
    ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL; HULL_INC] THEN CONJ_TAC THENL
     [REWRITE_TAC[OPEN_IN_OPEN] THEN EXISTS_TAC `ball(x:real^N,r)` THEN
      REWRITE_TAC[OPEN_BALL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
       (SET_RULE `b INTER t SUBSET s
                  ==> s SUBSET t ==> b INTER t = s INTER b`)) THEN
      REWRITE_TAC[HULL_SUBSET];
      MATCH_MP_TAC PATH_CONNECTED_CONVEX_DIFF_CARD_LT THEN
      ASM_SIMP_TAC[CONVEX_INTER; AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL;
                   CONVEX_BALL; COLLINEAR_AFF_DIM] THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV
       [COLLINEAR_AFF_DIM]) THEN
      MATCH_MP_TAC(INT_ARITH `x:int = y ==> ~(y <= &1) ==> ~(x <= &1)`) THEN
      GEN_REWRITE_TAC RAND_CONV [GSYM AFF_DIM_AFFINE_HULL] THEN
      ONCE_REWRITE_TAC[INTER_COMM] THEN
      MATCH_MP_TAC AFF_DIM_CONVEX_INTER_OPEN THEN
      ASM_SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; OPEN_BALL] THEN
      REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
      ASM_MESON_TAC[HULL_INC; CENTRE_IN_BALL]]]);;

let CONNECTED_OPEN_IN_DIFF_CARD_LT = prove
 (`!s t:real^N->bool.
        connected s /\ open_in (subtopology euclidean (affine hull s)) s /\
        ~collinear s /\ t <_c (:real)
        ==> connected(s DIFF t)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_IMP_CONNECTED THEN
  MATCH_MP_TAC PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT THEN
  ASM_REWRITE_TAC[]);;

let PATH_CONNECTED_OPEN_DIFF_CARD_LT = prove
 (`!s t:real^N->bool.
        2 <= dimindex(:N) /\ open s /\ connected s /\ t <_c (:real)
        ==> path_connected(s DIFF t)`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[EMPTY_DIFF; PATH_CONNECTED_EMPTY] THEN
  MATCH_MP_TAC PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT THEN
  ASM_REWRITE_TAC[COLLINEAR_AFF_DIM] THEN
  ASM_SIMP_TAC[AFFINE_HULL_OPEN; AFF_DIM_OPEN] THEN
  ASM_REWRITE_TAC[INT_OF_NUM_LE; SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN
  ASM_ARITH_TAC);;

let CONNECTED_OPEN_DIFF_CARD_LT = prove
 (`!s t:real^N->bool.
        2 <= dimindex(:N) /\ open s /\ connected s /\ t <_c (:real)
        ==> connected(s DIFF t)`,
  SIMP_TAC[PATH_CONNECTED_OPEN_DIFF_CARD_LT; PATH_CONNECTED_IMP_CONNECTED]);;

let PATH_CONNECTED_OPEN_DIFF_COUNTABLE = prove
 (`!s t:real^N->bool.
        2 <= dimindex(:N) /\ open s /\ connected s /\ COUNTABLE t
        ==> path_connected(s DIFF t)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_OPEN_DIFF_CARD_LT THEN
  ASM_REWRITE_TAC[GSYM CARD_NOT_LE] THEN
  ASM_MESON_TAC[UNCOUNTABLE_REAL; CARD_LE_COUNTABLE]);;

let CONNECTED_OPEN_DIFF_COUNTABLE = prove
 (`!s t:real^N->bool.
        2 <= dimindex(:N) /\ open s /\ connected s /\ COUNTABLE t
        ==> connected(s DIFF t)`,
  SIMP_TAC[PATH_CONNECTED_OPEN_DIFF_COUNTABLE; PATH_CONNECTED_IMP_CONNECTED]);;

let PATH_CONNECTED_OPEN_DELETE = prove
 (`!s a:real^N. 2 <= dimindex(:N) /\ open s /\ connected s
                ==> path_connected(s DELETE a)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE `s DELETE a = s DIFF {a}`] THEN
  MATCH_MP_TAC PATH_CONNECTED_OPEN_DIFF_COUNTABLE THEN
  ASM_REWRITE_TAC[COUNTABLE_SING]);;

let CONNECTED_OPEN_DELETE = prove
 (`!s a:real^N. 2 <= dimindex(:N) /\ open s /\ connected s
                ==> connected(s DELETE a)`,
  SIMP_TAC[PATH_CONNECTED_OPEN_DELETE; PATH_CONNECTED_IMP_CONNECTED]);;

let PATH_CONNECTED_PUNCTURED_UNIVERSE = prove
 (`!a. 2 <= dimindex(:N) ==> path_connected((:real^N) DIFF {a})`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_OPEN_DIFF_COUNTABLE THEN
  ASM_REWRITE_TAC[OPEN_UNIV; CONNECTED_UNIV; COUNTABLE_SING]);;

let CONNECTED_PUNCTURED_UNIVERSE = prove
 (`!a. 2 <= dimindex(:N) ==> connected((:real^N) DIFF {a})`,
  SIMP_TAC[PATH_CONNECTED_PUNCTURED_UNIVERSE; PATH_CONNECTED_IMP_CONNECTED]);;

let PATH_CONNECTED_PUNCTURED_BALL = prove
 (`!a:real^N r. 2 <= dimindex(:N) ==> path_connected(ball(a,r) DELETE a)`,
  SIMP_TAC[PATH_CONNECTED_OPEN_DELETE; OPEN_BALL; CONNECTED_BALL]);;

let CONNECTED_PUNCTURED_BALL = prove
 (`!a:real^N r. 2 <= dimindex(:N) ==> connected(ball(a,r) DELETE a)`,
  SIMP_TAC[CONNECTED_OPEN_DELETE; OPEN_BALL; CONNECTED_BALL]);;

let PATH_CONNECTED_PUNCTURED_CBALL = prove
 (`!a:real^N r. 2 <= dimindex(:N) ==> path_connected(cball(a,r) DELETE a)`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `&0 < r` THENL
   [MATCH_MP_TAC PATH_CONNECTED_PUNCTURED_CONVEX THEN
    ASM_REWRITE_TAC[CONVEX_CBALL; AFF_DIM_CBALL; INT_OF_NUM_EQ] THEN
    ASM_ARITH_TAC;
    MATCH_MP_TAC(MESON[PATH_CONNECTED_EMPTY]
     `s = {} ==> path_connected s`) THEN
    FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH
     `~(&0 < r) ==> r = &0 \/ r < &0`)) THEN
    ASM_SIMP_TAC[CBALL_EMPTY; CBALL_SING] THEN ASM SET_TAC[]]);;

let CONNECTED_PUNCTURED_CBALL = prove
 (`!a:real^N r. 2 <= dimindex(:N) ==> connected(cball(a,r) DELETE a)`,
  SIMP_TAC[PATH_CONNECTED_PUNCTURED_CBALL; PATH_CONNECTED_IMP_CONNECTED]);;

let PATH_CONNECTED_SPHERE = prove
 (`!a:real^N r. 2 <= dimindex(:N) ==> path_connected(sphere(a,r))`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[sphere; dist] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN
  GEOM_ORIGIN_TAC `a:real^N` THEN GEN_TAC THEN
  REWRITE_TAC[VECTOR_SUB_RZERO] THEN DISCH_TAC THEN
  REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
   (REAL_ARITH `r < &0 \/ r = &0 \/ &0 < r`)
  THENL
   [ASM_SIMP_TAC[NORM_ARITH `r < &0 ==> ~(norm(x:real^N) = r)`] THEN
    REWRITE_TAC[EMPTY_GSPEC; PATH_CONNECTED_EMPTY];
    ASM_REWRITE_TAC[NORM_EQ_0; SING_GSPEC; PATH_CONNECTED_SING];
    SUBGOAL_THEN
     `{x:real^N | norm x = r} =
      IMAGE (\x. r / norm x % x) ((:real^N) DIFF {vec 0})`
    SUBST1_TAC THENL
     [MATCH_MP_TAC SUBSET_ANTISYM THEN
      REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
      REWRITE_TAC[IN_IMAGE; IN_ELIM_THM; IN_DIFF; IN_SING; IN_UNIV] THEN
      ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL;
                   NORM_EQ_0; REAL_ARITH `&0 < r ==> abs r = r`] THEN
      X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `x:real^N` THEN
      ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; VECTOR_MUL_LID] THEN
      ASM_MESON_TAC[NORM_0; REAL_LT_IMP_NZ];
      MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN
      ASM_SIMP_TAC[PATH_CONNECTED_PUNCTURED_UNIVERSE] THEN
      MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN
    REWRITE_TAC[o_DEF; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
    X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_DIFF; IN_UNIV; IN_SING] THEN
    DISCH_TAC THEN REWRITE_TAC[real_div; LIFT_CMUL] THEN
    MATCH_MP_TAC CONTINUOUS_CMUL THEN
    MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_AT_WITHIN_INV) THEN
    ASM_REWRITE_TAC[NORM_EQ_0] THEN MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN
    REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_NORM]]]);;

let CONNECTED_SPHERE = prove
 (`!a:real^N r. 2 <= dimindex(:N) ==> connected(sphere(a,r))`,
  SIMP_TAC[PATH_CONNECTED_SPHERE; PATH_CONNECTED_IMP_CONNECTED]);;

let CONNECTED_SPHERE_EQ = prove
 (`!a:real^N r. connected(sphere(a,r)) <=> 2 <= dimindex(:N) \/ r <= &0`,
  let lemma = prove
   (`!a:real^1 r. &0 < r
         ==> ?x y. ~(x = y) /\ dist(a,x) = r /\ dist(a,y) = r`,
    MP_TAC SPHERE_1 THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
    COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
    REWRITE_TAC[EXTENSION; IN_SPHERE; IN_INSERT; NOT_IN_EMPTY] THEN
    REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[]
    `~(a = b) ==> ?x y. ~(x = y) /\ (x = a \/ x = b) /\ (y = a \/ y = b)`) THEN
    REWRITE_TAC[VECTOR_ARITH `a - r:real^1 = a + r <=> r = vec 0`] THEN
    REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN ASM_REAL_ARITH_TAC) in
  REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THEN
  ASM_SIMP_TAC[SPHERE_EMPTY; CONNECTED_EMPTY; REAL_LT_IMP_LE] THEN
  ASM_CASES_TAC `r = &0` THEN
  ASM_SIMP_TAC[SPHERE_SING; REAL_LE_REFL; CONNECTED_SING] THEN
  SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL
   [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[GSYM REAL_NOT_LT]] THEN
  EQ_TAC THEN SIMP_TAC[CONNECTED_SPHERE] THEN
  DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_FINITE_IFF_SING) THEN
  ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
  SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (2 <= n <=> ~(n = 1))`] THEN
  GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM DIMINDEX_1] THEN
  DISCH_TAC THEN FIRST_ASSUM (fun th ->
    REWRITE_TAC[GEOM_EQUAL_DIMENSION_RULE th FINITE_SPHERE_1]) THEN
  REWRITE_TAC[SET_RULE
   `~(s = {} \/ ?a. s = {a}) <=> ?x y. ~(x = y) /\ x IN s /\ y IN s`] THEN
  REWRITE_TAC[IN_SPHERE] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o C GEOM_EQUAL_DIMENSION_RULE lemma) THEN
  ASM_REWRITE_TAC[]);;

let PATH_CONNECTED_SPHERE_EQ = prove
 (`!a:real^N r. path_connected(sphere(a,r)) <=> 2 <= dimindex(:N) \/ r <= &0`,
  REPEAT GEN_TAC THEN EQ_TAC THENL
   [REWRITE_TAC[GSYM CONNECTED_SPHERE_EQ; PATH_CONNECTED_IMP_CONNECTED];
    STRIP_TAC THEN ASM_SIMP_TAC[PATH_CONNECTED_SPHERE]] THEN
  ASM_CASES_TAC `r < &0` THEN
  ASM_SIMP_TAC[SPHERE_EMPTY; PATH_CONNECTED_EMPTY] THEN
  ASM_CASES_TAC `r = &0` THEN
  ASM_SIMP_TAC[SPHERE_SING; PATH_CONNECTED_SING] THEN
  ASM_REAL_ARITH_TAC);;

let FINITE_SPHERE = prove
 (`!a:real^N r. FINITE(sphere(a,r)) <=> r <= &0 \/ dimindex(:N) = 1`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THEN
  ASM_REWRITE_TAC[] THENL
   [RULE_ASSUM_TAC(REWRITE_RULE[GSYM DIMINDEX_1]) THEN
    FIRST_ASSUM(MATCH_ACCEPT_TAC o C PROVE_HYP
      (GEOM_EQUAL_DIMENSION_RULE(ASSUME `dimindex(:N) = dimindex(:1)`)
      FINITE_SPHERE_1));
    ASM_SIMP_TAC[CONNECTED_SPHERE; ARITH_RULE `2 <= n <=> 1 <= n /\ ~(n = 1)`;
                 DIMINDEX_GE_1; CONNECTED_FINITE_IFF_SING] THEN
    REWRITE_TAC[SET_RULE `(s = {} \/ ?a. s = {a}) <=>
                          (!a b. a IN s /\ b IN s ==> a = b)`] THEN
    SIMP_TAC[IN_SPHERE] THEN EQ_TAC THENL [ALL_TAC; CONV_TAC NORM_ARITH] THEN
    ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
    REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN
    MP_TAC(ISPECL [`a:real^N`; `r:real`] VECTOR_CHOOSE_DIST) THEN
    ASM_SIMP_TAC[REAL_LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `a - (x - a):real^N`]) THEN
    FIRST_X_ASSUM(K ALL_TAC o check (is_neg o concl)) THEN
    REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC NORM_ARITH]);;

let LIMIT_POINT_OF_SPHERE = prove
 (`!a r x:real^N. x limit_point_of sphere(a,r) <=>
                  &0 < r /\ 2 <= dimindex(:N) /\ x IN sphere(a,r)`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `FINITE(sphere(a:real^N,r))` THENL
   [ASM_SIMP_TAC[LIMIT_POINT_FINITE]; ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o REWRITE_RULE[FINITE_SPHERE]) THEN
  REWRITE_TAC[DE_MORGAN_THM] THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[REAL_NOT_LE; ARITH; REAL_NOT_LT] THEN
  ASM_SIMP_TAC[GSYM REAL_NOT_LE; DIMINDEX_GE_1;
               ARITH_RULE `1 <= n ==> (2 <= n <=> ~(n = 1))`] THEN
  EQ_TAC THEN REWRITE_TAC[REWRITE_RULE[CLOSED_LIMPT] CLOSED_SPHERE] THEN
  DISCH_TAC THEN MATCH_MP_TAC CONNECTED_IMP_PERFECT THEN
  ASM_SIMP_TAC[CONNECTED_SPHERE_EQ; DIMINDEX_GE_1;
               ARITH_RULE `1 <= n ==> (2 <= n <=> ~(n = 1))`] THEN
  ASM_MESON_TAC[FINITE_SING]);;

let CARD_EQ_SPHERE = prove
 (`!a:real^N r. 2 <= dimindex(:N) /\ &0 < r ==> sphere(a,r) =_c (:real)`,
  SIMP_TAC[CONNECTED_CARD_EQ_IFF_NONTRIVIAL; CONNECTED_SPHERE] THEN
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN
  ASM_REWRITE_TAC[FINITE_SING; FINITE_SPHERE; REAL_NOT_LE; DE_MORGAN_THM] THEN
  ASM_ARITH_TAC);;

let HAS_SIZE_SPHERE_2 = prove
 (`!a:real^N r. sphere(a,r) HAS_SIZE 2 <=> dimindex(:N) = 1 /\ &0 < r`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `r < &0` THEN
  ASM_SIMP_TAC[HAS_SIZE; SPHERE_EMPTY; CARD_CLAUSES] THENL
   [CONV_TAC NUM_REDUCE_CONV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN
  ASM_CASES_TAC `r = &0` THEN
  ASM_SIMP_TAC[SPHERE_SING; CARD_CLAUSES; FINITE_EMPTY; NOT_IN_EMPTY] THEN
  REWRITE_TAC[REAL_LT_REFL] THEN CONV_TAC NUM_REDUCE_CONV THEN
  SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
  ASM_CASES_TAC `r <= &0` THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
  ASM_REWRITE_TAC[FINITE_SPHERE] THEN
  ASM_CASES_TAC `dimindex(:N) = 1` THEN ASM_REWRITE_TAC[] THEN
  SUBGOAL_THEN
   `sphere(a:real^N,r) = {a - r % basis 1,a + r % basis 1}`
  SUBST1_TAC THENL
   [ASM_REWRITE_TAC[EXTENSION; IN_SPHERE; dist; vector_norm; dot] THEN
    REWRITE_TAC[SUM_1; GSYM REAL_POW_2; POW_2_SQRT_ABS] THEN
    ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; CART_EQ; FORALL_1] THEN
    REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT;
                VECTOR_MUL_COMPONENT] THEN
    SIMP_TAC[BASIS_COMPONENT; LE_REFL; DIMINDEX_GE_1] THEN
    ASM_REAL_ARITH_TAC;
    SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY; NOT_IN_EMPTY] THEN
    SIMP_TAC[IN_SING; VECTOR_ARITH `a - r:real^N = a + r <=> r = vec 0`] THEN
    ASM_SIMP_TAC[VECTOR_MUL_EQ_0; BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1] THEN
    CONV_TAC NUM_REDUCE_CONV]);;

let LOCALLY_PATH_CONNECTED_SPHERE = prove
 (`!(a:real^N) r. locally path_connected (sphere(a:real^N,r))`,
  REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN GEN_TAC THEN
  REWRITE_TAC[GSYM LOCALLY_PATH_CONNECTED_SPACE_SUBTOPOLOGY_EUCLIDEAN] THEN
  ASM_CASES_TAC `FINITE(sphere(vec 0:real^N,r))` THEN
  ASM_SIMP_TAC[SUBTOPOLOGY_EUCLIDEAN_EQ_DISCRETE_TOPOLOGY_FINITE;
               LOCALLY_PATH_CONNECTED_SPACE_DISCRETE_TOPOLOGY] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [FINITE_SPHERE]) THEN
  REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LE] THEN STRIP_TAC THEN
  MATCH_MP_TAC(ISPEC
   `subtopology euclidean ((:real^N) DELETE vec 0)`
   LOCALLY_PATH_CONNECTED_SPACE_QUOTIENT_MAP_IMAGE) THEN
  EXISTS_TAC `\x:real^N. r / norm(x) % x` THEN CONJ_TAC THENL
   [MATCH_MP_TAC RETRACTION_IMP_QUOTIENT_MAP THEN
    REWRITE_TAC[retraction_map; retraction_maps] THEN
    EXISTS_TAC `\x:real^N. x` THEN
    REWRITE_TAC[CONTINUOUS_MAP_EUCLIDEAN2] THEN
    REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; CONTINUOUS_ON_ID] THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE; IN_SPHERE_0] THEN
    REWRITE_TAC[IN_UNIV; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
    ASM_SIMP_TAC[GSYM NORM_EQ_0; REAL_DIV_RMUL; REAL_DIV_REFL;
                 REAL_LT_IMP_NZ; VECTOR_MUL_LID;
                 REAL_ARITH `&0 < r ==> abs r = r`] THEN
    MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
    REWRITE_TAC[CONTINUOUS_ON_ID; o_DEF; real_div; LIFT_CMUL] THEN
    MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
    MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
    REWRITE_TAC[NORM_EQ_0; IN_DELETE; IN_UNIV] THEN
    REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_NORM];
    MATCH_MP_TAC LOCALLY_PATH_CONNECTED_SPACE_OPEN_SUBSET THEN
    SIMP_TAC[GSYM OPEN_IN; OPEN_DELETE; OPEN_UNIV] THEN
    GEN_REWRITE_TAC RAND_CONV [GSYM SUBTOPOLOGY_TOPSPACE] THEN
    REWRITE_TAC[LOCALLY_PATH_CONNECTED_SPACE_SUBTOPOLOGY_EUCLIDEAN] THEN
    REWRITE_TAC[TOPSPACE_EUCLIDEAN; LOCALLY_PATH_CONNECTED_UNIV]]);;

let LOCALLY_CONNECTED_SPHERE = prove
 (`!a:real^N r. locally connected(sphere(a,r))`,
  SIMP_TAC[LOCALLY_PATH_CONNECTED_SPHERE;
           LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);;

let FINITE_CIRCLE_INTERSECTION,CARD_CIRCLE_INTERSECTION_LE =
 (CONJ_PAIR o prove)
 (`(!a b:real^2 r s.
        FINITE(sphere(a,r) INTER sphere(b,s)) <=>
        ~(a = b /\ r = s /\ &0 < r /\ &0 < s)) /\
   (!a b:real^2 r s.
        ~(a = b /\ r = s /\ &0 < r /\ &0 < s)
        ==> CARD(sphere(a,r) INTER sphere(b,s)) <= 2)`,
  REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
  ASM_CASES_TAC `&0 < r` THEN ASM_REWRITE_TAC[] THENL
   [ALL_TAC;
    MATCH_MP_TAC(MESON[FINITE_SUBSET; CARD_SUBSET; LE_TRANS]
     `!t. s SUBSET t /\ FINITE t /\ CARD t <= n
          ==> FINITE s /\ CARD s <= n`) THEN
    EXISTS_TAC `{a:real^2}` THEN
    REWRITE_TAC[FINITE_SING; CARD_SING; SUBSET; IN_SING; IN_INTER; ARITH] THEN
    REWRITE_TAC[IN_SPHERE] THEN POP_ASSUM MP_TAC THEN CONV_TAC NORM_ARITH] THEN
  ASM_CASES_TAC `&0 < s` THEN ASM_REWRITE_TAC[] THENL
   [ALL_TAC;
    MATCH_MP_TAC(MESON[FINITE_SUBSET; CARD_SUBSET; LE_TRANS]
     `!t. s SUBSET t /\ FINITE t /\ CARD t <= n
          ==> FINITE s /\ CARD s <= n`) THEN
    EXISTS_TAC `{b:real^2}` THEN
    REWRITE_TAC[FINITE_SING; CARD_SING; SUBSET; IN_SING; IN_INTER; ARITH] THEN
    REWRITE_TAC[IN_SPHERE] THEN POP_ASSUM MP_TAC THEN CONV_TAC NORM_ARITH] THEN
  ASM_CASES_TAC `a:real^2 = b /\ r:real = s` THEN
  ASM_REWRITE_TAC[INTER_IDEMPOT; FINITE_SPHERE] THEN
  ASM_REWRITE_TAC[DIMINDEX_2; ARITH_EQ; REAL_NOT_LE] THEN
  REWRITE_TAC[ARITH_RULE `n <= 2 <=> ~(3 <= n)`] THEN
  MP_TAC(ISPECL [`3`; `sphere(a:real^2,r) INTER sphere(b,s)`]
        CHOOSE_SUBSET_STRONG) THEN
  MATCH_MP_TAC(TAUT `~r ==> ((p ==> q) ==> r) ==> p /\ ~q`) THEN
  CONV_TAC (ONCE_DEPTH_CONV HAS_SIZE_CONV) THEN
  DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN MP_TAC)) THEN
  SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM SUBST_ALL_TAC THEN
  FIRST_X_ASSUM(MP_TAC o MATCH_MP (TAUT `~(p /\ q) ==> p ==> ~q`)) THEN
  REPEAT(FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (REAL_ARITH
   `&0 < r ==> r = abs r`))) THEN
  REWRITE_TAC[REAL_EQ_SQUARE_ABS] THEN REPEAT(POP_ASSUM MP_TAC) THEN
  REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_INTER; IN_SPHERE] THEN
  ONCE_REWRITE_TAC[GSYM DIST_EQ_0] THEN
  REWRITE_TAC[dist; NORM_EQ_SQUARE; REAL_POS] THEN
  REWRITE_TAC[DOT_2; VECTOR_SUB_COMPONENT] THEN CONV_TAC REAL_RING);;

let INTER_SPHERE_EQ_EMPTY = prove
 (`!a b:real^N r s.
        sphere(a,r) INTER sphere(b,s) = {} <=>
        if dimindex(:N) = 1 then
          r < &0 \/ s < &0 \/ ~(dist(a,b) = abs(r - s)) /\ ~(dist(a,b) = r + s)
        else
          r < &0 \/ s < &0 \/ dist(a,b) < abs(r - s) \/ r + s < dist(a,b)`,
  REPEAT GEN_TAC THEN COND_CASES_TAC THENL
   [REWRITE_TAC[EXTENSION; IN_INTER; IN_SPHERE; NOT_IN_EMPTY] THEN
    REWRITE_TAC[dist; NORM_EQ_SQUARE] THEN
    ASM_CASES_TAC `&0 <= r` THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LE] THEN
    ASM_CASES_TAC `&0 <= s` THEN ASM_REWRITE_TAC[] THEN
    ASM_REWRITE_TAC[dot; SUM_1; VECTOR_SUB_COMPONENT] THEN
    REWRITE_TAC[GSYM REAL_POW_2; GSYM REAL_EQ_SQUARE_ABS] THEN
    ASM_SIMP_TAC[REAL_LE_ADD; REAL_ABS_POS; REAL_ABS_ABS] THEN
    REWRITE_TAC[REAL_ARITH
     `abs(x - y) = abs r <=> y = x - r \/ y = x + r`] THEN
    EQ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
    DISCH_THEN(fun th ->
        MP_TAC(SPEC `(lambda i. (a:real^N)$1 + r):real^N` th) THEN
        MP_TAC(SPEC `(lambda i. (a:real^N)$1 - r):real^N` th)) THEN
    ASM_SIMP_TAC[LAMBDA_BETA; ARITH] THEN REAL_ARITH_TAC;
    EQ_TAC THENL
     [ALL_TAC;
      REWRITE_TAC[EXTENSION; IN_INTER; IN_SPHERE; NOT_IN_EMPTY] THEN
      CONV_TAC NORM_ARITH] THEN
    DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE
     `~(n = 1) ==> 1 <= n ==> 2 <= n`)) THEN
    REWRITE_TAC[DIMINDEX_GE_1] THEN DISCH_TAC THEN
    ASM_CASES_TAC `sphere(a:real^N,r) SUBSET cball(b,s)` THENL
     [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV
       [GSYM SPHERE_UNION_BALL]) THEN
      ASM_SIMP_TAC[SET_RULE
       `a INTER b = {} ==> (a SUBSET b UNION c <=> a SUBSET c)`] THEN
      SIMP_TAC[SPHERE_SUBSET_CONVEX; CONVEX_BALL; SUBSET_BALLS] THEN
      REAL_ARITH_TAC;
      ALL_TAC] THEN
    MP_TAC(ISPECL [`sphere(a:real^N,r)`; `cball(b:real^N,s)`]
          CONNECTED_INTER_FRONTIER) THEN
    ASM_SIMP_TAC[CONNECTED_SPHERE; FRONTIER_CBALL; DE_MORGAN_THM] THEN
    DISCH_THEN DISJ_CASES_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    MP_TAC(ISPECL [`cball(b:real^N,s)`; `cball(a:real^N,r)`]
          CONNECTED_INTER_FRONTIER) THEN
    REWRITE_TAC[CONNECTED_CBALL; FRONTIER_CBALL] THEN
    GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN
    ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[DE_MORGAN_THM]] THEN
    REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN
    DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL
     [REWRITE_TAC[INTER_BALLS_EQ_EMPTY; DIST_SYM] THEN REAL_ARITH_TAC;
      GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM SPHERE_UNION_BALL] THEN
      ASM_SIMP_TAC[SET_RULE
       `a INTER b = {} ==> (b SUBSET a UNION c <=> b SUBSET c)`] THEN
      REWRITE_TAC[SUBSET_BALLS; DIST_SYM] THEN REAL_ARITH_TAC]]);;

let HAS_SIZE_INTER_SPHERE_1 = prove
 (`!a b:real^N r s.
        (sphere(a,r) INTER sphere(b,s)) HAS_SIZE 1 <=>
        &0 <= r /\ &0 <= s /\
        (a = b ==> r = &0 /\ s = &0) /\
        (dist(a,b) = r + s \/ dist(a,b) = abs(r - s))`,
  REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN
  GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN
  SIMP_TAC[DIST_0; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
  SIMP_TAC[REAL_ARITH `&0 <= b ==> (abs b * &1 = x <=> x = b)`] THEN
  X_GEN_TAC `b:real` THEN REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `b = &0` THENL
   [ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN ASM_CASES_TAC `r:real = s` THEN
    ASM_REWRITE_TAC[INTER_IDEMPOT; HAS_SIZE_SPHERE_1] THENL
     [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
    EQ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
    CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN
    MATCH_MP_TAC(SET_RULE `s = {} ==> (?a. s = {a}) ==> P`) THEN
    REWRITE_TAC[EXTENSION; IN_INTER; IN_SPHERE_0; NOT_IN_EMPTY] THEN
    ASM_REAL_ARITH_TAC;
    REWRITE_TAC[CONV_RULE (LAND_CONV SYM_CONV) (SPEC_ALL VECTOR_MUL_EQ_0)] THEN
    ASM_SIMP_TAC[BASIS_EQ_0; IN_NUMSEG; LE_1; DIMINDEX_GE_1; LE_REFL]] THEN
  ASM_CASES_TAC `sphere(vec 0:real^N,r) INTER sphere (b % basis 1,s) = {}` THEN
  ASM_REWRITE_TAC[] THENL
   [REWRITE_TAC[HAS_SIZE; CARD_CLAUSES; ARITH_EQ] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INTER_SPHERE_EQ_EMPTY]) THEN
    SIMP_TAC[DIST_0; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
    ASM_SIMP_TAC[REAL_ARITH `&0 <= b ==> (abs b * &1 = x <=> x = b)`] THEN
    REAL_ARITH_TAC;
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY])] THEN
  REWRITE_TAC[IN_INTER; IN_SPHERE; DIST_0; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT
   `!r. (p ==> r) /\ (r ==> q) /\ (q ==> p) ==> (p <=> q)`) THEN
  EXISTS_TAC `x:real^N = x$1 % basis 1` THEN REPEAT CONJ_TAC THENL
   [DISCH_TAC THEN REWRITE_TAC[CART_EQ] THEN
    SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN
    X_GEN_TAC `k:num` THEN STRIP_TAC THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RZERO] THEN
    FIRST_X_ASSUM(MP_TAC o CONV_RULE HAS_SIZE_CONV) THEN
    DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
     `(?a. s = {a}) ==> !x y. x IN s /\ y IN s ==> x = y`)) THEN
    DISCH_THEN(MP_TAC o SPECL
     [`x:real^N`;
      `(lambda i. if i = k then --((x:real^N)$k) else x$i):real^N`]) THEN
    ANTS_TAC THENL
     [REWRITE_TAC[IN_INTER; IN_SPHERE] THEN MATCH_MP_TAC(MESON[]
       `(x = r /\ y = s) /\ (x' = x /\ y' = y)
        ==> (x = r /\ y = s) /\ (x' = r /\ y' = s)`) THEN
      CONJ_TAC THENL [ASM_REWRITE_TAC[DIST_0]; ALL_TAC] THEN
      REWRITE_TAC[dist] THEN CONJ_TAC THEN
      MATCH_MP_TAC NORM_EQ_COMPONENTWISE THEN
      SIMP_TAC[VECTOR_SUB_COMPONENT; VEC_COMPONENT; LAMBDA_BETA] THEN
      SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN
      REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
      ASM_REAL_ARITH_TAC;
      SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
      DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_REWRITE_TAC[] THEN
      ASM_REAL_ARITH_TAC];
    DISCH_THEN SUBST_ALL_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN
    SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL;
             dist; GSYM VECTOR_SUB_RDISTRIB] THEN
    REAL_ARITH_TAC;
    DISCH_TAC THEN CONV_TAC HAS_SIZE_CONV THEN EXISTS_TAC `x:real^N` THEN
    REWRITE_TAC[EXTENSION; IN_INTER; IN_SPHERE; DIST_0; IN_SING] THEN
    X_GEN_TAC `y:real^N` THEN EQ_TAC THEN ASM_SIMP_TAC[] THEN
    REPEAT STRIP_TAC THEN
    SUBGOAL_THEN `x:real^N = x$1 % basis 1 /\ y:real^N = y$1 % basis 1`
     (CONJUNCTS_THEN SUBST_ALL_TAC)
    THENL
     [ALL_TAC;
      AP_THM_TAC THEN AP_TERM_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN
      REWRITE_TAC[dist; GSYM VECTOR_SUB_RDISTRIB; NORM_MUL] THEN
      SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN REAL_ARITH_TAC] THEN
    CONJ_TAC THEN
    MP_TAC(ISPEC `b % basis 1:real^N` COLLINEAR_LEMMA_ALT) THENL
     [DISCH_THEN(MP_TAC o SPEC `x:real^N`);
      DISCH_THEN(MP_TAC o SPEC `y:real^N`)] THEN
    ASM_SIMP_TAC[VECTOR_MUL_EQ_0; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN
    MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN
    SIMP_TAC[LEFT_IMP_EXISTS_THM; VECTOR_MUL_COMPONENT; VECTOR_MUL_ASSOC] THEN
    SIMP_TAC[BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL; REAL_MUL_RID] THEN
    REWRITE_TAC[COLLINEAR_BETWEEN_CASES; between] THEN
    POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
    REWRITE_TAC[DIST_SYM; DIST_0; NORM_MUL] THEN
    SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL; real_abs] THEN
    REAL_ARITH_TAC]);;

let PATH_CONNECTED_ANNULUS = prove
 (`(!a:real^N r1 r2.
        2 <= dimindex(:N)
        ==> path_connected {x | r1 < norm(x - a) /\ norm(x - a) < r2}) /\
   (!a:real^N r1 r2.
        2 <= dimindex(:N)
        ==> path_connected {x | r1 < norm(x - a) /\ norm(x - a) <= r2}) /\
   (!a:real^N r1 r2.
        2 <= dimindex(:N)
        ==> path_connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2}) /\
   (!a:real^N r1 r2.
        2 <= dimindex(:N)
        ==> path_connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2})`,
  let lemma = prove
   (`!a:real^N P.
      2 <= dimindex(:N) /\ path_connected {lift r | &0 <= r /\ P r}
      ==> path_connected {x | P(norm(x - a))}`,
    REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN
    REWRITE_TAC[VECTOR_SUB_RZERO] THEN REPEAT STRIP_TAC THEN
    SUBGOAL_THEN
     `{x:real^N | P(norm(x))} =
      IMAGE (\z. drop(fstcart z) % sndcart z)
            {pastecart x y | x IN {lift x | &0 <= x /\ P x} /\
                             y IN {y | norm y = &1}}`
    SUBST1_TAC THENL
     [REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
      REWRITE_TAC[EXISTS_IN_GSPEC; FSTCART_PASTECART; SNDCART_PASTECART] THEN
      X_GEN_TAC `z:real^N` THEN REWRITE_TAC[EXISTS_LIFT; LIFT_DROP] THEN
      ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
      REWRITE_TAC[LIFT_IN_IMAGE_LIFT; IMAGE_ID] THEN
      REWRITE_TAC[IN_ELIM_THM] THEN
      EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[NORM_MUL; REAL_MUL_RID] THEN
      ASM_REWRITE_TAC[real_abs] THEN ASM_CASES_TAC `z:real^N = vec 0` THENL
       [MAP_EVERY EXISTS_TAC [`&0`; `basis 1:real^N`] THEN
        ASM_SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL; VECTOR_MUL_LZERO] THEN
        ASM_MESON_TAC[NORM_0; REAL_ABS_NUM; REAL_LE_REFL];
        MAP_EVERY EXISTS_TAC [`norm(z:real^N)`; `inv(norm z) % z:real^N`] THEN
        ASM_SIMP_TAC[REAL_ABS_NORM; NORM_MUL; VECTOR_MUL_ASSOC; VECTOR_MUL_LID;
          NORM_POS_LE; REAL_ABS_INV; REAL_MUL_RINV; REAL_MUL_LINV; NORM_EQ_0]];
      MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN CONJ_TAC THENL
       [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
        REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN
        SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART];
        REWRITE_TAC[GSYM PCROSS] THEN
        MATCH_MP_TAC PATH_CONNECTED_PCROSS THEN ASM_REWRITE_TAC[] THEN
        ONCE_REWRITE_TAC[NORM_ARITH `norm y = norm(y - vec 0:real^N)`] THEN
        ONCE_REWRITE_TAC[NORM_SUB] THEN
        REWRITE_TAC[REWRITE_RULE[dist] (GSYM sphere)] THEN
        ASM_SIMP_TAC[PATH_CONNECTED_SPHERE]]]) in
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC `a:real^N` lemma) THEN
  DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC CONVEX_IMP_PATH_CONNECTED THEN
  MATCH_MP_TAC IS_INTERVAL_CONVEX THEN
  REWRITE_TAC[is_interval] THEN
  ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
  REWRITE_TAC[IN_IMAGE_LIFT_DROP; FORALL_1; DIMINDEX_1] THEN
  REWRITE_TAC[IN_ELIM_THM; GSYM drop] THEN REAL_ARITH_TAC);;

let CONNECTED_ANNULUS = prove
 (`(!a:real^N r1 r2.
        2 <= dimindex(:N)
        ==> connected {x | r1 < norm(x - a) /\ norm(x - a) < r2}) /\
   (!a:real^N r1 r2.
        2 <= dimindex(:N)
        ==> connected {x | r1 < norm(x - a) /\ norm(x - a) <= r2}) /\
   (!a:real^N r1 r2.
        2 <= dimindex(:N)
        ==> connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2}) /\
   (!a:real^N r1 r2.
        2 <= dimindex(:N)
        ==> connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2})`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_IMP_CONNECTED THEN
  ASM_SIMP_TAC[PATH_CONNECTED_ANNULUS]);;

let PATH_CONNECTED_COMPLEMENT_BOUNDED_CONVEX = prove
 (`!s. 2 <= dimindex(:N) /\ bounded s /\ convex s
       ==> path_connected((:real^N) DIFF s)`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_SIMP_TAC[DIFF_EMPTY; CONVEX_IMP_PATH_CONNECTED; CONVEX_UNIV] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN
  REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
  MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
  REWRITE_TAC[IN_DIFF; IN_UNIV] THEN STRIP_TAC THEN
  SUBGOAL_THEN `~(x:real^N = a) /\ ~(y = a)` STRIP_ASSUME_TAC THENL
   [ASM_MESON_TAC[]; ALL_TAC] THEN
  SUBGOAL_THEN `bounded((x:real^N) INSERT y INSERT s)` MP_TAC THENL
   [ASM_REWRITE_TAC[BOUNDED_INSERT]; ALL_TAC] THEN
  DISCH_THEN(MP_TAC o SPEC `a:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
  REWRITE_TAC[INSERT_SUBSET] THEN
  DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
  MATCH_MP_TAC PATH_COMPONENT_TRANS THEN
  ABBREV_TAC `C = (B / norm(x - a:real^N))` THEN
  EXISTS_TAC `a + C % (x - a):real^N` THEN CONJ_TAC THENL
   [MATCH_MP_TAC PATH_CONNECTED_LINEPATH THEN
    REWRITE_TAC[SUBSET; segment; FORALL_IN_GSPEC; IN_DIFF; IN_UNIV] THEN
    REWRITE_TAC[VECTOR_ARITH
     `(&1 - u) % x + u % (a + B % (x - a)):real^N =
      a + (&1 + (B - &1) * u) % (x - a)`] THEN
    X_GEN_TAC `u:real` THEN STRIP_TAC THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN
    DISCH_THEN(MP_TAC o SPECL
     [`a:real^N`; `a + (&1 + (C - &1) * u) % (x - a):real^N`;
      `&1 / (&1 + (C - &1) * u)`]) THEN
    SUBGOAL_THEN `&1 <= &1 + (C - &1) * u` ASSUME_TAC THENL
     [REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC REAL_LE_MUL THEN
      ASM_REWRITE_TAC[REAL_SUB_LE] THEN
      EXPAND_TAC "C" THEN
      ASM_SIMP_TAC[REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL; dist]) THEN
      ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_ARITH `&1 * norm(x - a) = norm(a - x)`];
      FIRST_ASSUM(ASSUME_TAC o MATCH_MP
       (REAL_ARITH `&1 <= a ==> &0 < a`))] THEN
    ASM_REWRITE_TAC[NOT_IMP] THEN
    ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE; REAL_LE_LDIV_EQ;
                 REAL_MUL_LID] THEN
    ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; REAL_DIV_RMUL;
                 REAL_LT_IMP_NZ] THEN
    UNDISCH_TAC `~((x:real^N) IN s)` THEN
    MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
    VECTOR_ARITH_TAC;
    ALL_TAC] THEN
  MATCH_MP_TAC PATH_COMPONENT_SYM THEN
  MATCH_MP_TAC PATH_COMPONENT_TRANS THEN
  ABBREV_TAC `D = (B / norm(y - a:real^N))` THEN
  EXISTS_TAC `a + D % (y - a):real^N` THEN CONJ_TAC THENL
   [MATCH_MP_TAC PATH_CONNECTED_LINEPATH THEN
    REWRITE_TAC[SUBSET; segment; FORALL_IN_GSPEC; IN_DIFF; IN_UNIV] THEN
    REWRITE_TAC[VECTOR_ARITH
     `(&1 - u) % y + u % (a + B % (y - a)):real^N =
      a + (&1 + (B - &1) * u) % (y - a)`] THEN
    X_GEN_TAC `u:real` THEN STRIP_TAC THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN
    DISCH_THEN(MP_TAC o SPECL
     [`a:real^N`; `a + (&1 + (D - &1) * u) % (y - a):real^N`;
      `&1 / (&1 + (D - &1) * u)`]) THEN
    SUBGOAL_THEN `&1 <= &1 + (D - &1) * u` ASSUME_TAC THENL
     [REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC REAL_LE_MUL THEN
      ASM_REWRITE_TAC[REAL_SUB_LE] THEN
      EXPAND_TAC "D" THEN
      ASM_SIMP_TAC[REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL; dist]) THEN
      ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_ARITH `&1 * norm(y - a) = norm(a - y)`];
      FIRST_ASSUM(ASSUME_TAC o MATCH_MP
       (REAL_ARITH `&1 <= a ==> &0 < a`))] THEN
    ASM_REWRITE_TAC[NOT_IMP] THEN
    ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE; REAL_LE_LDIV_EQ;
                 REAL_MUL_LID] THEN
    ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; REAL_DIV_RMUL;
                 REAL_LT_IMP_NZ] THEN
    UNDISCH_TAC `~((y:real^N) IN s)` THEN
    MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
    VECTOR_ARITH_TAC;
    ALL_TAC] THEN
  MATCH_MP_TAC PATH_COMPONENT_OF_SUBSET THEN
  EXISTS_TAC `{x:real^N | norm(x - a) = B}` THEN CONJ_TAC THENL
   [UNDISCH_TAC `s SUBSET ball(a:real^N,B)` THEN
    REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_DIFF; IN_UNIV; IN_BALL; dist] THEN
    MESON_TAC[NORM_SUB; REAL_LT_REFL];
    MP_TAC(ISPECL [`a:real^N`; `B:real`] PATH_CONNECTED_SPHERE) THEN
    REWRITE_TAC[REWRITE_RULE[ONCE_REWRITE_RULE[DIST_SYM] dist] sphere] THEN
    ASM_REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
    DISCH_THEN MATCH_MP_TAC THEN
    REWRITE_TAC[IN_ELIM_THM; VECTOR_ADD_SUB; NORM_MUL] THEN
    MAP_EVERY EXPAND_TAC ["C"; "D"] THEN
    REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NORM] THEN
    ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
    ASM_REAL_ARITH_TAC]);;

let CONNECTED_COMPLEMENT_BOUNDED_CONVEX = prove
 (`!s. 2 <= dimindex(:N) /\ bounded s /\ convex s
       ==> connected((:real^N) DIFF s)`,
  SIMP_TAC[PATH_CONNECTED_IMP_CONNECTED;
           PATH_CONNECTED_COMPLEMENT_BOUNDED_CONVEX]);;

let CONNECTED_DIFF_BALL = prove
 (`!s a:real^N r.
        2 <= dimindex(:N) /\ connected s /\ cball(a,r) SUBSET s
        ==> connected(s DIFF ball(a,r))`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_DIFF_OPEN_FROM_CLOSED THEN
  EXISTS_TAC `cball(a:real^N,r)` THEN
  ASM_REWRITE_TAC[OPEN_BALL; CLOSED_CBALL; BALL_SUBSET_CBALL] THEN
  REWRITE_TAC[CBALL_DIFF_BALL] THEN
  REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
  ASM_SIMP_TAC[CONNECTED_SPHERE]);;

let PATH_CONNECTED_DIFF_BALL = prove
 (`!s a:real^N r.
        2 <= dimindex(:N) /\ path_connected s /\ cball(a,r) SUBSET s
        ==> path_connected(s DIFF ball(a,r))`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `ball(a:real^N,r) = {}` THEN
  ASM_SIMP_TAC[DIFF_EMPTY] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[BALL_EQ_EMPTY; REAL_NOT_LE]) THEN
  REWRITE_TAC[path_connected] THEN
  FIRST_ASSUM(MP_TAC o SPEC `a:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN
  ASM_SIMP_TAC[CENTRE_IN_CBALL; REAL_LT_IMP_LE] THEN DISCH_TAC THEN
  MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
  REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
  DISCH_THEN(fun th ->
   MP_TAC(SPECL [`x:real^N`; `a:real^N`] th) THEN
   MP_TAC(SPECL [`y:real^N`; `a:real^N`] th)) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `g2:real^1->real^N` STRIP_ASSUME_TAC) THEN
  DISCH_THEN(X_CHOOSE_THEN `g1:real^1->real^N` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL [`g2:real^1->real^N`; `(:real^N) DIFF ball(a,r)`]
        EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN
  MP_TAC(ISPECL [`g1:real^1->real^N`; `(:real^N) DIFF ball(a,r)`]
        EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN
  ASM_SIMP_TAC[CENTRE_IN_BALL; IN_DIFF; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN
  ASM_SIMP_TAC[FRONTIER_COMPLEMENT; INTERIOR_COMPLEMENT; CLOSURE_BALL] THEN
  ASM_SIMP_TAC[FRONTIER_BALL; IN_SPHERE] THEN
  X_GEN_TAC `h1:real^1->real^N` THEN STRIP_TAC THEN
  X_GEN_TAC `h2:real^1->real^N` THEN STRIP_TAC THEN
  MP_TAC(ISPECL [`a:real^N`; `r:real`] PATH_CONNECTED_SPHERE) THEN
  ASM_REWRITE_TAC[path_connected] THEN
  DISCH_THEN(MP_TAC o SPECL
   [`pathfinish h1:real^N`; `pathfinish h2:real^N`]) THEN
  ASM_SIMP_TAC[IN_SPHERE] THEN
  DISCH_THEN(X_CHOOSE_THEN `h:real^1->real^N` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `h1 ++ h ++ reversepath h2:real^1->real^N` THEN
  ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_REVERSEPATH;
               PATHFINISH_REVERSEPATH; PATH_JOIN; PATH_REVERSEPATH;
               PATH_IMAGE_JOIN; PATH_IMAGE_REVERSEPATH] THEN
  REWRITE_TAC[UNION_SUBSET] THEN REPEAT CONJ_TAC THENL
   [ALL_TAC;
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          SUBSET_TRANS)) THEN
    UNDISCH_TAC `cball(a:real^N,r) SUBSET s` THEN
    SIMP_TAC[SUBSET; IN_CBALL; IN_SPHERE; IN_BALL; IN_DIFF] THEN
    MESON_TAC[REAL_LE_REFL; REAL_LT_REFL];
    ALL_TAC] THEN
  MATCH_MP_TAC(SET_RULE
   `s SUBSET t /\ s INTER u = {} ==> s SUBSET t DIFF u`) THEN
  (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
   `s DELETE a SUBSET (UNIV DIFF t) ==> ~(a IN u) /\ u SUBSET t
      ==> s INTER u = {}`)) THEN
  ASM_REWRITE_TAC[BALL_SUBSET_CBALL; IN_BALL; REAL_LT_REFL]);;

let CONNECTED_DELETE_INTERIOR_POINT = prove
 (`!s a:real^N.
        2 <= dimindex(:N) /\ connected s /\ a IN interior s
        ==> connected(s DELETE a)`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR_CBALL]) THEN
  DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN
   `s DELETE a = (s DIFF ball(a:real^N,r)) UNION (cball(a,r) DELETE a)`
  SUBST1_TAC THENL
   [MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN
    MP_TAC(ISPECL [`a:real^N`; `r:real`] CENTRE_IN_BALL) THEN
    ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
    MATCH_MP_TAC CONNECTED_UNION THEN
    ASM_SIMP_TAC[CONNECTED_DIFF_BALL; CONNECTED_PUNCTURED_CBALL] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `c SUBSET s ==> ~(c DIFF b = {}) /\ a IN b
                     ==> ~((s DIFF b) INTER (c DELETE a) = {})`)) THEN
    ASM_REWRITE_TAC[CBALL_DIFF_BALL; CENTRE_IN_BALL; SPHERE_EQ_EMPTY] THEN
    ASM_REAL_ARITH_TAC]);;

let CONNECTED_DELETE_INTERIOR_POINT_EQ = prove
 (`!s a:real^N.
        2 <= dimindex(:N) /\ a IN interior s
        ==> (connected (s DELETE a) <=> connected s)`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
  ASM_SIMP_TAC[CONNECTED_DELETE_INTERIOR_POINT] THEN FIRST_ASSUM
   (ASSUME_TAC o MATCH_MP (REWRITE_RULE[SUBSET] INTERIOR_SUBSET)) THEN
  SUBGOAL_THEN `s = (a:real^N) INSERT (s DELETE a)` SUBST1_TAC THENL
   [ASM SET_TAC[]; MATCH_MP_TAC CONNECTED_INSERT_LIMPT] THEN
  ASM_SIMP_TAC[LIMPT_DELETE; INTERIOR_LIMIT_POINT]);;

let CONNECTED_OPEN_DELETE_EQ = prove
 (`!s a:real^N.
        2 <= dimindex(:N) /\ open s
        ==> (connected(s DELETE a) <=> connected s)`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `s DELETE (a:real^N) = s \/ a IN s` STRIP_ASSUME_TAC THENL
   [SET_TAC[]; ASM_REWRITE_TAC[]; ALL_TAC] THEN
  MATCH_MP_TAC CONNECTED_DELETE_INTERIOR_POINT_EQ THEN
  ASM_SIMP_TAC[INTERIOR_OPEN]);;

let PATH_CONNECTED_DELETE_INTERIOR_POINT = prove
 (`!s a:real^N.
        2 <= dimindex(:N) /\ path_connected s /\ a IN interior s
        ==> path_connected(s DELETE a)`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR_CBALL]) THEN
  DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN
   `s DELETE a = (s DIFF ball(a:real^N,r)) UNION (cball(a,r) DELETE a)`
  SUBST1_TAC THENL
   [MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN
    MP_TAC(ISPECL [`a:real^N`; `r:real`] CENTRE_IN_BALL) THEN
    ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
    MATCH_MP_TAC PATH_CONNECTED_UNION THEN
    ASM_SIMP_TAC[PATH_CONNECTED_DIFF_BALL; PATH_CONNECTED_PUNCTURED_CBALL] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `c SUBSET s ==> ~(c DIFF b = {}) /\ a IN b
                     ==> ~((s DIFF b) INTER (c DELETE a) = {})`)) THEN
    ASM_REWRITE_TAC[CBALL_DIFF_BALL; CENTRE_IN_BALL; SPHERE_EQ_EMPTY] THEN
    ASM_REAL_ARITH_TAC]);;

let CONNECTED_OPEN_DIFF_CBALL = prove
 (`!s a:real^N r.
        2 <= dimindex (:N) /\ open s /\ connected s /\ cball(a,r) SUBSET s
        ==> connected(s DIFF cball(a,r))`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `cball(a:real^N,r) = {}` THEN ASM_REWRITE_TAC[DIFF_EMPTY] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[CBALL_EQ_EMPTY; REAL_NOT_LT]) THEN
  SUBGOAL_THEN `?r'. r < r' /\ cball(a:real^N,r') SUBSET s`
  STRIP_ASSUME_TAC THENL
   [ASM_CASES_TAC `s = (:real^N)` THENL
     [EXISTS_TAC `r + &1` THEN ASM_SIMP_TAC[SUBSET_UNIV] THEN REAL_ARITH_TAC;
      ALL_TAC] THEN
    MP_TAC(ISPECL [`cball(a:real^N,r)`; `(:real^N) DIFF s`]
      SETDIST_POS_LE) THEN
    REWRITE_TAC[REAL_ARITH `&0 <= x <=> &0 < x \/ x = &0`] THEN
    ASM_SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; GSYM OPEN_CLOSED;
                 COMPACT_CBALL; CBALL_EQ_EMPTY] THEN
    ASM_REWRITE_TAC[SET_RULE `UNIV DIFF s = {} <=> s = UNIV`] THEN
    ASM_SIMP_TAC[SET_RULE `b INTER (UNIV DIFF s) = {} <=> b SUBSET s`;
                 REAL_ARITH `&0 <= r ==> ~(r < &0)`] THEN
    STRIP_TAC THEN
    EXISTS_TAC `r + setdist(cball(a,r),(:real^N) DIFF s) / &2` THEN
    ASM_REWRITE_TAC[REAL_LT_ADDR; REAL_HALF; SUBSET; IN_CBALL] THEN
    X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `x:real^N = a` THENL
     [ASM_MESON_TAC[SUBSET; DIST_REFL; IN_CBALL]; ALL_TAC] THEN
    ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[REAL_NOT_LE] THEN
    MP_TAC(ISPECL [`cball(a:real^N,r)`; `(:real^N) DIFF s`;
                   `a + r / dist(a,x) % (x - a):real^N`; `x:real^N`]
      SETDIST_LE_DIST) THEN
    ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; IN_CBALL] THEN
    REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN
    ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; ONCE_REWRITE_RULE[DIST_SYM] dist;
                 REAL_ABS_NORM; REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
    ASM_REWRITE_TAC[REAL_ARITH `abs r <= r <=> &0 <= r`] THEN
    REWRITE_TAC[NORM_MUL; VECTOR_ARITH
     `x - (a + d % (x - a)):real^N = (&1 - d) % (x - a)`] THEN
    ONCE_REWRITE_TAC[GSYM REAL_ABS_NORM] THEN
    REWRITE_TAC[GSYM REAL_ABS_MUL] THEN
    REWRITE_TAC[REAL_ABS_NORM; REAL_SUB_RDISTRIB] THEN
    ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o REWRITE_RULE[SUBSET]) THEN
    ASM_REWRITE_TAC[IN_CBALL; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
    REAL_ARITH_TAC;
    SUBGOAL_THEN `s DIFF cball(a:real^N,r) =
                  s DIFF ball(a,r') UNION
                  {x | r < norm(x - a) /\ norm(x - a) <= r'}`
    SUBST1_TAC THENL
     [REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN
      REWRITE_TAC[GSYM REAL_NOT_LE; GSYM IN_CBALL] THEN MATCH_MP_TAC(SET_RULE
       `b' SUBSET c' /\ c' SUBSET s /\ c SUBSET b'
        ==> s DIFF c = (s DIFF b') UNION {x | ~(x IN c) /\ x IN c'}`) THEN
      ASM_REWRITE_TAC[BALL_SUBSET_CBALL] THEN
      REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN ASM_REAL_ARITH_TAC;
      MATCH_MP_TAC CONNECTED_UNION THEN
      ASM_SIMP_TAC[CONNECTED_ANNULUS; PATH_CONNECTED_DIFF_BALL;
        PATH_CONNECTED_IMP_CONNECTED; CONNECTED_OPEN_PATH_CONNECTED] THEN
      REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN
      REWRITE_TAC[GSYM REAL_NOT_LE; GSYM IN_CBALL] THEN MATCH_MP_TAC(SET_RULE
       `c' SUBSET s /\ (?x. x IN c' /\ ~(x IN b') /\ ~(x IN c))
        ==> ~((s DIFF b') INTER {x | ~(x IN c) /\ x IN c'} = {})`) THEN
      ASM_REWRITE_TAC[] THEN EXISTS_TAC `a + r' % basis 1:real^N` THEN
      REWRITE_TAC[IN_BALL; IN_CBALL] THEN
      REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN
      SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
      ASM_REAL_ARITH_TAC]]);;

let PATH_CONNECTED_CONVEX_DIFF_LOWDIM = prove
 (`!s t:real^N->bool.
        convex s /\ aff_dim t + &2 <= aff_dim s ==> path_connected(s DIFF t)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
  MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
  REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
  REWRITE_TAC[PATH_CONNECTED_COMPONENT_SET] THEN
  ASM_CASES_TAC `segment[x:real^N,y] INTER t = {}` THENL
   [MATCH_MP_TAC PATH_CONNECTED_LINEPATH THEN
    ASM_SIMP_TAC[CONVEX_CONTAINS_SEGMENT_IMP; SET_RULE
     `s SUBSET t DIFF u <=> s INTER u = {} /\ s SUBSET t`];
    ALL_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  DISCH_THEN(fun th -> REPEAT(POP_ASSUM MP_TAC) THEN
        X_CHOOSE_THEN `a:real^N` MP_TAC th) THEN
  GEOM_ORIGIN_TAC `a:real^N` THEN REWRITE_TAC[IN_INTER] THEN
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `(vec 0:real^N) IN s` ASSUME_TAC THENL
   [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; SUBSET]; ALL_TAC] THEN
  SUBGOAL_THEN
   `?z:real^N. z IN s /\ ~(z IN span(x INSERT y INSERT span t))`
  STRIP_ASSUME_TAC THENL
   [MATCH_MP_TAC(SET_RULE `~(t SUBSET s) ==> ?x. x IN t /\ ~(x IN s)`) THEN
    DISCH_THEN(MP_TAC o MATCH_MP DIM_SUBSET) THEN
    UNDISCH_TAC `aff_dim(t:real^N->bool) + &2 <= aff_dim(s:real^N->bool)` THEN
    ASM_SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; INT_OF_NUM_ADD; INT_OF_NUM_LE] THEN
    MATCH_MP_TAC(ARITH_RULE `x <= SUC y ==> y + 2 <= s ==> ~(s <= x)`) THEN
    ONCE_REWRITE_TAC[DIM_INSERT] THEN
    SUBGOAL_THEN `(x:real^N) IN span(y INSERT span t)`
     (fun th -> REWRITE_TAC[th; DIM_INSERT; DIM_SPAN] THEN ARITH_TAC) THEN
    SUBGOAL_THEN `(vec 0:real^N) IN segment(x,y)` MP_TAC THENL
     [ASM_REWRITE_TAC[open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN
      ASM SET_TAC[];
      REWRITE_TAC[IN_SEGMENT]] THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
     (X_CHOOSE_THEN `u:real` (STRIP_ASSUME_TAC o GSYM))) THEN
    FIRST_ASSUM(MP_TAC o AP_TERM `(%) (inv(&1 - u)):real^N->real^N`) THEN
    REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; VECTOR_MUL_RZERO] THEN
    ASM_SIMP_TAC[REAL_MUL_LINV; REAL_SUB_0; REAL_LT_IMP_NE] THEN
    REWRITE_TAC[VECTOR_ARITH
     `&1 % x + a % y:real^N = vec 0 <=> x = --a % y`] THEN
    SIMP_TAC[SPAN_MUL; SPAN_SUPERSET; IN_INSERT];
    ALL_TAC] THEN
  MATCH_MP_TAC PATH_COMPONENT_TRANS THEN EXISTS_TAC `z:real^N` THEN
  SUBGOAL_THEN `~((z:real^N) IN t)` ASSUME_TAC THENL
   [ASM_MESON_TAC[SPAN_SUPERSET; IN_INSERT]; ALL_TAC] THEN
  CONJ_TAC THEN MATCH_MP_TAC PATH_CONNECTED_LINEPATH THENL
   [ALL_TAC; ONCE_REWRITE_TAC[SEGMENT_SYM]] THEN
  ASM_SIMP_TAC[CONVEX_CONTAINS_SEGMENT_IMP; SET_RULE
   `s SUBSET t DIFF u <=> s INTER u = {} /\ s SUBSET t`] THEN
  ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; SET_RULE
   `(s UNION {a,b}) INTER t = {} <=>
    ~(a IN t) /\ ~(b IN t) /\ s INTER t = {}`] THEN
  REWRITE_TAC[SET_RULE `s INTER t = {} <=> !x. x IN s ==> ~(x IN t)`] THEN
  X_GEN_TAC `w:real^N` THEN REWRITE_TAC[IN_SEGMENT] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (inv u):real^N->real^N`) THEN
  ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; REAL_MUL_LINV;
               REAL_LT_IMP_NZ] THEN
  REWRITE_TAC[VECTOR_ARITH `a:real^N = b + &1 % z <=> z = a - b`] THEN
  REPEAT DISCH_TAC THEN
  UNDISCH_TAC `~((z:real^N) IN span (x INSERT y INSERT span t))` THEN
  ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC SPAN_SUB THEN CONJ_TAC THEN MATCH_MP_TAC SPAN_MUL THEN
  ASM_SIMP_TAC[SPAN_SUPERSET; IN_INSERT]);;

let PATH_CONNECTED_OPEN_IN_DIFF_LOWDIM = prove
 (`!s t:real^N->bool.
        connected s /\ open_in (subtopology euclidean (affine hull s)) s /\
        aff_dim t + &2 <= aff_dim s
        ==> path_connected(s DIFF t)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_CONNECTED_DIFF THEN
  ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
   [TRANS_TAC SUBSET_TRANS `closure s:real^N->bool` THEN
    REWRITE_TAC[CLOSURE_SUBSET] THEN
    MATCH_MP_TAC(SET_RULE `t = s ==> s SUBSET t`) THEN
    MATCH_MP_TAC DENSE_COMPLEMENT_OPEN_IN_AFFINE_HULL THEN
    ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC;
    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC o
       REWRITE_RULE[OPEN_IN_CONTAINS_BALL]) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `ball(x:real^N,r) INTER affine hull s` THEN
    ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL; HULL_INC] THEN CONJ_TAC THENL
     [REWRITE_TAC[OPEN_IN_OPEN] THEN EXISTS_TAC `ball(x:real^N,r)` THEN
      REWRITE_TAC[OPEN_BALL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
       (SET_RULE `b INTER t SUBSET s
                  ==> s SUBSET t ==> b INTER t = s INTER b`)) THEN
      REWRITE_TAC[HULL_SUBSET];
      MATCH_MP_TAC PATH_CONNECTED_CONVEX_DIFF_LOWDIM THEN
      ASM_SIMP_TAC[CONVEX_INTER; CONVEX_BALL; AFFINE_IMP_CONVEX;
                   AFFINE_AFFINE_HULL] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH
        `t:int <= s ==> s' = s ==> t <= s'`)) THEN
      GEN_REWRITE_TAC RAND_CONV [GSYM AFF_DIM_AFFINE_HULL] THEN
      ONCE_REWRITE_TAC[INTER_COMM] THEN
      MATCH_MP_TAC AFF_DIM_CONVEX_INTER_OPEN THEN
      ASM_SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; OPEN_BALL] THEN
      REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
      ASM_MESON_TAC[HULL_INC; CENTRE_IN_BALL]]]);;

let PATH_CONNECTED_OPEN_IN_DIFF_UNIONS_LOWDIM = prove
 (`!(s:real^N->bool) f.
        connected s /\ open_in (subtopology euclidean (affine hull s)) s /\
        FINITE f /\ (!t. t IN f ==> closed t /\ aff_dim t + &2 <= aff_dim s)
        ==> path_connected(s DIFF UNIONS f)`,
  GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
  REPEAT DISCH_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL
   [DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[UNIONS_0; DIFF_EMPTY] THEN
    ASM_MESON_TAC[PATH_CONNECTED_EQ_CONNECTED_LPC;
                  OPEN_IN_IMP_LOCALLY_PATH_CONNECTED];
    MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `g:(real^N->bool)->bool`] THEN
    REWRITE_TAC[FORALL_IN_INSERT; UNIONS_INSERT] THEN
    DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
    STRIP_TAC THEN
    REWRITE_TAC[SET_RULE `s DIFF (t UNION u) = (s DIFF u) DIFF t`] THEN
    ASM_CASES_TAC `s DIFF UNIONS g:real^N->bool = {}` THEN
    ASM_REWRITE_TAC[PATH_CONNECTED_EMPTY; EMPTY_DIFF] THEN
    MATCH_MP_TAC PATH_CONNECTED_OPEN_IN_DIFF_LOWDIM THEN
    ASM_SIMP_TAC[PATH_CONNECTED_IMP_CONNECTED] THEN
    SUBGOAL_THEN
     `open_in (subtopology euclidean (affine hull s))
              (s DIFF UNIONS g:real^N->bool)`
    ASSUME_TAC THENL
     [SUBGOAL_THEN
       `s DIFF UNIONS g:real^N->bool =
        s DIFF (affine hull s INTER UNIONS g)`
      SUBST1_TAC THENL
       [MATCH_MP_TAC(SET_RULE
         `s SUBSET t ==> s DIFF u = s DIFF (t INTER u)`) THEN
        REWRITE_TAC[HULL_SUBSET];
        MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[] THEN
        MATCH_MP_TAC CLOSED_IN_INTER_CLOSED THEN
        REWRITE_TAC[CLOSED_IN_REFL] THEN MATCH_MP_TAC CLOSED_UNIONS THEN
        ASM_SIMP_TAC[]];
      CONJ_TAC THENL
       [MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN
        EXISTS_TAC `affine hull s:real^N->bool` THEN
        ASM_REWRITE_TAC[HULL_SUBSET] THEN
        MATCH_MP_TAC HULL_MONO THEN SET_TAC[];
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH
         `t:int <= s ==> u = s ==> t <= u`)) THEN
        GEN_REWRITE_TAC RAND_CONV [GSYM AFF_DIM_AFFINE_HULL] THEN
        MATCH_MP_TAC AFF_DIM_OPEN_IN THEN
        ASM_REWRITE_TAC[AFFINE_AFFINE_HULL]]]]);;

let CONNECTED_OPEN_IN_DIFF_UNIONS_LOWDIM = prove
 (`!f s:real^N->bool.
        connected s /\ open_in (subtopology euclidean (affine hull s)) s /\
        FINITE f /\ (!t. t IN f ==> aff_dim t + &2 <= aff_dim s)
        ==> connected(s DIFF UNIONS f)`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
  EXISTS_TAC `s DIFF UNIONS {closure t:real^N->bool | t IN f}` THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC PATH_CONNECTED_IMP_CONNECTED THEN
    MATCH_MP_TAC PATH_CONNECTED_OPEN_IN_DIFF_UNIONS_LOWDIM THEN
    ASM_SIMP_TAC[FORALL_IN_GSPEC; CLOSED_CLOSURE; AFF_DIM_CLOSURE] THEN
    ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE];
    MATCH_MP_TAC(SET_RULE `u SUBSET t ==> s DIFF t SUBSET s DIFF u`) THEN
    MATCH_MP_TAC UNIONS_MONO THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN
    MESON_TAC[CLOSURE_SUBSET];
    ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN
    ASM_REWRITE_TAC[UNIONS_0; SET_RULE `{f x |x| F} = {}`; NOT_IN_EMPTY;
                    DIFF_EMPTY; CLOSURE_SUBSET] THEN
    REWRITE_TAC[DIFF_UNIONS] THEN
    REWRITE_TAC[SET_RULE `{f x | x IN {g y | P y}} = {f(g y) | P y}`] THEN
    MP_TAC(ISPECL [`s:real^N->bool`;
                   `INTERS {s DIFF closure t:real^N->bool | t IN f}`;
                   `affine hull s:real^N->bool`]
        CLOSURE_OPEN_IN_INTER_CLOSURE) THEN
    ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
     [TRANS_TAC SUBSET_TRANS `s:real^N->bool` THEN
      REWRITE_TAC[HULL_SUBSET; INTERS_GSPEC] THEN ASM SET_TAC[];
      DISCH_THEN(SUBST1_TAC o SYM)] THEN
    MATCH_MP_TAC(SET_RULE
     `u SUBSET closure u /\ s = u ==> s INTER t SUBSET closure u`) THEN
    REWRITE_TAC[CLOSURE_SUBSET; SET_RULE `s = s INTER t <=> s SUBSET t`] THEN
    MATCH_MP_TAC DENSE_OPEN_INTERS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN
    ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE] THEN
    X_GEN_TAC `t:real^N->bool` THEN REPEAT STRIP_TAC THENL
     [ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN
      SIMP_TAC[OPEN_IN_OPEN_INTER; GSYM closed; CLOSED_CLOSURE];
      TRANS_TAC SUBSET_TRANS `closure s:real^N->bool` THEN
      REWRITE_TAC[CLOSURE_SUBSET] THEN
      MATCH_MP_TAC(SET_RULE `t = s ==> s SUBSET t`) THEN
      MATCH_MP_TAC DENSE_COMPLEMENT_OPEN_IN_AFFINE_HULL THEN
      ASM_REWRITE_TAC[AFF_DIM_CLOSURE] THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`) THEN
      ASM_REWRITE_TAC[] THEN INT_ARITH_TAC]]);;

let BOUNDED_FRONTIER_BOUNDED_OR_COBOUNDED = prove
 (`!s. 2 <= dimindex(:N) /\ bounded(frontier s)
       ==> bounded(s) \/ bounded((:real^N) DIFF s)`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
  DISCH_THEN(X_CHOOSE_THEN `r:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DE_MORGAN_THM] THEN
  STRIP_TAC THEN
  REWRITE_TAC[SET_RULE `f SUBSET s <=> (UNIV DIFF s) INTER f = {}`] THEN
  MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN
  ASM_SIMP_TAC[CONNECTED_COMPLEMENT_BOUNDED_CONVEX; BOUNDED_BALL; CONVEX_BALL;
               SET_RULE `UNIV DIFF s DIFF t = {} <=> UNIV DIFF t SUBSET s`;
               SET_RULE `(UNIV DIFF s) INTER t = {} <=> t SUBSET s`] THEN
  ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL]);;

let BOUNDED_COMMON_FRONTIER_DOMAINS = prove
 (`!s t c:real^N->bool.
        2 <= dimindex(:N) /\ bounded c /\
        open s /\ connected s /\
        open t /\ connected t /\
        ~(s = t) /\ frontier s = c /\ frontier t = c
        ==> bounded s \/ bounded t`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC `t:real^N->bool` BOUNDED_FRONTIER_BOUNDED_OR_COBOUNDED) THEN
  MP_TAC(ISPEC `s:real^N->bool` BOUNDED_FRONTIER_BOUNDED_OR_COBOUNDED) THEN
  ASM_REWRITE_TAC[] THEN
  REPEAT(STRIP_TAC THEN ASM_REWRITE_TAC[]) THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`]
        COMMON_FRONTIER_DOMAINS) THEN
  ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
  DISCH_THEN(K ALL_TAC) THEN
  MATCH_MP_TAC(SET_RULE
   `~((UNIV DIFF s) UNION (UNIV DIFF t) = UNIV) ==> ~DISJOINT s t`) THEN
  MATCH_MP_TAC(MESON[NOT_BOUNDED_UNIV] `bounded s ==> ~(s = (:real^N))`) THEN
  ASM_REWRITE_TAC[BOUNDED_UNION]);;

let INTERIOR_ARC_IMAGE = prove
 (`!g:real^1->real^N.
        2 <= dimindex(:N) /\ arc g ==> interior(path_image g) = {}`,
  REPEAT STRIP_TAC THEN
  SIMP_TAC[path_image; CLOSED_OPEN_INTERVAL_1; DROP_VEC; REAL_POS] THEN
  REWRITE_TAC[IMAGE_UNION; IMAGE_CLAUSES] THEN
  SIMP_TAC[INTERIOR_UNION_EQ_EMPTY; CLOSED_INSERT; CLOSED_EMPTY] THEN
  SIMP_TAC[EMPTY_INTERIOR_FINITE; FINITE_INSERT; FINITE_EMPTY] THEN
  MATCH_MP_TAC(SET_RULE `(!a. ~(a IN s)) ==> s = {}`) THEN
  X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
    (REWRITE_RULE[CONJ_ASSOC] CONNECTED_DELETE_INTERIOR_POINT))) THEN
  ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
   [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
    REWRITE_TAC[CONNECTED_INTERVAL] THEN
    MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
    EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
    ASM_SIMP_TAC[INTERVAL_OPEN_SUBSET_CLOSED; GSYM path; ARC_IMP_PATH];
    FIRST_X_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[SUBSET] INTERIOR_SUBSET)) THEN
    SPEC_TAC(`a:real^N`,`a:real^N`) THEN
    REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `t:real^1` THEN
    REPEAT STRIP_TAC THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHISM_ARC) THEN
    DISCH_THEN(X_CHOOSE_THEN `h:real^N->real^1` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o ISPEC `interval(vec 0,vec 1) DELETE (t:real^1)` o
       MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_CONNECTEDNESS)) THEN
    MATCH_MP_TAC(TAUT `p /\ q /\ ~r ==> (p ==> (q <=> r)) ==> F`) THEN
    REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DELETE a SUBSET t`) THEN
      REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED];
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
       `connected s ==> s = t ==> connected t`)) THEN
      RULE_ASSUM_TAC(REWRITE_RULE[arc]) THEN
      MP_TAC(ISPECL [`vec 0:real^1`; `vec 1:real^1`]
         INTERVAL_OPEN_SUBSET_CLOSED) THEN
      ASM SET_TAC[];
      REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_1] THEN
      DISCH_THEN(MP_TAC o SPECL
       [`midpoint(vec 0:real^1,t)`;
        `midpoint(vec 1:real^1,t)`; `t:real^1`]) THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
      REWRITE_TAC[DROP_VEC; IN_DELETE; IN_INTERVAL_1; GSYM DROP_EQ;
                  midpoint; DROP_ADD; DROP_CMUL] THEN
      REAL_ARITH_TAC]]);;

let INTERIOR_SIMPLE_PATH_IMAGE = prove
 (`!g:real^1->real^N.
        2 <= dimindex(:N) /\ simple_path g ==> interior(path_image g) = {}`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`g:real^1->real^N`; `lift(&1 / &2)`]
        PATH_IMAGE_SUBPATH_COMBINE) THEN
  REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
  CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[SIMPLE_PATH_IMP_PATH] THEN
  DISCH_THEN(SUBST1_TAC o SYM) THEN
  W(MP_TAC o PART_MATCH (lhs o rand) INTERIOR_UNION_EQ_EMPTY o snd) THEN
  ANTS_TAC THENL
   [DISJ1_TAC THEN MATCH_MP_TAC CLOSED_PATH_IMAGE THEN
    MATCH_MP_TAC PATH_SUBPATH THEN
    REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[SIMPLE_PATH_IMP_PATH];
    DISCH_THEN SUBST1_TAC THEN CONJ_TAC THEN
    MATCH_MP_TAC INTERIOR_ARC_IMAGE THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH_INTERIOR THEN
    ASM_REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC; GSYM DROP_EQ] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV]);;

let ENDPOINTS_NOT_IN_INTERIOR_SIMPLE_PATH_IMAGE = prove
 (`!g:real^1->real^N.
     simple_path g
     ==> DISJOINT {pathstart g,pathfinish g} (interior(path_image g))`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `2 <= dimindex(:N)` THENL
   [ASM_SIMP_TAC[INTERIOR_SIMPLE_PATH_IMAGE] THEN SET_TAC[];
    FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE
     `~(2 <= p) ==> 1 <= p ==> p = 1`))] THEN
  REWRITE_TAC[DIMINDEX_GE_1] THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          COLLINEAR_SIMPLE_PATH_IMAGE)) THEN
  ANTS_TAC THENL
   [REWRITE_TAC[COLLINEAR_AFF_DIM] THEN ASM_MESON_TAC[AFF_DIM_LE_UNIV];
    DISCH_THEN SUBST1_TAC] THEN
  REWRITE_TAC[DISJOINT_INSERT; DISJOINT_EMPTY; INTERIOR_SEGMENT] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[ENDS_NOT_IN_SEGMENT; NOT_IN_EMPTY]);;

(* ------------------------------------------------------------------------- *)
(* Existence of unbounded components.                                        *)
(* ------------------------------------------------------------------------- *)

let COBOUNDED_UNBOUNDED_COMPONENT = prove
 (`!s. bounded((:real^N) DIFF s)
       ==> ?x. x IN s /\ ~bounded(connected_component s x)`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
  DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `B % basis 1:real^N` THEN CONJ_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o SPEC `B % basis 1:real^N` o
     GEN_REWRITE_RULE I [SUBSET]) THEN
    REWRITE_TAC[IN_UNIV; IN_DIFF; IN_BALL_0] THEN
    SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
    ASM_SIMP_TAC[REAL_ARITH `&0 < B ==> ~(abs B * &1 < B)`];
    MP_TAC(ISPECL [`basis 1:real^N`; `B:real`] BOUNDED_HALFSPACE_GE) THEN
    SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL; CONTRAPOS_THM] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN
    MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
    SIMP_TAC[CONVEX_HALFSPACE_GE; CONVEX_CONNECTED] THEN
    ASM_SIMP_TAC[IN_ELIM_THM; DOT_RMUL; DOT_BASIS_BASIS; DIMINDEX_GE_1;
                 LE_REFL; real_ge; REAL_MUL_RID; REAL_LE_REFL] THEN
    FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
    `UNIV DIFF s SUBSET b ==> (!x. x IN h ==> ~(x IN b)) ==> h SUBSET s`)) THEN
    SIMP_TAC[IN_ELIM_THM; DOT_BASIS; IN_BALL_0; DIMINDEX_GE_1; LE_REFL] THEN
    GEN_TAC THEN REWRITE_TAC[REAL_NOT_LT] THEN
    MATCH_MP_TAC(REAL_ARITH `abs x <= n ==> b <= x ==> b <= n`) THEN
    SIMP_TAC[COMPONENT_LE_NORM; DIMINDEX_GE_1; LE_REFL]]);;

let COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT = prove
 (`!s x y:real^N.
        2 <= dimindex(:N) /\ bounded((:real^N) DIFF s) /\
        ~bounded(connected_component s x) /\
        ~bounded(connected_component s y)
        ==> connected_component s x = connected_component s y`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
  DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPEC `ball(vec 0:real^N,B)` CONNECTED_COMPLEMENT_BOUNDED_CONVEX) THEN
  ASM_REWRITE_TAC[BOUNDED_BALL; CONVEX_BALL] THEN DISCH_TAC THEN
  MAP_EVERY
   (MP_TAC o SPEC `B:real` o REWRITE_RULE[bounded; NOT_EXISTS_THM] o ASSUME)
   [`~bounded(connected_component s (y:real^N))`;
    `~bounded(connected_component s (x:real^N))`] THEN
  REWRITE_TAC[NOT_FORALL_THM; IN; NOT_IMP] THEN
  DISCH_THEN(X_CHOOSE_THEN `x':real^N` STRIP_ASSUME_TAC) THEN
  DISCH_THEN(X_CHOOSE_THEN `y':real^N` STRIP_ASSUME_TAC) THEN
  MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN REWRITE_TAC[IN] THEN
  SUBGOAL_THEN `connected_component s (x':real^N) (y':real^N)` ASSUME_TAC THENL
   [REWRITE_TAC[connected_component] THEN
    EXISTS_TAC `(:real^N) DIFF ball (vec 0,B)` THEN ASM_REWRITE_TAC[] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_DIFF; IN_UNIV]] THEN
    REWRITE_TAC[IN_BALL_0] THEN ASM_MESON_TAC[REAL_LT_IMP_LE];
    ASM_MESON_TAC[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS]]);;

let COBOUNDED_UNBOUNDED_COMPONENTS = prove
 (`!s. bounded ((:real^N) DIFF s) ==> ?c. c IN components s /\ ~bounded c`,
  REWRITE_TAC[components; EXISTS_IN_GSPEC; COBOUNDED_UNBOUNDED_COMPONENT]);;

let COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS = prove
 (`!s c c'.
        2 <= dimindex(:N) /\
        bounded ((:real^N) DIFF s) /\
        c IN components s /\ ~bounded c /\
        c' IN components s /\ ~bounded c'
        ==> c' = c`,
  REWRITE_TAC[components; IN_ELIM_THM] THEN
  MESON_TAC[COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT]);;

let COBOUNDED_HAS_BOUNDED_COMPONENT = prove
 (`!s. 2 <= dimindex(:N) /\ bounded((:real^N) DIFF s) /\ ~connected s
       ==> ?c. c IN components s /\ bounded c`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `?c c':real^N->bool. c IN components s /\ c' IN components s /\ ~(c = c')`
  STRIP_ASSUME_TAC THENL
   [MATCH_MP_TAC(SET_RULE
     `~(s = {}) /\ ~(?a. s = {a}) ==> ?x y. x IN s /\ y IN s /\ ~(x = y)`) THEN
    ASM_REWRITE_TAC[COMPONENTS_EQ_SING_EXISTS; COMPONENTS_EQ_EMPTY] THEN
    ASM_MESON_TAC[DIFF_EMPTY; NOT_BOUNDED_UNIV];
    ASM_MESON_TAC[COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS]]);;

(* ------------------------------------------------------------------------- *)
(* Self-homeomorphisms shuffling points about in various ways.               *)
(* ------------------------------------------------------------------------- *)

let HOMEOMORPHISM_MOVING_POINT_EXISTS = prove
 (`!s t a b:real^N.
        open_in (subtopology euclidean (affine hull s)) s /\
        s SUBSET t /\ t SUBSET affine hull s /\
        connected s /\ a IN s /\ b IN s
        ==> ?f g. homeomorphism (t,t) (f,g) /\ f a = b /\
                  {x | ~(f x = x /\ g x = x)} SUBSET s /\
                  bounded {x | ~(f x = x /\ g x = x)}`,
  let lemma1 = prove
   (`!a t r u:real^N.
          affine t /\ a IN t /\ u IN ball(a,r) INTER t
          ==> ?f g. homeomorphism (cball(a,r) INTER t,cball(a,r) INTER t)
                                  (f,g) /\
                    f(a) = u /\ (!x. x IN sphere(a,r) ==> f(x) = x)`,
    REPEAT STRIP_TAC THEN
    DISJ_CASES_TAC(REAL_ARITH `r <= &0 \/ &0 < r`) THENL
     [ASM_MESON_TAC[BALL_EMPTY; INTER_EMPTY; NOT_IN_EMPTY]; ALL_TAC] THEN
    EXISTS_TAC `\x:real^N. (&1 - norm(x - a) / r) % (u - a) + x` THEN
    REWRITE_TAC[LEFT_EXISTS_AND_THM] THEN CONJ_TAC THENL
     [MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN
      ASM_SIMP_TAC[COMPACT_INTER_CLOSED; COMPACT_CBALL; CLOSED_AFFINE];
      ASM_SIMP_TAC[IN_SPHERE; ONCE_REWRITE_RULE[NORM_SUB] dist;
                   REAL_DIV_REFL; REAL_LT_IMP_NZ; IN_INTER] THEN
      REWRITE_TAC[real_div; VECTOR_SUB_REFL; NORM_0; REAL_MUL_LZERO] THEN
      REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC] THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN
      MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF; LIFT_SUB] THEN
      SIMP_TAC[CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB] THEN
      MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
      REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div; LIFT_CMUL] THEN
      MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
      MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN
      SIMP_TAC[CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB];
      ALL_TAC] THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC(SET_RULE
       `(!x. x IN s ==> f x IN s) /\ (!y. y IN s ==> ?x. x IN s /\ f x = y)
        ==> IMAGE f s = s`) THEN REWRITE_TAC[] THEN
      ONCE_REWRITE_TAC[VECTOR_ARITH
       `(&1 - n) % (u - a) + x:real^N = a + (&1 - n) % (u - a) + (x - a)`];
      ALL_TAC] THEN
    REPEAT(POP_ASSUM MP_TAC) THEN GEOM_ORIGIN_TAC `a:real^N` THEN
    REWRITE_TAC[IN_BALL_0; VECTOR_SUB_RZERO; IN_CBALL_0; IN_INTER] THEN
    REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID;
                VECTOR_ARITH `a + x:real^N = a + y <=> x = y`;
                VECTOR_ARITH `(&1 - n) % u + a + x = (&1 - m) % u + a + y <=>
                              (n - m) % u:real^N = x - y`] THEN
    REWRITE_TAC[REAL_ARITH `x / r - y / r:real = (x - y) / r`] THENL
     [ALL_TAC;
      REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN REPEAT GEN_TAC THEN
      ASM_CASES_TAC `x:real^N = y` THEN ASM_REWRITE_TAC[] THEN
      ASM_CASES_TAC `norm(x:real^N) = norm(y:real^N)` THEN
      ASM_REWRITE_TAC[real_div; REAL_SUB_REFL; REAL_MUL_LZERO; VECTOR_MUL_LZERO;
                      VECTOR_ARITH `vec 0:real^N = x - y <=> x = y`] THEN
      STRIP_TAC THEN FIRST_ASSUM(MP_TAC o AP_TERM `norm:real^N->real`) THEN
      ASM_SIMP_TAC[NORM_MUL; REAL_ABS_MUL; REAL_ABS_INV] THEN
      DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH
       `r = norm(x - y:real^N) ==> r < abs(norm x - norm y) * &1 ==> F`)) THEN
      REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LT_LMUL THEN
      CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ONCE_REWRITE_TAC[REAL_MUL_SYM]] THEN
      ASM_SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ;
                   REAL_ARITH `&0 < r ==> &0 < abs r`] THEN
      ASM_REAL_ARITH_TAC] THEN
    REPEAT GEN_TAC THEN
    ASM_CASES_TAC `subspace(t:real^N->bool)` THENL
     [ALL_TAC; ASM_MESON_TAC[AFFINE_IMP_SUBSPACE]] THEN
    ASM_SIMP_TAC[SUBSPACE_ADD; SUBSPACE_MUL] THEN
    REPEAT STRIP_TAC THENL
     [MATCH_MP_TAC(NORM_ARITH
       `norm(x) + norm(y) <= &1 * r ==> norm(x + y:real^N) <= r`) THEN
      ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LE_LDIV_EQ; REAL_ARITH
       `(a * u + x) / r:real = a * u / r + x / r`] THEN
      MATCH_MP_TAC(REAL_ARITH
       `x <= &1 /\ a <= abs(&1 - x) * &1 ==> a + x <= &1`) THEN
      ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN
      CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
      MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN
      ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_MUL_LID; REAL_LT_IMP_LE];
      ALL_TAC] THEN
    MP_TAC(ISPECL
     [`\a. lift((&1 - drop a) * r - norm(y - drop a % u:real^N))`;
      `vec 0:real^1`; `vec 1:real^1`; `&0`; `1`]
          IVT_DECREASING_COMPONENT_1) THEN
    REWRITE_TAC[DIMINDEX_1; GSYM drop; LIFT_DROP; DROP_VEC] THEN
    REWRITE_TAC[REAL_POS; LE_REFL; REAL_SUB_REFL; VECTOR_MUL_LZERO] THEN
    REWRITE_TAC[REAL_SUB_RZERO; VECTOR_SUB_RZERO; REAL_MUL_LID] THEN
    REWRITE_TAC[NORM_ARITH `&0 * r - norm(x:real^N) <= &0`] THEN
    ASM_REWRITE_TAC[REAL_SUB_LE; GSYM EXISTS_DROP; IN_INTERVAL_1] THEN
    ANTS_TAC THENL
     [REPEAT STRIP_TAC THEN
      REWRITE_TAC[REAL_ARITH `(&1 - x) * r - b:real = r - r * x - b`] THEN
      REWRITE_TAC[LIFT_SUB; LIFT_CMUL; LIFT_DROP] THEN
      REPEAT(MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THEN
             REWRITE_TAC[CONTINUOUS_CONST]) THEN
      SIMP_TAC[CONTINUOUS_CMUL; CONTINUOUS_AT_ID] THEN
      MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE THEN
      MATCH_MP_TAC CONTINUOUS_SUB THEN REWRITE_TAC[CONTINUOUS_CONST] THEN
      MATCH_MP_TAC CONTINUOUS_MUL THEN
      REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_AT_ID; CONTINUOUS_CONST];

      ASM_SIMP_TAC[DROP_VEC; REAL_FIELD
       `&0 < r ==> ((&1 - x) * r - n = &0 <=> &1 - n / r = x)`] THEN
      DISCH_THEN(X_CHOOSE_THEN `a:real` STRIP_ASSUME_TAC) THEN
      EXISTS_TAC `y - a % u:real^N` THEN ASM_REWRITE_TAC[] THEN
      CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN
      ASM_SIMP_TAC[SUBSPACE_SUB; SUBSPACE_MUL] THEN
      GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
      ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN ASM_REAL_ARITH_TAC]) in
  let lemma2 = prove
   (`!a t u v:real^N r.
          affine t /\ a IN t /\
          u IN ball(a,r) INTER t /\ v IN ball(a,r) INTER t
          ==> ?f g. homeomorphism (cball(a,r) INTER t,cball(a,r) INTER t)
                                  (f,g) /\ f(u) = v /\
                    !x. x IN sphere(a,r) /\ x IN t ==> f(x) = x`,
    REPEAT GEN_TAC THEN
    DISJ_CASES_TAC(REAL_ARITH `r <= &0 \/ &0 < r`) THENL
     [ASM_MESON_TAC[BALL_EMPTY; INTER_EMPTY; NOT_IN_EMPTY];
      REPLICATE_TAC 2 (DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
      DISCH_TAC] THEN
    MP_TAC(ISPECL [`a:real^N`; `t:real^N->bool`; `r:real`] lemma1) THEN
    ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th ->
        FIRST_ASSUM(CONJUNCTS_THEN(MP_TAC o MATCH_MP th))) THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`f1:real^N->real^N`; `g1:real^N->real^N`] THEN
    STRIP_TAC THEN
    MAP_EVERY X_GEN_TAC [`f2:real^N->real^N`; `g2:real^N->real^N`] THEN
    STRIP_TAC THEN
    EXISTS_TAC `(f1:real^N->real^N) o (g2:real^N->real^N)` THEN
    EXISTS_TAC `(f2:real^N->real^N) o (g1:real^N->real^N)` THEN
    REWRITE_TAC[o_THM; SUBSET; IN_ELIM_THM] THEN CONJ_TAC THENL
     [MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN ASM_MESON_TAC[HOMEOMORPHISM_SYM];
      RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; IN_INTER]) THEN CONJ_TAC THENL
       [MP_TAC(ISPECL [`a:real^N`; `r:real`] CENTRE_IN_CBALL) THEN
        ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN ASM SET_TAC[];
        MP_TAC(ISPECL [`a:real^N`; `r:real`] SPHERE_SUBSET_CBALL) THEN
        ASM SET_TAC[]]]) in
  let lemma3 = prove
   (`!a t u v:real^N r s.
        affine t /\ a IN t /\ ball(a,r) INTER t SUBSET s /\ s SUBSET t /\
        u IN ball(a,r) INTER t /\ v IN ball(a,r) INTER t
        ==> ?f g. homeomorphism (s,s) (f,g) /\ f(u) = v /\
                  {x | ~(f x = x /\ g x = x)} SUBSET ball(a,r) INTER t`,
    REPEAT STRIP_TAC THEN
    MP_TAC(ISPECL [`a:real^N`; `t:real^N->bool`; `u:real^N`; `v:real^N`;
                   `r:real`] lemma2) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN
    STRIP_TAC THEN
    EXISTS_TAC `\x:real^N. if x IN ball(a,r) INTER t then f x else x` THEN
    EXISTS_TAC `\x:real^N. if x IN ball(a,r) INTER t then g x else x` THEN
    ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN
    REWRITE_TAC[HOMEOMORPHISM; SUBSET; FORALL_IN_IMAGE] THEN
    STRIP_TAC THEN
    SUBGOAL_THEN `(!x:real^N. x IN ball(a,r) INTER t ==> f x IN ball(a,r)) /\
                  (!x:real^N. x IN ball(a,r) INTER t ==> g x IN ball(a,r))`
    STRIP_ASSUME_TAC THENL
     [REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN ASM SET_TAC[]; ALL_TAC] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN
    REWRITE_TAC[IN_INTER] THEN REPEAT CONJ_TAC THEN
    TRY(X_GEN_TAC `x:real^N` THEN
        ASM_CASES_TAC `x IN ball(a:real^N,r)` THEN ASM_SIMP_TAC[] THEN
        MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN
        REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[]) THEN
        ASM SET_TAC[]) THEN
    MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
    EXISTS_TAC `(cball(a,r) INTER t) UNION
                ((t:real^N->bool) DIFF ball(a,r))` THEN
    (CONJ_TAC THENL
      [ALL_TAC;
       MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN
       ASM SET_TAC[]]) THEN
    MATCH_MP_TAC CONTINUOUS_ON_CASES THEN
    ASM_SIMP_TAC[CLOSED_CBALL; CLOSED_DIFF; OPEN_BALL; CONTINUOUS_ON_ID;
             GSYM IN_DIFF; CBALL_DIFF_BALL; CLOSED_AFFINE; CLOSED_INTER] THEN
    MP_TAC(ISPECL [`a:real^N`; `r:real`] SPHERE_SUBSET_CBALL) THEN
    MP_TAC(ISPECL [`a:real^N`; `r:real`] CBALL_DIFF_BALL) THEN
    ASM SET_TAC[]) in
  REWRITE_TAC[TAUT `p /\ q /\ r /\ s /\ t ==> u <=>
                    p /\ q /\ r /\ s ==> t ==> u`] THEN
  REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
  ONCE_REWRITE_TAC[TAUT `p ==> q <=> p ==> p /\ q`] THEN
  MATCH_MP_TAC CONNECTED_EQUIVALENCE_RELATION THEN ASM_REWRITE_TAC[] THEN
  REPEAT CONJ_TAC THEN X_GEN_TAC `a:real^N` THENL
   [X_GEN_TAC `b:real^N` THEN
    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    ASM_REWRITE_TAC[] THEN
    GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^N` THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^N` THEN
    REWRITE_TAC[HOMEOMORPHISM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    ONCE_REWRITE_TAC[TAUT `~(p /\ q) <=> ~(q /\ p)`] THEN
    ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
    MAP_EVERY X_GEN_TAC [`b:real^N`; `c:real^N`] THEN
    MAP_EVERY (fun t -> ASM_CASES_TAC t THEN ASM_REWRITE_TAC[])
     [`(a:real^N) IN s`; `(b:real^N) IN s`; `(c:real^N) IN s`] THEN
    ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`f1:real^N->real^N`; `g1:real^N->real^N`] THEN
    STRIP_TAC THEN
    MAP_EVERY X_GEN_TAC [`f2:real^N->real^N`; `g2:real^N->real^N`] THEN
    STRIP_TAC THEN
    EXISTS_TAC `(f2:real^N->real^N) o (f1:real^N->real^N)` THEN
    EXISTS_TAC `(g1:real^N->real^N) o (g2:real^N->real^N)` THEN
    ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL
     [ASM_MESON_TAC[HOMEOMORPHISM_COMPOSE]; ALL_TAC] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC BOUNDED_SUBSET THEN
    EXISTS_TAC `{x | ~(f1 x = x /\ g1 x = x)} UNION
                {x:real^N | ~(f2 x = x /\ g2 x = x)}` THEN
    ASM_REWRITE_TAC[BOUNDED_UNION] THEN ASM SET_TAC[];
    DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN
    DISCH_THEN(MP_TAC o SPEC `a:real^N` o CONJUNCT2) THEN ASM_SIMP_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `s INTER ball(a:real^N,r)` THEN
    ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL; OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
    X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN
    MP_TAC(ISPECL
     [`a:real^N`; `affine hull s:real^N->bool`;
      `a:real^N`; `b:real^N`; `r:real`; `t:real^N->bool`]
        lemma3) THEN
    ASM_SIMP_TAC[CENTRE_IN_BALL; AFFINE_AFFINE_HULL; HULL_INC; IN_INTER] THEN
    ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
    ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL; INTER_SUBSET; SUBSET_TRANS]]);;

let HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN = prove
 (`!s t x (y:A->real^N) k.
        &2 <= aff_dim s /\ open_in (subtopology euclidean (affine hull s)) s /\
        s SUBSET t /\ t SUBSET affine hull s /\ connected s /\
        FINITE k /\ (!i. i IN k ==> x i IN s /\ y i IN s) /\
        pairwise (\i j. ~(x i = x j) /\ ~(y i = y j)) k
        ==> ?f g. homeomorphism (t,t) (f,g) /\
                  (!i. i IN k ==> f(x i) = y i) /\
                  {x | ~(f x = x /\ g x = x)} SUBSET s /\
                  bounded {x | ~(f x = x /\ g x = x)}`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `FINITE(k:A->bool)` THEN ASM_REWRITE_TAC[] THEN
  SPEC_TAC(`s:real^N->bool`,`s:real^N->bool`) THEN POP_ASSUM MP_TAC THEN
  SPEC_TAC(`k:A->bool`,`k:A->bool`) THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  CONJ_TAC THENL
   [GEN_TAC THEN STRIP_TAC THEN REPEAT(EXISTS_TAC `I:real^N->real^N`) THEN
    REWRITE_TAC[HOMEOMORPHISM_I; NOT_IN_EMPTY; I_THM; EMPTY_GSPEC] THEN
    REWRITE_TAC[EMPTY_SUBSET; BOUNDED_EMPTY];
    ALL_TAC] THEN
  MAP_EVERY X_GEN_TAC [`i:A`; `k:A->bool`] THEN STRIP_TAC THEN
  X_GEN_TAC `s:real^N->bool` THEN
  REWRITE_TAC[PAIRWISE_INSERT; FORALL_IN_INSERT] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN
  STRIP_TAC THEN MP_TAC(ISPECL
   [`s DIFF IMAGE (y:A->real^N) k`; `t:real^N->bool`;
    `(f:real^N->real^N) ((x:A->real^N) i)`; `(y:A->real^N) i`]
   HOMEOMORPHISM_MOVING_POINT_EXISTS) THEN
  SUBGOAL_THEN
   `affine hull (s DIFF (IMAGE (y:A->real^N) k)) = affine hull s`
  SUBST1_TAC THENL
   [MATCH_MP_TAC AFFINE_HULL_OPEN_IN THEN CONJ_TAC THENL
     [TRANS_TAC OPEN_IN_TRANS `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
      MATCH_MP_TAC FINITE_IMP_CLOSED_IN THEN
      ASM_SIMP_TAC[FINITE_IMAGE] THEN ASM SET_TAC[];

      REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN
      DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
        FINITE_SUBSET)) THEN
      ASM_SIMP_TAC[FINITE_IMAGE; CONNECTED_FINITE_IFF_SING] THEN
      UNDISCH_TAC `&2 <= aff_dim(s:real^N->bool)` THEN
      ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
      REWRITE_TAC[] THEN STRIP_TAC THEN
      ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_SING] THEN
      CONV_TAC INT_REDUCE_CONV];
    ASM_REWRITE_TAC[]] THEN
  ANTS_TAC THENL
   [REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC FINITE_IMP_CLOSED_IN THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN
      REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN
      MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[];
      ASM SET_TAC[];
      MATCH_MP_TAC CONNECTED_OPEN_IN_DIFF_CARD_LT THEN
      ASM_REWRITE_TAC[COLLINEAR_AFF_DIM;
                      INT_ARITH `~(s:int <= &1) <=> &2 <= s`] THEN
      MATCH_MP_TAC CARD_LT_FINITE_INFINITE THEN
      ASM_SIMP_TAC[FINITE_IMAGE; real_INFINITE];
      ALL_TAC; ALL_TAC] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN REWRITE_TAC[IN_DIFF] THEN
    (CONJ_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[IN_DIFF]]) THEN
    SIMP_TAC[SET_RULE `~(y IN IMAGE f s) <=> !x. x IN s ==> ~(f x = y)`] THEN
    ASM SET_TAC[];
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN
    STRIP_TAC THEN MAP_EVERY EXISTS_TAC
     [`(h:real^N->real^N) o (f:real^N->real^N)`;
      `(g:real^N->real^N) o (k:real^N->real^N)`] THEN
    CONJ_TAC THENL [ASM_MESON_TAC[HOMEOMORPHISM_COMPOSE]; ALL_TAC] THEN
    ASM_SIMP_TAC[o_THM] THEN
    REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
    MATCH_MP_TAC BOUNDED_SUBSET THEN
    EXISTS_TAC `{x | ~(f x = x /\ g x = x)} UNION
                {x:real^N | ~(h x = x /\ k x = x)}` THEN
    ASM_REWRITE_TAC[BOUNDED_UNION] THEN ASM SET_TAC[]]);;

let HOMEOMORPHISM_MOVING_POINTS_EXISTS = prove
 (`!s t x (y:A->real^N) k.
        2 <= dimindex(:N) /\ open s /\ connected s /\ s SUBSET t /\
        FINITE k /\ (!i. i IN k ==> x i IN s /\ y i IN s) /\
        pairwise (\i j. ~(x i = x j) /\ ~(y i = y j)) k
        ==> ?f g. homeomorphism (t,t) (f,g) /\
                  (!i. i IN k ==> f(x i) = y i) /\
                  {x | ~(f x = x /\ g x = x)} SUBSET s /\
                  bounded {x | ~(f x = x /\ g x = x)}`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL
   [STRIP_TAC THEN REPEAT(EXISTS_TAC `I:real^N->real^N`) THEN
    REWRITE_TAC[HOMEOMORPHISM_I; NOT_IN_EMPTY; I_THM; EMPTY_GSPEC] THEN
    REWRITE_TAC[EMPTY_SUBSET; BOUNDED_EMPTY] THEN ASM SET_TAC[];
    STRIP_TAC] THEN
  MATCH_MP_TAC HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN THEN
  ASM_REWRITE_TAC[] THEN
  ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN
  SUBGOAL_THEN `affine hull s = (:real^N)` SUBST1_TAC THENL
   [MATCH_MP_TAC AFFINE_HULL_OPEN THEN ASM SET_TAC[];
    ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; AFF_DIM_UNIV] THEN
    ASM_REWRITE_TAC[INT_OF_NUM_LE; SUBSET_UNIV]]);;

let HOMEOMORPHISM_GROUPING_POINTS_EXISTS = prove
 (`!u s t k:real^N->bool.
        open u /\ open s /\ connected s /\ ~(u = {}) /\
        FINITE k /\ k SUBSET s /\ u SUBSET s /\ s SUBSET t
        ==> ?f g. homeomorphism (t,t) (f,g) /\
                  {x | ~(f x = x /\ g x = x)} SUBSET s /\
                  bounded {x | ~(f x = x /\ g x = x)} /\
                  !x. x IN k ==> (f x) IN u`,
  let lemma1 = prove
   (`!a b:real^1 c d:real^1.
          drop a < drop b /\ drop c < drop d
          ==> ?f g. homeomorphism (interval[a,b],interval[c,d]) (f,g) /\
                    f(a) = c /\ f(b) = d`,
    REPEAT STRIP_TAC THEN EXISTS_TAC
     `\x. c + (drop x - drop a) / (drop b - drop a) % (d - c:real^1)` THEN
    ASM_SIMP_TAC[REAL_DIV_REFL; REAL_SUB_LT; REAL_LT_IMP_NZ;
                 REAL_ARITH `(a - a) / x = &0`; LEFT_EXISTS_AND_THM] THEN
    CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN
    MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN
    REWRITE_TAC[COMPACT_INTERVAL] THEN REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
      MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN
      REWRITE_TAC[LIFT_CMUL; real_div; o_DEF] THEN
      MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN
      REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP] THEN
      SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID];
      REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_IMAGE] THEN
      ASM_SIMP_TAC[GSYM DROP_EQ; DROP_ADD; DROP_CMUL; DROP_SUB; REAL_FIELD
       `a < b /\ c < d
        ==> (x = c + (y - a) / (b - a) * (d - c) <=>
             a + (x - c) / (d - c) * (b - a) = y)`] THEN
      REWRITE_TAC[GSYM EXISTS_DROP; UNWIND_THM1] THEN
      REWRITE_TAC[REAL_ARITH
       `c <= c + x /\ c + x <= d <=> &0 <= x /\ x <= &1 * (d - c)`] THEN
      ASM_SIMP_TAC[REAL_LE_MUL_EQ; REAL_LE_RMUL_EQ; REAL_SUB_LT] THEN
      ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN
      REAL_ARITH_TAC;
      ASM_SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`;
                  REAL_FIELD `a < b ==> (x / (b - a) = y / (b - a) <=> x = y)`;
                  REAL_ARITH `x - a:real = y - a <=> x = y`;
                  VECTOR_MUL_RCANCEL; DROP_EQ; VECTOR_SUB_EQ] THEN
      ASM_MESON_TAC[REAL_LT_REFL]]) in
  let lemma2 = prove
   (`!a b c:real^1 u v w:real^1 f1 g1 f2 g2.
          homeomorphism (interval[a,b],interval[u,v]) (f1,g1) /\
          homeomorphism (interval[b,c],interval[v,w]) (f2,g2)
          ==> b IN interval[a,c] /\ v IN interval[u,w] /\
              f1 a = u /\ f1 b = v /\ f2 b = v /\ f2 c = w
              ==> ?f g. homeomorphism(interval[a,c],interval[u,w]) (f,g) /\
                        f a = u /\ f c = w /\
                        (!x. x IN interval[a,b] ==> f x = f1 x) /\
                        (!x. x IN interval[b,c] ==> f x = f2 x)`,
    REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM
     (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism])) THEN
    EXISTS_TAC `\x. if drop x <= drop b then (f1:real^1->real^1) x
                    else f2 x` THEN
    ASM_REWRITE_TAC[LEFT_EXISTS_AND_THM; REAL_LE_REFL] THEN
    ASM_SIMP_TAC[DROP_EQ; REAL_ARITH `b <= c ==> (c <= b <=> c = b)`] THEN
    CONJ_TAC THENL [REWRITE_TAC[GSYM CONJ_ASSOC]; ASM_MESON_TAC[]] THEN
    MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN
    REWRITE_TAC[COMPACT_INTERVAL] THEN REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN
      ASM_SIMP_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID; DROP_EQ] THEN
      CONJ_TAC THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN
      SIMP_TAC[SUBSET; FORALL_DROP; IN_ELIM_THM; IN_INTERVAL_1];
      SUBGOAL_THEN
       `interval[a:real^1,c] = interval[a,b] UNION interval[b,c] /\
        interval[u:real^1,w] = interval[u,v] UNION interval[v,w]`
      (CONJUNCTS_THEN SUBST1_TAC) THENL
       [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN
        ASM_REAL_ARITH_TAC;
        REWRITE_TAC[IMAGE_UNION] THEN BINOP_TAC THEN FIRST_X_ASSUM(fun th ->
          GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
        MATCH_MP_TAC IMAGE_EQ THEN
        SIMP_TAC[IN_INTERVAL_1; REAL_ARITH
           `b <= c ==> (c <= b <=> c = b)`] THEN
        ASM_MESON_TAC[DROP_EQ]];
      REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN
      REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
      REWRITE_TAC[FORALL_DROP; LIFT_DROP; IN_INTERVAL_1] THEN
      MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN DISCH_TAC THEN
      ASM_CASES_TAC `drop y <= drop b` THEN ASM_REWRITE_TAC[] THENL
       [COND_CASES_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
        RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; REAL_NOT_LE]) THEN
        ASM_MESON_TAC[];
        ALL_TAC] THEN
      COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; REAL_NOT_LE]) THENL
       [ALL_TAC; ASM_MESON_TAC[REAL_LT_IMP_LE]] THEN
      STRIP_TAC THEN
      SUBGOAL_THEN `(f1:real^1->real^1) x IN interval[u,v] INTER interval[v,w]`
      MP_TAC THENL
       [REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL
         [ALL_TAC; ASM_REWRITE_TAC[]] THEN
        FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
        MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN
        ASM_REAL_ARITH_TAC;
        ALL_TAC] THEN
      REWRITE_TAC[IN_INTER; IN_INTERVAL_1] THEN DISCH_THEN(MP_TAC o MATCH_MP
       (REAL_ARITH `(a <= x /\ x <= b) /\ (b <= x /\ x <= c) ==> x = b`)) THEN
      REWRITE_TAC[DROP_EQ] THEN DISCH_TAC THEN
      SUBGOAL_THEN
       `(f1:real^1->real^1) x = f1 b /\ (f2:real^1->real^1) y = f2 b`
      MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
      MATCH_MP_TAC(MESON[]
       `!g1:real^1->real^1 g2:real^1->real^1.
          g1(f1 x) = x /\ g1(f1 b) = b /\ g2(f2 y) = y /\ g2(f2 b) = b
          ==> f1 x = f1 b /\ f2 y = f2 b ==> x = y`) THEN
      MAP_EVERY EXISTS_TAC [`g1:real^1->real^1`; `g2:real^1->real^1`] THEN
      REPEAT CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      ASM_REAL_ARITH_TAC]) in
  let lemma3 = prove
   (`!a b c d u v:real^1.
          interval[c,d] SUBSET interval(a,b) /\
          interval[u,v] SUBSET interval(a,b) /\
          ~(interval(c,d) = {}) /\ ~(interval(u,v) = {})
          ==> ?f g. homeomorphism (interval[a,b],interval[a,b]) (f,g) /\
                    f a = a /\ f b = b /\
                    !x. x IN interval[c,d] ==> f(x) IN interval[u,v]`,
    REPEAT GEN_TAC THEN
    REWRITE_TAC[SUBSET_INTERVAL_1; INTERVAL_NE_EMPTY_1] THEN
    ASM_CASES_TAC `drop u < drop v` THEN
    ASM_SIMP_TAC[REAL_ARITH `u < v ==> ~(v < u)`] THEN
    ASM_CASES_TAC `interval[c:real^1,d] = {}` THENL
     [DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
      REPEAT(EXISTS_TAC `I:real^1->real^1`) THEN
      REWRITE_TAC[HOMEOMORPHISM_I; NOT_IN_EMPTY; I_THM];
      RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN
      ASM_SIMP_TAC[REAL_ARITH `c <= d ==> ~(d < c)`] THEN STRIP_TAC] THEN
    MP_TAC(ISPECL [`d:real^1`; `b:real^1`; `v:real^1`; `b:real^1`] lemma1) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`f3:real^1->real^1`; `g3:real^1->real^1`] THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPECL [`c:real^1`; `d:real^1`; `u:real^1`; `v:real^1`] lemma1) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`f2:real^1->real^1`; `g2:real^1->real^1`] THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPECL [`a:real^1`; `c:real^1`; `a:real^1`; `u:real^1`] lemma1) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`f1:real^1->real^1`; `g1:real^1->real^1`] THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
    GEN_REWRITE_TAC I [IMP_IMP] THEN DISCH_THEN(fun th ->
      ASSUME_TAC(CONJUNCT2 th) THEN MP_TAC(MATCH_MP lemma2 th)) THEN
    ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`f4:real^1->real^1`; `g4:real^1->real^1`] THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
    GEN_REWRITE_TAC I [IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP lemma2) THEN
    ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN
    ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
    REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SIMP_TAC[] THEN
    DISCH_THEN(STRIP_ASSUME_TAC o CONJUNCT2) THEN
    X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1]) THEN
    SUBGOAL_THEN `drop a <= drop x` ASSUME_TAC THENL
     [ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[]]) in
  let lemma4 = prove
   (`!s k u t:real^1->bool.
          open u /\ open s /\ connected s /\ ~(u = {}) /\
          FINITE k /\ k SUBSET s /\ u SUBSET s /\ s SUBSET t
          ==> ?f g. homeomorphism (t,t) (f,g) /\
                    (!x. x IN k ==> f(x) IN u) /\
                    {x | ~(f x = x /\ g x = x)} SUBSET s /\
                    bounded {x | ~(f x = x /\ g x = x)}`,
    REPEAT STRIP_TAC THEN
    SUBGOAL_THEN
     `?c d:real^1. ~(interval(c,d) = {}) /\ interval[c,d] SUBSET u`
    STRIP_ASSUME_TAC THENL
     [UNDISCH_TAC `open(u:real^1->bool)` THEN
      REWRITE_TAC[OPEN_CONTAINS_INTERVAL] THEN
      FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
      DISCH_THEN(X_CHOOSE_TAC `y:real^1`) THEN
      DISCH_THEN(MP_TAC o SPEC `y:real^1`) THEN
      ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MESON_TAC[];
      ALL_TAC] THEN
    SUBGOAL_THEN
     `?a b:real^1. ~(interval(a,b) = {}) /\
                   k SUBSET interval[a,b] /\
                   interval[a,b] SUBSET s`
    STRIP_ASSUME_TAC THENL
     [ASM_CASES_TAC `k:real^1->bool = {}` THENL
       [ASM_MESON_TAC[SUBSET_TRANS; EMPTY_SUBSET]; ALL_TAC] THEN
      MP_TAC(SPEC `IMAGE drop k` COMPACT_ATTAINS_SUP) THEN
      MP_TAC(SPEC `IMAGE drop k` COMPACT_ATTAINS_INF) THEN
      ASM_SIMP_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_EQ_EMPTY;
        IMAGE_ID; FINITE_IMP_COMPACT; EXISTS_IN_IMAGE; FORALL_IN_IMAGE] THEN
      DISCH_THEN(X_CHOOSE_THEN `a:real^1` STRIP_ASSUME_TAC) THEN
      DISCH_THEN(X_CHOOSE_THEN `b:real^1` STRIP_ASSUME_TAC) THEN
      UNDISCH_TAC `open(s:real^1->bool)` THEN
      REWRITE_TAC[OPEN_CONTAINS_INTERVAL] THEN
      DISCH_THEN(MP_TAC o SPEC `b:real^1`) THEN
      ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
      MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN
      REWRITE_TAC[SUBSET; IN_INTERVAL_1] THEN STRIP_TAC THEN
      MAP_EVERY EXISTS_TAC [`a:real^1`; `v:real^1`] THEN
      REWRITE_TAC[INTERVAL_NE_EMPTY_1] THEN FIRST_X_ASSUM(MP_TAC o
        GEN_REWRITE_RULE I [GSYM IS_INTERVAL_CONNECTED_1]) THEN
      REWRITE_TAC[IS_INTERVAL_1] THEN
      ASM_MESON_TAC[GSYM MEMBER_NOT_EMPTY; REAL_LET_TRANS; REAL_LE_TRANS;
                    REAL_LT_IMP_LE; SUBSET; REAL_LE_TOTAL];
      ALL_TAC] THEN
    SUBGOAL_THEN
     `?w z:real^1. interval[w,z] SUBSET s /\
                   interval[a,b] UNION interval[c,d] SUBSET interval(w,z)`
    STRIP_ASSUME_TAC THENL
     [SUBGOAL_THEN
        `?w z:real^1. interval[w,z] SUBSET s /\
                      interval[a,b] UNION interval[c,d] SUBSET interval[w,z]`
      STRIP_ASSUME_TAC THENL
       [EXISTS_TAC `lift(min (drop a) (drop c))` THEN
        EXISTS_TAC `lift(max (drop b) (drop d))` THEN
        REWRITE_TAC[UNION_SUBSET; SUBSET_INTERVAL_1; LIFT_DROP] THEN
        CONJ_TAC THENL
         [FIRST_X_ASSUM(MP_TAC o
           GEN_REWRITE_RULE I [GSYM IS_INTERVAL_CONNECTED_1]) THEN
          REWRITE_TAC[IS_INTERVAL_1; SUBSET; IN_INTERVAL_1; LIFT_DROP] THEN
          REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
          EXISTS_TAC `lift(min (drop a) (drop c))` THEN
          EXISTS_TAC `lift(max (drop b) (drop d))` THEN
          ASM_REWRITE_TAC[LIFT_DROP] THEN
          REWRITE_TAC[real_min; real_max] THEN CONJ_TAC THEN
          COND_CASES_TAC THEN ASM_REWRITE_TAC[LIFT_DROP] THEN
          ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET; INTERVAL_EQ_EMPTY_1;
                        REAL_LT_IMP_LE];
          ASM_REAL_ARITH_TAC];
        UNDISCH_TAC `open(s:real^1->bool)` THEN
        REWRITE_TAC[OPEN_CONTAINS_INTERVAL] THEN DISCH_THEN(fun th ->
          MP_TAC(SPEC `z:real^1` th) THEN MP_TAC(SPEC `w:real^1` th)) THEN
        SUBGOAL_THEN `(w:real^1) IN interval[w,z] /\ z IN interval[w,z]`
        STRIP_ASSUME_TAC THENL
         [REWRITE_TAC[ENDS_IN_INTERVAL] THEN MP_TAC
           (ISPECL [`a:real^1`; `b:real^1`] INTERVAL_OPEN_SUBSET_CLOSED) THEN
          ASM SET_TAC[];
          REWRITE_TAC[UNION_SUBSET]] THEN
        ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
        MAP_EVERY X_GEN_TAC [`w0:real^1`; `w1:real^1`] THEN
        REWRITE_TAC[IN_INTERVAL_1; SUBSET] THEN STRIP_TAC THEN
        ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
        MAP_EVERY X_GEN_TAC [`z0:real^1`; `z1:real^1`] THEN
        STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`w0:real^1`; `z1:real^1`] THEN
        RULE_ASSUM_TAC
         (REWRITE_RULE[ENDS_IN_UNIT_INTERVAL; INTERVAL_NE_EMPTY_1;
                       UNION_SUBSET; SUBSET_INTERVAL_1]) THEN
        CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
        RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_INTERVAL_1]) THEN
        X_GEN_TAC `x:real^1` THEN
        REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`)) THEN
        ASM_CASES_TAC `(x:real^1) IN s` THEN ASM_REWRITE_TAC[] THEN
        ASM_REAL_ARITH_TAC];
      ALL_TAC] THEN
    FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [UNION_SUBSET]) THEN
    MP_TAC(ISPECL
     [`w:real^1`; `z:real^1`; `a:real^1`; `b:real^1`; `c:real^1`; `d:real^1`]
     lemma3) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`f:real^1->real^1`; `g:real^1->real^1`] THEN
    REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN
    EXISTS_TAC `\x:real^1. if x IN interval[w,z] then f x else x` THEN
    EXISTS_TAC `\x:real^1. if x IN interval[w,z] then g x else x` THEN
    ASSUME_TAC(ISPECL [`w:real^1`; `z:real^1`]INTERVAL_OPEN_SUBSET_CLOSED) THEN
    REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
     [ASM SET_TAC[];
      ASM SET_TAC[];
      ALL_TAC;
      ASM SET_TAC[];
      ASM SET_TAC[];
      ALL_TAC;
      ASM SET_TAC[];
      ASM SET_TAC[];
      MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `interval[w:real^1,z]` THEN
      REWRITE_TAC[BOUNDED_INTERVAL] THEN ASM SET_TAC[]] THEN
    (SUBGOAL_THEN
      `t = interval[w:real^1,z] UNION (t DIFF interval(w,z))`
      (fun th -> SUBST1_TAC th THEN
                 MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
                 ASSUME_TAC(SYM th))
     THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN
     ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN REPEAT CONJ_TAC THENL
      [MATCH_MP_TAC CLOSED_SUBSET THEN REWRITE_TAC[CLOSED_INTERVAL] THEN
       ASM SET_TAC[];
       MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN
       MATCH_MP_TAC OPEN_SUBSET THEN REWRITE_TAC[OPEN_INTERVAL] THEN
       ASM SET_TAC[];
       REWRITE_TAC[CLOSED_DIFF_OPEN_INTERVAL_1; SET_RULE
        `p /\ ~p \/ x IN t DIFF s /\ x IN u <=> x IN t /\ x IN u DIFF s`] THEN
       MAP_EVERY (MP_TAC o ISPECL [`w:real^1`; `z:real^1`])
                 (CONJUNCTS ENDS_IN_INTERVAL) THEN
       ASM SET_TAC[]])) in
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `2 <= dimindex(:N)` THENL
   [MP_TAC(ISPECL
     [`CARD(k:real^N->bool)`; `u:real^N->bool`] CHOOSE_SUBSET_STRONG) THEN
    ANTS_TAC THENL [ASM_MESON_TAC[FINITE_IMP_NOT_OPEN]; ALL_TAC] THEN
    REWRITE_TAC[HAS_SIZE; LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `p:real^N->bool` THEN STRIP_TAC THEN
    MP_TAC(ISPECL [`k:real^N->bool`; `p:real^N->bool`] CARD_EQ_BIJECTION) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `y:real^N->real^N` THEN STRIP_TAC THEN
    MP_TAC(ISPECL
     [`s:real^N->bool`; `t:real^N->bool`; `\x:real^N. x`;
      `y:real^N->real^N`; `k:real^N->bool`]
     HOMEOMORPHISM_MOVING_POINTS_EXISTS) THEN
    ASM_REWRITE_TAC[pairwise] THEN
    ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN
    ASM SET_TAC[];
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_LE]) THEN
    SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (n < 2 <=> n = 1)`] THEN
    REWRITE_TAC[GSYM DIMINDEX_1] THEN
    DISCH_THEN(MP_TAC o MATCH_MP ISOMORPHISMS_UNIV_UNIV) THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`h:real^N->real^1`; `j:real^1->real^N`] THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    MP_TAC(ISPECL
     [`IMAGE (h:real^N->real^1) s`;
      `IMAGE (h:real^N->real^1) k`;
      `IMAGE (h:real^N->real^1) u`;
      `IMAGE (h:real^N->real^1) t`]
        lemma4) THEN
    ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_SUBSET; IMAGE_EQ_EMPTY;
                 CONNECTED_CONTINUOUS_IMAGE; LINEAR_CONTINUOUS_ON] THEN
    ANTS_TAC THENL
     [ASM_MESON_TAC[OPEN_BIJECTIVE_LINEAR_IMAGE_EQ];
      REWRITE_TAC[LEFT_IMP_EXISTS_THM; homeomorphism]] THEN
    MAP_EVERY X_GEN_TAC [`f:real^1->real^1`; `g:real^1->real^1`] THEN
    STRIP_TAC THEN MAP_EVERY EXISTS_TAC
     [`(j:real^1->real^N) o (f:real^1->real^1) o (h:real^N->real^1)`;
      `(j:real^1->real^N) o (g:real^1->real^1) o (h:real^N->real^1)`] THEN
    ASM_REWRITE_TAC[o_THM; IMAGE_o] THEN
    ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_CONTINUOUS_ON] THEN
    ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    SUBGOAL_THEN
     `{x | ~(j ((f:real^1->real^1) (h x)) = x /\ j (g (h x)) = x)} =
      IMAGE (j:real^1->real^N) {x | ~(f x = x /\ g x = x)}`
    SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    ASM_SIMP_TAC[BOUNDED_LINEAR_IMAGE]]);;

let HOMEOMORPHISM_GROUPING_POINTS_EXISTS_GEN = prove
 (`!u s t k:real^N->bool.
        open_in (subtopology euclidean (affine hull s)) s /\
        s SUBSET t /\ t SUBSET affine hull s /\ connected s /\
        FINITE k /\ k SUBSET s /\
        open_in (subtopology euclidean s) u /\ ~(u = {})
        ==> ?f g. homeomorphism (t,t) (f,g) /\
                  (!x. x IN k ==> f(x) IN u) /\
                  {x | ~(f x = x /\ g x = x)} SUBSET s /\
                  bounded {x | ~(f x = x /\ g x = x)}`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `&2 <= aff_dim(s:real^N->bool)` THENL
   [MP_TAC(ISPECL
     [`CARD(k:real^N->bool)`; `u:real^N->bool`] CHOOSE_SUBSET_STRONG) THEN
    ANTS_TAC THENL
     [MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[GSYM INFINITE] THEN
      MATCH_MP_TAC INFINITE_OPEN_IN THEN
      EXISTS_TAC `affine hull s:real^N->bool` THEN CONJ_TAC THENL
       [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN
      STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC CONNECTED_IMP_PERFECT_AFF_DIM THEN
      ASM_SIMP_TAC[CONVEX_CONNECTED; AFFINE_AFFINE_HULL; AFFINE_IMP_CONVEX;
                   AFF_DIM_AFFINE_HULL] THEN
      CONJ_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN
      ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET];
      REWRITE_TAC[HAS_SIZE; LEFT_IMP_EXISTS_THM] THEN
      X_GEN_TAC `p:real^N->bool` THEN STRIP_TAC THEN MP_TAC
       (ISPECL [`k:real^N->bool`; `p:real^N->bool`] CARD_EQ_BIJECTION) THEN
      ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
      X_GEN_TAC `y:real^N->real^N` THEN STRIP_TAC THEN
      MP_TAC(ISPECL
       [`s:real^N->bool`; `t:real^N->bool`; `\x:real^N. x`;
        `y:real^N->real^N`; `k:real^N->bool`]
       HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN) THEN
      ASM_REWRITE_TAC[pairwise] THEN
      REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
      ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
      STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN
      ASM SET_TAC[]];
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INT_NOT_LE])] THEN
  SIMP_TAC[AFF_DIM_GE; INT_ARITH
   `--(&1):int <= x ==> (x < &2 <=> x = --(&1) \/ x = &0 \/ x = &1)`] THEN
  REWRITE_TAC[AFF_DIM_EQ_MINUS1; AFF_DIM_EQ_0] THEN
  SUBGOAL_THEN
   `(u:real^N->bool) SUBSET s /\ s SUBSET affine hull s`
  STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[open_in]; ALL_TAC] THEN
  DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN
  STRIP_TAC THENL
   [REPEAT(EXISTS_TAC `I:real^N->real^N`) THEN
    REWRITE_TAC[HOMEOMORPHISM_I; I_THM; EMPTY_GSPEC; BOUNDED_EMPTY] THEN
    ASM SET_TAC[];
    ALL_TAC] THEN
  MP_TAC(ISPECL [`affine hull s:real^N->bool`; `(:real^1)`]
   HOMEOMORPHIC_AFFINE_SETS) THEN
  ASM_REWRITE_TAC[AFF_DIM_UNIV; AFFINE_AFFINE_HULL; AFFINE_UNIV] THEN
  ASM_REWRITE_TAC[DIMINDEX_1; AFF_DIM_AFFINE_HULL] THEN
  REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`h:real^N->real^1`; `j:real^1->real^N`] THEN
  STRIP_TAC THEN MP_TAC(ISPECL
   [`IMAGE (h:real^N->real^1) u`; `IMAGE (h:real^N->real^1) s`;
    `IMAGE (h:real^N->real^1) t`; `IMAGE (h:real^N->real^1) k`]
    HOMEOMORPHISM_GROUPING_POINTS_EXISTS) THEN
  ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_SUBSET; IMAGE_EQ_EMPTY] THEN
  ANTS_TAC THENL
   [MP_TAC(ISPECL
     [`h:real^N->real^1`; `j:real^1->real^N`;
      `affine hull s:real^N->bool`; `(:real^1)`]
     HOMEOMORPHISM_IMP_OPEN_MAP) THEN
    ASM_SIMP_TAC[homeomorphism; SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN
    REPEAT STRIP_TAC THENL [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN
    MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
    ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
    REWRITE_TAC[LEFT_IMP_EXISTS_THM; homeomorphism]] THEN
  MAP_EVERY X_GEN_TAC [`f:real^1->real^1`; `g:real^1->real^1`] THEN
  STRIP_TAC THEN MAP_EVERY EXISTS_TAC
   [`\x. if x IN affine hull s
         then ((j:real^1->real^N) o (f:real^1->real^1) o (h:real^N->real^1)) x
         else x`;
    `\x. if x IN affine hull s
         then ((j:real^1->real^N) o (g:real^1->real^1) o (h:real^N->real^1)) x
         else x`] THEN
  ASM_SIMP_TAC[o_THM; IMAGE_o] THEN REPEAT CONJ_TAC THENL
   [ASM SET_TAC[];
    ASM_SIMP_TAC[SET_RULE
     `t SUBSET s ==> IMAGE (\x. if x IN s then f x else x) t = IMAGE f t`] THEN
    REPLICATE_TAC 3 (ONCE_REWRITE_TAC[GSYM o_DEF]) THEN
    ASM_REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
    MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC
     `(j:real^1->real^N) o (f:real^1->real^1) o (h:real^N->real^1)` THEN
    REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN
    ASM SET_TAC[];
    ASM SET_TAC[];
    ASM_SIMP_TAC[SET_RULE
     `t SUBSET s ==> IMAGE (\x. if x IN s then f x else x) t = IMAGE f t`] THEN
    REPLICATE_TAC 3 (ONCE_REWRITE_TAC[GSYM o_DEF]) THEN
    ASM_REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
    MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC
     `(j:real^1->real^N) o (g:real^1->real^1) o (h:real^N->real^1)` THEN
    REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN
    ASM SET_TAC[];
    ASM SET_TAC[];
    ALL_TAC;
    ALL_TAC] THEN
  REWRITE_TAC[MESON[] `(if P then f x else x) = x <=> ~P \/ f x = x`] THEN
  REWRITE_TAC[DE_MORGAN_THM; GSYM LEFT_OR_DISTRIB] THEN
  (SUBGOAL_THEN
   `{x | x IN affine hull s /\ (~(j (f (h x)) = x) \/ ~(j (g (h x)) = x))} =
    IMAGE (j:real^1->real^N) {x | ~(f x = x /\ g x = x)}`
   SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC])
  THENL
   [TRANS_TAC SUBSET_TRANS
     `IMAGE (j:real^1->real^N) (IMAGE (h:real^N->real^1) s)` THEN
    ASM SET_TAC[];
    MATCH_MP_TAC(MESON[CLOSURE_SUBSET; BOUNDED_SUBSET; IMAGE_SUBSET]
     `bounded (IMAGE f (closure s)) ==> bounded (IMAGE f s)`) THEN
    MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN
    MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
    ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN
    ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]]);;

let HOMEOMORPHISM_MOVING_DENSE_COUNTABLE_SUBSETS_EXISTS = prove
 (`!s:real^M->bool t:real^N->bool.
        COUNTABLE s /\ closure s = affine hull s /\
        COUNTABLE t /\ closure t = affine hull t /\
        aff_dim s = aff_dim t
        ==> ?f g. homeomorphism (affine hull s,affine hull t) (f,g) /\
                  IMAGE f s = t`,
  let lemma = prove
   (`!n s:real^N->bool t:real^N->bool.
        1 <= n /\ n <= dimindex(:N) /\
        INFINITE s /\ COUNTABLE s /\ closure s = span(IMAGE basis (1..n)) /\
        INFINITE t /\ COUNTABLE t /\ closure t = span(IMAGE basis (1..n))
        ==> ?f g. homeomorphism
                   (span(IMAGE basis (1..n)),span(IMAGE basis (1..n))) (f,g) /\
                  IMAGE f s = t`,
    X_GEN_TAC `n:num` THEN
    ASM_CASES_TAC `1 <= n` THEN ASM_REWRITE_TAC[] THEN
    ASM_CASES_TAC `n <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN
    ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (p /\ q /\ r) /\ s`] THEN
    MATCH_MP_TAC(METIS[]
     `!Q. (!s t. P s /\ P t /\ R s t ==> R t s) /\
          (!t. P t /\ (!s. P s /\ Q s ==> R s t)
               ==> (!s. P s ==> R s t)) /\
          (!s t. P s /\ Q s /\ P t /\ Q t ==> R s t)
          ==> !s t. P s /\ P t ==> R s t`) THEN
    EXISTS_TAC
     `\s. pairwise (\x y:real^N. !i. 1 <= i /\ i <= n ==> ~(x$i = y$i)) s` THEN
    REWRITE_TAC[] THEN CONJ_TAC THENL
     [MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN
      REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN
      GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN
      REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
      GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [HOMEOMORPHISM_SYM] THEN
      SIMP_TAC[] THEN REWRITE_TAC[homeomorphism] THEN
      MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[];
      ALL_TAC] THEN
    CONJ_TAC THENL
     [X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
      X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN
      MP_TAC(ISPECL [`n:num`; `s:real^N->bool`]
        ROTATION_TO_GENERAL_POSITION_EXISTS_GEN) THEN
      ANTS_TAC THENL [ASM_MESON_TAC[CLOSURE_SUBSET]; ALL_TAC] THEN
      DISCH_THEN(X_CHOOSE_THEN `f:real^N->real^N` STRIP_ASSUME_TAC) THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (f:real^N->real^N) s`) THEN
      FIRST_ASSUM(MP_TAC o
        SPECL [`span(IMAGE basis (1..n)):real^N->bool`;
               `span(IMAGE basis (1..n)):real^N->bool`] o
        MATCH_MP (REWRITE_RULE[IMP_CONJ]
          ORTHOGONAL_TRANSFORMATION_IMP_HOMEOMORPHISM)) THEN
      ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
      X_GEN_TAC `g:real^N->real^N` THEN STRIP_TAC THEN ANTS_TAC THENL
       [REPEAT CONJ_TAC THENL
         [ASM_MESON_TAC[HOMEOMORPHISM_INFINITENESS; CLOSURE_SUBSET];
          ASM_MESON_TAC[HOMEOMORPHISM_COUNTABILITY; CLOSURE_SUBSET];
          FIRST_ASSUM(MP_TAC o
            SPEC `s:real^N->bool` o
            MATCH_MP(REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_CLOSURE_OF)) THEN
          ASM_SIMP_TAC[CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF;
                       TOPSPACE_EUCLIDEAN_SUBTOPOLOGY;
                       CLOSURE_MINIMAL; CLOSED_SPAN;
                       SET_RULE `s INTER s = s`;
                       SET_RULE `s SUBSET t ==> t INTER s = s`] THEN
          ANTS_TAC THENL [ASM_MESON_TAC[CLOSURE_SUBSET]; ALL_TAC] THEN
          MATCH_MP_TAC(SET_RULE
           `c SUBSET d /\ d SUBSET s ==> s = s INTER c ==> d = s`) THEN
          SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN
          MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_SPAN] THEN
          ASM_MESON_TAC[CLOSURE_SUBSET; IMAGE_SUBSET; SUBSET_TRANS];
          FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
          REWRITE_TAC[PAIRWISE_IMAGE] THEN REWRITE_TAC[pairwise] THEN
          MESON_TAC[]];
        REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC
         [`h:real^N->real^N`; `k:real^N->real^N`] THEN
        STRIP_TAC THEN MAP_EVERY EXISTS_TAC
         [`(h:real^N->real^N) o (f:real^N->real^N)`;
          `(g:real^N->real^N) o (k:real^N->real^N)`] THEN
        ASM_REWRITE_TAC[IMAGE_o] THEN
        ASM_MESON_TAC[HOMEOMORPHISM_COMPOSE]];
      ALL_TAC] THEN
    MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN
    STRIP_TAC THEN
    SUBGOAL_THEN
     `?f:real^N->real^N.
          IMAGE f s = t /\
          !x y i. x IN s /\ y IN s /\ 1 <= i /\ i <= n
                  ==> real_sgn(f x$i - f y$i) = real_sgn(x$i - y$i)`
    STRIP_ASSUME_TAC THENL
     [ALL_TAC;
      SUBGOAL_THEN
       `!i. ?g h.
            1 <= i /\ i <= n
            ==> (!x. x IN s
                     ==> (f:real^N->real^N) x$i = drop(g(lift(x$i)))) /\
                homeomorphism ((:real^1),(:real^1)) (g,h)`
      MP_TAC THENL
       [REWRITE_TAC[RIGHT_EXISTS_IMP_THM] THEN
        X_GEN_TAC `i:num` THEN STRIP_TAC THEN
        SUBGOAL_THEN `?g. !x. x IN s ==> (f:real^N->real^N)(x)$i = g(x$i)`
        STRIP_ASSUME_TAC THENL
         [GEN_REWRITE_TAC I [GSYM FUNCTION_FACTORS_LEFT_GEN] THEN
          RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM_MESON_TAC[];
          ALL_TAC] THEN
        MP_TAC(ISPECL
         [`lift o g o drop`; `IMAGE (\x:real^N. lift(x$i)) s`]
         INCREASING_EXTENDS_FROM_DENSE) THEN
        ASM_REWRITE_TAC[o_THM; LIFT_DROP] THEN ANTS_TAC THENL
         [REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; RIGHT_FORALL_IMP_THM] THEN
          REWRITE_TAC[LIFT_DROP; CONJ_ASSOC] THEN CONJ_TAC THENL
           [REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP] THEN
            SUBGOAL_THEN
             `IMAGE (\x. lift(g(x$i))) s =
              IMAGE (\x. lift((f:real^N->real^N) x$i)) s`
            SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
            ONCE_REWRITE_TAC[SET_RULE
             `IMAGE (\x. lift(f x$i)) s =
              IMAGE (\y. lift(y$i)) (IMAGE f s)`] THEN
            ASM_REWRITE_TAC[IMAGE_ID] THEN CONJ_TAC THEN
            W(MP_TAC o PART_MATCH (rand o rand) CLOSURE_LINEAR_IMAGE_SUBSET o
              lhand o snd) THEN
            ASM_REWRITE_TAC[LINEAR_LIFT_COMPONENT] THEN
            MATCH_MP_TAC(SET_RULE
             `s = UNIV ==> s SUBSET t ==> t = UNIV`) THEN
            REWRITE_TAC[EXTENSION; IN_IMAGE; IN_SPAN_IMAGE_BASIS; IN_UNIV] THEN
            X_GEN_TAC `c:real^1` THEN EXISTS_TAC `drop c % basis i:real^N` THEN
            (SUBGOAL_THEN `i <= dimindex(:N)` ASSUME_TAC THENL
             [ASM_ARITH_TAC; ALL_TAC]) THEN
            ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN
            REWRITE_TAC[IN_NUMSEG; REAL_MUL_RID; LIFT_DROP] THEN
            GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO];
            X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
            X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
            FIRST_X_ASSUM(MP_TAC o SPECL[`x:real^N`; `y:real^N`; `i:num`]) THEN
            ASM_SIMP_TAC[real_sgn] THEN REAL_ARITH_TAC];
          REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP] THEN
          MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^1->real^1` THEN
          STRIP_TAC THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
          ASM_SIMP_TAC[] THEN
          CONJ_TAC THENL [ASM_MESON_TAC[LIFT_DROP]; ALL_TAC] THEN
          MATCH_MP_TAC MONOTONE_IMP_HOMEOMORPHISM_1D THEN
          ASM_REWRITE_TAC[IS_INTERVAL_UNIV; IN_UNIV]];
        REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
        MAP_EVERY X_GEN_TAC
         [`g:num->real^1->real^1`; `h:num->real^1->real^1`] THEN
        REWRITE_TAC[HOMEOMORPHISM; SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN
        STRIP_TAC THEN MAP_EVERY EXISTS_TAC
         [`(\x. lambda i. if i IN 1..n
                          then drop((g:num->real^1->real^1) i (lift(x$i)))
                          else &0):real^N->real^N`;
          `(\x. lambda i. if i IN 1..n
                          then drop((h:num->real^1->real^1) i (lift(x$i)))
                          else &0):real^N->real^N`] THEN
        SIMP_TAC[IN_SPAN_IMAGE_BASIS; LAMBDA_BETA; GSYM CONJ_ASSOC] THEN
        GEN_REWRITE_TAC I [CONJ_ASSOC] THEN CONJ_TAC THENL
         [ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN
          SIMP_TAC[LAMBDA_BETA] THEN
          CONJ_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
          ASM_CASES_TAC `i IN 1..n` THEN
          ASM_REWRITE_TAC[CONTINUOUS_ON_CONST; LIFT_DROP] THEN
          GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
          MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
          ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT] THEN
          MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real^1)` THEN
          RULE_ASSUM_TAC(REWRITE_RULE[IN_NUMSEG]) THEN ASM_SIMP_TAC[] THEN
          REWRITE_TAC[SUBSET_UNIV];
          ALL_TAC] THEN
        GEN_REWRITE_TAC I [CONJ_ASSOC] THEN CONJ_TAC THENL
         [SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
          CONJ_TAC THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN
          X_GEN_TAC `i:num` THEN STRIP_TAC THEN
          COND_CASES_TAC THEN ASM_SIMP_TAC[LIFT_DROP] THEN
          REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN
          RULE_ASSUM_TAC(REWRITE_RULE[IN_NUMSEG]) THEN ASM_SIMP_TAC[];
          EXPAND_TAC "t" THEN MATCH_MP_TAC IMAGE_EQ THEN
          ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; IN_NUMSEG] THEN
          X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
          X_GEN_TAC `i:num` THEN STRIP_TAC THEN
          COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN CONV_TAC SYM_CONV THEN
          SUBGOAL_THEN `(f:real^N->real^N) x IN span(IMAGE basis (1..n))`
          MP_TAC THENL
           [ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET; IN_IMAGE]; ALL_TAC] THEN
          ASM_SIMP_TAC[IN_SPAN_IMAGE_BASIS; IN_NUMSEG]]]] THEN
    REWRITE_TAC[TAUT `p /\ q /\ r /\ s ==> t <=> p /\ q ==> r /\ s ==> t`] THEN
    REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
    MATCH_MP_TAC(MESON[]
     `(?f. IMAGE f s = t /\
           (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ P f)
      ==> (?f. IMAGE f s = t /\ P f)`) THEN
    MATCH_MP_TAC BACK_AND_FORTH_2 THEN ASM_REWRITE_TAC[REAL_SUB_REFL] THEN
    CONJ_TAC THENL
     [REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_NEG_SUB] THEN
      REWRITE_TAC[REAL_SGN_NEG] THEN ASM_MESON_TAC[];
      ALL_TAC] THEN
    POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
    ONCE_REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN
    REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
    MAP_EVERY (fun t -> SPEC_TAC(t,t))
     [`t:real^N->bool`; `s:real^N->bool`] THEN
    REWRITE_TAC[FORALL_AND_THM] THEN
    GEN_REWRITE_TAC RAND_CONV [MESON[]
     `(!s t f s' t' x. P s t f s' t' x) <=>
      (!s t f t' s' x. P t s f t' s' x)`] THEN
    REWRITE_TAC[AND_FORALL_THM; IMP_IMP] THEN
    MAP_EVERY X_GEN_TAC
     [`s:real^N->bool`; `t:real^N->bool`; `f:real^N->real^N`;
      `s':real^N->bool`; `t':real^N->bool`; `x:real^N`] THEN
    MATCH_MP_TAC(TAUT `(q <=> p) /\ p ==> p /\ q`) THEN CONJ_TAC THENL
     [REWRITE_TAC[EQ_SYM_EQ] THEN REWRITE_TAC[CONJ_ACI];
      REWRITE_TAC[IN_DIFF] THEN STRIP_TAC] THEN
    ABBREV_TAC
     `u = INTERS {{y:real^N | y$i < (f:real^N->real^N)(z)$i} |i,z|
                  i IN 1..n /\ z IN {z | z IN s' /\ (x:real^N)$i < z$i}} INTER
          INTERS {{y:real^N | y$i > (f:real^N->real^N)(z)$i} |i,z|
                  i IN 1..n /\ z IN {z | z IN s' /\ (x:real^N)$i > z$i}}` THEN
    SUBGOAL_THEN `open(u:real^N->bool)` ASSUME_TAC THENL
     [EXPAND_TAC "u" THEN MATCH_MP_TAC OPEN_INTER THEN
      CONJ_TAC THEN MATCH_MP_TAC OPEN_INTERS THEN
      ASM_SIMP_TAC[FINITE_PRODUCT_DEPENDENT; FINITE_NUMSEG; FINITE_RESTRICT;
                   FORALL_IN_GSPEC; OPEN_HALFSPACE_COMPONENT_GT;
                   OPEN_HALFSPACE_COMPONENT_LT];
      ALL_TAC] THEN
    SUBGOAL_THEN `~(u:real^N->bool = {})` ASSUME_TAC THENL
     [EXPAND_TAC "u" THEN GEN_REWRITE_TAC RAND_CONV [EXTENSION] THEN
      REWRITE_TAC[INTERS_GSPEC; IN_INTER; NOT_IN_EMPTY; IN_ELIM_THM] THEN
      REWRITE_TAC[NOT_FORALL_THM; IN_NUMSEG] THEN
      SUBGOAL_THEN `!i. 1 <= i /\ i <= n <=>
                        (1 <= i /\ i <= dimindex(:N)) /\ i <= n`
      MP_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(fun th -> REWRITE_TAC[th])] THEN
      ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ r ==> s <=> p ==> q /\ r ==> s`] THEN
      REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[AND_FORALL_THM] THEN
      REWRITE_TAC[TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN
      REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN
      X_GEN_TAC `i:num` THEN STRIP_TAC THEN
      ASM_CASES_TAC `i:num <= n` THEN ASM_REWRITE_TAC[] THEN
      ONCE_REWRITE_TAC[SET_RULE
       `(!x. x IN s /\ P x ==> R y ((f x)$i)) <=>
        (!x. x IN IMAGE (\x. (f x)$i) {x | x IN s /\ P x} ==> R y x)`] THEN
      ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[real_gt] THEN
      ASM_SIMP_TAC[REAL_LT_BETWEEN_GEN; FINITE_RESTRICT; FINITE_IMAGE] THEN
      REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
      REWRITE_TAC[FORALL_IN_GSPEC] THEN
      X_GEN_TAC `u:real^N` THEN STRIP_TAC THEN
      X_GEN_TAC `v:real^N` THEN STRIP_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N`; `v:real^N`]) THEN
      ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `i:num`) THEN
      ASM_REWRITE_TAC[REAL_SGN_EQ_INEQ] THEN ASM_REAL_ARITH_TAC;
      ALL_TAC] THEN
    SUBGOAL_THEN `?y:real^N. y IN (t DIFF t') /\ y IN u` MP_TAC THENL
     [SUBGOAL_THEN `?z:real^N. z IN span(IMAGE basis (1..n)) INTER u`
      MP_TAC THENL
       [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
        DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN EXISTS_TAC
         `(lambda i. if i IN 1..n then (z:real^N)$i else &0):real^N` THEN
        UNDISCH_TAC `(z:real^N) IN u` THEN EXPAND_TAC "u" THEN
        REWRITE_TAC[INTERS_GSPEC; IN_INTER; IN_ELIM_THM] THEN
        SUBGOAL_THEN `!i. i IN 1..n ==> 1 <= i /\ i <= dimindex(:N)` MP_TAC
        THENL [REWRITE_TAC[IN_NUMSEG] THEN ASM_ARITH_TAC; ALL_TAC] THEN
        SIMP_TAC[IN_SPAN_IMAGE_BASIS; LAMBDA_BETA];
        REWRITE_TAC[IN_INTER] THEN STRIP_TAC] THEN
      SUBGOAL_THEN `(z:real^N) limit_point_of t` MP_TAC THENL
       [ONCE_REWRITE_TAC[GSYM LIMPT_OF_CLOSURE] THEN
        ASM_REWRITE_TAC[] THEN
        MATCH_MP_TAC CONNECTED_IMP_PERFECT_AFF_DIM THEN
        ASM_SIMP_TAC[CONVEX_SPAN; CONVEX_CONNECTED] THEN
        SIMP_TAC[AFF_DIM_DIM_SUBSPACE; SUBSPACE_SPAN] THEN
        REWRITE_TAC[DIM_SPAN; DIM_BASIS_IMAGE] THEN
        REWRITE_TAC[INTER_NUMSEG; CARD_NUMSEG_1; ARITH_RULE `MAX n n = n`] THEN
        REWRITE_TAC[INT_OF_NUM_EQ] THEN MATCH_MP_TAC(ARITH_RULE
         `1 <= m /\ 1 <= n ==> ~(MIN m n = 0)`) THEN
        ASM_REWRITE_TAC[DIMINDEX_GE_1];
        GEN_REWRITE_TAC LAND_CONV [LIMPT_INFINITE_OPEN]] THEN
      DISCH_THEN(MP_TAC o SPEC `u:real^N->bool`) THEN
      ASM_REWRITE_TAC[] THEN UNDISCH_TAC `FINITE(t':real^N->bool)` THEN
      REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN
      DISCH_THEN(MP_TAC o MATCH_MP INFINITE_DIFF_FINITE) THEN
      DISCH_THEN(MP_TAC o MATCH_MP INFINITE_NONEMPTY) THEN SET_TAC[];
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN
      REWRITE_TAC[IN_DIFF] THEN
      DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)] THEN
    ASM_REWRITE_TAC[] THEN EXPAND_TAC "u" THEN
    REWRITE_TAC[IN_INTER; INTERS_GSPEC; IN_ELIM_THM] THEN
    CONV_TAC(RAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN
    REWRITE_TAC[REAL_SGNS_EQ_ALT; real_gt; REAL_SUB_LT; REAL_SUB_0;
                REAL_ARITH `x - y < &0 <=> x < y`] THEN
    SIMP_TAC[IN_NUMSEG] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM SET_TAC[]) in
  REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL
   [ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; AFFINE_HULL_EMPTY] THEN
    REWRITE_TAC[IMAGE_CLAUSES; GSYM homeomorphic] THEN
    REWRITE_TAC[HOMEOMORPHIC_EMPTY];
    ALL_TAC] THEN
  ASM_CASES_TAC `aff_dim(t:real^N->bool) = &0` THENL
   [ASM_REWRITE_TAC[AFF_DIM_EQ_0; CONJ_ASSOC] THEN
    ONCE_REWRITE_TAC[IMP_CONJ_ALT] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [AFF_DIM_EQ_0]) THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `b:real^N` THEN DISCH_THEN SUBST1_TAC THEN
    X_GEN_TAC `a:real^M` THEN DISCH_THEN SUBST1_TAC THEN
    REWRITE_TAC[AFFINE_HULL_SING; CLOSURE_SING] THEN
    DISCH_THEN(K ALL_TAC) THEN MAP_EVERY EXISTS_TAC
     [`(\x. b):real^M->real^N`; `(\x. a):real^N->real^M`] THEN
    ASM_REWRITE_TAC[IMAGE_CLAUSES; homeomorphism; CONTINUOUS_ON_CONST] THEN
    REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY];
    ALL_TAC] THEN
  ASM_CASES_TAC `FINITE(s:real^M->bool)` THENL
   [ASM_SIMP_TAC[CLOSURE_CLOSED; FINITE_IMP_CLOSED] THEN
    DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
    MP_TAC(ISPEC `affine hull s:real^M->bool` CONNECTED_FINITE_IFF_SING) THEN
    SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; CONVEX_CONNECTED] THEN
    ASM_MESON_TAC[AFF_DIM_EQ_0; AFF_DIM_EQ_MINUS1];
    ALL_TAC] THEN
  ASM_CASES_TAC `FINITE(t:real^N->bool)` THENL
   [ASM_SIMP_TAC[CLOSURE_CLOSED; FINITE_IMP_CLOSED] THEN
    DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
    MP_TAC(ISPEC `affine hull t:real^N->bool` CONNECTED_FINITE_IFF_SING) THEN
    SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; CONVEX_CONNECTED] THEN
    ASM_MESON_TAC[AFF_DIM_EQ_0; AFF_DIM_EQ_MINUS1];
    ALL_TAC] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN `?n. aff_dim(t:real^N->bool) = &n`
  (CHOOSE_THEN (fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th)) THENL
   [ASM_REWRITE_TAC[INT_OF_NUM_EXISTS; AFF_DIM_POS_LE];
    ALL_TAC] THEN
  SUBGOAL_THEN `&1 <= aff_dim(t:real^N->bool)` MP_TAC THENL
   [MATCH_MP_TAC(INT_ARITH
     `-- &1:int <= x /\ ~(x = -- &1) /\ ~(x = &0) ==> &1 <= x`) THEN
    REWRITE_TAC[AFF_DIM_GE; AFF_DIM_EQ_MINUS1] THEN ASM_REWRITE_TAC[];
    ASM_REWRITE_TAC[INT_OF_NUM_LE] THEN DISCH_TAC] THEN
  MAP_EVERY (C UNDISCH_THEN (K ALL_TAC))
    [`~(t:real^N->bool = {})`; `~(&n:int = &0)`] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[GSYM INFINITE]) THEN
  MP_TAC(ISPEC `s:real^M->bool` AFF_DIM_LE_UNIV) THEN
  MP_TAC(ISPEC `t:real^N->bool` AFF_DIM_LE_UNIV) THEN
  ASM_REWRITE_TAC[INT_OF_NUM_LE] THEN REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL
   [`affine hull s:real^M->bool`;
    `span(IMAGE basis (1..n)):real^(M,N)finite_sum->bool`]
   HOMEOMORPHIC_AFFINE_SETS) THEN
  SIMP_TAC[AFFINE_AFFINE_HULL; AFFINE_SPAN; AFF_DIM_AFFINE_HULL] THEN
  SIMP_TAC[AFF_DIM_DIM_SUBSPACE; SUBSPACE_SPAN] THEN
  SIMP_TAC[DIM_BASIS_IMAGE; DIM_SPAN; INTER_NUMSEG] THEN
  ASM_SIMP_TAC[ARITH_RULE `MAX x x = x`; CARD_NUMSEG_1] THEN
  ASM_SIMP_TAC[DIMINDEX_FINITE_SUM; ARITH_RULE `n <= N ==> MIN (M + N) n = n`;
               homeomorphic; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC
   [`h1:real^M->real^(M,N)finite_sum`;
    `k1:real^(M,N)finite_sum->real^M`] THEN
  STRIP_TAC THEN
  MP_TAC(ISPECL
   [`affine hull t:real^N->bool`;
    `span(IMAGE basis (1..n)):real^(M,N)finite_sum->bool`]
   HOMEOMORPHIC_AFFINE_SETS) THEN
  SIMP_TAC[AFFINE_AFFINE_HULL; AFFINE_SPAN; AFF_DIM_AFFINE_HULL] THEN
  SIMP_TAC[AFF_DIM_DIM_SUBSPACE; SUBSPACE_SPAN] THEN
  SIMP_TAC[DIM_BASIS_IMAGE; DIM_SPAN; INTER_NUMSEG] THEN
  ASM_SIMP_TAC[ARITH_RULE `MAX x x = x`; CARD_NUMSEG_1] THEN
  ASM_SIMP_TAC[DIMINDEX_FINITE_SUM; ARITH_RULE `n <= N ==> MIN (M + N) n = n`;
               homeomorphic; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC
   [`h2:real^N->real^(M,N)finite_sum`;
    `k2:real^(M,N)finite_sum->real^N`] THEN
  STRIP_TAC THEN
  MP_TAC(ISPECL
   [`n:num`; `IMAGE (h1:real^M->real^(M,N)finite_sum) s`;
    `IMAGE (h2:real^N->real^(M,N)finite_sum) t`]
   lemma) THEN
  ASM_REWRITE_TAC[DIMINDEX_FINITE_SUM] THEN ANTS_TAC THENL
   [ALL_TAC;
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC
     [`f:real^(M,N)finite_sum->real^(M,N)finite_sum`;
      `g:real^(M,N)finite_sum->real^(M,N)finite_sum`] THEN
    STRIP_TAC THEN MAP_EVERY EXISTS_TAC
     [`(k2:real^(M,N)finite_sum->real^N) o f o
       (h1:real^M->real^(M,N)finite_sum)`;
      `(k1:real^(M,N)finite_sum->real^M) o g o
       (h2:real^N->real^(M,N)finite_sum)`] THEN
    CONJ_TAC THENL
     [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [o_ASSOC] THEN
      MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN
      EXISTS_TAC `span(IMAGE basis (1..n)):real^(M,N)finite_sum->bool` THEN
      GEN_REWRITE_TAC RAND_CONV [HOMEOMORPHISM_SYM] THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN
      EXISTS_TAC `span(IMAGE basis (1..n)):real^(M,N)finite_sum->bool` THEN
      ASM_REWRITE_TAC[];
      SUBGOAL_THEN `(t:real^N->bool) SUBSET affine hull t` MP_TAC THENL
       [REWRITE_TAC[HULL_SUBSET]; ASM_REWRITE_TAC[IMAGE_o]] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[]]] THEN
  CONJ_TAC THENL [ASM_ARITH_TAC; ASM_SIMP_TAC[COUNTABLE_IMAGE]] THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (p /\ r) /\ (q /\ s)`] THEN
  CONJ_TAC THENL
   [CONJ_TAC THEN MATCH_MP_TAC INFINITE_IMAGE THEN ASM_REWRITE_TAC[] THENL
     [SUBGOAL_THEN `(s:real^M->bool) SUBSET affine hull s` MP_TAC THENL
       [REWRITE_TAC[HULL_SUBSET]; ALL_TAC];
      SUBGOAL_THEN `(t:real^N->bool) SUBSET affine hull t` MP_TAC THENL
       [REWRITE_TAC[HULL_SUBSET]; ALL_TAC]] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[];
    CONJ_TAC THENL
     [FIRST_ASSUM(MP_TAC o SPEC `s:real^M->bool` o
        MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_CLOSURE_OF)) THEN
      SUBGOAL_THEN
       `span(IMAGE basis (1..n)) =
        IMAGE (h1:real^M->real^(M,N)finite_sum) (affine hull s)`
      (fun th -> SUBST1_TAC th THEN ASSUME_TAC(SYM th))
      THENL [ASM_MESON_TAC[homeomorphism]; ALL_TAC];
      FIRST_ASSUM(MP_TAC o SPEC `t:real^N->bool` o
        MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_CLOSURE_OF)) THEN
      SUBGOAL_THEN
       `span(IMAGE basis (1..n)) =
        IMAGE (h2:real^N->real^(M,N)finite_sum) (affine hull t)`
      (fun th -> SUBST1_TAC th THEN ASSUME_TAC(SYM th))
      THENL [ASM_MESON_TAC[homeomorphism]; ALL_TAC]] THEN
    SIMP_TAC[HULL_SUBSET; CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF;
             IMAGE_SUBSET; SET_RULE `s SUBSET t ==> t INTER s = s`] THEN
    ASM_REWRITE_TAC[SET_RULE `s INTER s = s`] THEN DISCH_THEN SUBST1_TAC THEN
    REWRITE_TAC[SET_RULE `c = s INTER c <=> c SUBSET s`] THEN
    MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_SPAN] THEN
    FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
    SIMP_TAC[IMAGE_SUBSET; HULL_SUBSET]]);;

(* ------------------------------------------------------------------------- *)
(* Boring but useful lemmas about the number of unbounded components.        *)
(* ------------------------------------------------------------------------- *)

let HAS_SIZE_UNBOUNDED_COMPONENTS_COMPLEMENT_1 = prove
 (`!s. bounded s /\ ~(s = {})
       ==> {c | c IN components((:real^1) DIFF s) /\ ~bounded c} HAS_SIZE 2`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM; NORM_1] THEN
  X_GEN_TAC `B:real` THEN STRIP_TAC THEN
  CONV_TAC HAS_SIZE_CONV THEN
  MAP_EVERY ABBREV_TAC
   [`l = connected_component ((:real^1) DIFF s) (--lift(B + &1))`;
    `r = connected_component ((:real^1) DIFF s) (lift(B + &1))`] THEN
  SUBGOAL_THEN
   `l IN components((:real^1) DIFF s) /\
    r IN components((:real^1) DIFF s)`
  STRIP_ASSUME_TAC THENL
   [MAP_EVERY EXPAND_TAC ["l"; "r"] THEN REWRITE_TAC[components] THEN
    REWRITE_TAC[SIMPLE_IMAGE; ETA_AX] THEN
    CONJ_TAC THEN MATCH_MP_TAC FUN_IN_IMAGE THEN
    REWRITE_TAC[IN_UNIV; IN_DIFF] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM]) THEN
    REWRITE_TAC[DROP_NEG; LIFT_DROP] THEN ASM_REAL_ARITH_TAC;
    ALL_TAC] THEN
  SUBGOAL_THEN
   `(!x. drop x < --B ==> x IN l) /\ (!x. B < drop x ==> x IN r)`
  STRIP_ASSUME_TAC THENL
   [REPEAT STRIP_TAC THEN MAP_EVERY EXPAND_TAC ["l"; "r"] THEN
    REWRITE_TAC[IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_1] THEN
    REWRITE_TAC[SEGMENT_1; SUBSET; IN_UNIV; IN_DIFF; DROP_NEG; LIFT_DROP] THEN
    GEN_TAC THEN COND_CASES_TAC THEN
    ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_NEG; LIFT_DROP] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM]) THEN
    REWRITE_TAC[DROP_NEG; LIFT_DROP] THEN ASM_REAL_ARITH_TAC;
    ALL_TAC] THEN
  MAP_EVERY EXISTS_TAC [`l:real^1->bool`; `r:real^1->bool`] THEN
  ASM_REWRITE_TAC[SET_RULE
   `{x | P x} = {a,b} <=> P a /\ P b /\ !c. P c ==> c = a \/ c = b`] THEN
  CONJ_TAC THENL
   [DISCH_TAC THEN
    SUBGOAL_THEN `--lift(B + &1) IN l /\ lift(B + &1) IN r` MP_TAC THENL
     [CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      REWRITE_TAC[DROP_NEG; LIFT_DROP] THEN ASM_REAL_ARITH_TAC;
      ASM_REWRITE_TAC[]] THEN
    W(MP_TAC o PART_MATCH (rand o rand) CONVEX_CONTAINS_SEGMENT_IMP o
        rand o snd) THEN
    REWRITE_TAC[GSYM CONNECTED_CONVEX_1] THEN
    ANTS_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN
    DISCH_THEN(SUBST1_TAC o SYM) THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
    REWRITE_TAC[SUBSET; NOT_FORALL_THM; SEGMENT_1] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`)) THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[DROP_NEG; LIFT_DROP] THEN COND_CASES_TAC THEN
    ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_NEG; LIFT_DROP] THEN
    REWRITE_TAC[NOT_IMP] THEN REPEAT STRIP_TAC THEN
    TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN TRY ASM_REAL_ARITH_TAC THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN
    ASM SET_TAC[];
    GEN_REWRITE_TAC I [CONJ_ASSOC]] THEN
  CONJ_TAC THENL
   [REWRITE_TAC[bounded; NOT_EXISTS_THM] THEN
    CONJ_TAC THEN X_GEN_TAC `c:real` THENL
     [DISCH_THEN(MP_TAC o SPEC `--lift(B + abs c + &1)`);
      DISCH_THEN(MP_TAC o SPEC `lift(B + abs c +  &1)`)] THEN
    REWRITE_TAC[NOT_IMP; NORM_NEG; NORM_LIFT] THEN
    (CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC]) THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    REWRITE_TAC[DROP_NEG; LIFT_DROP] THEN ASM_REAL_ARITH_TAC;
    ALL_TAC] THEN
  X_GEN_TAC `c:real^1->bool` THEN STRIP_TAC THEN
  MP_TAC(ISPEC `(:real^1) DIFF s` COMPONENTS_EQ) THEN
  ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [bounded]) THEN
  REWRITE_TAC[NOT_EXISTS_THM; NOT_FORALL_THM; NOT_IMP; REAL_NOT_LE] THEN
  DISCH_THEN(MP_TAC o SPEC `B:real`) THEN
  REWRITE_TAC[NORM_1; REAL_ARITH `B < abs x <=> x < -- B \/ B < x`] THEN
  ASM SET_TAC[]);;

let HAS_SIZE_UNBOUNDED_COMPONENTS_COMPLEMENT = prove
 (`!s. bounded s
       ==> {c | c IN components((:real^N) DIFF s) /\ ~bounded c} HAS_SIZE
           (if s = {} \/ 2 <= dimindex(:N) then 1 else 2)`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THENL
   [ASM_REWRITE_TAC[DIFF_EMPTY; COMPONENTS_UNIV; IN_SING] THEN
    REWRITE_TAC[MESON[] `c = u /\ ~bounded c <=> c = u /\ ~bounded u`] THEN
    REWRITE_TAC[NOT_BOUNDED_UNIV; SING_GSPEC] THEN
    CONV_TAC HAS_SIZE_CONV THEN MESON_TAC[];
    ALL_TAC] THEN
  ASM_CASES_TAC `2 <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THENL
   [CONV_TAC HAS_SIZE_CONV THEN
    MP_TAC(ISPEC `(:real^N) DIFF s` COBOUNDED_UNBOUNDED_COMPONENTS) THEN
    ASM_REWRITE_TAC[COMPL_COMPL] THEN MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN
    ASM_REWRITE_TAC[SET_RULE
     `{x | P x} = {a} <=> P a /\ !b. P b ==> b = a`] THEN
    REPEAT STRIP_TAC THEN
    MATCH_MP_TAC COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS THEN
    EXISTS_TAC `(:real^N) DIFF s` THEN
    ASM_REWRITE_TAC[COMPL_COMPL];
    FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE
     `~(2 <= n) ==> 1 <= n ==> n = 1`)) THEN
    REWRITE_TAC[DIMINDEX_GE_1] THEN
    GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM DIMINDEX_1] THEN
    DISCH_THEN(MATCH_MP_TAC o C GEOM_EQUAL_DIMENSION_RULE
      HAS_SIZE_UNBOUNDED_COMPONENTS_COMPLEMENT_1) THEN
    ASM_REWRITE_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* The "inside" and "outside" of a set, i.e. the points respectively in a    *)
(* bounded or unbounded connected component of the set's complement.         *)
(* ------------------------------------------------------------------------- *)

let inside = new_definition
 `inside s = {x | ~(x IN s) /\
                  bounded(connected_component ((:real^N) DIFF s) x)}`;;

let outside = new_definition
 `outside s = {x | ~(x IN s) /\
                   ~bounded(connected_component ((:real^N) DIFF s) x)}`;;

let INSIDE_TRANSLATION = prove
 (`!a s. inside(IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (inside s)`,
  REWRITE_TAC[inside] THEN GEOM_TRANSLATE_TAC[]);;

let OUTSIDE_TRANSLATION = prove
 (`!a s. outside(IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (outside s)`,
  REWRITE_TAC[outside] THEN GEOM_TRANSLATE_TAC[]);;

add_translation_invariants [INSIDE_TRANSLATION; OUTSIDE_TRANSLATION];;

let INSIDE_LINEAR_IMAGE = prove
 (`!f s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
         ==> inside(IMAGE f s) = IMAGE f (inside s)`,
  REWRITE_TAC[inside] THEN GEOM_TRANSFORM_TAC[]);;

let OUTSIDE_LINEAR_IMAGE = prove
 (`!f s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
         ==> outside(IMAGE f s) = IMAGE f (outside s)`,
  REWRITE_TAC[outside] THEN GEOM_TRANSFORM_TAC[]);;

add_linear_invariants [INSIDE_LINEAR_IMAGE; OUTSIDE_LINEAR_IMAGE];;

let OUTSIDE = prove
 (`!s. outside s = {x | ~bounded(connected_component((:real^N) DIFF s) x)}`,
  GEN_TAC THEN REWRITE_TAC[outside; EXTENSION; IN_ELIM_THM] THEN
  X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN s` THEN
  ASM_REWRITE_TAC[] THEN
  ASM_MESON_TAC[BOUNDED_EMPTY; CONNECTED_COMPONENT_EQ_EMPTY; IN_DIFF]);;

let INSIDE_NO_OVERLAP = prove
 (`!s. inside s INTER s = {}`,
  REWRITE_TAC[inside] THEN SET_TAC[]);;

let OUTSIDE_NO_OVERLAP = prove
 (`!s. outside s INTER s = {}`,
  REWRITE_TAC[outside] THEN SET_TAC[]);;

let INSIDE_INTER_OUTSIDE = prove
 (`!s. inside s INTER outside s = {}`,
  REWRITE_TAC[inside; outside] THEN SET_TAC[]);;

let INSIDE_UNION_OUTSIDE = prove
 (`!s. inside s UNION outside s = (:real^N) DIFF s`,
  REWRITE_TAC[inside; outside] THEN SET_TAC[]);;

let INSIDE_EQ_OUTSIDE = prove
 (`!s. inside s = outside s <=> s = (:real^N)`,
  REWRITE_TAC[inside; outside] THEN SET_TAC[]);;

let INSIDE_OUTSIDE = prove
 (`!s. inside s = (:real^N) DIFF (s UNION outside s)`,
  GEN_TAC THEN MAP_EVERY (MP_TAC o ISPEC `s:real^N->bool`)
   [INSIDE_INTER_OUTSIDE; INSIDE_UNION_OUTSIDE] THEN
  SET_TAC[]);;

let OUTSIDE_INSIDE = prove
 (`!s. outside s = (:real^N) DIFF (s UNION inside s)`,
  GEN_TAC THEN MAP_EVERY (MP_TAC o ISPEC `s:real^N->bool`)
   [INSIDE_INTER_OUTSIDE; INSIDE_UNION_OUTSIDE] THEN
  SET_TAC[]);;

let INSIDE_EMPTY_EQ_NO_BOUNDED_COMPONENT_COMPLEMENT = prove
 (`!s. inside s = {} <=>
       !c. c IN components((:real^N) DIFF s) ==> ~bounded c`,
  REWRITE_TAC[components; FORALL_IN_GSPEC; inside] THEN SET_TAC[]);;

let OUTSIDE_EMPTY_EQ_NO_BOUNDED_COMPONENT_COMPLEMENT = prove
 (`!s. outside s = {} <=>
       !c. c IN components((:real^N) DIFF s) ==> bounded c`,
  REWRITE_TAC[components; FORALL_IN_GSPEC; outside] THEN SET_TAC[]);;

let INSIDE_SELF_OUTSIDE_EVERSION = prove
 (`!s t:real^N->bool.
        s UNION inside s SUBSET inside t <=>
        t UNION outside t SUBSET outside s`,
  REPEAT GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV[SET_RULE `s SUBSET t <=>
    UNIV DIFF t SUBSET UNIV DIFF s`] THEN
  REWRITE_TAC[GSYM INSIDE_OUTSIDE] THEN
  REWRITE_TAC[OUTSIDE_INSIDE] THEN ASM SET_TAC[]);;

let UNION_WITH_INSIDE = prove
 (`!s. s UNION inside s = (:real^N) DIFF outside s`,
  REWRITE_TAC[OUTSIDE_INSIDE] THEN SET_TAC[]);;

let UNION_WITH_OUTSIDE = prove
 (`!s. s UNION outside s = (:real^N) DIFF inside s`,
  REWRITE_TAC[INSIDE_OUTSIDE] THEN SET_TAC[]);;

let OUTSIDE_MONO = prove
 (`!s t. s SUBSET t ==> outside t SUBSET outside s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[OUTSIDE; SUBSET; IN_ELIM_THM] THEN
  DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN
  MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN ASM SET_TAC[]);;

let INSIDE_MONO = prove
 (`!s t. s SUBSET t ==> inside s DIFF t SUBSET inside t`,
  REPEAT STRIP_TAC THEN SIMP_TAC[SUBSET; IN_DIFF; inside; IN_ELIM_THM] THEN
  GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)
    ASSUME_TAC) THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN
  MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN ASM SET_TAC[]);;

let INSIDE_MONO_ALT = prove
 (`!s t:real^N->bool. s SUBSET t ==> inside s SUBSET t UNION inside t`,
  REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP INSIDE_MONO) THEN
  SET_TAC[]);;

let COBOUNDED_OUTSIDE = prove
 (`!s:real^N->bool. bounded s ==> bounded((:real^N) DIFF outside s)`,
  GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[outside] THEN
  REWRITE_TAC[SET_RULE `UNIV DIFF {x | ~(x IN s) /\ ~P x} =
                        s UNION {x | P x}`] THEN
  ASM_REWRITE_TAC[BOUNDED_UNION] THEN
  FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
  DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
  MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(vec 0:real^N,B)` THEN
  REWRITE_TAC[BOUNDED_BALL; SUBSET; IN_ELIM_THM; IN_BALL_0] THEN
  X_GEN_TAC `x:real^N` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
  REWRITE_TAC[REAL_NOT_LT] THEN
  ASM_CASES_TAC `x:real^N = vec 0` THENL
   [ASM_REWRITE_TAC[NORM_0] THEN ASM_REAL_ARITH_TAC; DISCH_TAC] THEN
  REWRITE_TAC[BOUNDED_POS] THEN
  DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `(B + C) / norm(x) % x:real^N`) THEN
  REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
  ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; NOT_IMP] THEN
  CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
  REWRITE_TAC[IN] THEN REWRITE_TAC[connected_component] THEN
  EXISTS_TAC `segment[x:real^N,(B + C) / norm(x) % x]` THEN
  REWRITE_TAC[ENDS_IN_SEGMENT; CONNECTED_SEGMENT] THEN
  MATCH_MP_TAC SUBSET_TRANS THEN
  EXISTS_TAC `(:real^N) DIFF ball(vec 0,B)` THEN
  ASM_REWRITE_TAC[SET_RULE
   `UNIV DIFF s SUBSET UNIV DIFF t <=> t SUBSET s`] THEN
  REWRITE_TAC[SUBSET; IN_DIFF; IN_UNIV; IN_BALL_0] THEN
  REWRITE_TAC[segment; FORALL_IN_GSPEC] THEN X_GEN_TAC `u:real` THEN
  STRIP_TAC THEN REWRITE_TAC[REAL_NOT_LT] THEN
  REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB; NORM_MUL; VECTOR_MUL_ASSOC] THEN
  GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_ABS_NORM] THEN
  REWRITE_TAC[GSYM REAL_ABS_MUL] THEN MATCH_MP_TAC(REAL_ARITH
   `&0 < B /\ B <= x ==> B <= abs x`) THEN
  ASM_SIMP_TAC[REAL_ADD_RDISTRIB; REAL_DIV_RMUL; NORM_EQ_0; GSYM
               REAL_MUL_ASSOC] THEN
  MATCH_MP_TAC REAL_LE_TRANS THEN
  EXISTS_TAC `(&1 - u) * B + u * (B + C)` THEN
  ASM_SIMP_TAC[REAL_LE_RADD; REAL_LE_LMUL; REAL_SUB_LE] THEN
  SIMP_TAC[REAL_ARITH `B <= (&1 - u) * B + u * (B + C) <=> &0 <= u * C`] THEN
  MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC);;

let UNBOUNDED_OUTSIDE = prove
 (`!s:real^N->bool. bounded s ==> ~bounded(outside s)`,
  MESON_TAC[COBOUNDED_IMP_UNBOUNDED; COBOUNDED_OUTSIDE]);;

let BOUNDED_INSIDE = prove
 (`!s:real^N->bool. bounded s ==> bounded(inside s)`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC BOUNDED_SUBSET THEN
  EXISTS_TAC `(:real^N) DIFF outside s` THEN
  ASM_SIMP_TAC[COBOUNDED_OUTSIDE] THEN
  MP_TAC(ISPEC `s:real^N->bool` INSIDE_INTER_OUTSIDE) THEN SET_TAC[]);;

let CONNECTED_OUTSIDE = prove
 (`!s:real^N->bool. 2 <= dimindex(:N) /\ bounded s ==> connected(outside s)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
  MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
  REWRITE_TAC[outside; IN_ELIM_THM] THEN STRIP_TAC THEN
  MATCH_MP_TAC CONNECTED_COMPONENT_OF_SUBSET THEN
  EXISTS_TAC `connected_component ((:real^N) DIFF s) x` THEN
  REWRITE_TAC[SUBSET; IN_UNIV; IN_DIFF; IN_ELIM_THM] THEN CONJ_TAC THENL
   [X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET]
      CONNECTED_COMPONENT_SUBSET)) THEN
    REWRITE_TAC[IN_DIFF] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_EQ];
    REWRITE_TAC[CONNECTED_COMPONENT_IDEMP] THEN
    SUBGOAL_THEN `connected_component ((:real^N) DIFF s) x =
                  connected_component ((:real^N) DIFF s) y`
    SUBST1_TAC THENL
     [MATCH_MP_TAC COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT THEN
      ASM_REWRITE_TAC[COMPL_COMPL];
      ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ; IN_DIFF; IN_UNIV]]]);;

let OUTSIDE_CONNECTED_COMPONENT_LT = prove
 (`!s. outside s =
            {x | !B. ?y. B < norm(y) /\
                         connected_component((:real^N) DIFF s) x y}`,
  REWRITE_TAC[OUTSIDE; bounded; EXTENSION; IN_ELIM_THM] THEN
  REWRITE_TAC[IN] THEN ASM_MESON_TAC[REAL_NOT_LE]);;

let OUTSIDE_CONNECTED_COMPONENT_LE = prove
 (`!s. outside s =
            {x | !B. ?y. B <= norm(y) /\
                         connected_component((:real^N) DIFF s) x y}`,
  GEN_TAC THEN REWRITE_TAC[OUTSIDE_CONNECTED_COMPONENT_LT] THEN
  GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN
  REWRITE_TAC[IN_ELIM_THM] THEN
  MESON_TAC[REAL_LT_IMP_LE; REAL_ARITH `B + &1 <= x ==> B < x`]);;

let NOT_OUTSIDE_CONNECTED_COMPONENT_LT = prove
 (`!s. 2 <= dimindex(:N) /\ bounded s
       ==> (:real^N) DIFF (outside s) =
           {x | !B. ?y. B < norm(y) /\
                        ~(connected_component((:real^N) DIFF s) x y)}`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[OUTSIDE] THEN
  REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN
  X_GEN_TAC `x:real^N` THEN REWRITE_TAC[bounded] THEN EQ_TAC THENL
   [DISCH_THEN(X_CHOOSE_TAC `C:real`) THEN X_GEN_TAC `B:real` THEN
    EXISTS_TAC `(abs B + abs C + &1) % basis 1:real^N` THEN
    RULE_ASSUM_TAC(ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM]) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN
    CONJ_TAC THENL [ALL_TAC; FIRST_X_ASSUM MATCH_MP_TAC] THEN
    SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
    REAL_ARITH_TAC;
    DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN
    X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN] THEN DISCH_TAC THEN
    ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `B:real`) THEN DISCH_THEN
     (X_CHOOSE_THEN `z:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN
    EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC CONNECTED_COMPONENT_OF_SUBSET THEN
    EXISTS_TAC `(:real^N) DIFF cball(vec 0,B)` THEN
    ASM_REWRITE_TAC[SUBSET; IN_DIFF; IN_CBALL_0; IN_UNIV; CONTRAPOS_THM] THEN
    REWRITE_TAC[connected_component] THEN
    EXISTS_TAC `(:real^N) DIFF cball(vec 0,B)` THEN
    ASM_SIMP_TAC[SUBSET_REFL; IN_DIFF; IN_UNIV; IN_CBALL_0; REAL_NOT_LE] THEN
    MATCH_MP_TAC CONNECTED_COMPLEMENT_BOUNDED_CONVEX THEN
    ASM_SIMP_TAC[BOUNDED_CBALL; CONVEX_CBALL]]);;

let NOT_OUTSIDE_CONNECTED_COMPONENT_LE = prove
 (`!s. 2 <= dimindex(:N) /\ bounded s
       ==> (:real^N) DIFF (outside s) =
           {x | !B. ?y. B <= norm(y) /\
                        ~(connected_component((:real^N) DIFF s) x y)}`,
  REPEAT STRIP_TAC THEN ASM_SIMP_TAC[NOT_OUTSIDE_CONNECTED_COMPONENT_LT] THEN
  GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN
  REWRITE_TAC[IN_ELIM_THM] THEN
  MESON_TAC[REAL_LT_IMP_LE; REAL_ARITH `B + &1 <= x ==> B < x`]);;

let INSIDE_CONNECTED_COMPONENT_LT = prove
 (`!s. 2 <= dimindex(:N) /\ bounded s
       ==> inside s =
            {x:real^N | ~(x IN s) /\
                        !B. ?y. B < norm(y) /\
                                ~(connected_component((:real^N) DIFF s) x y)}`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[INSIDE_OUTSIDE] THEN
  REWRITE_TAC[SET_RULE `UNIV DIFF (s UNION t) = (UNIV DIFF t) DIFF s`] THEN
  ASM_SIMP_TAC[NOT_OUTSIDE_CONNECTED_COMPONENT_LT] THEN SET_TAC[]);;

let INSIDE_CONNECTED_COMPONENT_LE = prove
 (`!s. 2 <= dimindex(:N) /\ bounded s
       ==> inside s =
            {x:real^N | ~(x IN s) /\
                        !B. ?y. B <= norm(y) /\
                                ~(connected_component((:real^N) DIFF s) x y)}`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[INSIDE_OUTSIDE] THEN
  REWRITE_TAC[SET_RULE `UNIV DIFF (s UNION t) = (UNIV DIFF t) DIFF s`] THEN
  ASM_SIMP_TAC[NOT_OUTSIDE_CONNECTED_COMPONENT_LE] THEN SET_TAC[]);;

let OUTSIDE_UNION_OUTSIDE_UNION = prove
 (`!c c1 c2:real^N->bool.
        c INTER outside(c1 UNION c2) = {}
        ==> outside(c1 UNION c2) SUBSET outside(c1 UNION c)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN
  X_GEN_TAC `x:real^N` THEN
  DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
  REWRITE_TAC[OUTSIDE_CONNECTED_COMPONENT_LT; IN_ELIM_THM] THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `B:real` THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  ASM_REWRITE_TAC[connected_component] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  SUBGOAL_THEN `t SUBSET outside(c1 UNION c2:real^N->bool)`
  MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  MATCH_MP_TAC SUBSET_TRANS THEN
  EXISTS_TAC `connected_component((:real^N) DIFF (c1 UNION c2)) x` THEN
  CONJ_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_MAXIMAL]; ALL_TAC] THEN
  UNDISCH_TAC `(x:real^N) IN outside(c1 UNION c2)` THEN
  REWRITE_TAC[OUTSIDE; IN_ELIM_THM; SUBSET] THEN
  MESON_TAC[CONNECTED_COMPONENT_EQ]);;

let INSIDE_SUBSET = prove
 (`!s t u. connected u /\ ~bounded u /\ t UNION u = (:real^N) DIFF s
           ==> inside s SUBSET t`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET; inside; IN_ELIM_THM] THEN
  X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
  MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
  UNDISCH_TAC `~bounded(u:real^N->bool)` THEN REWRITE_TAC[] THEN
  MATCH_MP_TAC BOUNDED_SUBSET THEN
  EXISTS_TAC `connected_component((:real^N) DIFF s) x` THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
  ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);;

let INSIDE_UNIQUE = prove
 (`!s t u. connected t /\ bounded t /\
           connected u /\ ~(bounded u) /\
           ~connected((:real^N) DIFF s) /\
           t UNION u = (:real^N) DIFF s
           ==> inside s = t`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
   [ASM_MESON_TAC[INSIDE_SUBSET]; ALL_TAC] THEN
  REWRITE_TAC[SUBSET; inside; IN_ELIM_THM] THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `t:real^N->bool` THEN
  ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC(SET_RULE
   `!s u. c INTER s = {} /\ c INTER u = {} /\ t UNION u = UNIV DIFF s
          ==> c SUBSET t`) THEN
  MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `u:real^N->bool`] THEN
  ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
   [REWRITE_TAC[SET_RULE `c INTER s = {} <=> c SUBSET (UNIV DIFF s)`] THEN
    REWRITE_TAC[CONNECTED_COMPONENT_SUBSET];
    ALL_TAC] THEN
  MATCH_MP_TAC(SET_RULE `(!x. x IN s /\ x IN t ==> F) ==> s INTER t = {}`) THEN
  X_GEN_TAC `y:real^N` THEN
  GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [IN] THEN STRIP_TAC THEN
  UNDISCH_TAC `~connected((:real^N) DIFF s)` THEN
  REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
  MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN
  SUBGOAL_THEN
   `(!w. w IN t ==> connected_component ((:real^N) DIFF s) x w) /\
    (!w. w IN u ==> connected_component ((:real^N) DIFF s) y w)`
  STRIP_ASSUME_TAC THENL
   [CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN
    REWRITE_TAC[connected_component] THENL
     [EXISTS_TAC `t:real^N->bool`; EXISTS_TAC `u:real^N->bool`] THEN
    ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
    FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[IN_UNION] THEN
    ASM_REWRITE_TAC[] THEN
    ASM_MESON_TAC[CONNECTED_COMPONENT_TRANS; CONNECTED_COMPONENT_SYM]]);;

let INSIDE_OUTSIDE_UNIQUE = prove
 (`!s t u. connected t /\ bounded t /\
           connected u /\ ~(bounded u) /\
           ~connected((:real^N) DIFF s) /\
           t UNION u = (:real^N) DIFF s
           ==> inside s = t /\ outside s = u`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[OUTSIDE_INSIDE] THEN
  MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
   [ASM_MESON_TAC[INSIDE_UNIQUE];
    MP_TAC(ISPEC `(:real^N) DIFF s` INSIDE_NO_OVERLAP) THEN
    SUBGOAL_THEN `t INTER u:real^N->bool = {}` MP_TAC THENL
     [ALL_TAC; ASM SET_TAC[]] THEN
    UNDISCH_TAC `~connected ((:real^N) DIFF s)` THEN
    ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
    FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN DISCH_TAC THEN
    REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_UNION THEN
    ASM_REWRITE_TAC[]]);;

let INTERIOR_INSIDE_FRONTIER = prove
 (`!s:real^N->bool. bounded s ==> interior s SUBSET inside(frontier s)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[inside; SUBSET; IN_ELIM_THM] THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
   [ASM_REWRITE_TAC[frontier; IN_DIFF]; DISCH_TAC] THEN
  MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN
  ASM_REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
  MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
  SUBGOAL_THEN `~(connected_component((:real^N) DIFF frontier s) x INTER
                  frontier s = {})`
  MP_TAC THENL
   [MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN
    REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; GSYM MEMBER_NOT_EMPTY] THEN
    CONJ_TAC THENL [REWRITE_TAC[IN_INTER]; ASM SET_TAC[]] THEN
    EXISTS_TAC `x:real^N` THEN CONJ_TAC THENL
     [REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ] THEN
      GEN_REWRITE_TAC I [GSYM IN] THEN ASM SET_TAC[];
      ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]];
    REWRITE_TAC[SET_RULE `s INTER t = {} <=> s SUBSET (UNIV DIFF t)`] THEN
    REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]]);;

let INSIDE_EMPTY = prove
 (`inside {} = {}`,
  REWRITE_TAC[inside; NOT_IN_EMPTY; DIFF_EMPTY; CONNECTED_COMPONENT_UNIV] THEN
  REWRITE_TAC[NOT_BOUNDED_UNIV; EMPTY_GSPEC]);;

let OUTSIDE_EMPTY = prove
 (`outside {} = (:real^N)`,
  REWRITE_TAC[OUTSIDE_INSIDE; INSIDE_EMPTY] THEN SET_TAC[]);;

let INSIDE_SAME_COMPONENT = prove
 (`!s x y. connected_component((:real^N) DIFF s) x y /\ x IN inside s
           ==> y IN inside s`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o GEN_REWRITE_RULE I [GSYM IN])
        MP_TAC) THEN
  REWRITE_TAC[inside; IN_ELIM_THM] THEN
  FIRST_ASSUM(SUBST1_TAC o MATCH_MP CONNECTED_COMPONENT_EQ) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN
  SIMP_TAC[IN_DIFF]);;

let OUTSIDE_SAME_COMPONENT = prove
 (`!s x y. connected_component((:real^N) DIFF s) x y /\ x IN outside s
           ==> y IN outside s`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o GEN_REWRITE_RULE I [GSYM IN])
        MP_TAC) THEN
  REWRITE_TAC[outside; IN_ELIM_THM] THEN
  FIRST_ASSUM(SUBST1_TAC o MATCH_MP CONNECTED_COMPONENT_EQ) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN
  SIMP_TAC[IN_DIFF]);;

let CONNECTED_COMPONENT_INSIDE = prove
 (`!s a. connected_component (inside s) a =
         if a IN inside s then connected_component ((:real^N) DIFF s) a
         else {}`,
  REPEAT GEN_TAC THEN COND_CASES_TAC THEN
  ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY] THEN
  MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
   [MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN
    REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN
    REWRITE_TAC[INSIDE_NO_OVERLAP];
    GEN_REWRITE_TAC LAND_CONV [GSYM CONNECTED_COMPONENT_IDEMP] THEN
    MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN
    REWRITE_TAC[SUBSET] THEN ASM_MESON_TAC[IN; INSIDE_SAME_COMPONENT]]);;

let CONNECTED_COMPONENT_OUTSIDE = prove
 (`!s a. connected_component (outside s) a =
         if a IN outside s then connected_component ((:real^N) DIFF s) a
         else {}`,
  REPEAT GEN_TAC THEN COND_CASES_TAC THEN
  ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY] THEN
  MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
   [MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN
    REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN
    REWRITE_TAC[OUTSIDE_NO_OVERLAP];
    GEN_REWRITE_TAC LAND_CONV [GSYM CONNECTED_COMPONENT_IDEMP] THEN
    MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN
    REWRITE_TAC[SUBSET] THEN ASM_MESON_TAC[IN; OUTSIDE_SAME_COMPONENT]]);;

let BOUNDED_COMPONENTS_INSIDE = prove
 (`!c:real^N->bool. c IN components(inside s) ==> bounded c`,
  SIMP_TAC[components; FORALL_IN_GSPEC; CONNECTED_COMPONENT_INSIDE] THEN
  REWRITE_TAC[inside] THEN SET_TAC[]);;

let UNBOUNDED_COMPONENTS_OUTSIDE = prove
 (`!s c:real^N->bool. c IN components(outside s) ==> ~bounded c`,
  SIMP_TAC[components; FORALL_IN_GSPEC; CONNECTED_COMPONENT_OUTSIDE] THEN
  REWRITE_TAC[outside] THEN SET_TAC[]);;

let INSIDE_WITH_INSIDE = prove
 (`!s:real^N->bool. inside(s UNION inside s) = {}`,
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[INSIDE_EMPTY_EQ_NO_BOUNDED_COMPONENT_COMPLEMENT] THEN
  REWRITE_TAC[GSYM OUTSIDE_INSIDE; UNBOUNDED_COMPONENTS_OUTSIDE]);;

let OUTSIDE_WITH_OUTSIDE = prove
 (`!s:real^N->bool. outside(s UNION outside s) = {}`,
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[OUTSIDE_EMPTY_EQ_NO_BOUNDED_COMPONENT_COMPLEMENT] THEN
  REWRITE_TAC[GSYM INSIDE_OUTSIDE] THEN
  REWRITE_TAC[BOUNDED_COMPONENTS_INSIDE]);;

let OUTSIDE_CONVEX = prove
 (`!s. convex s ==> outside s = (:real^N) DIFF s`,
  REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ;
              REWRITE_RULE[SET_RULE `t INTER s = {} <=> t SUBSET UNIV DIFF s`]
                          OUTSIDE_NO_OVERLAP] THEN
  REWRITE_TAC[SUBSET; IN_UNIV; IN_DIFF] THEN
  MATCH_MP_TAC SET_PROVE_CASES THEN REWRITE_TAC[OUTSIDE_EMPTY; IN_UNIV] THEN
  X_GEN_TAC `a:real^N` THEN GEOM_ORIGIN_TAC `a:real^N` THEN
  X_GEN_TAC `t:real^N->bool` THEN DISCH_THEN(K ALL_TAC) THEN
  MP_TAC(SET_RULE `(vec 0:real^N) IN (vec 0 INSERT t)`) THEN
  SPEC_TAC(`(vec 0:real^N) INSERT t`,`s:real^N->bool`) THEN
  GEN_TAC THEN DISCH_TAC THEN DISCH_TAC THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  ASM_REWRITE_TAC[outside; IN_ELIM_THM] THEN
  SUBGOAL_THEN `~(x:real^N = vec 0)` ASSUME_TAC THENL
   [ASM_MESON_TAC[]; ALL_TAC] THEN
  REWRITE_TAC[BOUNDED_POS; NOT_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN(MP_TAC o SPEC `(max (&2) ((B + &1) / norm(x))) % x:real^N`) THEN
  REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
   [REWRITE_TAC[IN] THEN REWRITE_TAC[connected_component] THEN
    EXISTS_TAC `segment[x:real^N,(max (&2) ((B + &1) / norm(x))) % x]` THEN
    REWRITE_TAC[ENDS_IN_SEGMENT; CONNECTED_SEGMENT] THEN
    REWRITE_TAC[segment; SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `u:real` THEN
    ASM_CASES_TAC `u = &0` THEN
    ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID; REAL_SUB_RZERO;
                    VECTOR_ADD_RID; IN_DIFF; IN_UNIV] THEN
    DISCH_TAC THEN
    REWRITE_TAC[VECTOR_ARITH `a % x + b % c % x:real^N = (a + b * c) % x`] THEN
    ABBREV_TAC `c = &1 - u + u * max (&2) ((B + &1) / norm(x:real^N))` THEN
    DISCH_TAC THEN SUBGOAL_THEN `&1 < c` ASSUME_TAC THENL
     [EXPAND_TAC "c" THEN
      REWRITE_TAC[REAL_ARITH `&1 < &1 - u + u * x <=> &0 < u * (x - &1)`] THEN
      MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC;
      UNDISCH_TAC `~((x:real^N) IN s)` THEN REWRITE_TAC[] THEN
      SUBGOAL_THEN `x:real^N = (&1 - inv c) % vec 0 + inv c % c % x`
      SUBST1_TAC THENL
       [REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; VECTOR_MUL_ASSOC] THEN
        ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `&1 < x ==> ~(x = &0)`] THEN
        REWRITE_TAC[VECTOR_MUL_LID];
        MATCH_MP_TAC IN_CONVEX_SET THEN
        ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_INV_LE_1; REAL_LT_IMP_LE] THEN
        ASM_REAL_ARITH_TAC]];
    ASM_SIMP_TAC[NORM_MUL; REAL_NOT_LE; GSYM REAL_LT_LDIV_EQ; NORM_POS_LT] THEN
    MATCH_MP_TAC(REAL_ARITH `&0 < b /\ b < c ==> b < abs(max (&2) c)`) THEN
    ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; REAL_LT_DIV2_EQ] THEN
    REAL_ARITH_TAC]);;

let INSIDE_CONVEX = prove
 (`!s. convex s ==> inside s = {}`,
  SIMP_TAC[INSIDE_OUTSIDE; OUTSIDE_CONVEX] THEN SET_TAC[]);;

let OUTSIDE_SUBSET_CONVEX = prove
 (`!s t. convex t /\ s SUBSET t ==> (:real^N) DIFF t SUBSET outside s`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN
  EXISTS_TAC `outside(t:real^N->bool)` THEN
  ASM_SIMP_TAC[OUTSIDE_MONO] THEN
  ASM_SIMP_TAC[OUTSIDE_CONVEX; SUBSET_REFL]);;

let INSIDE_SUBSET_CONVEX = prove
 (`!s c:real^N->bool. convex c /\ s SUBSET c ==> inside s SUBSET c`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[INSIDE_OUTSIDE] THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N->bool`]
    OUTSIDE_SUBSET_CONVEX) THEN
  ASM SET_TAC[]);;

let INSIDE_SUBSET_CONVEX_HULL = prove
 (`!s:real^N->bool. inside s SUBSET convex hull s`,
  SIMP_TAC[INSIDE_SUBSET_CONVEX; CONVEX_CONVEX_HULL; HULL_SUBSET]);;

let UNBOUNDED_DISJOINT_IN_OUTSIDE = prove
 (`!s t x:real^N.
       connected t /\ ~bounded t /\ x IN t /\ DISJOINT s t ==> x IN outside s`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[outside; IN_ELIM_THM] THEN
  CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  UNDISCH_TAC `~bounded(t:real^N->bool)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN
  MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM SET_TAC[]);;

let INSIDE_SUBSET_INTERIOR_CONVEX = prove
 (`!s c:real^N->bool. convex c /\ s SUBSET c ==> inside s SUBSET interior c`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SET_DIFF_FRONTIER] THEN
  REWRITE_TAC[SET_RULE `s SUBSET t DIFF u <=> s SUBSET t /\ DISJOINT s u`] THEN
  ASM_SIMP_TAC[INSIDE_SUBSET_CONVEX] THEN
  REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s ==> ~(x IN t)`] THEN
  X_GEN_TAC `x:real^N` THEN REPEAT DISCH_TAC THEN
  MP_TAC(ISPECL [`c:real^N->bool`; `x:real^N`]
    SUPPORTING_HYPERPLANE_FRONTIER) THEN
  ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `a:real^N` THEN
  STRIP_TAC THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `x INSERT {y:real^N | a dot y < a dot x}`;
                 `x:real^N`] UNBOUNDED_DISJOINT_IN_OUTSIDE) THEN
  REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
    EXISTS_TAC `{y:real^N | a dot y < a dot x}` THEN
    ASM_SIMP_TAC[CLOSURE_HALFSPACE_LT; CONVEX_CONNECTED; CONVEX_HALFSPACE_LT;
                 INSERT_SUBSET; IN_ELIM_THM; SUBSET; IN_INSERT] THEN
    REAL_ARITH_TAC;
    ASM_REWRITE_TAC[BOUNDED_INSERT; BOUNDED_HALFSPACE_LT];
    REWRITE_TAC[IN_INSERT];
    REWRITE_TAC[SET_RULE
    `DISJOINT s (x INSERT t) <=> ~(x IN s) /\ (!y. y IN s ==> ~(y IN t))`] THEN
    CONJ_TAC THENL
     [MP_TAC(ISPEC `s:real^N->bool` INSIDE_NO_OVERLAP) THEN ASM SET_TAC[];
      REWRITE_TAC[IN_ELIM_THM; REAL_NOT_LT] THEN REPEAT STRIP_TAC THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN
      MATCH_MP_TAC CLOSURE_INC THEN ASM SET_TAC[]];
    MP_TAC(ISPEC `s:real^N->bool` INSIDE_INTER_OUTSIDE) THEN ASM SET_TAC[]]);;

let INSIDE_SUBSET_INTERIOR_CONVEX_HULL = prove
 (`!s:real^N->bool. inside s SUBSET interior(convex hull s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INSIDE_SUBSET_INTERIOR_CONVEX THEN
  REWRITE_TAC[CONVEX_CONVEX_HULL; HULL_SUBSET]);;

let OUTSIDE_FRONTIER_MISSES_CLOSURE = prove
 (`!s. bounded s ==> outside(frontier s) SUBSET (:real^N) DIFF closure s`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[OUTSIDE_INSIDE] THEN
  SIMP_TAC[SET_RULE `(UNIV DIFF s) SUBSET (UNIV DIFF t) <=> t SUBSET s`] THEN
  REWRITE_TAC[frontier] THEN
  MATCH_MP_TAC(SET_RULE
   `i SUBSET ins ==> c SUBSET (c DIFF i) UNION ins`) THEN
  ASM_SIMP_TAC[GSYM frontier; INTERIOR_INSIDE_FRONTIER]);;

let OUTSIDE_FRONTIER_EQ_COMPLEMENT_CLOSURE = prove
 (`!s. bounded s /\ convex s
       ==> outside(frontier s) = (:real^N) DIFF closure s`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
  ASM_SIMP_TAC[OUTSIDE_FRONTIER_MISSES_CLOSURE] THEN
  MATCH_MP_TAC OUTSIDE_SUBSET_CONVEX THEN
  ASM_SIMP_TAC[CONVEX_CLOSURE; frontier] THEN SET_TAC[]);;

let INSIDE_FRONTIER_EQ_INTERIOR = prove
 (`!s:real^N->bool.
        bounded s /\ convex s ==> inside(frontier s) = interior s`,
  REPEAT STRIP_TAC THEN
  ASM_SIMP_TAC[INSIDE_OUTSIDE; OUTSIDE_FRONTIER_EQ_COMPLEMENT_CLOSURE] THEN
  REWRITE_TAC[frontier] THEN
  MAP_EVERY (MP_TAC o ISPEC `s:real^N->bool`)
   [CLOSURE_SUBSET; INTERIOR_SUBSET] THEN
  ASM SET_TAC[]);;

let INSIDE_SPHERE = prove
 (`!a:real^N r. inside(sphere(a,r)) = ball(a,r)`,
  REWRITE_TAC[GSYM FRONTIER_CBALL] THEN
  SIMP_TAC[INSIDE_FRONTIER_EQ_INTERIOR; BOUNDED_CBALL; CONVEX_CBALL] THEN
  REWRITE_TAC[INTERIOR_CBALL]);;

let OUTSIDE_SPHERE = prove
 (`!a r. outside(sphere(a,r)) = (:real^N) DIFF cball(a,r)`,
  REWRITE_TAC[OUTSIDE_INSIDE; INSIDE_SPHERE; SPHERE_UNION_BALL]);;

let OPEN_INSIDE = prove
 (`!s:real^N->bool. closed s ==> open(inside s)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  SUBGOAL_THEN `open(connected_component ((:real^N) DIFF s) x)` MP_TAC THENL
   [MATCH_MP_TAC OPEN_CONNECTED_COMPONENT THEN ASM_REWRITE_TAC[GSYM closed];
    REWRITE_TAC[open_def] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
    ANTS_TAC THENL
     [REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ] THEN
      GEN_REWRITE_TAC I [GSYM IN] THEN
      ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN
      MP_TAC(ISPEC `s:real^N->bool` INSIDE_NO_OVERLAP) THEN
      ASM SET_TAC[];
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN
      STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN
      X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
      MATCH_MP_TAC INSIDE_SAME_COMPONENT THEN
      EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[DIST_SYM]]]);;

let OPEN_OUTSIDE = prove
 (`!s:real^N->bool. closed s ==> open(outside s)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  SUBGOAL_THEN `open(connected_component ((:real^N) DIFF s) x)` MP_TAC THENL
   [MATCH_MP_TAC OPEN_CONNECTED_COMPONENT THEN ASM_REWRITE_TAC[GSYM closed];
    REWRITE_TAC[open_def] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
    ANTS_TAC THENL
     [REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ] THEN
      GEN_REWRITE_TAC I [GSYM IN] THEN
      ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN
      MP_TAC(ISPEC `s:real^N->bool` OUTSIDE_NO_OVERLAP) THEN
      ASM SET_TAC[];
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN
      STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN
      X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
      MATCH_MP_TAC OUTSIDE_SAME_COMPONENT THEN
      EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[DIST_SYM]]]);;

let CLOSURE_INSIDE_SUBSET = prove
 (`!s:real^N->bool. closed s ==> closure(inside s) SUBSET s UNION inside s`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN
  ASM_SIMP_TAC[closed; GSYM OUTSIDE_INSIDE; OPEN_OUTSIDE] THEN SET_TAC[]);;

let FRONTIER_INSIDE_SUBSET = prove
 (`!s:real^N->bool. closed s ==> frontier(inside s) SUBSET s`,
  REPEAT STRIP_TAC THEN
  ASM_SIMP_TAC[frontier; OPEN_INSIDE; INTERIOR_OPEN] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP CLOSURE_INSIDE_SUBSET) THEN SET_TAC[]);;

let FRONTIER_WITH_INSIDE_SUBSET = prove
 (`!s:real^N->bool. closed s ==> frontier(s UNION inside s) SUBSET s`,
  REPEAT STRIP_TAC THEN TRANS_TAC SUBSET_TRANS
   `frontier s UNION frontier(inside s):real^N->bool` THEN
  REWRITE_TAC[FRONTIER_UNION_SUBSET; UNION_SUBSET] THEN
  ASM_SIMP_TAC[FRONTIER_INSIDE_SUBSET; FRONTIER_SUBSET_CLOSED]);;

let CLOSURE_OUTSIDE_SUBSET = prove
 (`!s:real^N->bool. closed s ==> closure(outside s) SUBSET s UNION outside s`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN
  ASM_SIMP_TAC[closed; GSYM INSIDE_OUTSIDE; OPEN_INSIDE] THEN SET_TAC[]);;

let FRONTIER_OUTSIDE_SUBSET = prove
 (`!s:real^N->bool. closed s ==> frontier(outside s) SUBSET s`,
  REPEAT STRIP_TAC THEN
  ASM_SIMP_TAC[frontier; OPEN_OUTSIDE; INTERIOR_OPEN] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP CLOSURE_OUTSIDE_SUBSET) THEN SET_TAC[]);;

let FRONTIER_WITH_OUTSIDE_SUBSET = prove
 (`!s:real^N->bool. closed s ==> frontier(s UNION outside s) SUBSET s`,
  REPEAT STRIP_TAC THEN TRANS_TAC SUBSET_TRANS
   `frontier s UNION frontier(outside s):real^N->bool` THEN
  REWRITE_TAC[FRONTIER_UNION_SUBSET; UNION_SUBSET] THEN
  ASM_SIMP_TAC[FRONTIER_OUTSIDE_SUBSET; FRONTIER_SUBSET_CLOSED]);;

let CLOSED_WITH_INSIDE = prove
 (`!s:real^N->bool. closed s ==> closed(s UNION inside s)`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `s UNION inside s:real^N->bool = s UNION closure(inside s)`
  SUBST1_TAC THENL
   [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSURE_INSIDE_SUBSET) THEN
    MP_TAC(ISPEC `inside s:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[];
    ASM_SIMP_TAC[CLOSED_UNION; CLOSED_CLOSURE]]);;

let BOUNDED_WITH_INSIDE = prove
 (`!s:real^N->bool. bounded s ==> bounded(s UNION inside s)`,
  SIMP_TAC[BOUNDED_UNION; BOUNDED_INSIDE]);;

let COMPACT_WITH_INSIDE = prove
 (`!s:real^N->bool. compact s ==> compact(s UNION inside s)`,
  SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_WITH_INSIDE;
           CLOSED_WITH_INSIDE]);;

let INSIDE_COMPLEMENT_UNBOUNDED_CONNECTED_EMPTY = prove
 (`!s. connected((:real^N) DIFF s) /\ ~bounded((:real^N) DIFF s)
       ==> inside s = {}`,
  REWRITE_TAC[inside; CONNECTED_CONNECTED_COMPONENT_SET] THEN
  REWRITE_TAC[SET_RULE `s = {} <=> !x. x IN s ==> F`] THEN
  SIMP_TAC[IN_ELIM_THM; IN_DIFF; IN_UNIV; TAUT `~(a /\ b) <=> a ==> ~b`]);;

let INSIDE_BOUNDED_COMPLEMENT_CONNECTED_EMPTY = prove
 (`!s. connected((:real^N) DIFF s) /\ bounded s
       ==> inside s = {}`,
  MESON_TAC[INSIDE_COMPLEMENT_UNBOUNDED_CONNECTED_EMPTY;
            COBOUNDED_IMP_UNBOUNDED]);;

let INSIDE_INSIDE = prove
 (`!s t:real^N->bool.
        s SUBSET inside t ==> inside s DIFF t SUBSET inside t`,
  REPEAT STRIP_TAC THEN SIMP_TAC[SUBSET; inside; IN_DIFF; IN_ELIM_THM] THEN
  X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
  ASM_CASES_TAC `s INTER connected_component ((:real^N) DIFF t) x = {}` THENL
   [MATCH_MP_TAC BOUNDED_SUBSET THEN
    EXISTS_TAC `connected_component ((:real^N) DIFF s) x` THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
    REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; IN] THEN
    REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM SET_TAC[];
    FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
     `~(s INTER t = {}) ==> ?x. x IN s /\ x IN t`)) THEN
    DISCH_THEN(X_CHOOSE_THEN `y:real^N`
     (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    DISCH_THEN(SUBST_ALL_TAC o SYM o MATCH_MP CONNECTED_COMPONENT_EQ) THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
    DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN
    ASM_SIMP_TAC[inside; IN_ELIM_THM]]);;

let INSIDE_INSIDE_SUBSET = prove
 (`!s:real^N->bool. inside(inside s) SUBSET s`,
  GEN_TAC THEN MP_TAC
   (ISPECL [`inside s:real^N->bool`; `s:real^N->bool`] INSIDE_INSIDE) THEN
  REWRITE_TAC[SUBSET_REFL] THEN
  MP_TAC(ISPEC `inside s:real^N->bool` INSIDE_NO_OVERLAP) THEN SET_TAC[]);;

let INSIDE_OUTSIDE_INTERSECT_CONNECTED = prove
 (`!s t:real^N->bool.
        connected t /\ ~(inside s INTER t = {}) /\ ~(outside s INTER t = {})
        ==> ~(s INTER t = {})`,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
  REWRITE_TAC[inside; outside; IN_ELIM_THM] THEN
  DISCH_THEN(CONJUNCTS_THEN2
   (X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC)
   (X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC)) THEN
  SUBGOAL_THEN
   `connected_component ((:real^N) DIFF s) y =
    connected_component ((:real^N) DIFF s) x`
   (fun th -> ASM_MESON_TAC[th]) THEN
  ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EQ; IN_DIFF; IN_UNIV] THEN
  REWRITE_TAC[connected_component] THEN
  EXISTS_TAC `t:real^N->bool` THEN ASM SET_TAC[]);;

let OUTSIDE_BOUNDED_NONEMPTY = prove
 (`!s:real^N->bool. bounded s ==> ~(outside s = {})`,
  GEN_TAC THEN
  DISCH_THEN(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
  DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP
   (REWRITE_RULE[IMP_CONJ_ALT] OUTSIDE_SUBSET_CONVEX)) THEN
  ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
  SIMP_TAC[CONVEX_BALL; SUBSET_EMPTY] THEN
  REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN
  MESON_TAC[BOUNDED_BALL; BOUNDED_SUBSET; NOT_BOUNDED_UNIV]);;

let OUTSIDE_COMPACT_IN_OPEN = prove
 (`!s t:real^N->bool.
        compact s /\ open t /\ s SUBSET t /\ ~(t = {})
        ==> ~(outside s INTER t = {})`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP OUTSIDE_BOUNDED_NONEMPTY o
        MATCH_MP COMPACT_IMP_BOUNDED) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM; IN_INTER] THEN
  X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN
  X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
  ASM_CASES_TAC `(a:real^N) IN t` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
  MP_TAC(ISPECL [`linepath(a:real^N,b)`; `(:real^N) DIFF t`]
        EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN
  REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
  ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `g:real^1->real^N` THEN REWRITE_TAC[FRONTIER_COMPLEMENT] THEN
  REWRITE_TAC[PATH_IMAGE_LINEPATH; INTERIOR_DIFF; INTERIOR_UNIV] THEN
  ABBREV_TAC `c:real^N = pathfinish g` THEN STRIP_TAC THEN
  SUBGOAL_THEN `frontier t SUBSET (:real^N) DIFF s` MP_TAC THENL
   [ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN
    REWRITE_TAC[frontier] THEN
    ASM_SIMP_TAC[CLOSURE_CLOSED; GSYM OPEN_CLOSED] THEN ASM SET_TAC[];
    REWRITE_TAC[SUBSET; IN_DIFF; IN_UNIV]] THEN
  DISCH_THEN(MP_TAC o SPEC `c:real^N`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_TAC THEN MP_TAC(ISPEC `(:real^N) DIFF s` OPEN_CONTAINS_CBALL) THEN
  ASM_SIMP_TAC[GSYM closed; COMPACT_IMP_CLOSED; IN_DIFF; IN_UNIV] THEN
  DISCH_THEN(MP_TAC o SPEC `c:real^N`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL [`c:real^N`; `t:real^N->bool`]
        CLOSURE_APPROACHABLE) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[frontier; IN_DIFF]) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^N` THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC OUTSIDE_SAME_COMPONENT THEN
  EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[connected_component] THEN
  EXISTS_TAC `path_image(g) UNION segment[c:real^N,d]` THEN
  REWRITE_TAC[IN_UNION; ENDS_IN_SEGMENT] THEN CONJ_TAC THENL
   [MATCH_MP_TAC CONNECTED_UNION THEN
    ASM_SIMP_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY;
                 CONNECTED_PATH_IMAGE] THEN
    EXISTS_TAC `c:real^N` THEN REWRITE_TAC[ENDS_IN_SEGMENT; IN_INTER] THEN
    ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE; SUBSET];
    CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]] THEN
    REWRITE_TAC[UNION_SUBSET] THEN CONJ_TAC THENL
     [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
       `~(c IN s)
        ==> (t DELETE c) SUBSET (UNIV DIFF s)
            ==> t SUBSET (UNIV DIFF s)`)) THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        SUBSET_TRANS)) THEN
      SIMP_TAC[SET_RULE `UNIV DIFF s SUBSET UNIV DIFF t <=> t SUBSET s`] THEN
      ASM_MESON_TAC[SUBSET_TRANS; CLOSURE_SUBSET];
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        SUBSET_TRANS)) THEN
     REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
      ASM_SIMP_TAC[CONVEX_CBALL; INSERT_SUBSET; REAL_LT_IMP_LE;
                   EMPTY_SUBSET; CENTRE_IN_CBALL] THEN
      REWRITE_TAC[IN_CBALL] THEN
      ASM_MESON_TAC[DIST_SYM; REAL_LT_IMP_LE]]]);;

let INSIDE_INSIDE_COMPACT_CONNECTED = prove
 (`!s t:real^N->bool.
        closed s /\ compact t /\ s SUBSET inside t /\ connected t
        ==> inside s SUBSET inside t`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `inside t:real^N->bool = {}` THEN
  ASM_SIMP_TAC[INSIDE_EMPTY; SUBSET_EMPTY; EMPTY_SUBSET] THEN
  SUBGOAL_THEN `1 <= dimindex(:N)` MP_TAC THENL
   [REWRITE_TAC[DIMINDEX_GE_1];
    REWRITE_TAC[ARITH_RULE `1 <= n <=> n = 1 \/ 2 <= n`]] THEN
  STRIP_TAC THEN ASM_SIMP_TAC[CONNECTED_CONVEX_1_GEN] THENL
   [ASM_MESON_TAC[INSIDE_CONVEX]; ALL_TAC] THEN
  STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP INSIDE_INSIDE) THEN
  MATCH_MP_TAC(SET_RULE
   `s INTER t = {} ==> s DIFF t SUBSET u ==> s SUBSET u`) THEN
  SUBGOAL_THEN `compact(s:real^N->bool)` ASSUME_TAC THENL
   [ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET; BOUNDED_INSIDE];
    ALL_TAC] THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`]
        INSIDE_OUTSIDE_INTERSECT_CONNECTED) THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT
   `r /\ q ==> (~p /\ q ==> ~r) ==> p`) THEN
  CONJ_TAC THENL
   [MP_TAC(ISPEC `t:real^N->bool` INSIDE_NO_OVERLAP) THEN ASM SET_TAC[];
    ONCE_REWRITE_TAC[INTER_COMM]] THEN
  MATCH_MP_TAC INSIDE_OUTSIDE_INTERSECT_CONNECTED THEN
  ASM_SIMP_TAC[CONNECTED_OUTSIDE; COMPACT_IMP_BOUNDED] THEN CONJ_TAC THENL
   [ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC OUTSIDE_COMPACT_IN_OPEN THEN
    ASM_SIMP_TAC[OPEN_INSIDE; COMPACT_IMP_CLOSED];
    MP_TAC(ISPECL [`s UNION t:real^N->bool`; `vec 0:real^N`]
        BOUNDED_SUBSET_BALL) THEN
    ASM_SIMP_TAC[BOUNDED_UNION; COMPACT_IMP_BOUNDED] THEN
    DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
    MATCH_MP_TAC(SET_RULE
     `!u. ~(u = UNIV) /\ UNIV DIFF u SUBSET s /\ UNIV DIFF u SUBSET t
          ==> ~(s INTER t = {})`) THEN
    EXISTS_TAC `ball(vec 0:real^N,r)` THEN CONJ_TAC THENL
     [ASM_MESON_TAC[NOT_BOUNDED_UNIV; BOUNDED_BALL]; ALL_TAC] THEN
    CONJ_TAC THEN MATCH_MP_TAC OUTSIDE_SUBSET_CONVEX THEN
    REWRITE_TAC[CONVEX_BALL] THEN ASM SET_TAC[]]);;

let INSIDE_SELF_OUTSIDE_COMPACT_CONNECTED = prove
 (`!s t:real^N->bool.
        closed s /\ compact t /\ s SUBSET inside t /\ connected t
        ==> t UNION outside t SUBSET outside s`,
  REWRITE_TAC[GSYM INSIDE_SELF_OUTSIDE_EVERSION] THEN
  SIMP_TAC[UNION_SUBSET] THEN
  REWRITE_TAC[INSIDE_INSIDE_COMPACT_CONNECTED]);;

let INSIDE_OUTSIDE_COMPACT_CONNECTED = prove
 (`!s t:real^N->bool.
        closed s /\ compact t /\ s SUBSET inside t /\ connected t
        ==> t SUBSET outside s`,
  REPEAT STRIP_TAC THEN
  TRANS_TAC SUBSET_TRANS `t UNION outside t:real^N->bool` THEN
  ASM_SIMP_TAC[INSIDE_SELF_OUTSIDE_COMPACT_CONNECTED] THEN SET_TAC[]);;

let CONNECTED_WITH_INSIDE = prove
 (`!s:real^N->bool. closed s /\ connected s ==> connected(s UNION inside s)`,
  GEN_TAC THEN ASM_CASES_TAC `s UNION inside s = (:real^N)` THEN
  ASM_REWRITE_TAC[CONNECTED_UNIV] THEN
  REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
  REWRITE_TAC[CONNECTED_COMPONENT_SET; IN_ELIM_THM] THEN STRIP_TAC THEN
  SUBGOAL_THEN
   `!x. x IN (s UNION inside s)
        ==> ?y:real^N t. y IN s /\ connected t /\ x IN t /\ y IN t /\
                         t SUBSET (s UNION inside s)`
  MP_TAC THENL
   [X_GEN_TAC `a:real^N` THEN REWRITE_TAC[IN_UNION] THEN STRIP_TAC THENL
     [MAP_EVERY EXISTS_TAC [`a:real^N`; `{a:real^N}`] THEN
      ASM_REWRITE_TAC[IN_SING; CONNECTED_SING] THEN ASM SET_TAC[];
      FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
       `~(s UNION t = UNIV) ==> ?b. ~(b IN s) /\ ~(b IN t)`)) THEN
      DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN
      MP_TAC(ISPECL [`linepath(a:real^N,b)`; `inside s:real^N->bool`]
        EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN
      ASM_SIMP_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH;
                   IN_UNION; OPEN_INSIDE; INTERIOR_OPEN] THEN
      DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
      EXISTS_TAC `pathfinish g :real^N` THEN
      EXISTS_TAC `path_image g :real^N->bool` THEN
      ASM_SIMP_TAC[PATHFINISH_IN_PATH_IMAGE; CONNECTED_PATH_IMAGE] THEN
      MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN
      REPEAT STRIP_TAC THENL
       [ASM_MESON_TAC[FRONTIER_INSIDE_SUBSET; SUBSET];
        ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE];
        ASM SET_TAC[]]];
    DISCH_THEN(fun th ->
      MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
      MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`a:real^N`; `t:real^N->bool`] THEN STRIP_TAC THEN
    MAP_EVERY X_GEN_TAC [`b:real^N`; `u:real^N->bool`] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
    ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `t UNION v UNION u:real^N->bool` THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    REPEAT(MATCH_MP_TAC CONNECTED_UNION THEN
           ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC) THEN
    ASM SET_TAC[]]);;

let CONNECTED_WITH_OUTSIDE = prove
 (`!s:real^N->bool. closed s /\ connected s ==> connected(s UNION outside s)`,
  GEN_TAC THEN ASM_CASES_TAC `s UNION outside s = (:real^N)` THEN
  ASM_REWRITE_TAC[CONNECTED_UNIV] THEN
  REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
  REWRITE_TAC[CONNECTED_COMPONENT_SET; IN_ELIM_THM] THEN STRIP_TAC THEN
  SUBGOAL_THEN
   `!x. x IN (s UNION outside s)
        ==> ?y:real^N t. y IN s /\ connected t /\ x IN t /\ y IN t /\
                         t SUBSET (s UNION outside s)`
  MP_TAC THENL
   [X_GEN_TAC `a:real^N` THEN REWRITE_TAC[IN_UNION] THEN STRIP_TAC THENL
     [MAP_EVERY EXISTS_TAC [`a:real^N`; `{a:real^N}`] THEN
      ASM_REWRITE_TAC[IN_SING; CONNECTED_SING] THEN ASM SET_TAC[];
      FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
       `~(s UNION t = UNIV) ==> ?b. ~(b IN s) /\ ~(b IN t)`)) THEN
      DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN
      MP_TAC(ISPECL [`linepath(a:real^N,b)`; `outside s:real^N->bool`]
        EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN
      ASM_SIMP_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH;
                   IN_UNION; OPEN_OUTSIDE; INTERIOR_OPEN] THEN
      DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
      EXISTS_TAC `pathfinish g :real^N` THEN
      EXISTS_TAC `path_image g :real^N->bool` THEN
      ASM_SIMP_TAC[PATHFINISH_IN_PATH_IMAGE; CONNECTED_PATH_IMAGE] THEN
      MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN
      REPEAT STRIP_TAC THENL
       [ASM_MESON_TAC[FRONTIER_OUTSIDE_SUBSET; SUBSET];
        ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE];
        ASM SET_TAC[]]];
    DISCH_THEN(fun th ->
      MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
      MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`a:real^N`; `t:real^N->bool`] THEN STRIP_TAC THEN
    MAP_EVERY X_GEN_TAC [`b:real^N`; `u:real^N->bool`] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
    ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `t UNION v UNION u:real^N->bool` THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    REPEAT(MATCH_MP_TAC CONNECTED_UNION THEN
           ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC) THEN
    ASM SET_TAC[]]);;

let INSIDE_INSIDE_EQ_EMPTY = prove
 (`!s:real^N->bool.
        closed s /\ connected s ==> inside(inside s) = {}`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN
  X_GEN_TAC `x:real^N` THEN ONCE_REWRITE_TAC[inside] THEN
  REWRITE_TAC[IN_ELIM_THM] THEN
  ONCE_REWRITE_TAC[INSIDE_OUTSIDE] THEN
  REWRITE_TAC[COMPL_COMPL] THEN
  REWRITE_TAC[IN_DIFF; IN_UNIV] THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  ASM_SIMP_TAC[CONNECTED_COMPONENT_EQ_SELF; CONNECTED_WITH_OUTSIDE] THEN
  REWRITE_TAC[BOUNDED_UNION] THEN MESON_TAC[UNBOUNDED_OUTSIDE]);;

let INSIDE_IN_COMPONENTS = prove
 (`!s. (inside s) IN components((:real^N) DIFF s) <=>
       connected(inside s) /\ ~(inside s = {})`,
  X_GEN_TAC `s:real^N->bool` THEN REWRITE_TAC[IN_COMPONENTS_MAXIMAL] THEN
  ASM_CASES_TAC `inside s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN
  ASM_CASES_TAC `connected(inside s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN
  REWRITE_TAC[INSIDE_NO_OVERLAP] THEN
  X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN
  ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
  REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  MATCH_MP_TAC INSIDE_SAME_COMPONENT THEN
  UNDISCH_TAC `~(inside s:real^N->bool = {})` THEN
  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN
  X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
  ASM_REWRITE_TAC[connected_component] THEN
  EXISTS_TAC `d:real^N->bool` THEN ASM SET_TAC[]);;

let OUTSIDE_IN_COMPONENTS = prove
 (`!s. (outside s) IN components((:real^N) DIFF s) <=>
       connected(outside s) /\ ~(outside s = {})`,
  X_GEN_TAC `s:real^N->bool` THEN REWRITE_TAC[IN_COMPONENTS_MAXIMAL] THEN
  ASM_CASES_TAC `outside s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN
  ASM_CASES_TAC `connected(outside s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN
  REWRITE_TAC[OUTSIDE_NO_OVERLAP] THEN
  X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN
  ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
  REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  MATCH_MP_TAC OUTSIDE_SAME_COMPONENT THEN
  UNDISCH_TAC `~(outside s:real^N->bool = {})` THEN
  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN
  X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
  ASM_REWRITE_TAC[connected_component] THEN
  EXISTS_TAC `d:real^N->bool` THEN ASM SET_TAC[]);;

let BOUNDED_UNIQUE_OUTSIDE = prove
 (`!c s. 2 <= dimindex(:N) /\ bounded s
         ==> (c IN components ((:real^N) DIFF s) /\ ~bounded c <=>
              c = outside s)`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL
   [MATCH_MP_TAC COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS THEN
    EXISTS_TAC `(:real^N) DIFF s` THEN
    ASM_REWRITE_TAC[COMPL_COMPL] THEN
    ASM_REWRITE_TAC[OUTSIDE_IN_COMPONENTS];
    ASM_REWRITE_TAC[OUTSIDE_IN_COMPONENTS]] THEN
  ASM_SIMP_TAC[UNBOUNDED_OUTSIDE; OUTSIDE_BOUNDED_NONEMPTY;
               CONNECTED_OUTSIDE]);;

let EMPTY_INSIDE_PSUBSET_CONVEX_FRONTIER = prove
 (`!s t:real^N->bool.
        convex s /\ t PSUBSET frontier s ==> inside t = {}`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[inside] THEN
  REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN
  X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
  ASM_CASES_TAC `(x:real^N) IN closure s` THEN ASM_REWRITE_TAC[] THENL
   [ALL_TAC;
    SUBGOAL_THEN `x IN UNIONS(components((:real^N) DIFF closure s))`
    MP_TAC THENL
     [ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; IN_DIFF; IN_UNIV];
      REWRITE_TAC[IN_UNIONS] THEN
      DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
      FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        UNBOUNDED_COMPLEMENT_COMPONENT_CONVEX)) THEN
      ASM_SIMP_TAC[CONVEX_CLOSURE] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        BOUNDED_SUBSET)) THEN
      MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
      FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN
      FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
      RULE_ASSUM_TAC(REWRITE_RULE[frontier]) THEN ASM SET_TAC[]]] THEN
  SUBGOAL_THEN
   `?y:real^N.
        y IN frontier s /\ ~(y IN t) /\
        connected_component ((:real^N) DIFF t) x =
        connected_component ((:real^N) DIFF t) y`
  STRIP_ASSUME_TAC THENL
   [ASM_CASES_TAC `(x:real^N) IN frontier s` THENL
     [ASM_MESON_TAC[]; ALL_TAC] THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE
     `t PSUBSET s ==> ?x. x IN s /\ ~(x IN t)`)) THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN REWRITE_TAC[IN] THEN
    REWRITE_TAC[connected_component] THEN
    EXISTS_TAC `(y:real^N) INSERT interior s` THEN
    ASM_REWRITE_TAC[IN_INSERT] THEN
    ASM_SIMP_TAC[IN_INSERT; CONNECTED_INSERT; CONVEX_CONNECTED;
                 CONVEX_INTERIOR; INSERT_SUBSET; IN_DIFF; IN_UNIV] THEN
    SUBGOAL_THEN `(x:real^N) IN interior s /\ ~(interior s = {})`
    STRIP_ASSUME_TAC THENL
     [RULE_ASSUM_TAC(REWRITE_RULE[frontier]) THEN ASM SET_TAC[]; ALL_TAC] THEN
    ASM_SIMP_TAC[CONVEX_CLOSURE_INTERIOR] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[frontier]) THEN ASM SET_TAC[];
    FIRST_X_ASSUM SUBST_ALL_TAC] THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `y:real^N`]
        SUPPORTING_HYPERPLANE_FRONTIER) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
  FIRST_ASSUM(MP_TAC o SPEC `y INSERT {u:real^N | a dot u < a dot y}` o
   MATCH_MP (REWRITE_RULE[IMP_CONJ] BOUNDED_SUBSET)) THEN
  ASM_REWRITE_TAC[NOT_IMP; BOUNDED_INSERT; BOUNDED_HALFSPACE_LT] THEN
  MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
  ASM_SIMP_TAC[IN_INSERT; CONNECTED_INSERT; CONVEX_CONNECTED;
               CONVEX_HALFSPACE_LT; CLOSURE_HALFSPACE_LT] THEN
  REWRITE_TAC[INSERT_SUBSET; IN_ELIM_THM; REAL_LE_REFL] THEN
  ASM_REWRITE_TAC[IN_DIFF; IN_ELIM_THM; REAL_NOT_LT; IN_UNIV; SET_RULE
   `s SUBSET UNIV DIFF t <=> !x. x IN t ==> ~(x IN s)`] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[frontier]) THEN ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* A Euclidean-centric formulation of homotopy.                              *)
(* ------------------------------------------------------------------------- *)

let HOMOTOPIC_WITH_EUCLIDEAN = prove
 (`!P X Y (p:real^M->real^N) q.
    homotopic_with P (subtopology euclidean X,subtopology euclidean Y) p q <=>
        ?h:real^(1,M)finite_sum->real^N.
                h continuous_on (interval[vec 0,vec 1] PCROSS X) /\
                IMAGE h (interval[vec 0,vec 1] PCROSS X) SUBSET Y /\
                (!x. h(pastecart (vec 0) x) = p x) /\
                (!x. h(pastecart (vec 1) x) = q x) /\
                (!t. t IN interval[vec 0,vec 1] ==> P(\x. h(pastecart t x)))`,
  REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with] THEN
  REWRITE_TAC[CONJ_ASSOC; GSYM CONTINUOUS_MAP_EUCLIDEAN2] THEN
  REWRITE_TAC[INTERVAL_REAL_INTERVAL; FORALL_IN_IMAGE; DROP_VEC] THEN
  EQ_TAC THEN REWRITE_TAC[GSYM CONJ_ASSOC; LEFT_IMP_EXISTS_THM] THENL
   [X_GEN_TAC `h:real#real^M->real^N` THEN STRIP_TAC THEN
    EXISTS_TAC `(h:real#real^M->real^N) o (\z. drop(fstcart z),sndcart z)` THEN
    ASM_REWRITE_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
    ASM_REWRITE_TAC[LIFT_DROP; DROP_VEC] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        CONTINUOUS_MAP_COMPOSE)) THEN
    REWRITE_TAC[CONTINUOUS_MAP_PAIRWISE; o_DEF] THEN
    REWRITE_TAC[CONTINUOUS_MAP_IN_SUBTOPOLOGY] THEN
    REWRITE_TAC[SUBSET; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; FORALL_IN_PCROSS;
                FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
    SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; LIFT_DROP] THEN
    CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_MAP_FROM_SUBTOPOLOGY THEN
    REWRITE_TAC[CONTINUOUS_MAP_EUCLIDEAN_EUCLIDEAN] THEN
    SIMP_TAC[CONTINUOUS_ON_SNDCART; CONTINUOUS_ON_ID] THEN
    GEN_REWRITE_TAC RAND_CONV [GSYM o_DEF] THEN
    MATCH_MP_TAC CONTINUOUS_MAP_COMPOSE THEN
    EXISTS_TAC `euclidean:(real^1)topology` THEN
    REWRITE_TAC[CONTINUOUS_MAP_DROP] THEN
    GEN_REWRITE_TAC RAND_CONV [GSYM ETA_AX] THEN
    REWRITE_TAC[CONTINUOUS_MAP_EUCLIDEAN_EUCLIDEAN] THEN
    SIMP_TAC[CONTINUOUS_ON_FSTCART; CONTINUOUS_ON_ID];
    X_GEN_TAC `h:real^(1,M)finite_sum->real^N` THEN STRIP_TAC THEN EXISTS_TAC
     `(h:real^(1,M)finite_sum->real^N) o
      (\(x,y). pastecart x y) o (\z. lift(FST z),SND z)` THEN
    ASM_REWRITE_TAC[o_THM; LIFT_NUM] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        CONTINUOUS_MAP_COMPOSE)) THEN
    REWRITE_TAC[CONTINUOUS_MAP_IN_SUBTOPOLOGY] THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; TOPSPACE_PROD_TOPOLOGY;
                FORALL_PAIR_THM; IN_CROSS; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY;
                PASTECART_IN_PCROSS; TOPSPACE_EUCLIDEANREAL_SUBTOPOLOGY] THEN
    SIMP_TAC[FUN_IN_IMAGE; o_THM; PASTECART_IN_PCROSS] THEN
    REWRITE_TAC[GSYM SUBTOPOLOGY_CROSS] THEN
    MATCH_MP_TAC CONTINUOUS_MAP_FROM_SUBTOPOLOGY THEN
    MATCH_MP_TAC CONTINUOUS_MAP_COMPOSE THEN
    EXISTS_TAC `prod_topology (euclidean:(real^1)topology)
                              (euclidean:(real^M)topology)` THEN
    REWRITE_TAC[CONTINUOUS_MAP_PASTECART] THEN
    REWRITE_TAC[CONTINUOUS_MAP_PAIRWISE; o_DEF] THEN CONJ_TAC THENL
     [GEN_REWRITE_TAC RAND_CONV [GSYM o_DEF] THEN
      MATCH_MP_TAC CONTINUOUS_MAP_COMPOSE THEN
      MESON_TAC[CONTINUOUS_MAP_LIFT; CONTINUOUS_MAP_FST];
      REWRITE_TAC[CONTINUOUS_MAP_SND; ETA_AX]]]);;

(* ------------------------------------------------------------------------- *)
(* We often want to just localize the ending function equality or whatever.  *)
(* ------------------------------------------------------------------------- *)

let HOMOTOPIC_WITH_EUCLIDEAN_ALT = prove
 (`(!h k. (!x. x IN X ==> h x = k x) ==> (P h <=> P k))
   ==> (homotopic_with P
           (subtopology euclidean X,subtopology euclidean Y) p q <=>
        ?h:real^(1,M)finite_sum->real^N.
          h continuous_on (interval[vec 0,vec 1] PCROSS X) /\
          IMAGE h (interval[vec 0,vec 1] PCROSS X) SUBSET Y /\
          (!x. x IN X ==> h(pastecart (vec 0) x) = p x) /\
          (!x. x IN X ==> h(pastecart (vec 1) x) = q x) /\
          (!t. t IN interval[vec 0,vec 1] ==> P(\x. h(pastecart t x))))`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL
   [REWRITE_TAC[HOMOTOPIC_WITH_EUCLIDEAN; PCROSS] THEN
    MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[];
    REWRITE_TAC[HOMOTOPIC_WITH_EUCLIDEAN; PCROSS] THEN
     DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N`
      (fun th -> EXISTS_TAC
        `\y. if sndcart(y) IN X then (h:real^(1,M)finite_sum->real^N) y
             else if fstcart(y) = vec 0 then p(sndcart y)
             else q(sndcart y)` THEN
      MP_TAC th)) THEN
     REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; VEC_EQ; ARITH_EQ] THEN
     REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL
      [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_EQ) THEN
       SIMP_TAC[FORALL_IN_GSPEC; SNDCART_PASTECART];
       SIMP_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC; SUBSET] THEN
       SIMP_TAC[FORALL_IN_GSPEC; SNDCART_PASTECART];
       ASM_MESON_TAC[];
       ASM_MESON_TAC[];
       MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `t:real^1` THEN
       MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
       MATCH_MP_TAC EQ_IMP THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
       SIMP_TAC[]]]);;

(* ------------------------------------------------------------------------- *)
(* Trivial properties.                                                       *)
(* ------------------------------------------------------------------------- *)

let HOMOTOPIC_WITH_RESTRICT = prove
 (`!P s t s' t' f g:real^M->real^N.
        homotopic_with P
         (subtopology euclidean s,subtopology euclidean t) f g /\
        s' SUBSET s /\
        (!h. P h /\ IMAGE h s SUBSET t ==> IMAGE h s' SUBSET t')
        ==> homotopic_with P
             (subtopology euclidean s',subtopology euclidean t') f g`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
  REWRITE_TAC[HOMOTOPIC_WITH_EUCLIDEAN] THEN MATCH_MP_TAC MONO_EXISTS THEN
  GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
   [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN
    REWRITE_TAC[SUBSET_PCROSS] THEN ASM SET_TAC[];
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
    MAP_EVERY X_GEN_TAC [`a:real^1`; `x:real^M`] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC
     `\x. (h:real^(1,M)finite_sum->real^N)(pastecart a x)`) THEN
    ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN
    RULE_ASSUM_TAC(REWRITE_RULE
     [SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS]) THEN
    ASM_SIMP_TAC[]]);;

let HOMOTOPIC_WITH_IMP_CONTINUOUS = prove
 (`!P X Y (f:real^M->real^N) g.
      homotopic_with P (subtopology euclidean X,subtopology euclidean Y) f g
      ==> f continuous_on X /\ g continuous_on X`,
  REPEAT GEN_TAC THEN REWRITE_TAC[HOMOTOPIC_WITH_EUCLIDEAN] THEN
  DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` MP_TAC) THEN
  STRIP_TAC THEN
  SUBGOAL_THEN
   `((h:real^(1,M)finite_sum->real^N) o (\x. pastecart (vec 0) x))
    continuous_on X /\
    ((h:real^(1,M)finite_sum->real^N) o (\x. pastecart (vec 1) x))
    continuous_on X`
  MP_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[o_DEF; ETA_AX]] THEN
  CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
  SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN
  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN
  ONCE_REWRITE_TAC[CONJ_SYM] THEN
  REWRITE_TAC[GSYM CONJ_ASSOC; FSTCART_PASTECART; SNDCART_PASTECART] THEN
  SIMP_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1; IN_INTERVAL_1] THEN
  REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL]);;

let HOMOTOPIC_WITH_IMP_SUBSET = prove
 (`!P X Y (f:real^M->real^N) g.
      homotopic_with P (subtopology euclidean X,subtopology euclidean Y) f g
      ==> IMAGE f X SUBSET Y /\ IMAGE g X SUBSET Y`,
  REPEAT GEN_TAC THEN REWRITE_TAC[HOMOTOPIC_WITH_EUCLIDEAN] THEN
  DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` MP_TAC) THEN
  STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
  REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS; SUBSET] THEN DISCH_THEN
   (fun th -> MP_TAC(SPEC `vec 0:real^1` th) THEN
              MP_TAC(SPEC `vec 1:real^1` th)) THEN
  ASM_SIMP_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL]);;

let HOMOTOPIC_WITH_MONO = prove
 (`!P Q X Y f g:real^M->real^N.
        homotopic_with P
          (subtopology euclidean X,subtopology euclidean Y) f g /\
        (!h. h continuous_on X /\ IMAGE h X SUBSET Y /\ P h ==> Q h)
        ==> homotopic_with Q
             (subtopology euclidean X,subtopology euclidean Y) f g`,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  REWRITE_TAC[HOMOTOPIC_WITH_EUCLIDEAN; PCROSS] THEN
  MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL
   [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID;
             CONTINUOUS_ON_CONST] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN
    ASM SET_TAC[];
    ASM SET_TAC[]]);;

let HOMOTOPIC_WITH_SUBSET_LEFT = prove
 (`!P X Y Z f g.
        homotopic_with P
         (subtopology euclidean X,subtopology euclidean Y) f g /\
        Z SUBSET X
        ==> homotopic_with P
             (subtopology euclidean Z,subtopology euclidean Y) f g`,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  REWRITE_TAC[HOMOTOPIC_WITH_EUCLIDEAN; PCROSS] THEN
  MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
   [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN
    ASM SET_TAC[];
    ASM SET_TAC[]]);;

let HOMOTOPIC_WITH_SUBSET_RIGHT = prove
 (`!P X Y Z (f:real^M->real^N) g.
        homotopic_with P
         (subtopology euclidean X,subtopology euclidean Y) f g /\
        Y SUBSET Z
        ==> homotopic_with P
             (subtopology euclidean X,subtopology euclidean Z) f g`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  REWRITE_TAC[HOMOTOPIC_WITH_EUCLIDEAN] THEN
  MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN
  ASM_MESON_TAC[SUBSET_TRANS]);;

let HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT = prove
 (`!p f:real^N->real^P g h:real^M->real^N W X Y.
      homotopic_with (\f. p(f o h))
       (subtopology euclidean X,subtopology euclidean Y) f g /\
      h continuous_on W /\ IMAGE h W SUBSET X
      ==> homotopic_with p
           (subtopology euclidean W,subtopology euclidean Y) (f o h) (g o h)`,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ_ALT] THEN STRIP_TAC THEN
  MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT]
   HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_MAP_RIGHT) THEN
  ASM_REWRITE_TAC[CONTINUOUS_MAP_EUCLIDEAN2]);;

let HOMOTOPIC_COMPOSE_CONTINUOUS_RIGHT = prove
 (`!f:real^N->real^P g h:real^M->real^N W X Y.
        homotopic_with (\f. T)
         (subtopology euclidean X,subtopology euclidean Y) f g /\
        h continuous_on W /\ IMAGE h W SUBSET X
        ==> homotopic_with (\f. T)
            (subtopology euclidean W,subtopology euclidean Y) (f o h) (g o h)`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
  EXISTS_TAC `X:real^N->bool` THEN ASM_REWRITE_TAC[]);;

let HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT = prove
 (`!p f:real^M->real^N g h:real^N->real^P X Y Z.
      homotopic_with (\f. p(h o f))
       (subtopology euclidean X,subtopology euclidean Y) f g /\
      h continuous_on Y /\ IMAGE h Y SUBSET Z
      ==> homotopic_with p
           (subtopology euclidean X,subtopology euclidean Z) (h o f) (h o g)`,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ_ALT] THEN STRIP_TAC THEN
  MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT]
   HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_MAP_LEFT) THEN
  ASM_REWRITE_TAC[CONTINUOUS_MAP_EUCLIDEAN2]);;

let HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT = prove
 (`!f:real^M->real^N g h:real^N->real^P X Y Z.
        homotopic_with (\f. T)
         (subtopology euclidean X,subtopology euclidean Y) f g /\
        h continuous_on Y /\ IMAGE h Y SUBSET Z
        ==> homotopic_with (\f. T)
             (subtopology euclidean X,subtopology euclidean Z)
             (h o f) (h o g)`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
  EXISTS_TAC `Y:real^N->bool` THEN ASM_REWRITE_TAC[]);;

let HOMOTOPIC_WITH_PCROSS = prove
 (`!f:real^M->real^N f':real^P->real^Q g g' p p' q s s' t t'.
     homotopic_with p
       (subtopology euclidean s,subtopology euclidean t) f g /\
     homotopic_with p'
       (subtopology euclidean s',subtopology euclidean t') f' g' /\
     (!f g. p f /\ p' g ==> q(\x. pastecart (f(fstcart x)) (g(sndcart x))))
     ==> homotopic_with q
          (subtopology euclidean (s PCROSS s'),
           subtopology euclidean (t PCROSS t'))
          (\z. pastecart (f(fstcart z)) (f'(sndcart z)))
          (\z. pastecart (g(fstcart z)) (g'(sndcart z)))`,
  REPEAT GEN_TAC THEN REWRITE_TAC[HOMOTOPIC_WITH_EUCLIDEAN] THEN
  REWRITE_TAC[CONJ_ASSOC] THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  REWRITE_TAC[GSYM CONJ_ASSOC] THEN
  DISCH_THEN(CONJUNCTS_THEN2
   (X_CHOOSE_THEN `k:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC)
   (X_CHOOSE_THEN `k':real^(1,P)finite_sum->real^Q` STRIP_ASSUME_TAC)) THEN
  EXISTS_TAC
   `\z:real^(1,(M,P)finite_sum)finite_sum.
        pastecart (k(pastecart (fstcart z) (fstcart(sndcart z))):real^N)
                  (k'(pastecart (fstcart z) (sndcart(sndcart z))):real^Q)` THEN
  ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS]) THEN
  ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS;
               FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS;
               IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
  MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN CONJ_TAC THEN
  GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
  MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
  (CONJ_TAC THENL
    [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
     SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
     GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
     SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART];
     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
      CONTINUOUS_ON_SUBSET)) THEN
     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS;
                 IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
     ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART;
                  PASTECART_IN_PCROSS]]));;

(* ------------------------------------------------------------------------- *)
(* Homotopy with P is an equivalence relation (on continuous functions       *)
(* mapping X into Y that satisfy P, though this only affects reflexivity).   *)
(* ------------------------------------------------------------------------- *)

let HOMOTOPIC_WITH_COMPOSE = prove
 (`!P Q R f f':real^M->real^N g g':real^N->real^P s t u.
           (!f g. f continuous_on s /\ IMAGE f s SUBSET t /\ P f /\
                  g continuous_on t /\ IMAGE g t SUBSET u /\ Q g
                  ==> R(g o f)) /\
           homotopic_with P
            (subtopology euclidean s,subtopology euclidean t) f f' /\
           homotopic_with Q
            (subtopology euclidean t,subtopology euclidean u) g g'
           ==> homotopic_with R
                (subtopology euclidean s,subtopology euclidean u)
                (g o f) (g' o f')`,
  REPEAT STRIP_TAC THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_TRANS THEN
  EXISTS_TAC `(g:real^N->real^P) o (f':real^M->real^N)` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT;
    MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT] THEN
  EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
  (CONJ_TAC THENL
    [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
      (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_MONO)) THEN
     FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN
     FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN
     FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
     ASM_SIMP_TAC[];
     ASM_MESON_TAC[HOMOTOPIC_WITH_IMP_CONTINUOUS;
                   HOMOTOPIC_WITH_IMP_SUBSET]]));;

let HOMOTOPIC_COMPOSE = prove
 (`!f f':real^M->real^N g g':real^N->real^P s t u.
        homotopic_with (\x. T)
          (subtopology euclidean s,subtopology euclidean t) f f' /\
        homotopic_with (\x. T)
          (subtopology euclidean t,subtopology euclidean u) g g'
        ==> homotopic_with (\x. T)
             (subtopology euclidean s,subtopology euclidean u)
             (g o f) (g' o f')`,
  REPEAT GEN_TAC THEN
  MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_COMPOSE) THEN
  REWRITE_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Two characterizations of homotopic triviality, one of which               *)
(* implicitly incorporates path-connectedness.                               *)
(* ------------------------------------------------------------------------- *)

let HOMOTOPIC_TRIVIALITY = prove
 (`!s:real^M->bool t:real^N->bool.
        (!f g. f continuous_on s /\ IMAGE f s SUBSET t /\
               g continuous_on s /\ IMAGE g s SUBSET t
               ==> homotopic_with (\x. T)
                    (subtopology euclidean s,subtopology euclidean t) f g) <=>
        (s = {} \/ path_connected t) /\
        (!f. f continuous_on s /\ IMAGE f s SUBSET t
             ==> ?c. homotopic_with (\x. T)
                      (subtopology euclidean s,subtopology euclidean t)
                      f (\x. c))`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL
   [ASM_SIMP_TAC[CONTINUOUS_ON_EMPTY; HOMOTOPIC_WITH_EUCLIDEAN_ALT;
                 NOT_IN_EMPTY;PCROSS_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET];
    ASM_CASES_TAC `t:real^N->bool = {}` THEN
    ASM_REWRITE_TAC[SUBSET_EMPTY; IMAGE_EQ_EMPTY; PATH_CONNECTED_EMPTY]] THEN
  EQ_TAC THEN REPEAT STRIP_TAC THENL
   [REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
    REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM PATH_COMPONENT_OF_EUCLIDEAN] THEN
    MP_TAC(ISPECL
     [`subtopology euclidean (s:real^M->bool)`;
      `subtopology euclidean (t:real^N->bool)`]
     HOMOTOPIC_CONSTANT_MAPS) THEN
    ASM_REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
    DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; CONTINUOUS_ON_CONST] THEN
    ASM SET_TAC[];
    SUBGOAL_THEN `?c:real^N. c IN t` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; CONTINUOUS_ON_CONST];
    FIRST_X_ASSUM(fun th ->
      MP_TAC(ISPEC `g:real^M->real^N` th) THEN
      MP_TAC(ISPEC `f:real^M->real^N` th)) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN
    X_GEN_TAC `d:real^N` THEN DISCH_TAC THEN
    TRANS_TAC HOMOTOPIC_WITH_TRANS `(\x. c):real^M->real^N` THEN
    ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN
    TRANS_TAC HOMOTOPIC_WITH_TRANS `(\x. d):real^M->real^N` THEN
    ASM_REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS; PATH_COMPONENT_OF_EUCLIDEAN;
                    TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o
      REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]) THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET)) THEN
    ASM SET_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* Homotopy on a union of closed-open sets.                                  *)
(* ------------------------------------------------------------------------- *)

let HOMOTOPIC_ON_CLOPEN_UNIONS = prove
 (`!f:real^M->real^N g t u.
        (!s. s IN u
             ==> closed_in (subtopology euclidean (UNIONS u)) s /\
                 open_in (subtopology euclidean (UNIONS u)) s /\
                 homotopic_with (\x. T)
                  (subtopology euclidean s,subtopology euclidean t) f g)
        ==> homotopic_with (\x. T)
             (subtopology euclidean (UNIONS u),subtopology euclidean t) f g`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `?v. v SUBSET u /\ COUNTABLE v /\ UNIONS v :real^M->bool = UNIONS u`
  STRIP_ASSUME_TAC THENL
   [MATCH_MP_TAC LINDELOF_OPEN_IN THEN ASM_MESON_TAC[];
    FIRST_X_ASSUM(SUBST_ALL_TAC o SYM)] THEN
  ASM_CASES_TAC `v:(real^M->bool)->bool = {}` THEN
  ASM_SIMP_TAC[HOMOTOPIC_ON_EMPTY; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY;
               UNIONS_0] THEN
  MP_TAC(ISPEC `v:(real^M->bool)->bool` COUNTABLE_AS_IMAGE) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `f:num->real^M->bool` THEN DISCH_THEN SUBST_ALL_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `(f:num->real^M->bool) n`) THEN
  DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN
  ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[FORALL_AND_THM]] THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [HOMOTOPIC_WITH_EUCLIDEAN] THEN
  SIMP_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; HOMOTOPIC_WITH_EUCLIDEAN_ALT] THEN
  X_GEN_TAC `h:num->real^(1,M)finite_sum->real^N` THEN
  REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN
  MP_TAC(ISPECL
   [`subtopology euclidean
       ((interval[vec 0,vec 1] PCROSS UNIONS(IMAGE f (:num)))
        :real^(1,M)finite_sum->bool)`;
    `euclidean:(real^N)topology`;
    `h:num->real^(1,M)finite_sum->real^N`;
    `(\n. interval[vec 0,vec 1] PCROSS (f n DIFF UNIONS {f m | m < n}))
     :num->real^(1,M)finite_sum->bool`;
    `(:num)`] PASTING_LEMMA_EXISTS) THEN
  REWRITE_TAC[CONTINUOUS_MAP_EUCLIDEAN; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY;
              SUBTOPOLOGY_SUBTOPOLOGY] THEN
  ONCE_REWRITE_TAC[TAUT `open_in a b /\ c <=> ~(open_in a b ==> ~c)`] THEN
  SIMP_TAC[ISPEC `euclidean` OPEN_IN_IMP_SUBSET;
           SET_RULE `s SUBSET u ==> u INTER s = s`] THEN
  REWRITE_TAC[NOT_IMP] THEN
  REWRITE_TAC[IN_UNIV; FORALL_AND_THM; SUBSET_UNIV; INTER_PCROSS] THEN
  ANTS_TAC THENL
   [REPEAT CONJ_TAC THENL
     [REWRITE_TAC[UNIONS_GSPEC; SUBSET; IN_ELIM_THM; FORALL_PASTECART] THEN
      REWRITE_TAC[PASTECART_IN_PCROSS; IMP_CONJ; RIGHT_FORALL_IMP_THM;
                  FORALL_IN_UNIONS; FORALL_IN_IMAGE; IN_UNIV; IMP_CONJ] THEN
      X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
      ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN X_GEN_TAC `y:real^M` THEN
      REWRITE_TAC[LEFT_FORALL_IMP_THM; IN_DIFF; IN_ELIM_THM] THEN
      GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN MESON_TAC[];
      X_GEN_TAC `n:num` THEN MATCH_MP_TAC OPEN_IN_PCROSS THEN
      REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IN_UNIONS THEN
      ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
      SIMP_TAC[FINITE_NUMSEG_LT; FINITE_IMAGE] THEN ASM SET_TAC[];
      X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(fun th ->
        MATCH_MP_TAC(MATCH_MP(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)
        (SPEC `n:num` th))) THEN
      REWRITE_TAC[SUBSET_PCROSS; SUBSET_REFL; SUBSET_DIFF];
      MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL
       [REWRITE_TAC[INTER_ACI] THEN MESON_TAC[];
        REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN SET_TAC[]]];
    MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `g:real^(1,M)finite_sum->real^N` THEN
    REWRITE_TAC[INTER_ACI; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[FORALL_IN_UNIONS; FORALL_IN_IMAGE; IMP_CONJ; SUBSET;
                RIGHT_FORALL_IMP_THM; IN_UNIV; FORALL_IN_PCROSS] THEN
    CONJ_TAC THENL
     [X_GEN_TAC `t:real^1` THEN DISCH_TAC; CONJ_TAC] THEN
    ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN X_GEN_TAC `y:real^M` THEN
    REWRITE_TAC[LEFT_FORALL_IMP_THM] THEN
    GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN
    DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THENL
     [FIRST_X_ASSUM(MP_TAC o SPECL [`t:real^1`; `y:real^M`; `n:num`]);
      FIRST_X_ASSUM(MP_TAC o SPECL [`vec 0:real^1`; `y:real^M`; `n:num`]);
      FIRST_X_ASSUM(MP_TAC o SPECL [`vec 1:real^1`; `y:real^M`; `n:num`])] THEN
    ASM_REWRITE_TAC[IN_INTER; UNIONS_IMAGE; IN_UNIV; IN_DIFF;
                    UNIONS_GSPEC; IN_ELIM_THM; ENDS_IN_UNIT_INTERVAL] THEN
    (ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC]) THEN
    REWRITE_TAC[] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [SUBSET]) THEN
    REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN ASM SET_TAC[]]);;

let INESSENTIAL_ON_CLOPEN_UNIONS = prove
 (`!f:real^M->real^N t u.
        path_connected t /\
        (!s. s IN u
             ==> closed_in (subtopology euclidean (UNIONS u)) s /\
                 open_in (subtopology euclidean (UNIONS u)) s /\
                 ?a. homotopic_with (\x. T)
                      (subtopology euclidean s,subtopology euclidean t) f (\x. a))
        ==> ?a. homotopic_with (\x. T)
                 (subtopology euclidean (UNIONS u),subtopology euclidean t)
                 f (\x. a)`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `UNIONS u:real^M->bool = {}` THEN
  ASM_SIMP_TAC[UNIONS_0; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY;
               HOMOTOPIC_ON_EMPTY] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [EMPTY_UNIONS]) THEN
  REWRITE_TAC[NOT_FORALL_THM; LEFT_IMP_EXISTS_THM; NOT_IMP] THEN
  X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN
  ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  DISCH_THEN(X_CHOOSE_THEN `a:real^N` MP_TAC) THEN
  DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
  STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
   `IMAGE (\x. a) s SUBSET t ==> ~(s = {}) ==> a IN t`)) THEN
  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN EXISTS_TAC `a:real^N` THEN
  MATCH_MP_TAC HOMOTOPIC_ON_CLOPEN_UNIONS THEN
  X_GEN_TAC `s:real^M->bool` THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `s:real^M->bool`) THEN
  ASM_REWRITE_TAC[] THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  ASM_CASES_TAC `s:real^M->bool = {}` THEN
  ASM_SIMP_TAC[HOMOTOPIC_ON_EMPTY; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  X_GEN_TAC `b:real^N` THEN
  DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN
  REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS; PATH_COMPONENT_OF_EUCLIDEAN] THEN
  DISJ2_TAC THEN
  FIRST_X_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
  FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
   `IMAGE (\x. a) s SUBSET t ==> ~(s = {}) ==> a IN t`)) THEN
  ASM_MESON_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT]);;

(* ------------------------------------------------------------------------- *)
(* Homotopy within the space of linear maps.                                 *)
(* ------------------------------------------------------------------------- *)

let HOMOTOPIC_WITH_REFLECTIONS_ALONG = prove
 (`!P s t a b:real^N.
        ~(a = vec 0) /\ ~(b = vec 0) /\
        (!c. c IN segment[a,b]
             ==> P(reflect_along c) /\ IMAGE (reflect_along c) s SUBSET t)
        ==> homotopic_with P (subtopology euclidean s,subtopology euclidean t)
                             (reflect_along a) (reflect_along b)`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `vec 0 IN segment[a:real^N,b]` THENL
   [SUBGOAL_THEN `reflect_along (b:real^N) = reflect_along a` SUBST1_TAC THENL
     [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM BETWEEN_IN_SEGMENT]) THEN
      DISCH_THEN(MP_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR) THEN
      ONCE_REWRITE_TAC[SET_RULE `{a,z,b} = {z,a,b}`] THEN
      ASM_REWRITE_TAC[COLLINEAR_LEMMA_ALT] THEN
      DISCH_THEN(X_CHOOSE_THEN `c:real` SUBST_ALL_TAC) THEN
      REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN
      MATCH_MP_TAC REFLECT_ALONG_SCALE THEN
      ASM_MESON_TAC[VECTOR_MUL_EQ_0];
      ASM_SIMP_TAC[HOMOTOPIC_WITH_REFL; ENDS_IN_SEGMENT; LINEAR_CONTINUOUS_ON;
                   CONTINUOUS_MAP_EUCLIDEAN2; LINEAR_REFLECT_ALONG]];
    ALL_TAC] THEN
  REWRITE_TAC[homotopic_with] THEN
  EXISTS_TAC
   `(\(c,x). reflect_along (c:real^N) x) o
    (\(t,x). (&1 - t) % a + t % b,x)` THEN
  REWRITE_TAC[o_THM] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
  REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID] THEN
  REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID; ETA_AX] THEN
  REWRITE_TAC[CONTINUOUS_MAP_IN_SUBTOPOLOGY; TOPSPACE_PROD_TOPOLOGY] THEN
  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_CROSS; o_THM] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEANREAL_SUBTOPOLOGY; IMP_CONJ] THEN
  REWRITE_TAC[GSYM CONJ_ASSOC] THEN CONJ_TAC THENL
   [MATCH_MP_TAC CONTINUOUS_MAP_COMPOSE THEN
    EXISTS_TAC `prod_topology
                 (subtopology euclidean ((:real^N) DIFF {vec 0}))
                 (euclidean:(real^N)topology)` THEN
    REWRITE_TAC[CONTINUOUS_MAP_PROD] THEN CONJ_TAC THENL
     [DISJ2_TAC THEN REWRITE_TAC[CONTINUOUS_MAP_IN_SUBTOPOLOGY] THEN
      SIMP_TAC[CONTINUOUS_MAP_ID; CONTINUOUS_MAP_FROM_SUBTOPOLOGY] THEN
      REWRITE_TAC[SUBSET; FORALL_IN_IMAGE;
                  TOPSPACE_EUCLIDEANREAL_SUBTOPOLOGY] THEN
      CONJ_TAC THENL
       [MATCH_MP_TAC CONTINUOUS_MAP_FROM_SUBTOPOLOGY THEN
        REWRITE_TAC[CONTINUOUS_MAP_DROP_EQ; o_DEF; GSYM DROP_VEC] THEN
        REWRITE_TAC[CONTINUOUS_MAP_EUCLIDEAN_EUCLIDEAN; GSYM DROP_SUB] THEN
        MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
        MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN REWRITE_TAC[o_DEF; LIFT_DROP] THEN
        SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID];
        FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_SEGMENT]) THEN
        REWRITE_TAC[IN_REAL_INTERVAL] THEN SET_TAC[]];
      REWRITE_TAC[reflect_along; LAMBDA_PAIR] THEN
      MATCH_MP_TAC CONTINUOUS_MAP_VECTOR_SUB THEN
      GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN
      REWRITE_TAC[CONTINUOUS_MAP_OF_SND; CONTINUOUS_MAP_ID] THEN
      MATCH_MP_TAC CONTINUOUS_MAP_VECTOR_MUL THEN
      GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN
      REWRITE_TAC[CONTINUOUS_MAP_OF_FST] THEN
      SIMP_TAC[CONTINUOUS_MAP_FROM_SUBTOPOLOGY; CONTINUOUS_MAP_ID] THEN
      MATCH_MP_TAC CONTINUOUS_MAP_REAL_LMUL THEN
      MATCH_MP_TAC CONTINUOUS_MAP_REAL_DIV THEN
      REWRITE_TAC[TOPSPACE_PROD_TOPOLOGY; FORALL_IN_CROSS] THEN
      REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; DOT_EQ_0] THEN
      SIMP_TAC[IN_DIFF; IN_SING] THEN
      CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_MAP_DOT THEN CONJ_TAC THEN
      GEN_REWRITE_TAC RAND_CONV [GSYM ETA_AX] THEN
      REWRITE_TAC[CONTINUOUS_MAP_OF_FST; CONTINUOUS_MAP_OF_SND] THEN
      SIMP_TAC[CONTINUOUS_MAP_ID; CONTINUOUS_MAP_FROM_SUBTOPOLOGY]];
    REWRITE_TAC[AND_FORALL_THM; RIGHT_FORALL_IMP_THM; IN_REAL_INTERVAL; TAUT
                 `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN
    X_GEN_TAC `t:real` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `(&1 - t) % a + t % b:real^N`) THEN
    REWRITE_TAC[IN_SEGMENT; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
    ASM SET_TAC[]]);;

let HOMOTOPIC_WITH_ORTHOGONAL_TRANSFORMATIONS = prove
 (`!f g:real^N->real^N.
        homotopic_with orthogonal_transformation
         (subtopology euclidean (sphere(vec 0,&1)),
          subtopology euclidean (sphere(vec 0,&1)))
         f g <=>
        orthogonal_transformation f /\ orthogonal_transformation g /\
        det(matrix f) = det(matrix g)`,
  let lemma = prove
   (`!f:real^N->real^N.
          orthogonal_transformation f
          ==> homotopic_with orthogonal_transformation
               (subtopology euclidean (sphere(vec 0,&1)),
                subtopology euclidean (sphere(vec 0,&1)))
               f
               (if det(matrix f) = &1 then I else reflect_along(basis 1))`,
    MATCH_MP_TAC ORTHOGONAL_TRANSFORMATION_REFLECT_INDUCT THEN CONJ_TAC THENL
     [REWRITE_TAC[MATRIX_I; DET_I; HOMOTOPIC_WITH_REFL] THEN
      REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_I; CONTINUOUS_MAP_EUCLIDEAN2] THEN
      REWRITE_TAC[I_DEF; CONTINUOUS_ON_ID; IMAGE_ID; SUBSET_REFL];
      MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `a:real^N`] THEN STRIP_TAC THEN
      MP_TAC(ISPECL
       [`orthogonal_transformation:(real^N->real^N)->bool`;
        `orthogonal_transformation:(real^N->real^N)->bool`;
        `orthogonal_transformation:(real^N->real^N)->bool`;
        `f:real^N->real^N`;
        `if det(matrix f:real^N^N) = &1 then I
        else reflect_along (basis 1:real^N)`;
        `reflect_along(a:real^N)`; `reflect_along(basis 1:real^N)`;
        `sphere(vec 0:real^N,&1)`;
        `sphere(vec 0:real^N,&1)`; `sphere(vec 0:real^N,&1)`]
          HOMOTOPIC_WITH_COMPOSE) THEN
      ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_COMPOSE] THEN ANTS_TAC THENL
       [MATCH_MP_TAC HOMOTOPIC_WITH_REFLECTIONS_ALONG THEN
        ASM_SIMP_TAC[BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1] THEN
        REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_REFLECT_ALONG; SUBSET] THEN
        REWRITE_TAC[FORALL_IN_IMAGE; IN_SPHERE_0; NORM_REFLECT_ALONG];
        MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN
        ASM_SIMP_TAC[MATRIX_COMPOSE; ORTHOGONAL_TRANSFORMATION_LINEAR; DET_MUL;
                     LINEAR_REFLECT_ALONG; DET_MATRIX_REFLECT_ALONG] THEN
        FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP DET_ORTHOGONAL_MATRIX o
          MATCH_MP ORTHOGONAL_MATRIX_MATRIX) THEN
        ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
        REWRITE_TAC[o_DEF; I_DEF; REFLECT_ALONG_INVOLUTION; ETA_AX] THEN
        REWRITE_TAC[HOMOTOPIC_WITH_REFL] THEN
        REWRITE_TAC[CONTINUOUS_MAP_ID; ORTHOGONAL_TRANSFORMATION_ID] THEN
        REWRITE_TAC[CONTINUOUS_MAP_EUCLIDEAN2;
                    ORTHOGONAL_TRANSFORMATION_REFLECT_ALONG] THEN
        REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0] THEN
        REWRITE_TAC[NORM_REFLECT_ALONG] THEN
        SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_REFLECT_ALONG]]]) in
  REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL
   [FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMOTOPIC_WITH_EUCLIDEAN]) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `k:real^(1,N)finite_sum->real^N` THEN
    STRIP_TAC THEN MP_TAC(ISPECL
     [`\t. lift(det(matrix((k:real^(1,N)finite_sum->real^N) o pastecart t)))`;
      `interval[vec 0:real^1,vec 1]`]
     CONTINUOUS_DISCRETE_RANGE_CONSTANT) THEN
    REWRITE_TAC[CONNECTED_INTERVAL] THEN ANTS_TAC THENL
     [CONJ_TAC THENL
       [MATCH_MP_TAC CONTINUOUS_ON_LIFT_DET THEN
        SIMP_TAC[matrix; LAMBDA_BETA; o_DEF] THEN
        MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN
        MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN
        ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
        MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
        SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST;
                 CONTINUOUS_ON_ID] THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN
        ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; IN_SPHERE_0;
                     NORM_BASIS];
        X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN EXISTS_TAC `&1` THEN
        REWRITE_TAC[REAL_LT_01] THEN X_GEN_TAC `u:real^1` THEN
        DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
        REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT; LIFT_EQ] THEN
        MATCH_MP_TAC(REAL_ARITH
         `(a = &1 \/ a = -- &1) /\ (b = &1 \/ b = -- &1)
          ==> ~(a = b) ==> &1 <= abs(a - b)`) THEN
        CONJ_TAC THEN MATCH_MP_TAC DET_ORTHOGONAL_MATRIX THEN
        ASM_SIMP_TAC[ORTHOGONAL_MATRIX_MATRIX; o_DEF]];
      DISCH_THEN(MP_TAC o SPECL [`vec 0:real^1`; `vec 1:real^1`] o MATCH_MP
       (MESON[] `(?y. !x. x IN s ==> f x = y)
                 ==> !x x'. x IN s /\ x' IN s ==> f x = f x'`)) THEN
      ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; LIFT_EQ] THEN
      MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN AP_TERM_TAC THEN
      AP_TERM_TAC THEN ASM_REWRITE_TAC[FUN_EQ_THM; o_THM]];
    MP_TAC(SPEC `g:real^N->real^N` lemma) THEN
    MP_TAC(SPEC `f:real^N->real^N` lemma) THEN
    ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
    MESON_TAC[HOMOTOPIC_WITH_SYM; HOMOTOPIC_WITH_TRANS]]);;

let HOMOTOPIC_WITH_ORTHOGONAL_TRANSFORMATIONS_GEN = prove
 (`!P f g:real^N->real^N.
        (?r. &0 < r /\ P r)
        ==> (homotopic_with orthogonal_transformation
               (subtopology euclidean {x | P(norm x)},
                subtopology euclidean {x | P(norm x)})
               f g <=>
             orthogonal_transformation f /\ orthogonal_transformation g /\
             det(matrix f) = det(matrix g))`,
  SUBGOAL_THEN
   `!P f g:real^N->real^N.
        (?r. &0 < r /\ P r)
        ==> (homotopic_with orthogonal_transformation
               (subtopology euclidean {x | P(norm x)},
                subtopology euclidean {x | P(norm x)})
               f g <=>
             homotopic_with orthogonal_transformation
              (subtopology euclidean (:real^N),
               subtopology euclidean (:real^N)) f g)`
  ASSUME_TAC THENL
   [ALL_TAC;
    ASM_SIMP_TAC[GSYM HOMOTOPIC_WITH_ORTHOGONAL_TRANSFORMATIONS] THEN
    REPEAT GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN
    CONV_TAC SYM_CONV THEN REWRITE_TAC[sphere; DIST_0] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `&1` THEN
    CONV_TAC REAL_RAT_REDUCE_CONV] THEN
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [ALL_TAC;
    DISCH_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_RESTRICT THEN
    REPEAT(EXISTS_TAC `(:real^N)`) THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
    MESON_TAC[ORTHOGONAL_TRANSFORMATION]] THEN
  REWRITE_TAC[HOMOTOPIC_WITH_EUCLIDEAN] THEN MATCH_MP_TAC MONO_EXISTS THEN
  X_GEN_TAC `h:real^(1,N)finite_sum->real^N` THEN STRIP_TAC THEN
  ASM_REWRITE_TAC[SUBSET_UNIV] THEN
  MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC
   `\z. norm(sndcart z) / r %
        (h:real^(1,N)finite_sum->real^N)
        (pastecart (fstcart z) (r / norm(sndcart z) % sndcart z))` THEN
  REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; FORALL_IN_PCROSS; IN_UNIV;
              FSTCART_PASTECART; SNDCART_PASTECART] THEN
  CONJ_TAC THENL
   [MAP_EVERY X_GEN_TAC [`a:real^1`; `x:real^N`] THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `a:real^1`) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(MP_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN
    DISCH_THEN(MP_TAC o MATCH_MP LINEAR_CMUL) THEN
    SIMP_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `&0`) THEN
    REWRITE_TAC[VECTOR_MUL_LZERO] THEN STRIP_TAC THEN
    ASM_CASES_TAC `x:real^N = vec 0` THEN
    ASM_REWRITE_TAC[NORM_0; VECTOR_MUL_LZERO; real_div; REAL_MUL_LZERO] THEN
    ASM_SIMP_TAC[VECTOR_MUL_ASSOC; NORM_EQ_0; VECTOR_MUL_LID; REAL_FIELD
     `~(x = &0) /\ &0 < r ==> (x * inv r) * r * inv x = &1`];
    ALL_TAC] THEN
  REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
  MAP_EVERY X_GEN_TAC [`a:real^1`; `x:real^N`] THEN DISCH_TAC THEN
  ASM_CASES_TAC `x:real^N = vec 0` THENL
   [ASM_REWRITE_TAC[CONTINUOUS_WITHIN; SNDCART_PASTECART] THEN
    REWRITE_TAC[NORM_0; real_div; REAL_MUL_LZERO; VECTOR_MUL_LZERO] THEN
    MATCH_MP_TAC LIM_NULL_COMPARISON THEN
    EXISTS_TAC `(norm o sndcart):real^(1,N)finite_sum->real` THEN
    CONJ_TAC THENL
     [SIMP_TAC[EVENTUALLY_WITHIN; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
      EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; IN_UNIV] THEN
      REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART] THEN
      MAP_EVERY X_GEN_TAC [`b:real^1`; `y:real^N`] THEN STRIP_TAC THEN
      ASM_CASES_TAC `y:real^N = vec 0` THEN
      ASM_SIMP_TAC[NORM_0; VECTOR_MUL_LZERO; REAL_MUL_LZERO; REAL_LE_REFL] THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `b:real^1`) THEN
      ASM_REWRITE_TAC[ORTHOGONAL_TRANSFORMATION] THEN
      DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
      DISCH_THEN(MP_TAC o MATCH_MP LINEAR_CMUL) THEN
      ASM_SIMP_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_MUL; REAL_ABS_NORM] THEN
      ASM_SIMP_TAC[NORM_EQ_0; REAL_LE_REFL; REAL_FIELD
       `&0 < r /\ ~(y = &0) ==> (y * inv(abs r)) * (abs r * inv y) * y = y`];
      MATCH_MP_TAC(MESON[CONTINUOUS_WITHIN; CONTINUOUS_AT_WITHIN]
       `f continuous at a /\ f a = l ==> (f --> l) (at a within s)`) THEN
      REWRITE_TAC[o_DEF; SNDCART_PASTECART; NORM_0; LIFT_NUM] THEN
      SIMP_TAC[CONTINUOUS_LIFT_NORM_COMPOSE; LINEAR_CONTINUOUS_AT;
               LINEAR_SNDCART]];
    MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF; real_div] THEN
    ONCE_REWRITE_TAC[REAL_ARITH `norm(x:real^N) * inv r = inv r * norm x`] THEN
    SIMP_TAC[LIFT_CMUL; CONTINUOUS_CMUL; CONTINUOUS_LIFT_NORM_COMPOSE;
             LINEAR_CONTINUOUS_WITHIN; LINEAR_SNDCART] THEN
    GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
    MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_PASTECART THEN
      SIMP_TAC[LINEAR_CONTINUOUS_WITHIN; LINEAR_FSTCART] THEN
      MATCH_MP_TAC CONTINUOUS_MUL THEN
      SIMP_TAC[LINEAR_CONTINUOUS_WITHIN; LINEAR_SNDCART] THEN
      REWRITE_TAC[o_DEF; LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_CMUL THEN
      MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_AT_WITHIN_INV) THEN
      SIMP_TAC[CONTINUOUS_LIFT_NORM_COMPOSE; LINEAR_CONTINUOUS_WITHIN;
               LINEAR_SNDCART; o_DEF] THEN
      ASM_REWRITE_TAC[NORM_EQ_0; SNDCART_PASTECART];
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
        [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN
      REWRITE_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN
      DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `r / norm(x) % x:real^N`]) THEN
      ASM_SIMP_TAC[IN_ELIM_THM; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM;
                   REAL_MUL_LINV; NORM_EQ_0; real_div; REAL_ABS_INV;
                   REAL_ABS_MUL; REAL_ARITH `&0 < r ==> abs r = r`;
                REAL_FIELD `&0 < r /\ ~(x = &0) ==> (r * inv x) * x = r`] THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_TRANSFORM_WITHIN_SET_IMP) THEN
      REWRITE_TAC[EVENTUALLY_AT] THEN
      REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN
      REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; FORALL_IN_PCROSS; IN_UNIV] THEN
      EXISTS_TAC `r:real` THEN ASM_REWRITE_TAC[] THEN
      SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS] THEN
      MAP_EVERY X_GEN_TAC [`b:real^1`; `y:real^N`] THEN STRIP_TAC THEN
      ASM_SIMP_TAC[IN_ELIM_THM; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM;
                   REAL_ABS_MUL; REAL_ARITH `&0 < r ==> abs r = r`;
                   REAL_RING `(r * x) * y = r <=> r = &0 \/ x * y = &1`;
                   REAL_LT_IMP_NZ; REAL_FIELD `inv x * x = &1 <=> ~(x = &0)`;
                   NORM_EQ_0] THEN
      ASM_CASES_TAC `y:real^N = vec 0` THEN
      ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_MUL_LINV;
                  REAL_MUL_RID; NORM_EQ_0] THEN
      DISCH_THEN(K ALL_TAC) THEN
      DISCH_THEN(MP_TAC o MATCH_MP (MESON[DIST_LE_PASTECART; REAL_LET_TRANS]
        `dist(pastecart a b,pastecart c d) < r ==> dist(b,d) < r`)) THEN
      REWRITE_TAC[DIST_0; VECTOR_MUL_RZERO] THEN
      REWRITE_TAC[NORM_MUL; REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN
      ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_MUL_LINV; NORM_EQ_0] THEN
      ASM_REAL_ARITH_TAC]]);;

let HOMOTOPIC_WITH_ORTHOGONAL_TRANSFORMATIONS_ALT = prove
 (`!f g:real^N->real^N.
        homotopic_with orthogonal_transformation
          (subtopology euclidean ((:real^N) DELETE vec 0),
           subtopology euclidean ((:real^N) DELETE vec 0))
          f g <=>
        orthogonal_transformation f /\ orthogonal_transformation g /\
        det(matrix f) = det(matrix g)`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[GSYM NORM_EQ_0; SET_RULE `UNIV DELETE a = {x | ~(x = a)}`] THEN
  MATCH_MP_TAC HOMOTOPIC_WITH_ORTHOGONAL_TRANSFORMATIONS_GEN THEN
  EXISTS_TAC `&1` THEN CONV_TAC REAL_RAT_REDUCE_CONV);;

let HOMOTOPIC_WITH_ORTHOGONAL_TRANSFORMATIONS_UNIV = prove
 (`!P f g:real^N->real^N.
        homotopic_with orthogonal_transformation
          (subtopology euclidean (:real^N),
           subtopology euclidean (:real^N)) f g <=>
        orthogonal_transformation f /\ orthogonal_transformation g /\
        det(matrix f) = det(matrix g)`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[GSYM NORM_EQ_0; SET_RULE `UNIV = {x | T}`] THEN
  MATCH_MP_TAC HOMOTOPIC_WITH_ORTHOGONAL_TRANSFORMATIONS_GEN THEN
  EXISTS_TAC `&1` THEN CONV_TAC REAL_RAT_REDUCE_CONV);;

let HOMOTOPIC_WITH_LINEAR_POSITIVE_DEFINITE_MAPS = prove
 (`!f g. homotopic_with (\f. linear f /\ positive_definite(matrix f))
           (subtopology euclidean ((:real^N) DELETE vec 0),
            subtopology euclidean ((:real^N) DELETE vec 0)) f g <=>
           linear f /\ linear g /\
           positive_definite(matrix f) /\
           positive_definite(matrix g)`,
  REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL
   [FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN SIMP_TAC[];
    REWRITE_TAC[HOMOTOPIC_WITH_EUCLIDEAN]] THEN
  EXISTS_TAC `\z. (&1 - drop(fstcart z)) % (f:real^N->real^N) (sndcart z) +
                  drop(fstcart z) % (g:real^N->real^N) (sndcart z)` THEN
  REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC;
              SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART; PASTECART_IN_PCROSS;
              IN_UNIV; IN_DELETE; REAL_SUB_RZERO; REAL_SUB_REFL; VECTOR_MUL_LID;
              VECTOR_MUL_LZERO; VECTOR_ADD_LID; VECTOR_ADD_RID] THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
    MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
    SIMP_TAC[o_DEF; LIFT_SUB; LIFT_DROP; CONTINUOUS_ON_SUB; LINEAR_FSTCART;
      ETA_AX; LINEAR_SNDCART; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON] THEN
    GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART];
    ALL_TAC] THEN
  MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL
   [REWRITE_TAC[IN_INTERVAL_1; GSYM FORALL_DROP; DROP_VEC] THEN
    ASM_SIMP_TAC[LINEAR_COMPOSE_ADD; MATRIX_ADD; LINEAR_COMPOSE_CMUL;
                 MATRIX_CMUL] THEN
    X_GEN_TAC `t:real` THEN STRIP_TAC THEN ASM_CASES_TAC `t = &0` THEN
    ASM_REWRITE_TAC[REAL_SUB_RZERO; MATRIX_CMUL_LZERO; MATRIX_ADD_RID;
                    MATRIX_CMUL_LID] THEN
    ASM_CASES_TAC `t = &1` THEN
    ASM_REWRITE_TAC[REAL_SUB_REFL; MATRIX_CMUL_LZERO; MATRIX_ADD_LID;
                    MATRIX_CMUL_LID] THEN
    MATCH_MP_TAC POSITIVE_DEFINITE_ADD THEN
    CONJ_TAC THEN MATCH_MP_TAC POSITIVE_DEFINITE_CMUL THEN
    ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
    REWRITE_TAC[FORALL_LIFT; LIFT_DROP] THEN DISCH_TAC THEN
    MAP_EVERY X_GEN_TAC [`t:real`; `x:real^N`] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `t:real`) THEN
    ASM_REWRITE_TAC [POSITIVE_DEFINITE_EIGENVALUES] THEN
    DISCH_THEN(MP_TAC o SPECL [`&0`; `x:real^N`] o last o CONJUNCTS) THEN
    ASM_REWRITE_TAC[VECTOR_MUL_LZERO; REAL_LT_REFL; CONTRAPOS_THM] THEN
    DISCH_THEN(SUBST1_TAC o SYM) THEN
    MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM] MATRIX_WORKS) THEN
    ASM_SIMP_TAC[LINEAR_COMPOSE_ADD; LINEAR_COMPOSE_CMUL]]);;

let HOMOTOPIC_WITH_LINEAR_MAPS = prove
 (`!f g:real^N->real^N.
     homotopic_with linear
       (subtopology euclidean ((:real^N) DELETE vec 0),
        subtopology euclidean ((:real^N) DELETE vec 0)) f g <=>
     linear f /\ linear g /\ &0 < det(matrix f) * det(matrix g)`,
  let lemma = prove
   (`!f:real^N->real^N.
        linear f /\ ~(det(matrix f) = &0)
        ==> ?f' P. orthogonal_transformation f' /\ positive_definite P /\
                   f = f' o (\x. P ** x)`,
    REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM INVERTIBLE_DET_NZ]) THEN
    REWRITE_TAC[RIGHT_POLAR_DECOMPOSITION_INVERTIBLE] THEN
    ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `S:real^N^N` THEN
    DISCH_THEN(X_CHOOSE_THEN `P:real^N^N` (STRIP_ASSUME_TAC o GSYM)) THEN
    EXISTS_TAC `(\x. P ** x):real^N->real^N` THEN
    ASM_REWRITE_TAC[GSYM ORTHOGONAL_MATRIX_TRANSFORMATION] THEN
    FIRST_ASSUM(ASSUME_TAC o GSYM o MATCH_MP MATRIX_WORKS) THEN
    ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; GSYM MATRIX_VECTOR_MUL_ASSOC]) in
  REPEAT GEN_TAC THEN EQ_TAC THENL
   [DISCH_TAC THEN
    FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMOTOPIC_WITH_EUCLIDEAN]) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `h:real^(1,N)finite_sum->real^N` THEN STRIP_TAC THEN
    SUBGOAL_THEN
     `(\t. lift(det(matrix((h:real^(1,N)finite_sum->real^N) o pastecart t))))
      continuous_on interval[vec 0,vec 1]`
    MP_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_LIFT_DET THEN
      SIMP_TAC[matrix; LAMBDA_BETA; o_THM] THEN
      MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN
      MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN
      GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
      MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
      SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST;
               CONTINUOUS_ON_ID] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN
      ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; IN_UNIV;
                   IN_DELETE; BASIS_NONZERO];
      DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONNECTED_CONTINUOUS_IMAGE)) THEN
      REWRITE_TAC[CONNECTED_INTERVAL] THEN
      REWRITE_TAC[GSYM CONVEX_CONNECTED_1; CONVEX_CONTAINS_SEGMENT] THEN
      REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; o_DEF] THEN
      REWRITE_TAC[FORALL_IN_IMAGE] THEN
      DISCH_THEN(MP_TAC o SPEC `vec 0:real^1`) THEN
      REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
      DISCH_THEN(MP_TAC o SPEC `vec 1:real^1`) THEN
      ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; ETA_AX] THEN
      ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
      REWRITE_TAC[REAL_MUL_POS_LT] THEN
      DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
       `~(&0 < x /\ &0 < y \/ x < &0 /\ y < &0)
        ==> abs(x - y) = abs(x - &0) + abs(&0 - y)`)) THEN
      REWRITE_TAC[GSYM DIST_LIFT; LIFT_NUM; GSYM between] THEN
      REWRITE_TAC[BETWEEN_IN_SEGMENT] THEN MATCH_MP_TAC(SET_RULE
       `~(z IN t) ==> z IN s ==> ~(s SUBSET t)`) THEN
      REWRITE_TAC[IN_IMAGE; GSYM LIFT_NUM; LIFT_EQ] THEN
      DISCH_THEN(X_CHOOSE_THEN `t:real^1` (STRIP_ASSUME_TAC o GSYM)) THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
      REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
      DISCH_THEN(MP_TAC o SPEC `t:real^1`) THEN
      ASM_REWRITE_TAC[GSYM LIFT_NUM; IN_DELETE; IN_UNIV; CONTRAPOS_THM] THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
       [GSYM HOMOGENEOUS_LINEAR_EQUATIONS_DET]) THEN
      ASM_SIMP_TAC[MATRIX_WORKS; GSYM LIFT_NUM] THEN MESON_TAC[]];
    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    ASM_CASES_TAC `det(matrix f:real^N^N) = &0` THEN
    ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_LT_REFL] THEN
    ASM_CASES_TAC `det(matrix g:real^N^N) = &0` THEN
    ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_LT_REFL] THEN
    MP_TAC(ISPEC `g:real^N->real^N` lemma) THEN
    MP_TAC(ISPEC `f:real^N->real^N` lemma) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`h:real^N->real^N`; `P:real^N^N`] THEN STRIP_TAC THEN
    MAP_EVERY X_GEN_TAC [`k:real^N->real^N`; `Q:real^N^N`] THEN STRIP_TAC THEN
    ASM_SIMP_TAC[MATRIX_COMPOSE; MATRIX_VECTOR_MUL_LINEAR;
                 ORTHOGONAL_TRANSFORMATION_LINEAR; DET_MUL;
                 MATRIX_OF_MATRIX_VECTOR_MUL] THEN
    ONCE_REWRITE_TAC[REAL_ARITH
     `(a * b) * (c * d):real = (a * c) * b * d`] THEN
    ASM_SIMP_TAC[DET_POSITIVE_DEFINITE; REAL_LT_MUL; REAL_LT_MUL_EQ] THEN
    REWRITE_TAC[REAL_MUL_POS_LT] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
     `&0 < x /\ &0 < y \/ x < &0 /\ y < &0
      ==> (x = &1 \/ x = -- &1) /\ (y = &1 \/ y = -- &1)
          ==> x = y`)) THEN
    ASM_SIMP_TAC[DET_ORTHOGONAL_MATRIX; ORTHOGONAL_MATRIX_MATRIX] THEN
    DISCH_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE THEN
    MAP_EVERY EXISTS_TAC
     [`\f:real^N->real^N. linear f /\ positive_definite(matrix f)`;
      `orthogonal_transformation:(real^N->real^N)->bool`;
      `(:real^N) DELETE vec 0`] THEN
    ASM_REWRITE_TAC[HOMOTOPIC_WITH_ORTHOGONAL_TRANSFORMATIONS_ALT] THEN
    SIMP_TAC[LINEAR_COMPOSE; ORTHOGONAL_TRANSFORMATION_LINEAR] THEN
    REWRITE_TAC[HOMOTOPIC_WITH_LINEAR_POSITIVE_DEFINITE_MAPS] THEN
    REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN
    ASM_REWRITE_TAC[MATRIX_OF_MATRIX_VECTOR_MUL]]);;

(* ------------------------------------------------------------------------- *)
(* Homotopy of paths, maintaining the same endpoints.                        *)
(* ------------------------------------------------------------------------- *)

let homotopic_paths = new_definition
 `homotopic_paths s p q =
     homotopic_with
       (\r. pathstart r = pathstart p /\ pathfinish r = pathfinish p)
       (subtopology euclidean (interval[vec 0:real^1,vec 1]),
        subtopology euclidean s)
       p q`;;

let HOMOTOPIC_PATHS = prove
 (`!s p q:real^1->real^N.
      homotopic_paths s p q <=>
      ?h. h continuous_on
          interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1] /\
          IMAGE h (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1])
          SUBSET s /\
          (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 0) x) = p x) /\
          (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 1) x) = q x) /\
          (!t. t IN interval[vec 0:real^1,vec 1]
               ==> pathstart(h o pastecart t) = pathstart p /\
                   pathfinish(h o pastecart t) = pathfinish p)`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[homotopic_paths] THEN
  W(MP_TAC o PART_MATCH (lhand o rand) HOMOTOPIC_WITH_EUCLIDEAN_ALT o
    lhand o snd) THEN
  ANTS_TAC THENL
   [SIMP_TAC[pathstart; pathfinish; ENDS_IN_UNIT_INTERVAL];
    DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF]]);;

let HOMOTOPIC_PATHS_IMP_PATHSTART = prove
 (`!s p q. homotopic_paths s p q ==> pathstart p = pathstart q`,
  REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN
  DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN
  SIMP_TAC[]);;

let HOMOTOPIC_PATHS_IMP_PATHFINISH = prove
 (`!s p q. homotopic_paths s p q ==> pathfinish p = pathfinish q`,
  REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN
  DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN
  SIMP_TAC[]);;

let HOMOTOPIC_PATHS_IMP_PATH = prove
 (`!s p q. homotopic_paths s p q ==> path p /\ path q`,
  REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN
  DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN
  SIMP_TAC[path]);;

let HOMOTOPIC_PATHS_IMP_SUBSET = prove
 (`!s p q.
     homotopic_paths s p q ==> path_image p SUBSET s /\ path_image q SUBSET s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN
  DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
  SIMP_TAC[path_image]);;

let HOMOTOPIC_PATHS_REFL = prove
 (`!s p. homotopic_paths s p p <=>
           path p /\ path_image p SUBSET s`,
  REWRITE_TAC[homotopic_paths; HOMOTOPIC_WITH_REFL; CONTINUOUS_MAP_EUCLIDEAN2;
              path; path_image]);;

let HOMOTOPIC_PATHS_SYM = prove
 (`!s p q. homotopic_paths s p q <=> homotopic_paths s q p`,
  REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_paths]) THEN
  ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN ASM_SIMP_TAC[homotopic_paths]);;

let HOMOTOPIC_PATHS_TRANS = prove
 (`!s p q r.
        homotopic_paths s p q /\ homotopic_paths s q r
        ==> homotopic_paths s p r`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(CONJUNCTS_THEN
   (fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART th) THEN
              ASSUME_TAC(MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH th))) THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE BINOP_CONV [homotopic_paths]) THEN
  ASM_REWRITE_TAC[HOMOTOPIC_WITH_TRANS; homotopic_paths]);;

let HOMOTOPIC_PATHS_EQ = prove
 (`!p:real^1->real^N q s.
        path p /\ path_image p SUBSET s /\
        (!t. t IN interval[vec 0,vec 1] ==> p(t) = q(t))
        ==> homotopic_paths s p q`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[homotopic_paths] THEN
  MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  REPEAT(EXISTS_TAC `p:real^1->real^N`) THEN
  ASM_SIMP_TAC[HOMOTOPIC_WITH_REFL; CONTINUOUS_MAP_EUCLIDEAN2] THEN
  ASM_REWRITE_TAC[GSYM path; GSYM path_image] THEN
  REWRITE_TAC[pathstart; pathfinish] THEN
  MESON_TAC[ENDS_IN_UNIT_INTERVAL]);;

let HOMOTOPIC_PATHS_REPARAMETRIZE = prove
 (`!p:real^1->real^N q.
        path p /\ path_image p SUBSET s /\
        (?f. f continuous_on interval[vec 0,vec 1] /\
             IMAGE f (interval[vec 0,vec 1]) SUBSET interval[vec 0,vec 1] /\
             f(vec 0) = vec 0 /\ f(vec 1) = vec 1 /\
             !t. t IN interval[vec 0,vec 1] ==> q(t) = p(f t))
        ==> homotopic_paths s p q`,
  REWRITE_TAC[path; path_image] THEN REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
  MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
  EXISTS_TAC `(p:real^1->real^N) o (f:real^1->real^1)` THEN CONJ_TAC THENL
   [MATCH_MP_TAC HOMOTOPIC_PATHS_EQ THEN
    ASM_SIMP_TAC[o_THM; pathstart; pathfinish; o_THM;
                 IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN
    REWRITE_TAC[path; path_image] THEN CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
      EXISTS_TAC `(p:real^1->real^N) o (f:real^1->real^1)` THEN
      ASM_SIMP_TAC[o_THM] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
      ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
      ASM SET_TAC[]];
    REWRITE_TAC[homotopic_paths; HOMOTOPIC_WITH_EUCLIDEAN; PCROSS] THEN
    EXISTS_TAC `(p:real^1->real^N) o
                (\y. (&1 - drop(fstcart y)) % f(sndcart y) +
                     drop(fstcart y) % sndcart y)` THEN
    ASM_REWRITE_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC;
                    pathstart; pathfinish] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN
    REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_RZERO; VECTOR_ADD_LID;
                VECTOR_MUL_LID; VECTOR_ADD_RID] THEN
    REWRITE_TAC[VECTOR_ARITH `(&1 - u) % x + u % x:real^N = x`] THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
       [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
        MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
        REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX; LIFT_SUB] THEN
        SIMP_TAC[LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_CONST; LINEAR_FSTCART;
                 LINEAR_SNDCART; CONTINUOUS_ON_SUB] THEN
        MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN
        SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN
        SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; SNDCART_PASTECART];
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET))];
      ONCE_REWRITE_TAC[IMAGE_o] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
       `IMAGE p i SUBSET s
        ==> IMAGE f x SUBSET i
            ==> IMAGE p (IMAGE f x) SUBSET s`))] THEN
    SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; SNDCART_PASTECART;
             FSTCART_PASTECART] THEN
    REPEAT STRIP_TAC THEN
    MATCH_MP_TAC(REWRITE_RULE[CONVEX_ALT] (CONJUNCT1(SPEC_ALL
      CONVEX_INTERVAL))) THEN
    ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC; SUBSET; IN_IMAGE]]);;

let HOMOTOPIC_PATHS_SUBSET = prove
 (`!s p q.
        homotopic_paths s p q /\ s SUBSET t
        ==> homotopic_paths t p q`,
  REWRITE_TAC[homotopic_paths; HOMOTOPIC_WITH_SUBSET_RIGHT]);;

(* ------------------------------------------------------------------------- *)
(* A slightly ad-hoc but useful lemma in constructing homotopies.            *)
(* ------------------------------------------------------------------------- *)

let HOMOTOPIC_JOIN_LEMMA = prove
 (`!p q:real^1->real^1->real^N.
  (\y. p (fstcart y) (sndcart y)) continuous_on
  (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1]) /\
  (\y. q (fstcart y) (sndcart y)) continuous_on
  (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1]) /\
  (!t. t IN interval[vec 0,vec 1] ==> pathfinish(p t) = pathstart(q t))
  ==> (\y. (p(fstcart y) ++ q(fstcart y)) (sndcart y)) continuous_on
      (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1])`,
  REWRITE_TAC[joinpaths; PCROSS] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN REPEAT CONJ_TAC THENL
   [SUBGOAL_THEN
    `(\y. p (fstcart y) (&2 % sndcart y)):real^(1,1)finite_sum->real^N =
     (\y. p (fstcart y) (sndcart y)) o
     (\y. pastecart (fstcart y) (&2 % sndcart y))`
    SUBST1_TAC THENL
     [REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]; ALL_TAC];
    SUBGOAL_THEN
    `(\y. q (fstcart y) (&2 % sndcart y - vec 1)):real^(1,1)finite_sum->real^N =
     (\y. q (fstcart y) (sndcart y)) o
     (\y. pastecart (fstcart y) (&2 % sndcart y - vec 1))`
    SUBST1_TAC THENL
     [REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]; ALL_TAC];
    SIMP_TAC[o_DEF; LIFT_DROP; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; ETA_AX];
    SIMP_TAC[IMP_CONJ; FORALL_IN_GSPEC; FSTCART_PASTECART; SNDCART_PASTECART;
             GSYM LIFT_EQ; LIFT_DROP; GSYM LIFT_CMUL] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN
    RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
    ASM_SIMP_TAC[LIFT_NUM; VECTOR_SUB_REFL]] THEN
  MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
  (CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_PASTECART; ALL_TAC]) THEN
  SIMP_TAC[CONTINUOUS_ON_CMUL; LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_SUB;
           CONTINUOUS_ON_CONST; LINEAR_FSTCART; LINEAR_SNDCART] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
    CONTINUOUS_ON_SUBSET)) THEN
  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; IMP_CONJ] THEN
  SIMP_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
  REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_SUB; DROP_VEC] THEN
  REAL_ARITH_TAC);;

(* ------------------------------------------------------------------------- *)
(* Congruence properties of homotopy w.r.t. path-combining operations.       *)
(* ------------------------------------------------------------------------- *)

let HOMOTOPIC_PATHS_REVERSEPATH = prove
 (`!s p q:real^1->real^N.
     homotopic_paths s (reversepath p) (reversepath q) <=>
     homotopic_paths s p q`,
  GEN_TAC THEN MATCH_MP_TAC(MESON[]
   `(!p. f(f p) = p) /\
    (!a b. homotopic_paths s a b ==> homotopic_paths s (f a) (f b))
    ==> !a b. homotopic_paths s (f a) (f b) <=>
              homotopic_paths s a b`) THEN
  REWRITE_TAC[REVERSEPATH_REVERSEPATH] THEN REPEAT GEN_TAC THEN
  REWRITE_TAC[homotopic_paths; HOMOTOPIC_WITH_EUCLIDEAN; PCROSS; o_DEF] THEN
  DISCH_THEN(X_CHOOSE_THEN `h:real^(1,1)finite_sum->real^N`
    STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `\y:real^(1,1)finite_sum.
                 (h:real^(1,1)finite_sum->real^N)
                 (pastecart(fstcart y) (vec 1 - sndcart y))` THEN
  ASM_REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
  ASM_SIMP_TAC[reversepath; pathstart; pathfinish; VECTOR_SUB_REFL;
               VECTOR_SUB_RZERO] THEN
  CONJ_TAC THENL
   [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
      SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
               CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST];
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN
      SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC;
        IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
      REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC];
     GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
     REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `IMAGE h s SUBSET t ==> IMAGE g s SUBSET s
      ==> IMAGE h (IMAGE g s) SUBSET t`)) THEN
     SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC;
        IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
     REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC]);;

let HOMOTOPIC_PATHS_JOIN = prove
 (`!s p q p' q':real^1->real^N.
     homotopic_paths s p p' /\ homotopic_paths s q q' /\
     pathfinish p = pathstart q
     ==> homotopic_paths s (p ++ q) (p' ++ q')`,
  REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
  REWRITE_TAC[homotopic_paths; HOMOTOPIC_WITH_EUCLIDEAN; PCROSS] THEN
  DISCH_THEN(CONJUNCTS_THEN2
   (X_CHOOSE_THEN `k1:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC)
   (X_CHOOSE_THEN `k2:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC)) THEN
  EXISTS_TAC `(\y. ((k1 o pastecart (fstcart y)) ++
                    (k2 o pastecart (fstcart y))) (sndcart y))
              :real^(1,1)finite_sum->real^N` THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN
    ASM_REWRITE_TAC[o_DEF; PASTECART_FST_SND; ETA_AX] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
    ASM_REWRITE_TAC[pathstart; pathfinish] THEN ASM_MESON_TAC[];
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
    REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
    REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
    REWRITE_TAC[ETA_AX; GSYM path_image; SET_RULE
      `(!x. x IN i ==> f x IN s) <=> IMAGE f i SUBSET s`] THEN
    REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN
    REWRITE_TAC[path_image; SUBSET; FORALL_IN_IMAGE; o_DEF] THEN ASM SET_TAC[];
    ALL_TAC; ALL_TAC; ALL_TAC] THEN
  REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
  ASM_REWRITE_TAC[joinpaths; o_DEF] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
  REWRITE_TAC[pathstart; pathfinish; DROP_VEC] THEN
  CONV_TAC REAL_RAT_REDUCE_CONV THEN
  ASM_SIMP_TAC[VECTOR_ARITH `&2 % x - x:real^N = x`; VECTOR_MUL_RZERO]);;

let HOMOTOPIC_PATHS_CONTINUOUS_IMAGE = prove
 (`!f:real^1->real^M g h:real^M->real^N s t.
        homotopic_paths s f g /\
        h continuous_on s /\ IMAGE h s SUBSET t
        ==> homotopic_paths t (h o f) (h o g)`,
  REWRITE_TAC[homotopic_paths] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
  EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        HOMOTOPIC_WITH_MONO)) THEN
  SIMP_TAC[pathstart; pathfinish; o_THM]);;

(* ------------------------------------------------------------------------- *)
(* Group properties for homotopy of paths (so taking equivalence classes     *)
(* under homotopy would give the fundamental group).                         *)
(* ------------------------------------------------------------------------- *)

let HOMOTOPIC_PATHS_RID = prove
 (`!s p. path p /\ path_image p SUBSET s
         ==> homotopic_paths s (p ++ linepath(pathfinish p,pathfinish p)) p`,
  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
  MATCH_MP_TAC HOMOTOPIC_PATHS_REPARAMETRIZE THEN
  ASM_REWRITE_TAC[joinpaths] THEN
  EXISTS_TAC `\t. if drop t <= &1 / &2 then &2 % t else vec 1` THEN
  ASM_REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
  REWRITE_TAC[VECTOR_MUL_RZERO; linepath; pathfinish;
              VECTOR_ARITH `(&1 - t) % x + t % x:real^N = x`] THEN
  REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
  CONJ_TAC THENL
   [SUBGOAL_THEN
     `interval[vec 0:real^1,vec 1] =
      interval[vec 0,lift(&1 / &2)] UNION interval[lift(&1 / &2),vec 1]`
    SUBST1_TAC THENL
     [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
      REAL_ARITH_TAC;
      MATCH_MP_TAC CONTINUOUS_ON_CASES THEN
      SIMP_TAC[CLOSED_INTERVAL; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID;
               CONTINUOUS_ON_CONST; IN_INTERVAL_1; DROP_VEC; LIFT_DROP;
               GSYM DROP_EQ; DROP_CMUL] THEN
      REAL_ARITH_TAC];
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_VEC] THEN
    GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[DROP_CMUL; DROP_VEC] THEN
    ASM_REAL_ARITH_TAC]);;

let HOMOTOPIC_PATHS_LID = prove
 (`!s p:real^1->real^N.
        path p /\ path_image p SUBSET s
        ==> homotopic_paths s (linepath(pathstart p,pathstart p) ++ p) p`,
  REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC[GSYM HOMOTOPIC_PATHS_REVERSEPATH] THEN
  REWRITE_TAC[o_DEF; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH] THEN
  SIMP_TAC[REVERSEPATH_JOINPATHS; REVERSEPATH_LINEPATH;
           PATHFINISH_LINEPATH] THEN
  ONCE_REWRITE_TAC[CONJ_SYM] THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `reversepath p :real^1->real^N`]
    HOMOTOPIC_PATHS_RID) THEN
  ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH;
               PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH]);;

let HOMOTOPIC_PATHS_ASSOC = prove
 (`!s p q r:real^1->real^N.
        path p /\ path_image p SUBSET s /\
        path q /\ path_image q SUBSET s /\
        path r /\ path_image r SUBSET s /\
        pathfinish p = pathstart q /\ pathfinish q = pathstart r
        ==> homotopic_paths s (p ++ (q ++ r)) ((p ++ q) ++ r)`,
  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
  MATCH_MP_TAC HOMOTOPIC_PATHS_REPARAMETRIZE THEN
  ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET;
               PATHSTART_JOIN; PATHFINISH_JOIN] THEN
  REWRITE_TAC[joinpaths] THEN
  EXISTS_TAC `\t. if drop t <= &1 / &2 then inv(&2) % t
                  else if drop t <= &3 / &4 then t - lift(&1 / &4)
                  else &2 % t - vec 1` THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC CONTINUOUS_ON_CASES_1 THEN
    SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; LIFT_DROP] THEN
    REWRITE_TAC[GSYM LIFT_SUB; GSYM LIFT_CMUL] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN
    MATCH_MP_TAC CONTINUOUS_ON_CASES_1 THEN
    SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID;
             CONTINUOUS_ON_CONST] THEN
    REWRITE_TAC[GSYM LIFT_SUB; GSYM LIFT_CMUL; GSYM LIFT_NUM] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV;
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_VEC] THEN
    REPEAT STRIP_TAC THEN
    REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
    REWRITE_TAC[DROP_CMUL; DROP_VEC; LIFT_DROP; DROP_SUB] THEN
    ASM_REAL_ARITH_TAC;
    REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
    REWRITE_TAC[VECTOR_MUL_RZERO];
    REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
    VECTOR_ARITH_TAC;
    X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
    STRIP_TAC THEN
    ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_REWRITE_TAC[DROP_CMUL] THEN
    ASM_REWRITE_TAC[REAL_ARITH `inv(&2) * t <= &1 / &2 <=> t <= &1`] THEN
    REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_ASSOC] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[REAL_MUL_LID] THEN
    ASM_CASES_TAC `drop t <= &3 / &4` THEN
    ASM_REWRITE_TAC[DROP_SUB; DROP_VEC; DROP_CMUL; LIFT_DROP;
                    REAL_ARITH `&2 * (t - &1 / &4) <= &1 / &2 <=> t <= &1 / &2`;
                    REAL_ARITH `&2 * t - &1 <= &1 / &2 <=> t <= &3 / &4`;
                    REAL_ARITH `t - &1 / &4 <= &1 / &2 <=> t <= &3 / &4`] THEN
    REWRITE_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC; GSYM LIFT_CMUL] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM] THEN
    REWRITE_TAC[VECTOR_ARITH `a - b - b:real^N = a - &2 % b`]]);;

let HOMOTOPIC_PATHS_RINV = prove
 (`!s p:real^1->real^N.
        path p /\ path_image p SUBSET s
        ==> homotopic_paths s
              (p ++ reversepath p) (linepath(pathstart p,pathstart p))`,
  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
  REWRITE_TAC[homotopic_paths; HOMOTOPIC_WITH_EUCLIDEAN; PCROSS] THEN
  EXISTS_TAC `(\y. (subpath (vec 0) (fstcart y) p ++
                    reversepath(subpath (vec 0) (fstcart y) p)) (sndcart y))
              : real^(1,1)finite_sum->real^N` THEN
  REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SUBPATH_TRIVIAL] THEN
  REWRITE_TAC[ETA_AX; PATHSTART_JOIN; PATHFINISH_JOIN] THEN
  REWRITE_TAC[REVERSEPATH_SUBPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
  REPEAT CONJ_TAC THENL
   [REWRITE_TAC[joinpaths] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN
    RULE_ASSUM_TAC(REWRITE_RULE[path; path_image]) THEN REPEAT CONJ_TAC THENL
     [REWRITE_TAC[subpath; VECTOR_ADD_LID; VECTOR_SUB_RZERO] THEN
      GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
      MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
       [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
        REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN
        SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
                 CONTINUOUS_ON_CMUL];
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN
        REWRITE_TAC[FORALL_IN_IMAGE; SUBSET; FORALL_IN_GSPEC; IMP_CONJ] THEN
        REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
        REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC] THEN
        REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS] THEN
        MATCH_MP_TAC REAL_LE_TRANS THEN
        EXISTS_TAC `drop x * &2 * &1 / &2` THEN CONJ_TAC THEN
        REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC) THEN
        ASM_REAL_ARITH_TAC];
      REWRITE_TAC[subpath; VECTOR_ADD_LID; VECTOR_SUB_RZERO] THEN
      GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
      MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
       [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
        SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
        MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
        REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN
        SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
                 CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST];
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN
        REWRITE_TAC[FORALL_IN_IMAGE; SUBSET; FORALL_IN_GSPEC; IMP_CONJ] THEN
        REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
        REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_CMUL; DROP_VEC; DROP_ADD;
         REAL_ARITH `t + (&0 - t) * (&2 * x - &1) =
                     t * &2 * (&1 - x)`] THEN
        REPEAT STRIP_TAC THEN
        ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_SUB_LE] THEN
        MATCH_MP_TAC REAL_LE_TRANS THEN
        EXISTS_TAC `drop x * &2 * &1 / &2` THEN CONJ_TAC THEN
        REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC) THEN
        ASM_REAL_ARITH_TAC];
      SIMP_TAC[o_DEF; LIFT_DROP; ETA_AX; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART];
      REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN
      REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[subpath] THEN AP_TERM_TAC THEN
      REWRITE_TAC[GSYM DROP_EQ; DROP_SUB; DROP_VEC; DROP_ADD; DROP_CMUL;
                  LIFT_DROP] THEN
      REAL_ARITH_TAC];
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
    REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN
    X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
    REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; ETA_AX;
      SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN
    REWRITE_TAC[GSYM path_image] THEN MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN
    REWRITE_TAC[PATH_IMAGE_SUBPATH_GEN] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [path_image]) THEN
    MATCH_MP_TAC(SET_RULE
      `t SUBSET s /\ u SUBSET s
       ==> IMAGE p s SUBSET v
           ==> IMAGE p t SUBSET v /\ IMAGE p u SUBSET v`) THEN
    REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN CONJ_TAC THEN
    MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_INTERVAL] THEN
    ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN
    REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL];
    REWRITE_TAC[subpath; linepath; pathstart; joinpaths] THEN
    REWRITE_TAC[VECTOR_SUB_REFL; DROP_VEC; VECTOR_MUL_LZERO] THEN
    REWRITE_TAC[VECTOR_ADD_RID; COND_ID] THEN VECTOR_ARITH_TAC;
    REWRITE_TAC[pathstart; PATHFINISH_LINEPATH; PATHSTART_LINEPATH]]);;

let HOMOTOPIC_PATHS_LINV = prove
 (`!s p:real^1->real^N.
        path p /\ path_image p SUBSET s
        ==> homotopic_paths s
              (reversepath p ++ p) (linepath(pathfinish p,pathfinish p))`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `reversepath p:real^1->real^N`]
        HOMOTOPIC_PATHS_RINV) THEN
  ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH] THEN
  REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH;
              REVERSEPATH_REVERSEPATH]);;

let HOMOTOPIC_PATHS_LCANCEL = prove
 (`!p q r s:real^N->bool.
        homotopic_paths s (p ++ q) (p ++ r) /\
        pathstart q = pathfinish p /\ pathstart r = pathfinish p
        ==> homotopic_paths s q r`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN
  ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET] THEN
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `homotopic_paths (s:real^N->bool)
                    (reversepath p ++ p ++ q) (reversepath p ++ p ++ r)`
  MP_TAC THENL
   [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
    ASM_REWRITE_TAC[PATHFINISH_REVERSEPATH; PATHSTART_JOIN] THEN
    ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL; PATH_REVERSEPATH;
                    PATH_IMAGE_REVERSEPATH];

    MATCH_MP_TAC(MESON[HOMOTOPIC_PATHS_SYM; HOMOTOPIC_PATHS_TRANS]
     `homotopic_paths s p p' /\ homotopic_paths s q q'
      ==> homotopic_paths s p q ==> homotopic_paths s p' q'`) THEN
    CONJ_TAC THEN
    W(MP_TAC o PART_MATCH (rator o rand) HOMOTOPIC_PATHS_ASSOC o
      rator o snd) THEN
    ASM_REWRITE_TAC[PATH_REVERSEPATH; PATHFINISH_REVERSEPATH;
                    PATH_IMAGE_REVERSEPATH] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_PATHS_TRANS) THEN
    MP_TAC(ISPEC `s:real^N->bool` HOMOTOPIC_PATHS_LID) THENL
     [DISCH_THEN(MP_TAC o SPEC `q:real^1->real^N`);
      DISCH_THEN(MP_TAC o SPEC `r:real^1->real^N`)] THEN
    ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_PATHS_TRANS) THEN
    MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
    ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL; PATHFINISH_JOIN] THEN
    MATCH_MP_TAC HOMOTOPIC_PATHS_LINV THEN ASM_REWRITE_TAC[]]);;

let HOMOTOPIC_PATHS_LCANCEL_EQ = prove
 (`!p q r s:real^N->bool.
        pathstart q = pathfinish p /\ pathstart r = pathfinish p
        ==> (homotopic_paths s (p ++ q) (p ++ r) <=>
              path p /\ path_image p SUBSET s /\ homotopic_paths s q r)`,
  REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN
  ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET] THEN
  REPEAT STRIP_TAC THEN
  ASM_SIMP_TAC[HOMOTOPIC_PATHS_JOIN; HOMOTOPIC_PATHS_REFL] THEN
  ASM_MESON_TAC[HOMOTOPIC_PATHS_LCANCEL]);;

let HOMOTOPIC_PATHS_RCANCEL = prove
 (`!p q r s:real^N->bool.
        homotopic_paths s (p ++ r) (q ++ r) /\
        pathfinish p = pathstart r /\ pathfinish q = pathstart r
        ==> homotopic_paths s p q`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN
  ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET] THEN
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `homotopic_paths (s:real^N->bool)
                    ((p ++ r) ++ reversepath r) ((q ++ r) ++ reversepath r)`
  MP_TAC THENL
   [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
    ASM_REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_JOIN] THEN
    ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL; PATH_REVERSEPATH;
                    PATH_IMAGE_REVERSEPATH];

    MATCH_MP_TAC(MESON[HOMOTOPIC_PATHS_SYM; HOMOTOPIC_PATHS_TRANS]
     `homotopic_paths s p p' /\ homotopic_paths s q q'
      ==> homotopic_paths s p q ==> homotopic_paths s p' q'`) THEN
    CONJ_TAC THEN
    W(MP_TAC o PART_MATCH (rator o rand)
      (ONCE_REWRITE_RULE[HOMOTOPIC_PATHS_SYM] HOMOTOPIC_PATHS_ASSOC) o
      rator o snd) THEN
    ASM_REWRITE_TAC[PATH_REVERSEPATH; PATHSTART_REVERSEPATH;
                    PATH_IMAGE_REVERSEPATH] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_PATHS_TRANS) THEN
    MP_TAC(ISPEC `s:real^N->bool` HOMOTOPIC_PATHS_RID) THENL
     [DISCH_THEN(MP_TAC o SPEC `p:real^1->real^N`);
      DISCH_THEN(MP_TAC o SPEC `q:real^1->real^N`)] THEN
    ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_PATHS_TRANS) THEN
    MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
    ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL; PATHSTART_JOIN] THEN
    MATCH_MP_TAC HOMOTOPIC_PATHS_RINV THEN ASM_REWRITE_TAC[]]);;

let HOMOTOPIC_PATHS_RCANCEL_EQ = prove
 (`!p q r s:real^N->bool.
        pathfinish p = pathstart r /\ pathfinish q = pathstart r
        ==> (homotopic_paths s (p ++ r) (q ++ r) <=>
             homotopic_paths s p q /\ path r /\ path_image r SUBSET s)`,
  REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN
  ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET] THEN
  REPEAT STRIP_TAC THEN
  ASM_SIMP_TAC[HOMOTOPIC_PATHS_JOIN; HOMOTOPIC_PATHS_REFL] THEN
  ASM_MESON_TAC[HOMOTOPIC_PATHS_RCANCEL]);;

(* ------------------------------------------------------------------------- *)
(* Homotopy of loops without requiring preservation of endpoints.            *)
(* ------------------------------------------------------------------------- *)

let homotopic_loops = new_definition
 `homotopic_loops s p q =
     homotopic_with
       (\r. pathfinish r = pathstart r)
       (subtopology euclidean (interval[vec 0:real^1,vec 1]),
        subtopology euclidean s)
       p q`;;

let HOMOTOPIC_LOOPS = prove
 (`!s p q:real^1->real^N.
      homotopic_loops s p q <=>
      ?h. h continuous_on
          interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1] /\
          IMAGE h (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1])
          SUBSET s /\
          (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 0) x) = p x) /\
          (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 1) x) = q x) /\
          (!t. t IN interval[vec 0:real^1,vec 1]
               ==> pathfinish(h o pastecart t) = pathstart(h o pastecart t))`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[homotopic_loops] THEN
  W(MP_TAC o PART_MATCH (lhand o rand) HOMOTOPIC_WITH_EUCLIDEAN_ALT o
    lhand o snd) THEN
  ANTS_TAC THENL
   [SIMP_TAC[pathstart; pathfinish; ENDS_IN_UNIT_INTERVAL];
    DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF]]);;

let HOMOTOPIC_LOOPS_IMP_LOOP = prove
 (`!s p q. homotopic_loops s p q
           ==> pathfinish p = pathstart p /\
               pathfinish q = pathstart q`,
  REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops] THEN
  DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN
  SIMP_TAC[]);;

let HOMOTOPIC_LOOPS_IMP_PATH = prove
 (`!s p q. homotopic_loops s p q ==> path p /\ path q`,
  REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops] THEN
  DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN
  SIMP_TAC[path]);;

let HOMOTOPIC_LOOPS_IMP_SUBSET = prove
 (`!s p q.
     homotopic_loops s p q ==> path_image p SUBSET s /\ path_image q SUBSET s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops] THEN
  DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
  SIMP_TAC[path_image]);;

let HOMOTOPIC_LOOPS_REFL = prove
 (`!s p. homotopic_loops s p p <=>
           path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p`,
  REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_REFL; CONTINUOUS_MAP_EUCLIDEAN2;
              path; path_image] THEN
  CONV_TAC TAUT);;

let HOMOTOPIC_LOOPS_SYM = prove
 (`!s p q. homotopic_loops s p q <=> homotopic_loops s q p`,
  REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_SYM]);;

let HOMOTOPIC_LOOPS_TRANS = prove
 (`!s p q r.
        homotopic_loops s p q /\ homotopic_loops s q r
        ==> homotopic_loops s p r`,
  REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_TRANS]);;

let HOMOTOPIC_LOOPS_SUBSET = prove
 (`!s p q.
        homotopic_loops s p q /\ s SUBSET t
        ==> homotopic_loops t p q`,
  REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_SUBSET_RIGHT]);;

let HOMOTOPIC_LOOPS_EQ = prove
 (`!p:real^1->real^N q s.
        path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p /\
        (!t. t IN interval[vec 0,vec 1] ==> p(t) = q(t))
        ==> homotopic_loops s p q`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[homotopic_loops] THEN
  MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  REPEAT(EXISTS_TAC `p:real^1->real^N`) THEN
  ASM_SIMP_TAC[HOMOTOPIC_WITH_REFL; CONTINUOUS_MAP_EUCLIDEAN2] THEN
  ASM_REWRITE_TAC[GSYM path; GSYM path_image] THEN
  REWRITE_TAC[pathstart; pathfinish] THEN
  MESON_TAC[ENDS_IN_UNIT_INTERVAL]);;

let HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE = prove
 (`!f:real^1->real^M g h:real^M->real^N s t.
        homotopic_loops s f g /\
        h continuous_on s /\ IMAGE h s SUBSET t
        ==> homotopic_loops t (h o f) (h o g)`,
  REWRITE_TAC[homotopic_loops] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
  EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        HOMOTOPIC_WITH_MONO)) THEN
  SIMP_TAC[pathstart; pathfinish; o_THM]);;

let HOMOTOPIC_LOOPS_SHIFTPATH_SELF = prove
 (`!p:real^1->real^N t s.
        path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p /\
        t IN interval[vec 0,vec 1]
        ==> homotopic_loops s p (shiftpath t p)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[HOMOTOPIC_LOOPS] THEN EXISTS_TAC
   `\z. shiftpath (drop t % fstcart z) (p:real^1->real^N) (sndcart z)` THEN
  REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; o_DEF] THEN
  REWRITE_TAC[GSYM LIFT_EQ_CMUL; VECTOR_MUL_RZERO; ETA_AX] THEN
  REPEAT CONJ_TAC THENL
   [ALL_TAC;
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
    REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
    MATCH_MP_TAC(SET_RULE
     `IMAGE p t SUBSET u /\
      (!x. x IN s ==> IMAGE(shiftpath (f x) p) t = IMAGE p t)
      ==> (!x y. x IN s /\ y IN t ==> shiftpath (f x) p y  IN u)`) THEN
    ASM_REWRITE_TAC[GSYM path_image] THEN REPEAT STRIP_TAC THEN
    MATCH_MP_TAC PATH_IMAGE_SHIFTPATH THEN
    ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
    ASM_SIMP_TAC[REAL_LE_MUL] THEN
    GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
    MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[];
    SIMP_TAC[shiftpath; VECTOR_ADD_LID; IN_INTERVAL_1; DROP_VEC];
    REWRITE_TAC[LIFT_DROP];
    X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN MATCH_MP_TAC CLOSED_SHIFTPATH THEN
    ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
    ASM_SIMP_TAC[REAL_LE_MUL] THEN
    GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
    MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[]] THEN
  REWRITE_TAC[shiftpath; DROP_ADD; DROP_CMUL] THEN
  MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN REPEAT CONJ_TAC THENL
   [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_MUL; o_DEF; LIFT_DROP;
             LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
             CONTINUOUS_ON_CONST] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[path]) THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN
    REWRITE_TAC[IN_ELIM_THM; PASTECART_IN_PCROSS] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
    ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1;
                 DROP_ADD; DROP_CMUL; DROP_VEC; REAL_LE_ADD; REAL_LE_MUL];
    GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_MUL; o_DEF; LIFT_DROP;
             LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
             CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[path]) THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN
    REWRITE_TAC[IN_ELIM_THM; PASTECART_IN_PCROSS] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
    ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1; DROP_SUB;
                 DROP_ADD; DROP_CMUL; DROP_VEC; REAL_LE_ADD; REAL_LE_MUL] THEN
    SIMP_TAC[REAL_ARITH `&0 <= x + y - &1 <=> &1 <= x + y`] THEN
    REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
     `t * x <= &1 * &1 /\ y <= &1 ==> t * x + y - &1 <= &1`) THEN
    ASM_SIMP_TAC[REAL_LE_MUL2; REAL_POS];
    REWRITE_TAC[o_DEF; LIFT_ADD; LIFT_CMUL; LIFT_DROP] THEN
    SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CMUL; LINEAR_CONTINUOUS_ON;
             LINEAR_FSTCART; LINEAR_SNDCART];
    SIMP_TAC[GSYM LIFT_EQ; LIFT_ADD; LIFT_CMUL; LIFT_DROP; LIFT_NUM;
             VECTOR_ARITH `a + b - c:real^1 = (a + b) - c`] THEN
    ASM_MESON_TAC[VECTOR_SUB_REFL; pathstart; pathfinish]]);;

(* ------------------------------------------------------------------------- *)
(* Relations between the two variants of homotopy.                           *)
(* ------------------------------------------------------------------------- *)

let HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS = prove
 (`!s p q. homotopic_paths s p q /\
           pathfinish p = pathstart p /\
           pathfinish q = pathstart p
           ==> homotopic_loops s p q`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
  REWRITE_TAC[homotopic_paths; homotopic_loops] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_MONO) THEN
  ASM_SIMP_TAC[]);;

let HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL = prove
 (`!s p a:real^N.
        homotopic_loops s p (linepath(a,a))
        ==> homotopic_paths s p (linepath(pathstart p,pathstart p))`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o MATCH_MP HOMOTOPIC_LOOPS_IMP_LOOP) THEN
  FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_PATH) THEN
  FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_SUBSET) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_loops]) THEN
  REWRITE_TAC[HOMOTOPIC_WITH_EUCLIDEAN; PCROSS; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `h:real^(1,1)finite_sum->real^N` THEN STRIP_TAC THEN
  MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC
   `(p:real^1->real^N) ++ linepath(pathfinish p,pathfinish p)` THEN
  CONJ_TAC THENL
   [ASM_MESON_TAC[HOMOTOPIC_PATHS_RID; HOMOTOPIC_PATHS_SYM]; ALL_TAC] THEN
  MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC
   `linepath(pathstart p,pathstart p) ++ (p:real^1->real^N) ++
    linepath(pathfinish p,pathfinish p)` THEN
  CONJ_TAC THENL
   [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
    MP_TAC(ISPECL [`s:real^N->bool`;
       `(p:real^1->real^N) ++ linepath(pathfinish p,pathfinish p)`]
     HOMOTOPIC_PATHS_LID) THEN
    REWRITE_TAC[PATHSTART_JOIN] THEN DISCH_THEN MATCH_MP_TAC THEN
    ASM_SIMP_TAC[PATH_JOIN; PATH_LINEPATH; PATHSTART_LINEPATH] THEN
    MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN
    ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
    REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN
    ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET];
    ALL_TAC] THEN
  MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC
   `((\u. (h:real^(1,1)finite_sum->real^N) (pastecart u (vec 0))) ++
     linepath(a,a) ++
     reversepath(\u. h (pastecart u (vec 0))))` THEN
  CONJ_TAC THENL
   [ALL_TAC;
    MATCH_MP_TAC(MESON[HOMOTOPIC_PATHS_LID; HOMOTOPIC_PATHS_JOIN;
                       HOMOTOPIC_PATHS_TRANS; HOMOTOPIC_PATHS_SYM;
                       HOMOTOPIC_PATHS_RINV]
       `(path p /\ path(reversepath p)) /\
        (path_image p SUBSET s /\ path_image(reversepath p) SUBSET s) /\
        (pathfinish p = pathstart(linepath(b,b) ++ reversepath p) /\
         pathstart(reversepath p) = b) /\
        pathstart p = a
        ==> homotopic_paths s (p ++ linepath(b,b) ++ reversepath p)
                              (linepath(a,a))`) THEN
    REWRITE_TAC[PATHSTART_REVERSEPATH; PATHSTART_JOIN; PATH_REVERSEPATH;
                PATH_IMAGE_REVERSEPATH; PATHSTART_LINEPATH] THEN
    ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish;
                    LINEPATH_REFL] THEN
    CONJ_TAC THENL
     [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
      MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
      SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID;
               CONTINUOUS_ON_CONST] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN
      SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM;
               ENDS_IN_UNIT_INTERVAL];
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
          SUBSET_TRANS)) THEN
      GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
      REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
      SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM;
               ENDS_IN_UNIT_INTERVAL]]] THEN
  REWRITE_TAC[homotopic_paths; HOMOTOPIC_WITH_EUCLIDEAN; PCROSS] THEN
  EXISTS_TAC
   `\y:real^(1,1)finite_sum.
        (subpath (vec 0) (fstcart y) (\u. h(pastecart u (vec 0))) ++
         (\u. (h:real^(1,1)finite_sum->real^N) (pastecart (fstcart y) u)) ++
         subpath (fstcart y) (vec 0) (\u. h(pastecart u (vec 0))))
        (sndcart y)` THEN
  ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SUBPATH_TRIVIAL;
                  SUBPATH_REFL; SUBPATH_REVERSEPATH; ETA_AX;
                  PATHSTART_JOIN; PATHFINISH_JOIN;
                  PATHSTART_SUBPATH; PATHFINISH_SUBPATH;
                  PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
  ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
   [ALL_TAC; REWRITE_TAC[pathstart]] THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN
    REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
     [ALL_TAC;
      MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN
      ASM_REWRITE_TAC[PASTECART_FST_SND; ETA_AX] THEN CONJ_TAC THENL
       [ALL_TAC;
        RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
        REWRITE_TAC[PATHSTART_SUBPATH] THEN
        ASM_SIMP_TAC[pathstart; pathfinish]];
      RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
      REWRITE_TAC[PATHFINISH_SUBPATH; PATHSTART_JOIN] THEN
      ASM_SIMP_TAC[pathstart]] THEN
    REWRITE_TAC[subpath] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    REWRITE_TAC[VECTOR_SUB_RZERO; VECTOR_SUB_LZERO; VECTOR_ADD_LID] THEN
    (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5)
       [CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ADD; CONTINUOUS_ON_MUL;
        LIFT_DROP; CONTINUOUS_ON_NEG; DROP_NEG; CONTINUOUS_ON_CONST;
        CONTINUOUS_ON_ID; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
        LIFT_NEG; o_DEF; ETA_AX] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
       CONTINUOUS_ON_SUBSET)) THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
    REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN
    REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1] THEN
    REWRITE_TAC[DROP_ADD; DROP_NEG; DROP_VEC; DROP_CMUL; REAL_POS] THEN
    SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_ARITH
     `t + --t * x = t * (&1 - x)`] THEN REPEAT STRIP_TAC THEN
    MATCH_MP_TAC(REAL_ARITH
     `t * x <= t * &1 /\ &1 * t <= &1 * &1 ==> t * x <= &1`) THEN
    CONJ_TAC THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC;

    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; IMP_CONJ;
      RIGHT_FORALL_IMP_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
    X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN
    REWRITE_TAC[SET_RULE
     `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN
    REWRITE_TAC[GSYM path_image; ETA_AX] THEN
    REPEAT(MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN CONJ_TAC) THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
      SUBSET_TRANS)) THEN
    REWRITE_TAC[path_image; subpath] THEN
    GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
    REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
    ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM] THEN
    SIMP_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; DROP_CMUL; DROP_ADD] THEN
    REWRITE_TAC[REAL_ADD_LID; REAL_SUB_RZERO; REAL_POS] THEN
    REWRITE_TAC[REAL_ARITH `t + (&0 - t) * x = t * (&1 - x)`] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
    ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE] THEN
    REPEAT STRIP_TAC THEN
    GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
    MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REAL_ARITH_TAC]);;

let HOMOTOPIC_LOOPS_CONJUGATE = prove
 (`!p q s:real^N->bool.
        path p /\ path_image p SUBSET s /\
        path q /\ path_image q SUBSET s /\
        pathfinish p = pathstart q /\ pathfinish q = pathstart q
        ==> homotopic_loops s (p ++ q ++ reversepath p) q`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN EXISTS_TAC
   `linepath(pathstart q,pathstart q) ++ (q:real^1->real^N) ++
    linepath(pathstart q,pathstart q)` THEN
  CONJ_TAC THENL
   [ALL_TAC;
    MATCH_MP_TAC HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS THEN
    MP_TAC(ISPECL [`s:real^N->bool`;
       `(q:real^1->real^N) ++ linepath(pathfinish q,pathfinish q)`]
     HOMOTOPIC_PATHS_LID) THEN
    ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; UNION_SUBSET; SING_SUBSET;
                 PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH;
                 PATH_JOIN; PATH_IMAGE_JOIN; PATH_LINEPATH; SEGMENT_REFL] THEN
    ANTS_TAC THENL
     [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]; ALL_TAC] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_PATHS_TRANS) THEN
    ASM_MESON_TAC[HOMOTOPIC_PATHS_RID]] THEN
  REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_EUCLIDEAN; PCROSS] THEN
  EXISTS_TAC
   `(\y. (subpath (fstcart y) (vec 1) p ++ q ++ subpath (vec 1) (fstcart y) p)
         (sndcart y)):real^(1,1)finite_sum->real^N` THEN
  ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SUBPATH_TRIVIAL;
                  SUBPATH_REFL; SUBPATH_REVERSEPATH; ETA_AX;
                 PATHSTART_JOIN; PATHFINISH_JOIN;
                  PATHSTART_SUBPATH; PATHFINISH_SUBPATH;
                  PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
  ASM_REWRITE_TAC[pathstart; pathfinish] THEN CONJ_TAC THENL
   [RULE_ASSUM_TAC(REWRITE_RULE[path; path_image]) THEN
    MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN
    REPEAT CONJ_TAC THENL
     [ALL_TAC;
      MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN
      REPEAT CONJ_TAC THENL
       [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
        MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
        SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN
        REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
        SIMP_TAC[SNDCART_PASTECART];
        ALL_TAC;
        REWRITE_TAC[PATHSTART_SUBPATH] THEN ASM_REWRITE_TAC[pathfinish]];
      REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_SUBPATH] THEN
      ASM_REWRITE_TAC[pathstart]] THEN
    REWRITE_TAC[subpath] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    (CONJ_TAC THENL
      [REWRITE_TAC[DROP_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
       SIMP_TAC[LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_CONST; LINEAR_FSTCART] THEN
       MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
       SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
       REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP] THEN
       SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON;
                LINEAR_FSTCART];
       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN
       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
       REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1] THEN
       REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC; DROP_CMUL]])
    THENL
     [REPEAT STRIP_TAC THENL
       [MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THEN
        TRY(MATCH_MP_TAC REAL_LE_MUL) THEN ASM_REAL_ARITH_TAC;
        REWRITE_TAC[REAL_ARITH `t + (&1 - t) * x <= &1 <=>
                                (&1 - t) * x <= (&1 - t) * &1`] THEN
        MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC];
      REPEAT STRIP_TAC THENL
       [MATCH_MP_TAC(REAL_ARITH
         `x * (&1 - t) <= x * &1 /\ x <= &1
          ==> &0 <= &1 + (t - &1) * x`) THEN
        ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN
        ASM_REAL_ARITH_TAC;
        REWRITE_TAC[REAL_ARITH
         `a + (t - &1) * x <= a <=> &0 <= (&1 - t) * x`] THEN
        MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC]];
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
    REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
    REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
    REWRITE_TAC[ETA_AX; GSYM path_image; SET_RULE
      `(!x. x IN i ==> f x IN s) <=> IMAGE f i SUBSET s`] THEN
    REPEAT STRIP_TAC THEN
    REPEAT(MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN CONJ_TAC) THEN
    ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `path_image p:real^N->bool` THEN
    ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC PATH_IMAGE_SUBPATH_SUBSET THEN
    ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]]);;

(* ------------------------------------------------------------------------- *)
(* Relating homotopy of trivial loops to path-connectedness.                 *)
(* ------------------------------------------------------------------------- *)

let PATH_COMPONENT_IMP_HOMOTOPIC_POINTS = prove
 (`!s a b:real^N.
        path_component s a b
        ==> homotopic_loops s (linepath(a,a)) (linepath(b,b))`,
  REWRITE_TAC[path_component; homotopic_loops;
              HOMOTOPIC_WITH_EUCLIDEAN; PCROSS] THEN
  REPEAT GEN_TAC THEN REWRITE_TAC[pathstart; pathfinish; path_image; path] THEN
  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
  DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `\y:real^(1,1)finite_sum. (g(fstcart y):real^N)` THEN
  ASM_SIMP_TAC[FSTCART_PASTECART; linepath] THEN
  REWRITE_TAC[VECTOR_ARITH `(&1 - x) % a + x % a:real^N = a`] THEN
  MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN
  SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN
  SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; FSTCART_PASTECART]);;

let HOMOTOPIC_LOOPS_IMP_PATH_COMPONENT_VALUE = prove
 (`!s p q:real^1->real^N t.
        homotopic_loops s p q /\ t IN interval[vec 0,vec 1]
        ==> path_component s (p t) (q t)`,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  REWRITE_TAC[path_component; homotopic_loops;
              HOMOTOPIC_WITH_EUCLIDEAN; PCROSS] THEN
  DISCH_THEN(X_CHOOSE_THEN `h:real^(1,1)finite_sum->real^N` MP_TAC) THEN
  STRIP_TAC THEN
  EXISTS_TAC `\u. (h:real^(1,1)finite_sum->real^N) (pastecart u t)` THEN
  ASM_REWRITE_TAC[pathstart; pathfinish] THEN CONJ_TAC THENL
   [REWRITE_TAC[path] THEN
    MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
      REWRITE_TAC[CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID];
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN
      REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
      ASM SET_TAC[]];
    REWRITE_TAC[path_image] THEN ASM SET_TAC[]]);;

let HOMOTOPIC_POINTS_EQ_PATH_COMPONENT = prove
 (`!s a b:real^N.
        homotopic_loops s (linepath(a,a)) (linepath(b,b)) <=>
        path_component s a b`,
  REPEAT GEN_TAC THEN EQ_TAC THEN
  REWRITE_TAC[PATH_COMPONENT_IMP_HOMOTOPIC_POINTS] THEN
  DISCH_THEN(MP_TAC o SPEC `vec 0:real^1` o MATCH_MP (REWRITE_RULE[IMP_CONJ]
    HOMOTOPIC_LOOPS_IMP_PATH_COMPONENT_VALUE)) THEN
  REWRITE_TAC[linepath; IN_INTERVAL_1; DROP_VEC; REAL_POS] THEN
  REWRITE_TAC[VECTOR_ARITH `(&1 - &0) % a + &0 % b:real^N = a`]);;

let PATH_CONNECTED_EQ_HOMOTOPIC_POINTS = prove
 (`!s:real^N->bool.
        path_connected s <=>
        !a b. a IN s /\ b IN s
              ==> homotopic_loops s (linepath(a,a)) (linepath(b,b))`,
  GEN_TAC THEN REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN
  REWRITE_TAC[path_connected; path_component]);;

(* ------------------------------------------------------------------------- *)
(* Homotopy of "nearby" function, paths and loops.                           *)
(* ------------------------------------------------------------------------- *)

let HOMOTOPIC_WITH_LINEAR = prove
 (`!f g:real^M->real^N s t.
        f continuous_on s /\ g continuous_on s /\
        (!x. x IN s ==> segment[f x,g x] SUBSET t)
        ==> homotopic_with (\z. T)
             (subtopology euclidean s,subtopology euclidean t) f g`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[HOMOTOPIC_WITH_EUCLIDEAN] THEN
  EXISTS_TAC
    `\y. ((&1 - drop(fstcart y)) % (f:real^M->real^N)(sndcart y) +
         drop(fstcart y) % g(sndcart y):real^N)` THEN
  REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC] THEN
  ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_SUB_RZERO] THEN
  REWRITE_TAC[VECTOR_ARITH `(&1 - t) % a + t % a:real^N = a`] THEN
  REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID] THEN
  REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID] THEN CONJ_TAC THENL
   [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
    MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
    REWRITE_TAC[o_DEF; LIFT_DROP; LIFT_SUB] THEN
    SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON;
             LINEAR_FSTCART; ETA_AX] THEN
    GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
    SIMP_TAC[SNDCART_PASTECART; FORALL_IN_PCROSS];
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
    MAP_EVERY X_GEN_TAC [`t:real^1`; `u:real^M`] THEN STRIP_TAC THEN
    SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; RIGHT_IMP_FORALL_THM; IMP_IMP]) THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `u:real^M` THEN
    ASM_REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `drop t` THEN
    ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC]]);;

let HOMOTOPIC_PATHS_LINEAR,HOMOTOPIC_LOOPS_LINEAR = (CONJ_PAIR o prove)
 (`(!g s:real^N->bool h.
        path g /\ path h /\
        pathstart h = pathstart g /\ pathfinish h = pathfinish g /\
        (!t x. t IN interval[vec 0,vec 1] ==> segment[g t,h t] SUBSET s)
        ==> homotopic_paths s g h) /\
   (!g s:real^N->bool h.
        path g /\ path h /\
        pathfinish g = pathstart g /\ pathfinish h = pathstart h /\
        (!t x. t IN interval[vec 0,vec 1] ==> segment[g t,h t] SUBSET s)
        ==> homotopic_loops s g h)`,
  CONJ_TAC THEN
 (REWRITE_TAC[pathstart; pathfinish] THEN
  REWRITE_TAC[SUBSET; RIGHT_IMP_FORALL_THM; IMP_IMP] THEN REPEAT STRIP_TAC THEN
  REWRITE_TAC[homotopic_paths; homotopic_loops;
              HOMOTOPIC_WITH_EUCLIDEAN; PCROSS] THEN
  EXISTS_TAC
   `\y:real^(1,1)finite_sum.
      ((&1 - drop(fstcart y)) % g(sndcart y) +
       drop(fstcart y) % h(sndcart y):real^N)` THEN
  REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC] THEN
  ASM_REWRITE_TAC[pathstart; pathfinish; REAL_SUB_REFL; REAL_SUB_RZERO] THEN
  REWRITE_TAC[VECTOR_ARITH `(&1 - t) % a + t % a:real^N = a`] THEN
  REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID] THEN
  REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID] THEN CONJ_TAC THENL
   [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
    MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
    REWRITE_TAC[o_DEF; LIFT_DROP; LIFT_SUB] THEN
    SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON;
             LINEAR_FSTCART; ETA_AX] THEN
    GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[path]) THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
    SIMP_TAC[SNDCART_PASTECART];
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
    MAP_EVERY X_GEN_TAC [`t:real^1`; `u:real^1`] THEN STRIP_TAC THEN
    SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `u:real^1` THEN
    ASM_REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `drop t` THEN
    ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC]]));;

let HOMOTOPIC_PATHS_NEARBY_EXPLICIT,
    HOMOTOPIC_LOOPS_NEARBY_EXPLICIT = (CONJ_PAIR o prove)
 (`(!g s:real^N->bool h.
        path g /\ path h /\
        pathstart h = pathstart g /\ pathfinish h = pathfinish g /\
        (!t x. t IN interval[vec 0,vec 1] /\ ~(x IN s)
               ==> norm(h t - g t) < norm(g t - x))
        ==> homotopic_paths s g h) /\
   (!g s:real^N->bool h.
        path g /\ path h /\
        pathfinish g = pathstart g /\ pathfinish h = pathstart h /\
        (!t x. t IN interval[vec 0,vec 1] /\ ~(x IN s)
               ==> norm(h t - g t) < norm(g t - x))
        ==> homotopic_loops s g h)`,
  ONCE_REWRITE_TAC[TAUT `p /\ ~q ==> r <=> p /\ ~r ==> q`] THEN
  REPEAT STRIP_TAC THENL
   [MATCH_MP_TAC HOMOTOPIC_PATHS_LINEAR;
    MATCH_MP_TAC HOMOTOPIC_LOOPS_LINEAR] THEN
  ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; segment; FORALL_IN_GSPEC] THEN
  X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN
  X_GEN_TAC `u:real` THEN STRIP_TAC THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `t:real^1` THEN
  ASM_REWRITE_TAC[REAL_NOT_LT] THEN
  MP_TAC(ISPECL [`(g:real^1->real^N) t`; `(h:real^1->real^N) t`]
      DIST_IN_CLOSED_SEGMENT) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
  REWRITE_TAC[segment; FORALL_IN_GSPEC;
              ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
  ASM_MESON_TAC[]);;

let HOMOTOPIC_NEARBY_PATHS,HOMOTOPIC_NEARBY_LOOPS = (CONJ_PAIR o prove)
 (`(!g s:real^N->bool.
        path g /\ open s /\ path_image g SUBSET s
        ==> ?e. &0 < e /\
                !h. path h /\
                    pathstart h = pathstart g /\
                    pathfinish h = pathfinish g /\
                    (!t. t IN interval[vec 0,vec 1] ==> norm(h t - g t) < e)
                    ==> homotopic_paths s g h) /\
   (!g s:real^N->bool.
        path g /\ pathfinish g = pathstart g /\ open s /\ path_image g SUBSET s
        ==> ?e. &0 < e /\
                !h. path h /\
                    pathfinish h = pathstart h /\
                    (!t. t IN interval[vec 0,vec 1] ==> norm(h t - g t) < e)
                    ==> homotopic_loops s g h)`,
  CONJ_TAC THEN
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`path_image g:real^N->bool`; `(:real^N) DIFF s`]
        SEPARATE_COMPACT_CLOSED) THEN
  ASM_SIMP_TAC[COMPACT_PATH_IMAGE; GSYM OPEN_CLOSED] THEN
  (ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_DIFF; IN_UNIV; dist]]) THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN
  REWRITE_TAC[REAL_NOT_LE] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THENL
   [MATCH_MP_TAC HOMOTOPIC_PATHS_NEARBY_EXPLICIT;
    MATCH_MP_TAC HOMOTOPIC_LOOPS_NEARBY_EXPLICIT] THEN
  ASM_REWRITE_TAC[] THEN
  MAP_EVERY X_GEN_TAC [`t:real^1`; `x:real^N`] THEN STRIP_TAC THEN
  MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `e:real` THEN
  ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
  ASM_REWRITE_TAC[path_image] THEN ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Homotopy of non-antipodal sphere maps.                                    *)
(* ------------------------------------------------------------------------- *)

let HOMOTOPIC_NON_MIDPOINT_SPHEREMAPS = prove
 (`!f g:real^M->real^N s a r.
        f continuous_on s /\ IMAGE f s SUBSET sphere(a,r) /\
        g continuous_on s /\ IMAGE g s SUBSET sphere(a,r) /\
        (!x. x IN s ==> ~(midpoint(f x,g x) = a))
    ==> homotopic_with (\x. T)
         (subtopology euclidean s,subtopology euclidean (sphere(a,r))) f g`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `r <= &0` THENL
   [REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN
    REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
    REPEAT(EXISTS_TAC `g:real^M->real^N`) THEN
    ASM_REWRITE_TAC[HOMOTOPIC_WITH_REFL; CONTINUOUS_MAP_EUCLIDEAN2] THEN
    SUBGOAL_THEN `?c:real^N. sphere(a,r) SUBSET {c}` MP_TAC THENL
     [ALL_TAC; ASM SET_TAC[]] THEN
    ASM_CASES_TAC `r = &0` THEN
    ASM_SIMP_TAC[SPHERE_SING; SPHERE_EMPTY; REAL_LT_LE] THEN
    MESON_TAC[SUBSET_REFL; EMPTY_SUBSET];
    RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN STRIP_TAC] THEN
  SUBGOAL_THEN
   `homotopic_with (\z. T)
     (subtopology euclidean (s:real^M->bool),
      subtopology euclidean ((:real^N) DELETE a)) f g`
  MP_TAC THENL
   [MATCH_MP_TAC HOMOTOPIC_WITH_LINEAR THEN
    ASM_REWRITE_TAC[SET_RULE `s SUBSET UNIV DELETE a <=> ~(a IN s)`] THEN
    X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET])) THEN
    REWRITE_TAC[FORALL_IN_IMAGE; IN_SPHERE; IMP_IMP] THEN
    REWRITE_TAC[AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
    FIRST_X_ASSUM(MP_TAC o GSYM o SPEC `x:real^M`) THEN
    ASM_REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; MIDPOINT_BETWEEN] THEN
    MESON_TAC[DIST_SYM];
    ALL_TAC] THEN
  DISCH_THEN(MP_TAC o
    ISPECL [`\y:real^N. a + r / norm(y - a) % (y - a)`;
            `sphere(a:real^N,r)`] o
    MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
    HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN
  REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL
   [CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
      MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
      SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
      REWRITE_TAC[real_div; o_DEF; LIFT_CMUL] THEN
      MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
      MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
      SIMP_TAC[IN_DELETE; NORM_EQ_0; VECTOR_SUB_EQ] THEN
      MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN
      SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID];
      SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; IN_DELETE; IN_SPHERE] THEN
      REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + b) = norm b`] THEN
      SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
      ASM_SIMP_TAC[real_abs; REAL_LE_RMUL; REAL_DIV_RMUL;
                   NORM_EQ_0; VECTOR_SUB_EQ; REAL_LT_IMP_LE]];
      MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN
      REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; IN_SPHERE]) THEN
      ASM_SIMP_TAC[NORM_ARITH `norm(a - b:real^N) = dist(b,a)`] THEN
      ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ] THEN REPEAT STRIP_TAC THEN
      VECTOR_ARITH_TAC]);;

let HOMOTOPIC_NON_ANTIPODAL_SPHEREMAPS = prove
 (`!f g:real^M->real^N s r.
        f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0,r) /\
        g continuous_on s /\ IMAGE g s SUBSET sphere(vec 0,r) /\
        (!x. x IN s ==> ~(f x = --g x))
    ==> homotopic_with (\x. T)
         (subtopology euclidean s,subtopology euclidean (sphere(vec 0,r))) f g`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_NON_MIDPOINT_SPHEREMAPS THEN
  ASM_REWRITE_TAC[midpoint; VECTOR_ARITH
   `inv(&2) % (a + b):real^N = vec 0 <=> a = --b`]);;

(* ------------------------------------------------------------------------- *)
(* Retracts, in a general sense, preserve (co)homotopic triviality.          *)
(* ------------------------------------------------------------------------- *)

let HOMOTOPICALLY_TRIVIAL_RETRACTION_GEN = prove
 (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k.
        (h continuous_on s /\ IMAGE h s = t /\
         k continuous_on t /\ IMAGE k t SUBSET s /\
         (!y. y IN t ==> h(k y) = y) /\
         (!f. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f ==> P(k o f)) /\
         (!f. f continuous_on u /\ IMAGE f u SUBSET s /\ P f ==> Q(h o f)) /\
         (!h k. (!x. x IN u ==> h x = k x) ==> (Q h <=> Q k))) /\
        (!f g. f continuous_on u /\ IMAGE f u SUBSET s /\ P f /\
               g continuous_on u /\ IMAGE g u SUBSET s /\ P g
               ==> homotopic_with P
                    (subtopology euclidean u,subtopology euclidean s)  f g)
        ==> (!f g. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f /\
                   g continuous_on u /\ IMAGE g u SUBSET t /\ Q g
                   ==> homotopic_with Q
                        (subtopology euclidean u,subtopology euclidean t) f g)`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  MAP_EVERY X_GEN_TAC [`p:real^P->real^N`; `q:real^P->real^N`] THEN
  STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
   [`(k:real^N->real^M) o (p:real^P->real^N)`;
    `(k:real^N->real^M) o (q:real^P->real^N)`]) THEN
  ANTS_TAC THENL
   [ASM_SIMP_TAC[IMAGE_o] THEN REPEAT CONJ_TAC THEN
    TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN
    TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET))) THEN
    ASM SET_TAC[];
    DISCH_TAC] THEN
  MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  MAP_EVERY EXISTS_TAC
   [`(h:real^M->real^N) o (k:real^N->real^M) o (p:real^P->real^N)`;
    `(h:real^M->real^N) o (k:real^N->real^M) o (q:real^P->real^N)`] THEN
  ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
  EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        HOMOTOPIC_WITH_MONO)) THEN
  ASM_SIMP_TAC[]);;

let HOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN = prove
 (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k.
        (h continuous_on s /\ IMAGE h s = t /\
         k continuous_on t /\ IMAGE k t SUBSET s /\
         (!y. y IN t ==> h(k y) = y) /\
         (!f. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f ==> P(k o f)) /\
         (!f. f continuous_on u /\ IMAGE f u SUBSET s /\ P f ==> Q(h o f)) /\
         (!h k. (!x. x IN u ==> h x = k x) ==> (Q h <=> Q k))) /\
        (!f. f continuous_on u /\ IMAGE f u SUBSET s /\ P f
             ==> ?c. homotopic_with P
                      (subtopology euclidean u,subtopology euclidean s)
                      f (\x. c))
        ==> (!f. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f
                 ==> ?c. homotopic_with Q
                          (subtopology euclidean u,subtopology euclidean t)
                          f (\x. c))`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `p:real^P->real^N` THEN
  STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC
    `(k:real^N->real^M) o (p:real^P->real^N)`) THEN
  ANTS_TAC THENL
   [ASM_SIMP_TAC[IMAGE_o] THEN CONJ_TAC THEN
    TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN
    TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET))) THEN
    ASM SET_TAC[];
    DISCH_THEN(X_CHOOSE_TAC `c:real^M`)] THEN
  EXISTS_TAC `(h:real^M->real^N) c` THEN
  MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  MAP_EVERY EXISTS_TAC
   [`(h:real^M->real^N) o (k:real^N->real^M) o (p:real^P->real^N)`;
    `(h:real^M->real^N) o ((\x. c):real^P->real^M)`] THEN
  ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
  EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        HOMOTOPIC_WITH_MONO)) THEN
  ASM_SIMP_TAC[]);;

let COHOMOTOPICALLY_TRIVIAL_RETRACTION_GEN = prove
 (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k.
        (h continuous_on s /\ IMAGE h s = t /\
         k continuous_on t /\ IMAGE k t SUBSET s /\
         (!y. y IN t ==> h(k y) = y) /\
         (!f. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f ==> P(f o h)) /\
         (!f. f continuous_on s /\ IMAGE f s SUBSET u /\ P f ==> Q(f o k)) /\
         (!h k. (!x. x IN t ==> h x = k x) ==> (Q h <=> Q k))) /\
        (!f g. f continuous_on s /\ IMAGE f s SUBSET u /\ P f /\
               g continuous_on s /\ IMAGE g s SUBSET u /\ P g
               ==> homotopic_with P
                    (subtopology euclidean s,
                     subtopology euclidean u) f g)
        ==> (!f g. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f /\
                   g continuous_on t /\ IMAGE g t SUBSET u /\ Q g
                   ==> homotopic_with Q
                       (subtopology euclidean t,subtopology euclidean u) f g)`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  MAP_EVERY X_GEN_TAC [`p:real^N->real^P`; `q:real^N->real^P`] THEN
  STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
   [`(p:real^N->real^P) o (h:real^M->real^N)`;
    `(q:real^N->real^P) o (h:real^M->real^N)`]) THEN
  ANTS_TAC THENL
   [ASM_SIMP_TAC[IMAGE_o] THEN REPEAT CONJ_TAC THEN
    TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN
    TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET))) THEN
    ASM SET_TAC[];
    DISCH_TAC] THEN
  MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  MAP_EVERY EXISTS_TAC
   [`((p:real^N->real^P) o (h:real^M->real^N)) o (k:real^N->real^M)`;
    `((q:real^N->real^P) o (h:real^M->real^N)) o (k:real^N->real^M)`] THEN
  ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
  EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        HOMOTOPIC_WITH_MONO)) THEN
  ASM_SIMP_TAC[]);;

let COHOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN = prove
 (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k.
        (h continuous_on s /\ IMAGE h s = t /\
         k continuous_on t /\ IMAGE k t SUBSET s /\
         (!y. y IN t ==> h(k y) = y) /\
         (!f. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f ==> P(f o h)) /\
         (!f. f continuous_on s /\ IMAGE f s SUBSET u /\ P f ==> Q(f o k)) /\
         (!h k. (!x. x IN t ==> h x = k x) ==> (Q h <=> Q k))) /\
        (!f. f continuous_on s /\ IMAGE f s SUBSET u /\ P f
             ==> ?c. homotopic_with P
                      (subtopology euclidean s,subtopology euclidean u)
                      f (\x. c))
        ==> (!f. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f
                 ==> ?c. homotopic_with Q
                           (subtopology euclidean t,subtopology euclidean u)
                           f (\x. c))`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `p:real^N->real^P` THEN
  STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC
    `(p:real^N->real^P) o (h:real^M->real^N)`) THEN
  ANTS_TAC THENL
   [ASM_SIMP_TAC[IMAGE_o] THEN
    TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN
    TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET))) THEN
    ASM SET_TAC[];
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^P` THEN DISCH_TAC] THEN
  MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  MAP_EVERY EXISTS_TAC
   [`((p:real^N->real^P) o (h:real^M->real^N)) o (k:real^N->real^M)`;
    `((\x. c):real^M->real^P) o (k:real^N->real^M)`] THEN
  ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
  EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        HOMOTOPIC_WITH_MONO)) THEN
  ASM_SIMP_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Another useful lemma.                                                     *)
(* ------------------------------------------------------------------------- *)

let HOMOTOPIC_JOIN_SUBPATHS = prove
 (`!g:real^1->real^N s.
       path g /\ path_image g SUBSET s /\
       u IN interval[vec 0,vec 1] /\
       v IN interval[vec 0,vec 1] /\
       w IN interval[vec 0,vec 1]
       ==> homotopic_paths s (subpath u v g ++ subpath v w g) (subpath u w g)`,
  let lemma1 = prove
   (`!g:real^1->real^N s.
         drop u <= drop v /\ drop v <= drop w
         ==> path g /\ path_image g SUBSET s /\
             u IN interval[vec 0,vec 1] /\
             v IN interval[vec 0,vec 1] /\
             w IN interval[vec 0,vec 1] /\
             drop u <= drop v /\ drop v <= drop w
             ==> homotopic_paths s
                 (subpath u v g ++ subpath v w g) (subpath u w g)`,
    REPEAT STRIP_TAC THEN
    MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN
    EXISTS_TAC `path_image g:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
    ASM_CASES_TAC `w:real^1 = u` THENL
     [MP_TAC(ISPECL
      [`path_image g:real^N->bool`;
       `subpath u v (g:real^1->real^N)`] HOMOTOPIC_PATHS_RINV) THEN
      ASM_REWRITE_TAC[REVERSEPATH_SUBPATH; SUBPATH_REFL] THEN
      REWRITE_TAC[LINEPATH_REFL; PATHSTART_SUBPATH] THEN
      ASM_SIMP_TAC[PATH_SUBPATH; PATH_IMAGE_SUBPATH_SUBSET];
      ALL_TAC] THEN
    ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
    MATCH_MP_TAC HOMOTOPIC_PATHS_REPARAMETRIZE THEN
    ASM_SIMP_TAC[PATH_SUBPATH; PATH_IMAGE_SUBPATH_SUBSET] THEN
    EXISTS_TAC
    `\t. if drop t <= &1 / &2
         then inv(drop(w - u)) % (&2 * drop(v - u)) % t
         else inv(drop(w - u)) %
              ((v - u) + drop(w - v) % (&2 % t - vec 1))` THEN
    REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
    REWRITE_TAC[VECTOR_MUL_RZERO] THEN REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_CASES_1 THEN
      REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; LIFT_DROP; GSYM LIFT_NUM;
                  DROP_ADD; DROP_SUB] THEN
      (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5)
        [CONTINUOUS_ON_MUL; o_DEF; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID;
         CONTINUOUS_ON_SUB; CONTINUOUS_ON_ADD] THEN
      REPEAT STRIP_TAC THEN REAL_ARITH_TAC;
      SUBGOAL_THEN `drop u < drop w` ASSUME_TAC THENL
       [ASM_SIMP_TAC[REAL_LT_LE; DROP_EQ] THEN ASM_REAL_ARITH_TAC;
        ALL_TAC] THEN
      REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
      X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN COND_CASES_TAC THEN
      REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC; DROP_ADD; DROP_SUB] THEN
      ONCE_REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
      ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN
      REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
      (CONJ_TAC THENL
        [REPEAT(MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC) THEN
         REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN
         ASM_REAL_ARITH_TAC;
         ALL_TAC]) THEN
      REWRITE_TAC[REAL_ARITH `v - u + x * t <= w - u <=> x * t <= w - v`;
                  REAL_ARITH `(&2 * x) * t = x * &2 * t`] THEN
      MATCH_MP_TAC(REAL_ARITH `a * t <= a * &1 /\ a <= b ==> a * t <= b`) THEN
      (CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL; ALL_TAC]) THEN
      ASM_REAL_ARITH_TAC;
      REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; DROP_ADD; DROP_CMUL; DROP_SUB] THEN
      CONV_TAC REAL_RAT_REDUCE_CONV THEN
      REWRITE_TAC[REAL_ARITH `(v - u) + (w - v) * &1 = w - u`] THEN
      ASM_SIMP_TAC[REAL_SUB_0; DROP_EQ; REAL_MUL_LINV];
      X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
      REWRITE_TAC[subpath; joinpaths] THEN COND_CASES_TAC THEN
      ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_ASSOC] THEN
      ASM_SIMP_TAC[REAL_MUL_RINV; DROP_EQ_0; VECTOR_SUB_EQ] THEN
      AP_TERM_TAC THEN
      REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; DROP_ADD; DROP_CMUL; DROP_SUB] THEN
      REAL_ARITH_TAC]) in
  let lemma2 = prove
   (`path g /\ path_image g SUBSET s /\
     u IN interval[vec 0,vec 1] /\
     v IN interval[vec 0,vec 1] /\
     w IN interval[vec 0,vec 1] /\
     homotopic_paths s (subpath u v g ++ subpath v w g) (subpath u w g)
     ==> homotopic_paths s (subpath w v g ++ subpath v u g) (subpath w u g)`,
    REPEAT STRIP_TAC THEN
    ONCE_REWRITE_TAC[GSYM HOMOTOPIC_PATHS_REVERSEPATH] THEN
    SIMP_TAC[REVERSEPATH_JOINPATHS; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
    ASM_REWRITE_TAC[REVERSEPATH_SUBPATH]) in
  let lemma3 = prove
   (`path (g:real^1->real^N) /\ path_image g SUBSET s /\
     u IN interval[vec 0,vec 1] /\
     v IN interval[vec 0,vec 1] /\
     w IN interval[vec 0,vec 1] /\
     homotopic_paths s (subpath u v g ++ subpath v w g) (subpath u w g)
     ==> homotopic_paths s (subpath v w g ++ subpath w u g) (subpath v u g)`,
    let tac =
      ASM_MESON_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH; PATH_SUBPATH;
                 HOMOTOPIC_PATHS_REFL; PATH_IMAGE_SUBPATH_SUBSET; SUBSET_TRANS;
                 PATHSTART_JOIN; PATHFINISH_JOIN] in
    REPEAT STRIP_TAC THEN
    ONCE_REWRITE_TAC[GSYM HOMOTOPIC_PATHS_REVERSEPATH] THEN
    SIMP_TAC[REVERSEPATH_JOINPATHS; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
    ASM_REWRITE_TAC[REVERSEPATH_SUBPATH] THEN
    MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
    EXISTS_TAC
     `(subpath u v g ++ subpath v w g) ++ subpath w v g:real^1->real^N` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
      ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
      ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN tac;
      ALL_TAC] THEN
    MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
    EXISTS_TAC
     `subpath u v g ++ (subpath v w g ++ subpath w v g):real^1->real^N` THEN
    CONJ_TAC THENL
     [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
      MATCH_MP_TAC HOMOTOPIC_PATHS_ASSOC THEN tac;
      ALL_TAC] THEN
    MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
    EXISTS_TAC
     `(subpath u v g :real^1->real^N) ++
      linepath(pathfinish(subpath u v g),pathfinish(subpath u v g))` THEN
    CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HOMOTOPIC_PATHS_RID THEN tac] THEN
    MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
    REPEAT CONJ_TAC THENL [tac; ALL_TAC; tac] THEN
    MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
    EXISTS_TAC
     `linepath(pathstart(subpath v w g):real^N,pathstart(subpath v w g))` THEN
    CONJ_TAC THENL
     [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REVERSEPATH_SUBPATH] THEN
      MATCH_MP_TAC HOMOTOPIC_PATHS_RINV THEN tac;
      ALL_TAC] THEN
    REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH; HOMOTOPIC_PATHS_REFL;
                PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL;
                INSERT_SUBSET; EMPTY_SUBSET] THEN
    ASM_MESON_TAC[path_image; IN_IMAGE; SUBSET]) in
  REPEAT STRIP_TAC THEN
  REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
     (REAL_ARITH `(drop u <= drop v /\ drop v <= drop w \/
                   drop w <= drop v /\ drop v <= drop u) \/
                  (drop u <= drop w /\ drop w <= drop v \/
                   drop v <= drop w /\ drop w <= drop u) \/
                  (drop v <= drop u /\ drop u <= drop w \/
                   drop w <= drop u /\ drop u <= drop v)`) THEN
  FIRST_ASSUM(MP_TAC o SPECL [`g:real^1->real^N`; `s:real^N->bool`] o
    MATCH_MP lemma1) THEN
  ASM_MESON_TAC[lemma2; lemma3]);;

let HOMOTOPIC_LOOPS_SHIFTPATH = prove
 (`!s:real^N->bool p q u.
        homotopic_loops s p q /\ u IN interval[vec 0,vec 1]
        ==> homotopic_loops s (shiftpath u p) (shiftpath u q)`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_EUCLIDEAN; PCROSS] THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN(
   (X_CHOOSE_THEN `h:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC)) THEN
  EXISTS_TAC
   `\z. shiftpath u (\t. (h:real^(1,1)finite_sum->real^N)
                         (pastecart (fstcart z) t)) (sndcart z)` THEN
  ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; ETA_AX] THEN
  ASM_SIMP_TAC[CLOSED_SHIFTPATH] THEN CONJ_TAC THENL
   [REWRITE_TAC[shiftpath; DROP_ADD; REAL_ARITH
     `u + z <= &1 <=> z <= &1 - u`] THEN
    SUBGOAL_THEN
     `{ pastecart (t:real^1) (x:real^1) |
        t IN interval[vec 0,vec 1] /\ x IN interval[vec 0,vec 1]} =
      { pastecart (t:real^1) (x:real^1) |
        t IN interval[vec 0,vec 1] /\ x IN interval[vec 0,vec 1 - u]} UNION
      { pastecart (t:real^1) (x:real^1) |
        t IN interval[vec 0,vec 1] /\ x IN interval[vec 1 - u,vec 1]}`
    SUBST1_TAC THENL
     [MATCH_MP_TAC(SET_RULE `s UNION s' = u
        ==> {f t x | t IN i /\ x IN u} =
            {f t x | t IN i /\ x IN s} UNION
            {f t x | t IN i /\ x IN s'}`) THEN
      UNDISCH_TAC `(u:real^1) IN interval[vec 0,vec 1]` THEN
      REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_UNION; DROP_SUB; DROP_VEC] THEN
      REAL_ARITH_TAC;
      ALL_TAC] THEN
    MATCH_MP_TAC CONTINUOUS_ON_CASES THEN
    SIMP_TAC[REWRITE_RULE[PCROSS] CLOSED_PCROSS; CLOSED_INTERVAL] THEN
    REWRITE_TAC[FORALL_AND_THM; FORALL_IN_GSPEC; TAUT
     `p /\ q \/ r /\ s ==> t <=> (p ==> q ==> t) /\ (r ==> s ==> t)`] THEN
    SIMP_TAC[SNDCART_PASTECART; IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN
    SIMP_TAC[REAL_ARITH `&1 - u <= x ==> (x <= &1 - u <=> x = &1 - u)`] THEN
    SIMP_TAC[GSYM LIFT_EQ; LIFT_SUB; LIFT_DROP; LIFT_NUM] THEN
    REWRITE_TAC[FSTCART_PASTECART; VECTOR_ARITH `u + v - u:real^N = v`;
                VECTOR_ARITH `u + v - u - v:real^N = vec 0`] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN
    ASM_SIMP_TAC[GSYM IN_INTERVAL_1; GSYM DROP_VEC] THEN CONJ_TAC THEN
    GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST;
             LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART;
             VECTOR_ARITH `u + z - v:real^N = (u - v) + z`] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
      CONTINUOUS_ON_SUBSET)) THEN
    UNDISCH_TAC `(u:real^1) IN interval[vec 0,vec 1]` THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
    REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1;
                IN_ELIM_PASTECART_THM; DROP_ADD; DROP_SUB; DROP_VEC] THEN
    REAL_ARITH_TAC;
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
    REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SET_RULE
     `(!t x. t IN i /\ x IN i ==> f t x IN s) <=>
      (!t. t IN i ==> IMAGE (f t) i SUBSET s)`] THEN
    X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN REWRITE_TAC[GSYM path_image] THEN
    ASM_SIMP_TAC[PATH_IMAGE_SHIFTPATH; ETA_AX] THEN
    REWRITE_TAC[path_image] THEN ASM SET_TAC[]]);;

let HOMOTOPIC_PATHS_LOOP_PARTS = prove
 (`!s p q a:real^N.
        homotopic_loops s (p ++ reversepath q) (linepath(a,a)) /\ path q
        ==> homotopic_paths s p q`,
  REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o
    MATCH_MP HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL) THEN
  REWRITE_TAC[PATHSTART_JOIN] THEN STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o CONJUNCT1 o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN
  ASM_CASES_TAC `pathfinish p:real^N = pathstart(reversepath q)` THENL
   [ASM_SIMP_TAC[PATH_JOIN; PATH_REVERSEPATH] THEN STRIP_TAC;
    ASM_MESON_TAC[PATH_JOIN_PATH_ENDS; PATH_REVERSEPATH]] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[PATHSTART_REVERSEPATH]) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN
  ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN;
    PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; UNION_SUBSET; SING_SUBSET;
    PATH_IMAGE_REVERSEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
  STRIP_TAC THEN
  MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
  EXISTS_TAC `p ++ (linepath(pathfinish p:real^N,pathfinish p))` THEN
  CONJ_TAC THENL
   [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
    MATCH_MP_TAC HOMOTOPIC_PATHS_RID THEN ASM_REWRITE_TAC[];
    ALL_TAC] THEN
  MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
  EXISTS_TAC `p ++ (reversepath q ++ q):real^1->real^N` THEN CONJ_TAC THENL
   [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
    MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
    ASM_SIMP_TAC[HOMOTOPIC_PATHS_LINV; PATHSTART_JOIN; PATHSTART_REVERSEPATH;
                 HOMOTOPIC_PATHS_REFL];
    ALL_TAC] THEN
  MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
  EXISTS_TAC `(p ++ reversepath q) ++ q:real^1->real^N` THEN CONJ_TAC THENL
   [MATCH_MP_TAC HOMOTOPIC_PATHS_ASSOC THEN
    ASM_REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH;
                    PATH_IMAGE_REVERSEPATH; PATH_REVERSEPATH];
    ALL_TAC] THEN
  MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
  EXISTS_TAC `linepath(pathstart p:real^N,pathstart p) ++ q` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
    ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN
    REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_REVERSEPATH];
    FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN
    REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_LINEPATH;
                PATHFINISH_REVERSEPATH] THEN
    DISCH_THEN(SUBST1_TAC o SYM) THEN
    MATCH_MP_TAC HOMOTOPIC_PATHS_LID THEN ASM_REWRITE_TAC[]]);;

let HOMOTOPIC_LOOPS_ADD_SYM = prove
 (`!p q:real^1->real^N.
        path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p /\
        path q /\ path_image q SUBSET s /\ pathfinish q = pathstart q /\
        pathstart q = pathstart p
        ==> homotopic_loops s (p ++ q) (q ++ p)`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
  SUBGOAL_THEN `lift(&1 / &2) IN interval[vec 0,vec 1]` ASSUME_TAC THENL
   [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV;
    ALL_TAC] THEN
  EXISTS_TAC `shiftpath (lift(&1 / &2)) (p ++ q:real^1->real^N)` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC HOMOTOPIC_LOOPS_SHIFTPATH_SELF;
    MATCH_MP_TAC HOMOTOPIC_LOOPS_EQ] THEN
  ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN;
               UNION_SUBSET; IN_INTERVAL_1; DROP_VEC; LIFT_DROP;
               PATH_SHIFTPATH; PATH_IMAGE_SHIFTPATH; CLOSED_SHIFTPATH] THEN
  SIMP_TAC[shiftpath; joinpaths; LIFT_DROP; DROP_ADD; DROP_SUB; DROP_VEC;
           REAL_ARITH `&0 <= t ==> (a + t <= a <=> t = &0)`;
           REAL_ARITH `t <= &1 ==> &1 / &2 + t - &1 <= &1 / &2`;
           REAL_ARITH `&1 / &2 + t <= &1 <=> t <= &1 / &2`] THEN
  X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN
  ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_REWRITE_TAC[] THENL
   [REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_RID] THENL
     [REWRITE_TAC[GSYM LIFT_CMUL; VECTOR_MUL_RZERO] THEN
      CONV_TAC REAL_RAT_REDUCE_CONV THEN
      ASM_MESON_TAC[LIFT_NUM; pathstart; pathfinish];
      ALL_TAC];
    ALL_TAC] THEN
  AP_TERM_TAC THEN
  REWRITE_TAC[GSYM DROP_EQ; DROP_SUB; DROP_ADD; DROP_VEC; DROP_CMUL;
              LIFT_DROP] THEN REAL_ARITH_TAC);;

(* ------------------------------------------------------------------------- *)
(* Simply connected sets defined as "all loops are homotopic (as loops)".    *)
(* ------------------------------------------------------------------------- *)

let simply_connected = new_definition
 `simply_connected(s:real^N->bool) <=>
        !p q. path p /\ pathfinish p = pathstart p /\ path_image p SUBSET s /\
              path q /\ pathfinish q = pathstart q /\ path_image q SUBSET s
              ==> homotopic_loops s p q`;;

let SIMPLY_CONNECTED_EMPTY = prove
 (`simply_connected {}`,
  REWRITE_TAC[simply_connected; SUBSET_EMPTY] THEN
  MESON_TAC[PATH_IMAGE_NONEMPTY]);;

let SIMPLY_CONNECTED_IMP_PATH_CONNECTED = prove
 (`!s:real^N->bool. simply_connected s ==> path_connected s`,
  REWRITE_TAC[simply_connected; PATH_CONNECTED_EQ_HOMOTOPIC_POINTS] THEN
  REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
  ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH;
                  PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
  ASM SET_TAC[]);;

let SIMPLY_CONNECTED_IMP_CONNECTED = prove
 (`!s:real^N->bool. simply_connected s ==> connected s`,
  SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED;
           PATH_CONNECTED_IMP_CONNECTED]);;

let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY = prove
 (`!s:real^N->bool.
        simply_connected s <=>
        !p a. path p /\ path_image p SUBSET s /\
              pathfinish p = pathstart p /\ a IN s
              ==> homotopic_loops s p (linepath(a,a))`,
  GEN_TAC THEN REWRITE_TAC[simply_connected] THEN EQ_TAC THEN DISCH_TAC THENL
   [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    ASM_SIMP_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
    ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET];
    MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `q:real^1->real^N`] THEN
    STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
    EXISTS_TAC `linepath(pathstart p:real^N,pathstart p)` THEN
    CONJ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[HOMOTOPIC_LOOPS_SYM]] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
    ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]]);;

let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_SOME = prove
 (`!s:real^N->bool.
        simply_connected s <=>
        path_connected s /\
        !p. path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p
            ==> ?a. a IN s /\ homotopic_loops s p (linepath(a,a))`,
  GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
  ASM_SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED] THENL
   [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
     [SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN
    MESON_TAC[SUBSET; PATHSTART_IN_PATH_IMAGE];
    REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN
    MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `a:real^N`] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `p:real^1->real^N`) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN
    STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
    EXISTS_TAC `linepath(b:real^N,b)` THEN
    ASM_REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN
    ASM_MESON_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT]]);;

let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ALL = prove
 (`!s:real^N->bool.
        simply_connected s <=>
        s = {} \/
        ?a. a IN s /\
            !p. path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p
                ==> homotopic_loops s p (linepath(a,a))`,
  GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[SIMPLY_CONNECTED_EMPTY] THEN
  REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_SOME] THEN
  EQ_TAC THENL
   [STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN
    ASM_REWRITE_TAC[] THEN X_GEN_TAC `p:real^1->real^N` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `p:real^1->real^N`) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN
    STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
    EXISTS_TAC `linepath(b:real^N,b)` THEN
    ASM_REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN
    ASM_MESON_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT];
    DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
    CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
    REWRITE_TAC[PATH_CONNECTED_EQ_HOMOTOPIC_POINTS] THEN
    MAP_EVERY X_GEN_TAC [`b:real^N`; `c:real^N`] THEN STRIP_TAC THEN
    MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
    EXISTS_TAC `linepath(a:real^N,a)` THEN
    GEN_REWRITE_TAC RAND_CONV [HOMOTOPIC_LOOPS_SYM] THEN
    CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL;
                PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
    ASM SET_TAC[]]);;

let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH = prove
 (`!s:real^N->bool.
        simply_connected s <=>
        path_connected s /\
        !p. path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p
            ==> homotopic_paths s p (linepath(pathstart p,pathstart p))`,
  GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL
   [ASM_SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED] THEN
    REPEAT STRIP_TAC THEN
    MATCH_MP_TAC HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL THEN
    EXISTS_TAC `pathstart p :real^N` THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o
      REWRITE_RULE[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN
    ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET];
    REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN
    MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `a:real^N`] THEN
    STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN
    EXISTS_TAC `linepath(pathstart p:real^N,pathfinish p)` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS THEN
      ASM_SIMP_TAC[PATHFINISH_LINEPATH];
      ASM_REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]) THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN
      ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]]]);;

let SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS = prove
 (`!s:real^N->bool.
        simply_connected s <=>
        path_connected s /\
        !p q. path p /\ path_image p SUBSET s /\
              path q /\ path_image q SUBSET s /\
              pathstart q = pathstart p /\ pathfinish q = pathfinish p
              ==> homotopic_paths s p q`,
  REPEAT GEN_TAC THEN REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH] THEN
  EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  X_GEN_TAC `p:real^1->real^N` THENL
   [X_GEN_TAC `q:real^1->real^N` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `p ++ reversepath q :real^1->real^N`) THEN
    ASM_SIMP_TAC[PATH_JOIN; PATHSTART_REVERSEPATH; PATH_REVERSEPATH;
                 PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH;
                 PATH_IMAGE_JOIN; UNION_SUBSET; PATH_IMAGE_REVERSEPATH] THEN
    DISCH_TAC THEN
    MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
    EXISTS_TAC `p ++ linepath(pathfinish p,pathfinish p):real^1->real^N` THEN
    GEN_REWRITE_TAC LAND_CONV [HOMOTOPIC_PATHS_SYM] THEN
    ASM_SIMP_TAC[HOMOTOPIC_PATHS_RID] THEN
    MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
    EXISTS_TAC `p ++ (reversepath q ++ q):real^1->real^N` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
      ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL; PATHSTART_LINEPATH] THEN
      ASM_MESON_TAC[HOMOTOPIC_PATHS_LINV; HOMOTOPIC_PATHS_SYM];
      ALL_TAC] THEN
    MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
    EXISTS_TAC `(p ++ reversepath q) ++ q:real^1->real^N` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC HOMOTOPIC_PATHS_ASSOC THEN
      ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH] THEN
      ASM_REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH];
      ALL_TAC] THEN
    MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
    EXISTS_TAC `linepath(pathstart q,pathstart q) ++ q:real^1->real^N` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
      ASM_SIMP_TAC[HOMOTOPIC_PATHS_RINV; HOMOTOPIC_PATHS_REFL] THEN
      ASM_REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_REVERSEPATH];
      ASM_MESON_TAC[HOMOTOPIC_PATHS_LID]];
    STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    ASM_SIMP_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_LINEPATH] THEN
    REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN
    ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]]);;

let SIMPLY_CONNECTED_RETRACTION_GEN = prove
 (`!s:real^M->bool t:real^N->bool h k.
        h continuous_on s /\ IMAGE h s = t /\
        k continuous_on t /\ IMAGE k t SUBSET s /\
        (!y. y IN t ==> h(k y) = y) /\
        simply_connected s
        ==> simply_connected t`,
  REPEAT GEN_TAC THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  REWRITE_TAC[simply_connected; path; path_image; homotopic_loops] THEN
  ONCE_REWRITE_TAC[TAUT
   `a /\ b /\ c /\ a' /\ b' /\ c' <=> a /\ c /\ b /\ a' /\ c' /\ b'`] THEN
  MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
    HOMOTOPICALLY_TRIVIAL_RETRACTION_GEN) THEN
  MAP_EVERY EXISTS_TAC [`h:real^M->real^N`; `k:real^N->real^M`] THEN
  ASM_SIMP_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN
  REWRITE_TAC[pathfinish; pathstart] THEN MESON_TAC[ENDS_IN_UNIT_INTERVAL]);;

let HOMEOMORPHIC_SIMPLY_CONNECTED = prove
 (`!s:real^M->bool t:real^N->bool.
        s homeomorphic t /\ simply_connected s
        ==> simply_connected t`,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
   (REWRITE_RULE[CONJ_ASSOC] SIMPLY_CONNECTED_RETRACTION_GEN)) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
  REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
  SIMP_TAC[homeomorphism; SUBSET_REFL]);;

let HOMEOMORPHIC_SIMPLY_CONNECTED_EQ = prove
 (`!s:real^M->bool t:real^N->bool.
        s homeomorphic t
        ==> (simply_connected s <=> simply_connected t)`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_SIMPLY_CONNECTED) THEN
  ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
  ASM_REWRITE_TAC[]);;

let SIMPLY_CONNECTED_TRANSLATION = prove
 (`!a:real^N s. simply_connected (IMAGE (\x. a + x) s) <=> simply_connected s`,
  REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_SIMPLY_CONNECTED_EQ THEN
  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
  REWRITE_TAC[HOMEOMORPHIC_TRANSLATION]);;

add_translation_invariants [SIMPLY_CONNECTED_TRANSLATION];;

let SIMPLY_CONNECTED_INJECTIVE_LINEAR_IMAGE = prove
 (`!f:real^M->real^N s.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (simply_connected (IMAGE f s) <=> simply_connected s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_SIMPLY_CONNECTED_EQ THEN
  ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ;
                HOMEOMORPHIC_REFL]);;

add_linear_invariants [SIMPLY_CONNECTED_INJECTIVE_LINEAR_IMAGE];;

let HOMEOMORPHISM_SIMPLE_CONNECTEDNESS = prove
 (`!f:real^M->real^N g s t k.
        homeomorphism (s,t) (f,g) /\ k SUBSET s
        ==> (simply_connected(IMAGE f k) <=> simply_connected k)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_SIMPLY_CONNECTED_EQ THEN
  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN
  MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
          HOMEOMORPHISM_OF_SUBSETS)) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);;

let SIMPLY_CONNECTED_PCROSS = prove
 (`!s:real^M->bool t:real^N->bool.
        simply_connected s /\ simply_connected t
        ==> simply_connected(s PCROSS t)`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN
  REWRITE_TAC[path; path_image; pathstart; pathfinish; FORALL_PASTECART] THEN
  DISCH_TAC THEN
  MAP_EVERY X_GEN_TAC
   [`p:real^1->real^(M,N)finite_sum`; `a:real^M`; `b:real^N`] THEN
  REWRITE_TAC[PASTECART_IN_PCROSS; FORALL_IN_IMAGE; SUBSET] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(CONJUNCTS_THEN2
   (MP_TAC o SPECL [`fstcart o (p:real^1->real^(M,N)finite_sum)`; `a:real^M`])
   (MP_TAC o SPECL [`sndcart o (p:real^1->real^(M,N)finite_sum)`;
                    `b:real^N`])) THEN
  ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_FSTCART; LINEAR_SNDCART;
               LINEAR_CONTINUOUS_ON; homotopic_loops; HOMOTOPIC_WITH_EUCLIDEAN;
               pathfinish; pathstart; IMAGE_o; o_THM] THEN
  ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN ANTS_TAC THENL
   [RULE_ASSUM_TAC(REWRITE_RULE[PCROSS; IN_ELIM_THM]) THEN
    ASM_MESON_TAC[SNDCART_PASTECART];
    DISCH_THEN(X_CHOOSE_THEN
      `k:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC)] THEN
  ANTS_TAC THENL
   [RULE_ASSUM_TAC(REWRITE_RULE[PCROSS; IN_ELIM_THM]) THEN
    ASM_MESON_TAC[FSTCART_PASTECART];
    DISCH_THEN(X_CHOOSE_THEN
      `h:real^(1,1)finite_sum->real^M` STRIP_ASSUME_TAC)] THEN
  EXISTS_TAC
   `(\z. pastecart (h z) (k z))
    :real^(1,1)finite_sum->real^(M,N)finite_sum` THEN
  ASM_SIMP_TAC[CONTINUOUS_ON_PASTECART; ETA_AX] THEN
  REWRITE_TAC[LINEPATH_REFL; PASTECART_FST_SND] THEN
  ASM_SIMP_TAC[PASTECART_IN_PCROSS]);;

let SIMPLY_CONNECTED_PCROSS_EQ = prove
 (`!s:real^M->bool t:real^N->bool.
        simply_connected(s PCROSS t) <=>
        s = {} \/ t = {} \/ simply_connected s /\ simply_connected t`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `s:real^M->bool = {}` THEN
  ASM_REWRITE_TAC[PCROSS_EMPTY; SIMPLY_CONNECTED_EMPTY] THEN
  ASM_CASES_TAC `t:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[PCROSS_EMPTY; SIMPLY_CONNECTED_EMPTY] THEN
  EQ_TAC THEN REWRITE_TAC[SIMPLY_CONNECTED_PCROSS] THEN REPEAT STRIP_TAC THENL
   [REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN
    MAP_EVERY X_GEN_TAC [`p:real^1->real^M`; `a:real^M`] THEN
    REWRITE_TAC[path; path_image; pathstart; pathfinish; SUBSET;
                FORALL_IN_IMAGE] THEN
    STRIP_TAC THEN UNDISCH_TAC `~(t:real^N->bool = {})` THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
    DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
     [SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN
    DISCH_THEN(MP_TAC o SPECL
     [`(\t. pastecart (p t) (b)):real^1->real^(M,N)finite_sum`;
      `pastecart (a:real^M) (b:real^N)`]) THEN
    ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN
    ASM_SIMP_TAC[path; path_image; pathstart; pathfinish; SUBSET;
                 FORALL_IN_IMAGE; PASTECART_IN_PCROSS; PASTECART_INJ;
                 CONTINUOUS_ON_PASTECART; ETA_AX; CONTINUOUS_ON_CONST] THEN
    STRIP_TAC THEN
    MP_TAC(ISPECL
     [`(\t. pastecart (p t) b):real^1->real^(M,N)finite_sum`;
      `linepath (pastecart (a:real^M) (b:real^N),pastecart a b)`;
      `fstcart:real^(M,N)finite_sum->real^M`;
      `(s:real^M->bool) PCROSS (t:real^N->bool)`; `s:real^M->bool`]
        HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE) THEN
    ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
    SIMP_TAC[o_DEF; LINEPATH_REFL; FSTCART_PASTECART; ETA_AX;
             SUBSET; FORALL_IN_PCROSS; FORALL_IN_IMAGE];
    REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN
    MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `b:real^N`] THEN
    REWRITE_TAC[path; path_image; pathstart; pathfinish; SUBSET;
                FORALL_IN_IMAGE] THEN
    STRIP_TAC THEN UNDISCH_TAC `~(s:real^M->bool = {})` THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
    DISCH_THEN(X_CHOOSE_THEN `a:real^M` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
     [SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN
    DISCH_THEN(MP_TAC o SPECL
     [`(\t. pastecart a (p t)):real^1->real^(M,N)finite_sum`;
      `pastecart (a:real^M) (b:real^N)`]) THEN
    ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN
    ASM_SIMP_TAC[path; path_image; pathstart; pathfinish; SUBSET;
                 FORALL_IN_IMAGE; PASTECART_IN_PCROSS; PASTECART_INJ;
                 CONTINUOUS_ON_PASTECART; ETA_AX; CONTINUOUS_ON_CONST] THEN
    STRIP_TAC THEN
    MP_TAC(ISPECL
     [`(\t. pastecart a (p t)):real^1->real^(M,N)finite_sum`;
      `linepath (pastecart (a:real^M) (b:real^N),pastecart a b)`;
      `sndcart:real^(M,N)finite_sum->real^N`;
      `(s:real^M->bool) PCROSS (t:real^N->bool)`; `t:real^N->bool`]
        HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE) THEN
    ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
    SIMP_TAC[o_DEF; LINEPATH_REFL; SNDCART_PASTECART; ETA_AX;
             SUBSET; FORALL_IN_PCROSS; FORALL_IN_IMAGE]]);;

let SIMPLY_CONNECTED_NESTED_UNIONS = prove
 (`!f:(real^N->bool)->bool.
        (!s. s IN f ==> open s /\ simply_connected s) /\
        (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s)
        ==> simply_connected(UNIONS f)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[simply_connected] THEN
  MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `q:real^1->real^N`] THEN

  STRIP_TAC THEN
  MP_TAC(ISPEC
   `IMAGE (\u:real^N->bool. (path_image p UNION path_image q) DIFF u) f`
   COMPACT_CHAIN) THEN
  REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_IMAGE_2] THEN
  MATCH_MP_TAC(TAUT `q /\ r /\ (~p ==> s) ==> (p /\ q ==> ~r) ==> s`) THEN
  REPEAT CONJ_TAC THENL
   [ASM SET_TAC[];
    MP_TAC(ISPEC `p:real^1->real^N` PATH_IMAGE_NONEMPTY) THEN
    REWRITE_TAC[INTERS_IMAGE] THEN ASM SET_TAC[];
    REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM]] THEN
  X_GEN_TAC `s:real^N->bool` THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`)) THEN
  ASM_REWRITE_TAC[] THEN REPLICATE_TAC 2 STRIP_TAC THEN
  FIRST_X_ASSUM(K ALL_TAC o check (is_forall o concl)) THEN
  ASM_SIMP_TAC[COMPACT_DIFF; COMPACT_UNION; COMPACT_PATH_IMAGE] THEN
  REWRITE_TAC[SET_RULE
   `(s UNION t) DIFF u = {} <=> s SUBSET u /\ t SUBSET u`] THEN
  STRIP_TAC THEN
  MATCH_MP_TAC HOMOTOPIC_LOOPS_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN
  CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[simply_connected]) THEN
  ASM_REWRITE_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* The (carrier of) the fundamental group: homotopy classes of loops at a.   *)
(* ------------------------------------------------------------------------- *)

let fundamental_group = new_definition
 `fundamental_group(s,a:real^N) =
    { homotopic_paths s p | p |  path p /\ path_image p SUBSET s /\
                                 pathstart p = a /\ pathfinish p = a}`;;

let FUNDAMENTAL_GROUP_EQ_EMPTY = prove
 (`!s a:real^N. fundamental_group (s,a) = {} <=> ~(a IN s)`,
  REPEAT GEN_TAC THEN
  ONCE_REWRITE_TAC[SET_RULE `s = {} <=> !x. x IN s ==> F`] THEN
  PURE_REWRITE_TAC[fundamental_group; FORALL_IN_GSPEC] THEN
  EQ_TAC THENL [ALL_TAC; MESON_TAC[SUBSET; PATHSTART_IN_PATH_IMAGE]] THEN
  DISCH_THEN(MP_TAC o SPEC `linepath(a:real^N,a)`) THEN
  REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
  REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
  SET_TAC[]);;

let CARD_EQ_FUNDAMENTAL_GROUPS_BASEPOINTS = prove
 (`!s a b:real^N.
        path_connected s /\ a IN s /\ b IN s
        ==> fundamental_group(s,a) =_c fundamental_group(s,b)`,
  let lemma = prove
   (`!g:real^1->real^N.
        path g /\ path_image g SUBSET s
        ==> homotopic_paths s g ((@) (homotopic_paths s g)) /\
            path ((@) (homotopic_paths s g)) /\
            path_image ((@) (homotopic_paths s g)) SUBSET s /\
            pathstart ((@) (homotopic_paths s g)) = pathstart g /\
            pathfinish ((@) (homotopic_paths s g)) = pathfinish g`,
    REPEAT GEN_TAC THEN STRIP_TAC THEN
    MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
     [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN
      CONV_TAC SELECT_CONV THEN ASM_MESON_TAC[HOMOTOPIC_PATHS_REFL];
      ASM MESON_TAC[HOMOTOPIC_PATHS_IMP_PATH; HOMOTOPIC_PATHS_IMP_SUBSET;
                HOMOTOPIC_PATHS_IMP_PATHSTART;
                HOMOTOPIC_PATHS_IMP_PATHFINISH]])
  and tac =
    ASM_SIMP_TAC[HOMOTOPIC_PATHS_REFL; PATHSTART_JOIN; PATHFINISH_JOIN;
      PATH_REVERSEPATH; SUBSET_PATH_IMAGE_JOIN; PATHSTART_REVERSEPATH;
      PATHFINISH_REVERSEPATH; PATH_IMAGE_REVERSEPATH; PATH_JOIN] in
  REWRITE_TAC[GSYM CARD_LE_ANTISYM; FORALL_AND_THM; TAUT
   `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN
  MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN
  CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
  REPEAT STRIP_TAC THEN REWRITE_TAC[le_c] THEN
  SUBGOAL_THEN
   `?f:real^1->real^N.
        path f /\ path_image f SUBSET s /\
        pathstart f = a /\ pathfinish f = b`
  STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[path_connected]; ALL_TAC] THEN
  REWRITE_TAC[fundamental_group; FORALL_IN_GSPEC;
              IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
  EXISTS_TAC
    `\g. homotopic_paths (s:real^N->bool) (reversepath f ++ (@) g ++ f)` THEN
  CONJ_TAC THEN X_GEN_TAC `g:real^1->real^N` THEN REPEAT DISCH_TAC THEN
  MP_TAC(ISPEC `g:real^1->real^N` lemma) THEN ASM_REWRITE_TAC[] THEN
  ABBREV_TAC `g':real^1->real^N = (@) (homotopic_paths s g)` THEN
  STRIP_TAC THENL
   [MATCH_MP_TAC(SET_RULE
     `P q ==> homotopic_paths s q IN {homotopic_paths s p | P p}`) THEN
    tac;
    X_GEN_TAC `h:real^1->real^N` THEN
    REPLICATE_TAC 4 DISCH_TAC THEN
    MP_TAC(ISPEC `h:real^1->real^N` lemma) THEN ASM_REWRITE_TAC[] THEN
    ABBREV_TAC `h':real^1->real^N = (@) (homotopic_paths s h)` THEN
    STRIP_TAC THEN
    DISCH_THEN(MP_TAC o C AP_THM`reversepath f ++ h' ++ f:real^1->real^N`) THEN
    tac THEN
    DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        HOMOTOPIC_PATHS_LCANCEL)) THEN tac THEN
    DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        HOMOTOPIC_PATHS_RCANCEL)) THEN tac THEN
    REWRITE_TAC[FUN_EQ_THM] THEN
    ASM_MESON_TAC[HOMOTOPIC_PATHS_SYM; HOMOTOPIC_PATHS_TRANS]]);;

let SIMPLY_CONNECTED_FUNDAMENTAL_GROUP = prove
 (`!s:real^N->bool.
        simply_connected s <=>
        path_connected s /\
        !a. a IN s
            ==> fundamental_group(s,a) = {homotopic_paths s (linepath(a,a))}`,
  GEN_TAC THEN REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH] THEN
  ASM_CASES_TAC `path_connected(s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[SET_RULE `s = {a} <=> a IN s /\ !x. x IN s ==> x = a`] THEN
  REWRITE_TAC[fundamental_group; FORALL_IN_GSPEC] THEN
  SIMP_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH;
    PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET;
    SET_RULE `P q ==> homotopic_paths s q IN {homotopic_paths s p | P p}`] THEN
  REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s /\ t <=> t /\ q /\ p /\ r /\ s`] THEN
  ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
  REWRITE_TAC[IMP_CONJ; FORALL_UNWIND_THM1] THEN
  REWRITE_TAC[MESON[PATHFINISH_IN_PATH_IMAGE; SUBSET]
   `pathfinish p IN s ==> path_image p SUBSET s ==> P <=>
    path_image p SUBSET s ==> P`] THEN
  AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
  REWRITE_TAC[ISPEC `pathfinish p:real^N` EQ_SYM_EQ] THEN
  X_GEN_TAC `p:real^1->real^N` THEN REPEAT
    (MATCH_MP_TAC(TAUT `(p ==> (q <=> r)) ==> ((p ==> q) <=> (p ==> r))`) THEN
     DISCH_TAC) THEN
  REPEAT(EQ_TAC ORELSE STRIP_TAC) THEN
  ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL; PATH_LINEPATH] THEN
  REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN
  ASM_MESON_TAC[HOMOTOPIC_PATHS_TRANS; HOMOTOPIC_PATHS_SYM;
                PATHFINISH_IN_PATH_IMAGE; SUBSET]);;

let FUNDAMENTAL_GROUP_SIMPLY_CONNECTED = prove
 (`!s a:real^N.
     simply_connected s /\ a IN s
     ==> fundamental_group(s,a) = {homotopic_paths s (linepath(a,a))}`,
  SIMP_TAC[SIMPLY_CONNECTED_FUNDAMENTAL_GROUP]);;

(* ------------------------------------------------------------------------- *)
(* A mapping out of a sphere is nullhomotopic iff it extends to the ball.    *)
(* This even works out in the degenerate cases when the radius is <= 0, and  *)
(* we also don't need to explicitly assume continuity since it's already     *)
(* implicit in both sides of the equivalence.                                *)
(* ------------------------------------------------------------------------- *)

let NULLHOMOTOPIC_FROM_SPHERE_EXTENSION = prove
 (`!f:real^M->real^N s a r.
        (?c. homotopic_with (\x. T)
              (subtopology euclidean (sphere(a,r)),
               subtopology euclidean s) f (\x. c)) <=>
        (?g. g continuous_on cball(a,r) /\ IMAGE g (cball(a,r)) SUBSET s /\
             !x. x IN sphere(a,r) ==> g x = f x)`,
  let lemma = prove
   (`!f:real^M->real^N g a r.
        (!e. &0 < e
             ==> ?d. &0 < d /\
                     !x. ~(x = a) /\ norm(x - a) < d ==> norm(g x - f a) < e) /\
        g continuous_on (cball(a,r) DELETE a) /\
        (!x. x IN cball(a,r) /\ ~(x = a) ==> f x = g x)
        ==> f continuous_on cball(a,r)`,
    REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
    X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_CBALL; dist] THEN STRIP_TAC THEN
    ASM_CASES_TAC `x:real^M = a` THENL
     [ASM_REWRITE_TAC[continuous_within; IN_CBALL; dist] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_CBALL; dist]) THEN
      X_GEN_TAC `e:real` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
      GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
      X_GEN_TAC `y:real^M` THEN ASM_CASES_TAC `y:real^M = a` THEN
      ASM_MESON_TAC[VECTOR_SUB_REFL; NORM_0];
      MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN THEN
      EXISTS_TAC `g:real^M->real^N` THEN EXISTS_TAC `norm(x - a:real^M)` THEN
      ASM_SIMP_TAC[NORM_POS_LT; VECTOR_SUB_EQ; IN_CBALL; dist] THEN
      CONJ_TAC THENL
       [RULE_ASSUM_TAC(REWRITE_RULE[IN_CBALL; dist]);
        UNDISCH_TAC
         `(g:real^M->real^N) continuous_on (cball(a,r) DELETE a)` THEN
        REWRITE_TAC[continuous_on; continuous_within] THEN
        DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
        ASM_REWRITE_TAC[IN_DELETE; IN_CBALL; dist] THEN
        MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
        ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
        DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
        EXISTS_TAC `min d (norm(x - a:real^M))` THEN
        ASM_REWRITE_TAC[REAL_LT_MIN; NORM_POS_LT; VECTOR_SUB_EQ]] THEN
       ASM_MESON_TAC[NORM_SUB; NORM_ARITH
        `norm(y - x:real^N) < norm(x - a) ==> ~(y = a)`]]) in
  REWRITE_TAC[sphere; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
  REPEAT GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
   (REAL_ARITH `r < &0 \/ r = &0 \/ &0 < r`)
  THENL
   [ASM_SIMP_TAC[NORM_ARITH `r < &0 ==> ~(norm x = r)`] THEN
    FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [GSYM CBALL_EQ_EMPTY]) THEN
    ASM_SIMP_TAC[HOMOTOPIC_WITH_EUCLIDEAN_ALT; IMAGE_CLAUSES; EMPTY_GSPEC;
     NOT_IN_EMPTY; PCROSS; SET_RULE `{f t x |x,t| F} = {}`; EMPTY_SUBSET] THEN
    REWRITE_TAC[CONTINUOUS_ON_EMPTY];
    ASM_SIMP_TAC[NORM_EQ_0; VECTOR_SUB_EQ; CBALL_SING] THEN
    SIMP_TAC[HOMOTOPIC_WITH_EUCLIDEAN_ALT; PCROSS;
             FORALL_IN_GSPEC; FORALL_UNWIND_THM2] THEN
    ASM_CASES_TAC `(f:real^M->real^N) a IN s` THENL
     [MATCH_MP_TAC(TAUT `p /\ q ==> (p <=> q)`) THEN CONJ_TAC THENL
       [EXISTS_TAC `(f:real^M->real^N) a` THEN
        EXISTS_TAC `\y:real^(1,M)finite_sum. (f:real^M->real^N) a` THEN
        ASM_REWRITE_TAC[CONTINUOUS_ON_CONST; SUBSET; FORALL_IN_IMAGE];
        EXISTS_TAC `f:real^M->real^N` THEN REWRITE_TAC[CONTINUOUS_ON_SING] THEN
        ASM SET_TAC[]];
      MATCH_MP_TAC(TAUT `~q /\ ~p ==> (p <=> q)`) THEN CONJ_TAC THENL
       [ASM SET_TAC[]; STRIP_TAC] THEN
      UNDISCH_TAC `~((f:real^M->real^N) a IN s)` THEN REWRITE_TAC[] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
       `IMAGE h t SUBSET s ==> (?y. y IN t /\ z = h y) ==> z IN s`)) THEN
      REWRITE_TAC[EXISTS_IN_GSPEC] THEN
      EXISTS_TAC `vec 0:real^1` THEN ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL] THEN
      ASM_REWRITE_TAC[EXISTS_IN_GSPEC; UNWIND_THM2]];
    ALL_TAC] THEN
  MATCH_MP_TAC(TAUT
   `!p. (q ==> p) /\ (r ==> p) /\ (p ==> (q <=> r)) ==> (q <=> r)`) THEN
  EXISTS_TAC
   `(f:real^M->real^N) continuous_on {x | norm(x - a) = r} /\
    IMAGE f {x | norm(x - a) = r} SUBSET s` THEN
  REPEAT CONJ_TAC THENL
   [STRIP_TAC THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN
    ASM_REWRITE_TAC[];
    DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `g:real^M->real^N` THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
      EXISTS_TAC `cball(a:real^M,r)`;
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
        `IMAGE g t SUBSET s
         ==> u SUBSET t /\ (!x. x IN u ==> f x = g x)
             ==> IMAGE f u SUBSET s`)) THEN
      ASM_SIMP_TAC[]] THEN
    ASM_SIMP_TAC[SUBSET; IN_CBALL; dist; IN_ELIM_THM] THEN
    MESON_TAC[REAL_LE_REFL; NORM_SUB];
    STRIP_TAC] THEN
  ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN EQ_TAC THENL
   [REWRITE_TAC[HOMOTOPIC_WITH_EUCLIDEAN; PCROSS; LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`c:real^N`; `h:real^(1,M)finite_sum->real^N`] THEN
    STRIP_TAC THEN
    EXISTS_TAC `\x. (h:real^(1,M)finite_sum->real^N)
                    (pastecart (lift(inv(r) * norm(x - a)))
                               (a + (if x = a then r % basis 1
                                     else r / norm(x - a) % (x - a))))` THEN
    ASM_SIMP_TAC[IN_ELIM_THM; REAL_MUL_LINV; REAL_DIV_REFL; REAL_LT_IMP_NZ;
                 LIFT_NUM; VECTOR_ARITH `a + &1 % (x - a):real^N = x`] THEN
    REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC lemma THEN
      EXISTS_TAC `\x. (h:real^(1,M)finite_sum->real^N)
                    (pastecart (lift(inv(r) * norm(x - a)))
                               (a + r / norm(x - a) % (x - a)))` THEN
      SIMP_TAC[] THEN CONJ_TAC THENL
       [X_GEN_TAC `e:real` THEN DISCH_TAC THEN
        ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_MUL_RZERO; LIFT_NUM] THEN
        FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          COMPACT_UNIFORMLY_CONTINUOUS)) THEN
        SIMP_TAC[REWRITE_RULE[PCROSS] COMPACT_PCROSS;
            REWRITE_RULE[REWRITE_RULE[ONCE_REWRITE_RULE[DIST_SYM] dist] sphere]
                 COMPACT_SPHERE; COMPACT_INTERVAL] THEN
        REWRITE_TAC[uniformly_continuous_on] THEN
        DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
        REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN
        DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
        EXISTS_TAC `min r (d * r):real` THEN
        ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_MIN] THEN
        X_GEN_TAC `x:real^M` THEN REPEAT STRIP_TAC THEN
        FIRST_X_ASSUM(MP_TAC o SPEC `vec 0:real^1`) THEN
        REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; RIGHT_IMP_FORALL_THM] THEN
        ASM_REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN
        DISCH_THEN(MP_TAC o MATCH_MP (MESON[]
         `(!x t y. P x t y) ==> (!t x. P x t x)`)) THEN
        REWRITE_TAC[dist] THEN DISCH_THEN MATCH_MP_TAC THEN
        REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
        REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
        ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN
        ASM_SIMP_TAC[REAL_MUL_LID; REAL_MUL_LZERO; NORM_POS_LE] THEN
        ASM_SIMP_TAC[REAL_LT_IMP_LE; CONJ_ASSOC] THEN
        REWRITE_TAC[VECTOR_ADD_SUB; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
        ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
        ASM_SIMP_TAC[REAL_ARITH `&0 < r ==> abs r = r`] THEN
        REWRITE_TAC[PASTECART_SUB; VECTOR_SUB_REFL; NORM_PASTECART] THEN
        REWRITE_TAC[NORM_0; VECTOR_SUB_RZERO] THEN
        CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ADD_RID] THEN
        REWRITE_TAC[POW_2_SQRT_ABS; REAL_ABS_NORM; NORM_LIFT] THEN
        ASM_SIMP_TAC[REAL_ABS_DIV; REAL_LT_LDIV_EQ; REAL_ABS_NORM;
                     REAL_ARITH `&0 < r ==> abs r = r`];
        GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
        MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
         [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
          SIMP_TAC[CONTINUOUS_ON_CMUL; LIFT_CMUL; CONTINUOUS_ON_SUB;
                   CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST;
                   CONTINUOUS_ON_LIFT_NORM_COMPOSE] THEN
          MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
          REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
          MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
          SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST;
                   o_DEF; real_div; LIFT_CMUL] THEN
          MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
          REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
          GEN_TAC THEN REWRITE_TAC[IN_DELETE] THEN DISCH_TAC THEN
          MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN
          MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_INV) THEN
          ASM_SIMP_TAC[NETLIMIT_AT; NORM_EQ_0; VECTOR_SUB_EQ] THEN
          MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE THEN
          SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_AT_ID; CONTINUOUS_CONST];
          FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
            CONTINUOUS_ON_SUBSET)) THEN
          REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC; SUBSET] THEN
          REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_DELETE; IN_ELIM_THM] THEN
          SIMP_TAC[IN_CBALL; NORM_ARITH `dist(a:real^M,a + x) = norm x`] THEN
          REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN
          REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
          REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
          ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN
          ASM_SIMP_TAC[REAL_MUL_LID; REAL_MUL_LZERO; NORM_POS_LE] THEN
          SIMP_TAC[VECTOR_ADD_SUB; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM;
                   REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
          ASM_REAL_ARITH_TAC]];
      GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
      REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
       `IMAGE g s SUBSET u ==> t SUBSET s ==> IMAGE g t SUBSET u`)) THEN
      REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
      REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_CBALL; IN_ELIM_THM] THEN
      X_GEN_TAC `x:real^M` THEN
      REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN REPEAT STRIP_TAC THENL
       [REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
        REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN
        ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN
        ASM_REWRITE_TAC[REAL_MUL_LID; REAL_MUL_LZERO; NORM_POS_LE];
        REWRITE_TAC[VECTOR_ADD_SUB] THEN COND_CASES_TAC THEN
        ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL;
                     REAL_ABS_DIV; REAL_ABS_NORM;
                     REAL_MUL_RID; REAL_ARITH `&0 < r ==> abs r = r`] THEN
        ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ]];
      GEN_TAC THEN COND_CASES_TAC THEN
      ASM_SIMP_TAC[VECTOR_SUB_REFL; NORM_0; REAL_LT_IMP_NZ] THEN
      REWRITE_TAC[VECTOR_ARITH `a + &1 % (x - a):real^N = x`]];
    DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `(g:real^M->real^N) a` THEN
    ASM_SIMP_TAC[HOMOTOPIC_WITH_EUCLIDEAN_ALT; PCROSS] THEN
    EXISTS_TAC `\y:real^(1,M)finite_sum.
                   (g:real^M->real^N)
                   (a + drop(fstcart y) % (sndcart y - a))` THEN
    REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC] THEN
    REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_RID; VECTOR_MUL_LID] THEN
    ASM_SIMP_TAC[VECTOR_SUB_ADD2] THEN CONJ_TAC THENL
     [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
      MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
       [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN SIMP_TAC[CONTINUOUS_ON_CONST] THEN
        MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
        SIMP_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST;
                 LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; LINEAR_FSTCART; ETA_AX];
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET))];
      GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
      REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
       `IMAGE g s SUBSET u ==> t SUBSET s ==> IMAGE g t SUBSET u`))] THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
    REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_ELIM_THM] THEN
    REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(a:real^M,a + x) = norm x`] THEN
    ASM_SIMP_TAC[NORM_MUL; IN_INTERVAL_1; DROP_VEC; REAL_LE_RMUL_EQ;
                 REAL_ARITH `x * r <= r <=> x * r <= &1 * r`] THEN
    REAL_ARITH_TAC]);;

(* ------------------------------------------------------------------------- *)
(* Homotopy equivalence.                                                     *)
(* ------------------------------------------------------------------------- *)

parse_as_infix("homotopy_equivalent",(12,"right"));;

let homotopy_equivalent = new_definition
 `(s:real^M->bool) homotopy_equivalent (t:real^N->bool) <=>
        ?f g. f continuous_on s /\ IMAGE f s SUBSET t /\
              g continuous_on t /\ IMAGE g t SUBSET s /\
              homotopic_with (\x. T)
               (subtopology euclidean s,subtopology euclidean s) (g o f) I /\
              homotopic_with (\x. T)
               (subtopology euclidean t,subtopology euclidean t) (f o g) I`;;

let HOMOTOPY_EQUIVALENT_SPACE_EUCLIDEAN = prove
 (`!(s:real^M->bool) (t:real^N->bool).
     (subtopology euclidean s) homotopy_equivalent_space
     (subtopology euclidean t) <=>
     s homotopy_equivalent t`,
  REWRITE_TAC[homotopy_equivalent_space; homotopy_equivalent] THEN
  REWRITE_TAC[CONTINUOUS_MAP_EUCLIDEAN2] THEN MESON_TAC[]);;

let HOMOTOPY_EQUIVALENT = prove
 (`!s:real^M->bool t:real^N->bool.
        s homotopy_equivalent t <=>
        ?f g h. f continuous_on s /\ IMAGE f s SUBSET t /\
                g continuous_on t /\ IMAGE g t SUBSET s /\
                h continuous_on t /\ IMAGE h t SUBSET s /\
                homotopic_with (\x. T)
                 (subtopology euclidean s,subtopology euclidean s) (g o f) I /\
                homotopic_with (\x. T)
                 (subtopology euclidean t,subtopology euclidean t) (f o h) I`,
  REPEAT GEN_TAC THEN REWRITE_TAC[homotopy_equivalent] THEN
  MATCH_MP_TAC(MESON[] `(!x. P x <=> Q x) ==> ((?x. P x) <=> (?x. Q x))`) THEN
  X_GEN_TAC `f:real^M->real^N` THEN
  EQ_TAC THENL [MESON_TAC[]; STRIP_TAC] THEN
  EXISTS_TAC `(g:real^N->real^M) o f o (h:real^N->real^M)` THEN
  ASM_REWRITE_TAC[IMAGE_o] THEN REPEAT CONJ_TAC THENL
   [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN
    REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
     (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[];
    ASM SET_TAC[];
    TRANS_TAC HOMOTOPIC_WITH_TRANS
      `((g:real^N->real^M) o I) o (f:real^M->real^N)` THEN
    CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[I_O_ID]] THEN
    MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
    EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
    EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[];
    TRANS_TAC HOMOTOPIC_WITH_TRANS
      `(f:real^M->real^N) o I o (h:real^N->real^M)` THEN
    CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[I_O_ID]] THEN
    MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
    EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[o_ASSOC] THEN
    MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
    EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[]]);;

let HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT = prove
 (`!s:real^M->bool t:real^N->bool.
        s homeomorphic t ==> s homotopy_equivalent t`,
  REWRITE_TAC[GSYM HOMEOMORPHIC_SPACE_EUCLIDEAN;
              GSYM HOMOTOPY_EQUIVALENT_SPACE_EUCLIDEAN] THEN
  REWRITE_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT_SPACE]);;

let HOMOTOPY_EQUIVALENT_REFL = prove
 (`!s:real^N->bool. s homotopy_equivalent s`,
  SIMP_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT; HOMEOMORPHIC_REFL]);;

let HOMOTOPY_EQUIVALENT_SYM = prove
 (`!s:real^M->bool t:real^N->bool.
        s homotopy_equivalent t <=> t homotopy_equivalent s`,
  REWRITE_TAC[GSYM HOMOTOPY_EQUIVALENT_SPACE_EUCLIDEAN] THEN
  REWRITE_TAC[HOMOTOPY_EQUIVALENT_SPACE_SYM]);;

let HOMOTOPY_EQUIVALENT_TRANS = prove
 (`!s:real^M->bool t:real^N->bool u:real^P->bool.
        s homotopy_equivalent t /\ t homotopy_equivalent u
        ==> s homotopy_equivalent u`,
  REWRITE_TAC[GSYM HOMOTOPY_EQUIVALENT_SPACE_EUCLIDEAN] THEN
  REWRITE_TAC[HOMOTOPY_EQUIVALENT_SPACE_TRANS]);;

let HOMOTOPY_EQUIVALENT_PCROSS = prove
 (`!s:real^M->bool t:real^N->bool s':real^P->bool t':real^Q->bool.
         s homotopy_equivalent s' /\ t homotopy_equivalent t'
         ==> s PCROSS t homotopy_equivalent s' PCROSS t'`,
  REPEAT GEN_TAC THEN REWRITE_TAC[homotopy_equivalent] THEN
  REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
  REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC
   [`f1:real^M->real^P`; `g1:real^P->real^M`;
    `f2:real^N->real^Q`; `g2:real^Q->real^N`] THEN
  DISCH_TAC THEN
  EXISTS_TAC `\z. pastecart ((f1:real^M->real^P) (fstcart z))
                            ((f2:real^N->real^Q) (sndcart z))` THEN
  EXISTS_TAC `\z. pastecart ((g1:real^P->real^M) (fstcart z))
                            ((g2:real^Q->real^N) (sndcart z))` THEN
  FIRST_X_ASSUM(CONJUNCTS_THEN
   (CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC o
    GEN_REWRITE_RULE I [TAUT
      `p /\ q /\ r /\ s /\ t <=> (p /\ q /\ r /\ s) /\ t`])) THEN
  ONCE_REWRITE_TAC[TAUT
   `p /\ q ==> p' /\ q' ==> r <=> (p' /\ p) /\ (q' /\ q) ==> r`] THEN
  DISCH_THEN(CONJUNCTS_THEN(MP_TAC o
    MATCH_MP(MESON[] `(!x. p x) ==> (!x. p(\a. T))`) o
    MATCH_MP (ONCE_REWRITE_RULE[TAUT
     `p /\ q /\ r ==> s <=> p /\ q ==> r ==> s`] HOMOTOPIC_WITH_PCROSS))) THEN
  REWRITE_TAC[I_DEF; PASTECART_FST_SND; o_DEF] THEN
  REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
  DISCH_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (p /\ r) /\ (q /\ s)`] THEN
  CONJ_TAC THENL
   [CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN CONJ_TAC THEN
    GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN
    REWRITE_TAC[IMAGE_FSTCART_PCROSS; IMAGE_SNDCART_PCROSS] THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY];
    CONJ_TAC THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
    REWRITE_TAC[PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN
    ASM SET_TAC[]]);;

let HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_SELF = prove
 (`!f:real^M->real^N s.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (IMAGE f s) homotopy_equivalent s`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT THEN
  MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF THEN
  ASM_REWRITE_TAC[]);;

let HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ = prove
 (`!f:real^M->real^N s t.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> ((IMAGE f s) homotopy_equivalent t <=> s homotopy_equivalent t)`,
  REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o SPEC `s:real^M->bool` o
    MATCH_MP HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_SELF) THEN
  EQ_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMOTOPY_EQUIVALENT_SYM]);
    POP_ASSUM MP_TAC] THEN
  REWRITE_TAC[IMP_IMP; HOMOTOPY_EQUIVALENT_TRANS]);;

let HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ = prove
 (`!f:real^M->real^N s t.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (s homotopy_equivalent (IMAGE f t) <=> s homotopy_equivalent t)`,
  ONCE_REWRITE_TAC[HOMOTOPY_EQUIVALENT_SYM] THEN
  REWRITE_TAC[HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ]);;

add_linear_invariants
  [HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ;
   HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ];;

let HOMOTOPY_EQUIVALENT_TRANSLATION_SELF = prove
 (`!a:real^N s. (IMAGE (\x. a + x) s) homotopy_equivalent s`,
  REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT THEN
  REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);;

let HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ = prove
 (`!a:real^N s t.
      (IMAGE (\x. a + x) s) homotopy_equivalent t <=> s homotopy_equivalent t`,
  MESON_TAC[HOMOTOPY_EQUIVALENT_TRANSLATION_SELF;
            HOMOTOPY_EQUIVALENT_SYM; HOMOTOPY_EQUIVALENT_TRANS]);;

let HOMOTOPY_EQUIVALENT_TRANSLATION_RIGHT_EQ = prove
 (`!a:real^N s t.
      s homotopy_equivalent (IMAGE (\x. a + x) t) <=> s homotopy_equivalent t`,
  ONCE_REWRITE_TAC[HOMOTOPY_EQUIVALENT_SYM] THEN
  REWRITE_TAC[HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ]);;

add_translation_invariants
  [HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ;
   HOMOTOPY_EQUIVALENT_TRANSLATION_RIGHT_EQ];;

let HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY = prove
  (`!s:real^M->bool t:real^N->bool u:real^P->bool.
        s homotopy_equivalent t
        ==> ((!f g. f continuous_on u /\ IMAGE f u SUBSET s /\
                    g continuous_on u /\ IMAGE g u SUBSET s
                    ==> homotopic_with (\x. T)
                         (subtopology euclidean u,subtopology euclidean s)
                         f g) <=>
             (!f g. f continuous_on u /\ IMAGE f u SUBSET t /\
                    g continuous_on u /\ IMAGE g u SUBSET t
                    ==> homotopic_with (\x. T)
                         (subtopology euclidean u,subtopology euclidean t)
                         f g))`,
  let lemma = prove
   (`!s:real^M->bool t:real^N->bool u:real^P->bool.
          s homotopy_equivalent t /\
          (!f g. f continuous_on u /\ IMAGE f u SUBSET s /\
                 g continuous_on u /\ IMAGE g u SUBSET s
                 ==> homotopic_with (\x. T)
                      (subtopology euclidean u,subtopology euclidean s) f g)
          ==> (!f g. f continuous_on u /\ IMAGE f u SUBSET t /\
                     g continuous_on u /\ IMAGE g u SUBSET t
                     ==> homotopic_with (\x. T)
                          (subtopology euclidean u,subtopology euclidean t)
                          f g)`,
    REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN
    DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N`
     (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN
    SUBGOAL_THEN
     `homotopic_with (\x. T)
          (subtopology euclidean u,subtopology euclidean t)
          ((h:real^M->real^N) o (k:real^N->real^M) o (f:real^P->real^N))
          (h o k o g)`
    MP_TAC THENL
     [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
      EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IMAGE_o] THEN
      REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN
      ASM_REWRITE_TAC[] THEN
      TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET))) THEN
      ASM SET_TAC[];
      MATCH_MP_TAC(MESON[HOMOTOPIC_WITH_TRANS; HOMOTOPIC_WITH_SYM]
       `homotopic_with P
         (subtopology euclidean u,subtopology euclidean t) f f' /\
        homotopic_with P (subtopology euclidean u,subtopology euclidean t) g g'
        ==> homotopic_with P
             (subtopology euclidean u,subtopology euclidean t) f g
            ==> homotopic_with P
                 (subtopology euclidean u,subtopology euclidean t) f' g'`) THEN
      CONJ_TAC THEN
      GEN_REWRITE_TAC RAND_CONV [GSYM(CONJUNCT1(SPEC_ALL I_O_ID))] THEN
      REWRITE_TAC[o_ASSOC] THEN
      MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
      EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]]) in
  REPEAT STRIP_TAC THEN EQ_TAC THEN
  MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN
  ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);;

let HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY = prove
 (`!s:real^M->bool t:real^N->bool u:real^P->bool.
        s homotopy_equivalent t
        ==> ((!f g. f continuous_on s /\ IMAGE f s SUBSET u /\
                    g continuous_on s /\ IMAGE g s SUBSET u
                    ==> homotopic_with (\x. T)
                         (subtopology euclidean s,subtopology euclidean u)
                         f g) <=>
             (!f g. f continuous_on t /\ IMAGE f t SUBSET u /\
                    g continuous_on t /\ IMAGE g t SUBSET u
                    ==> homotopic_with (\x. T)
                         (subtopology euclidean t,subtopology euclidean u)
                         f g))`,
  let lemma = prove
   (`!s:real^M->bool t:real^N->bool u:real^P->bool.
          s homotopy_equivalent t /\
          (!f g. f continuous_on s /\ IMAGE f s SUBSET u /\
                 g continuous_on s /\ IMAGE g s SUBSET u
                 ==> homotopic_with (\x. T)
                      (subtopology euclidean s,subtopology euclidean u) f g)
           ==> (!f g. f continuous_on t /\ IMAGE f t SUBSET u /\
                      g continuous_on t /\ IMAGE g t SUBSET u
                      ==> homotopic_with (\x. T)
                           (subtopology euclidean t,subtopology euclidean u)
                           f g)`,
    REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN
    DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N`
     (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN
    SUBGOAL_THEN
     `homotopic_with (\x. T) (subtopology euclidean t,subtopology euclidean u)
          (((f:real^N->real^P) o h) o (k:real^N->real^M)) ((g o h) o k)`
    MP_TAC THENL
     [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
      EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IMAGE_o] THEN
      REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN
      ASM_REWRITE_TAC[] THEN
      TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET))) THEN
      ASM SET_TAC[];
      MATCH_MP_TAC(MESON[HOMOTOPIC_WITH_TRANS; HOMOTOPIC_WITH_SYM]
       `homotopic_with P
         (subtopology euclidean u,subtopology euclidean t) f f' /\
        homotopic_with P (subtopology euclidean u,subtopology euclidean t) g g'
        ==> homotopic_with P
              (subtopology euclidean u,subtopology euclidean t) f g
            ==> homotopic_with P
                 (subtopology euclidean u,subtopology euclidean t) f' g'`) THEN
      CONJ_TAC THEN
      GEN_REWRITE_TAC RAND_CONV [GSYM(CONJUNCT2(SPEC_ALL I_O_ID))] THEN
      REWRITE_TAC[GSYM o_ASSOC] THEN
      MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
      EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]]) in
  REPEAT STRIP_TAC THEN EQ_TAC THEN
  MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN
  ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);;

let HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY_NULL = prove
  (`!s:real^M->bool t:real^N->bool u:real^P->bool.
        s homotopy_equivalent t
        ==> ((!f. f continuous_on u /\ IMAGE f u SUBSET s
                  ==> ?c. homotopic_with (\x. T)
                           (subtopology euclidean u,subtopology euclidean s)
                           f (\x. c)) <=>
             (!f. f continuous_on u /\ IMAGE f u SUBSET t
                  ==> ?c. homotopic_with (\x. T)
                           (subtopology euclidean u,subtopology euclidean t)
                           f (\x. c)))`,
  let lemma = prove
   (`!s:real^M->bool t:real^N->bool u:real^P->bool.
          s homotopy_equivalent t /\
          (!f. f continuous_on u /\ IMAGE f u SUBSET s
               ==> ?c. homotopic_with (\x. T)
                        (subtopology euclidean u,subtopology euclidean s)
                        f (\x. c))
          ==> (!f. f continuous_on u /\ IMAGE f u SUBSET t
                   ==> ?c. homotopic_with (\x. T)
                            (subtopology euclidean u,subtopology euclidean t)
                            f (\x. c))`,
    REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN
    DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N`
     (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `(k:real^N->real^M) o (f:real^P->real^N)`) THEN
    REWRITE_TAC[IMAGE_o] THEN ANTS_TAC THENL
     [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE; ASM SET_TAC[]] THEN
      ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
      DISCH_THEN(X_CHOOSE_TAC `c:real^M`) THEN
      EXISTS_TAC `(h:real^M->real^N) c`] THEN
    SUBGOAL_THEN
     `homotopic_with (\x. T)
          (subtopology euclidean u,subtopology euclidean t)
          ((h:real^M->real^N) o (k:real^N->real^M) o (f:real^P->real^N))
          (h o (\x. c))`
    MP_TAC THENL
     [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
      EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[];
      GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [o_DEF] THEN
      REWRITE_TAC[] THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_TRANS) THEN
      GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT1(SPEC_ALL I_O_ID))] THEN
      REWRITE_TAC[o_ASSOC] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN
      MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
      EXISTS_TAC `t:real^N->bool` THEN
      ASM_REWRITE_TAC[]]) in
  REPEAT STRIP_TAC THEN EQ_TAC THEN
  MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN
  ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);;

let HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL = prove
 (`!s:real^M->bool t:real^N->bool u:real^P->bool.
        s homotopy_equivalent t
        ==> ((!f. f continuous_on s /\ IMAGE f s SUBSET u
                  ==> ?c. homotopic_with (\x. T)
                            (subtopology euclidean s,subtopology euclidean u)
                            f (\x. c)) <=>
             (!f. f continuous_on t /\ IMAGE f t SUBSET u
                  ==> ?c. homotopic_with (\x. T)
                           (subtopology euclidean t,subtopology euclidean u)
                           f (\x. c)))`,
  let lemma = prove
   (`!s:real^M->bool t:real^N->bool u:real^P->bool.
          s homotopy_equivalent t /\
          (!f. f continuous_on s /\ IMAGE f s SUBSET u
               ==> ?c. homotopic_with (\x. T)
                        (subtopology euclidean s,subtopology euclidean u)
                        f (\x. c))
          ==> (!f. f continuous_on t /\ IMAGE f t SUBSET u
                   ==> ?c. homotopic_with (\x. T)
                            (subtopology euclidean t,subtopology euclidean u)
                            f (\x. c))`,
    REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN
    DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N`
     (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^N->real^P) o (h:real^M->real^N)`) THEN
    REWRITE_TAC[IMAGE_o] THEN ANTS_TAC THENL
     [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE; ASM SET_TAC[]] THEN
      ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^P` THEN DISCH_TAC] THEN
    SUBGOAL_THEN
     `homotopic_with (\x. T) (subtopology euclidean t,subtopology euclidean u)
          (((f:real^N->real^P) o h) o (k:real^N->real^M)) ((\x. c) o k)`
    MP_TAC THENL
     [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN
      EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[];
      GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [o_DEF] THEN
      REWRITE_TAC[] THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_TRANS) THEN
      GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT2(SPEC_ALL I_O_ID))] THEN
      REWRITE_TAC[GSYM o_ASSOC] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN
      MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
      EXISTS_TAC `t:real^N->bool` THEN
      ASM_REWRITE_TAC[]]) in
  REPEAT STRIP_TAC THEN EQ_TAC THEN
  MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN
  ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);;

let HOMOTOPIC_WITH_IMP_PATH_COMPONENT = prove
 (`!f g:real^M->real^N s t a.
        homotopic_with (\x. T)
         (subtopology euclidean s,subtopology euclidean t) f g /\
        a IN s
        ==> path_component t (f a) (g a)`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMOTOPIC_WITH_EUCLIDEAN]) THEN
  REWRITE_TAC[o_THM; I_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N`
        STRIP_ASSUME_TAC) THEN
  MATCH_MP_TAC PATH_COMPONENT_OF_SUBSET THEN
  EXISTS_TAC
   `IMAGE (h:real^(1,M)finite_sum->real^N)
          (interval[vec 0,vec 1] PCROSS {a})` THEN
  CONJ_TAC THENL
   [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `IMAGE f s' SUBSET t ==> s SUBSET s' ==> IMAGE f s SUBSET t`)) THEN
    REWRITE_TAC[SUBSET_PCROSS] THEN ASM SET_TAC[];
    W(MP_TAC o fst o EQ_IMP_RULE o PART_MATCH (rand o lhand)
       PATH_CONNECTED_IFF_PATH_COMPONENT o lhand o rator o snd) THEN
    ANTS_TAC THENL
     [MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN
      REWRITE_TAC[PATH_CONNECTED_PCROSS_EQ; PATH_CONNECTED_INTERVAL;
                  PATH_CONNECTED_SING] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN
      REWRITE_TAC[SUBSET_PCROSS] THEN ASM SET_TAC[];
      DISCH_THEN MATCH_MP_TAC THEN
      REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS] THEN
      ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL; IN_SING]]]);;

let HOMOTOPY_INVARIANT_CARD_COMPONENTS = prove
 (`!f:real^M->real^N g s t.
        f continuous_on s /\ IMAGE f s SUBSET t /\
        g continuous_on t /\ IMAGE g t SUBSET s /\
        homotopic_with (\x. T)
         (subtopology euclidean t,subtopology euclidean t) (f o g) I
        ==> components t <=_c components s`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN
  ASM_SIMP_TAC[SUBSET_EMPTY; IMAGE_EQ_EMPTY; COMPONENTS_EMPTY] THEN
  REWRITE_TAC[CARD_EMPTY_LE] THEN STRIP_TAC THEN
  MATCH_MP_TAC CARD_LE_RELATIONAL_FULL THEN
  EXISTS_TAC `\c d. IMAGE (g:real^N->real^M) d SUBSET c` THEN
  REWRITE_TAC[] THEN CONJ_TAC THENL
   [REPEAT STRIP_TAC THEN MATCH_MP_TAC EXISTS_COMPONENT_SUPERSET THEN
    ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
     [FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN ASM SET_TAC[];
      MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
      ASM_MESON_TAC[IN_COMPONENTS_SUBSET; CONTINUOUS_ON_SUBSET;
                    IN_COMPONENTS_CONNECTED]];
    ALL_TAC] THEN
  REWRITE_TAC[IMP_CONJ; components; FORALL_IN_GSPEC; RIGHT_FORALL_IMP_THM] THEN
  SIMP_TAC[CONNECTED_COMPONENT_EQ_EQ] THEN
  X_GEN_TAC `a:real^M` THEN DISCH_TAC THEN
  X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN
  X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN REPEAT DISCH_TAC THEN
  MATCH_MP_TAC(MESON[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS]
   `!f. connected_component s (f b) (f c) /\
        connected_component s (f b) b /\
        connected_component s (f c) c
        ==> connected_component s b c`) THEN
  EXISTS_TAC `(f:real^M->real^N) o (g:real^N->real^M)` THEN CONJ_TAC THENL
   [ALL_TAC;
    CONJ_TAC THEN
    MATCH_MP_TAC PATH_COMPONENT_IMP_CONNECTED_COMPONENT THEN
    GEN_REWRITE_TAC RAND_CONV [GSYM I_THM] THEN
    MATCH_MP_TAC HOMOTOPIC_WITH_IMP_PATH_COMPONENT THEN
    EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[ETA_AX]] THEN
  REWRITE_TAC[connected_component] THEN
  EXISTS_TAC `IMAGE (f:real^M->real^N) (connected_component s a)` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
    REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN
    ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET; CONTINUOUS_ON_SUBSET];
    ALL_TAC] THEN
  CONJ_TAC THENL
   [MP_TAC(ISPECL [`s:real^M->bool`; `a:real^M`]
        CONNECTED_COMPONENT_SUBSET) THEN ASM SET_TAC[];
    REWRITE_TAC[o_THM] THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CONNECTED_COMPONENT_REFL)) THEN
    ASM SET_TAC[]]);;

let HOMOTOPY_INVARIANT_CONNECTEDNESS = prove
 (`!f:real^M->real^N g s t.
        f continuous_on s /\ IMAGE f s SUBSET t /\
        g continuous_on t /\ IMAGE g t SUBSET s /\
        homotopic_with (\x. T)
         (subtopology euclidean t,subtopology euclidean t) (f o g) I /\
        connected s
        ==> connected t`,
  REPEAT GEN_TAC THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  REWRITE_TAC[CONNECTED_EQ_CARD_COMPONENTS] THEN STRIP_TAC THEN
  MP_TAC(ISPECL
   [`f:real^M->real^N`; `g:real^N->real^M`; `s:real^M->bool`; `t:real^N->bool`]
   HOMOTOPY_INVARIANT_CARD_COMPONENTS) THEN
  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        CARD_LE_FINITE)) THEN
  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
  ASM_MESON_TAC[CARD_LE_CARD_IMP; LE_TRANS]);;

let HOMOTOPY_EQUIVALENT_CONNECTEDNESS = prove
 (`!s:real^M->bool t:real^N->bool.
        s homotopy_equivalent t ==> (connected s <=> connected t)`,
  REWRITE_TAC[homotopy_equivalent] THEN REPEAT STRIP_TAC THEN
  EQ_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
   (REWRITE_RULE[CONJ_ASSOC] HOMOTOPY_INVARIANT_CONNECTEDNESS)) THEN
  ASM_MESON_TAC[]);;

let HOMOTOPY_EQUIVALENT_CARD_EQ_COMPONENTS = prove
 (`!s:real^M->bool t:real^N->bool.
        s homotopy_equivalent t ==> components s =_c components t`,
  REWRITE_TAC[homotopy_equivalent] THEN REPEAT STRIP_TAC THEN
  REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THEN
  MATCH_MP_TAC HOMOTOPY_INVARIANT_CARD_COMPONENTS THEN ASM_MESON_TAC[]);;

let HOMEOMORPHIC_CARD_EQ_COMPONENTS = prove
 (`!s:real^M->bool t:real^N->bool.
        s homeomorphic t ==> components s =_c components t`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC HOMOTOPY_EQUIVALENT_CARD_EQ_COMPONENTS THEN
  MATCH_MP_TAC HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT THEN
  ASM_REWRITE_TAC[]);;

let HOMOTOPY_INVARIANT_CARD_PATH_COMPONENTS = prove
 (`!f:real^M->real^N g s t.
        f continuous_on s /\ IMAGE f s SUBSET t /\
        g continuous_on t /\ IMAGE g t SUBSET s /\
        homotopic_with (\x. T)
         (subtopology euclidean t,subtopology euclidean t) (f o g) I
        ==> {path_component t x | x | x IN t}
            <=_c {path_component s x | x | x IN s}`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC CARD_LE_RELATIONAL_FULL THEN
  EXISTS_TAC `\c d. IMAGE (g:real^N->real^M) d SUBSET c` THEN
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
  REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN CONJ_TAC THENL
   [X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
    EXISTS_TAC `(g:real^N->real^M) y` THEN
    CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC PATH_COMPONENT_MAXIMAL] THEN
    REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN] THEN
      ASM_SIMP_TAC[PATH_COMPONENT_REFL];
      MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN
      REWRITE_TAC[PATH_CONNECTED_PATH_COMPONENT] THEN
      ASM_MESON_TAC[PATH_COMPONENT_SUBSET; CONTINUOUS_ON_SUBSET];
      MP_TAC(ISPECL [`t:real^N->bool`; `y:real^N`]
        PATH_COMPONENT_SUBSET) THEN ASM SET_TAC[]];
    ALL_TAC] THEN
  SIMP_TAC[PATH_COMPONENT_EQ_EQ] THEN
  X_GEN_TAC `a:real^M` THEN DISCH_TAC THEN
  X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN
  X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN REPEAT DISCH_TAC THEN
  MATCH_MP_TAC(MESON[PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS]
   `!f. path_component s (f b) (f c) /\
        path_component s (f b) b /\
        path_component s (f c) c
        ==> path_component s b c`) THEN
  EXISTS_TAC `(f:real^M->real^N) o (g:real^N->real^M)` THEN CONJ_TAC THENL
   [ALL_TAC;
    CONJ_TAC THEN
    GEN_REWRITE_TAC RAND_CONV [GSYM I_THM] THEN
    MATCH_MP_TAC HOMOTOPIC_WITH_IMP_PATH_COMPONENT THEN
    EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[ETA_AX]] THEN
  REWRITE_TAC[PATH_COMPONENT] THEN
  EXISTS_TAC `IMAGE (f:real^M->real^N) (path_component s a)` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN
    REWRITE_TAC[PATH_CONNECTED_PATH_COMPONENT] THEN
    ASM_MESON_TAC[PATH_COMPONENT_SUBSET; CONTINUOUS_ON_SUBSET];
    ALL_TAC] THEN
  CONJ_TAC THENL
   [MP_TAC(ISPECL [`s:real^M->bool`; `a:real^M`]
        PATH_COMPONENT_SUBSET) THEN ASM SET_TAC[];
    REWRITE_TAC[o_THM] THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP PATH_COMPONENT_REFL)) THEN
    ASM SET_TAC[]]);;

let HOMOTOPY_INVARIANT_PATH_CONNECTEDNESS = prove
 (`!f:real^M->real^N g s t.
        f continuous_on s /\ IMAGE f s SUBSET t /\
        g continuous_on t /\ IMAGE g t SUBSET s /\
        homotopic_with (\x. T)
         (subtopology euclidean t,subtopology euclidean t) (f o g) I /\
        path_connected s
        ==> path_connected t`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN
  ASM_SIMP_TAC[SUBSET_EMPTY; IMAGE_EQ_EMPTY; COMPONENTS_EMPTY] THEN
  REWRITE_TAC[PATH_CONNECTED_EMPTY] THEN STRIP_TAC THEN
  SUBGOAL_THEN `{path_component s (x:real^M) | x | x IN s} = {s}`
  ASSUME_TAC THENL
   [REWRITE_TAC[SET_RULE `s = {a} <=> a IN s /\ !x. x IN s ==> x = a`] THEN
    REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM] THEN
    MP_TAC(ISPEC `s:real^M->bool` PATH_CONNECTED_COMPONENT_SET) THEN
    ASM SET_TAC[];
    ALL_TAC] THEN
  MP_TAC(ISPECL
   [`f:real^M->real^N`; `g:real^N->real^M`; `s:real^M->bool`; `t:real^N->bool`]
   HOMOTOPY_INVARIANT_CARD_PATH_COMPONENTS) THEN
  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        CARD_LE_FINITE)) THEN
  REWRITE_TAC[FINITE_SING] THEN DISCH_TAC THEN
  UNDISCH_TAC
   `{path_component t (x:real^N) | x | x IN t} <=_c {s:real^M->bool}` THEN
  ASM_SIMP_TAC[CARD_LE_CARD; FINITE_SING; CARD_SING] THEN
  UNDISCH_TAC `FINITE {path_component t (x:real^N) | x | x IN t}` THEN
  REWRITE_TAC[ARITH_RULE `n <= 1 <=> n = 0 \/ n = 1`] THEN
  REWRITE_TAC[IMP_IMP; LEFT_OR_DISTRIB; GSYM HAS_SIZE] THEN
  CONV_TAC(ONCE_DEPTH_CONV HAS_SIZE_CONV) THEN
  DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
   `s = {} \/ (?a. s = {a}) ==> !x. x IN s ==> !y. y IN s ==> x = y`)) THEN
  SIMP_TAC[FORALL_IN_GSPEC; PATH_COMPONENT_EQ_EQ] THEN
  REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN MESON_TAC[]);;

let HOMOTOPY_EQUIVALENT_PATH_CONNECTEDNESS = prove
 (`!s:real^M->bool t:real^N->bool.
        s homotopy_equivalent t ==> (path_connected s <=> path_connected t)`,
  REWRITE_TAC[homotopy_equivalent] THEN REPEAT STRIP_TAC THEN
  EQ_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
   (REWRITE_RULE[CONJ_ASSOC] HOMOTOPY_INVARIANT_PATH_CONNECTEDNESS)) THEN
  ASM_MESON_TAC[]);;

let HOMOTOPY_EQUIVALENT_CARD_EQ_PATH_COMPONENTS = prove
 (`!s:real^M->bool t:real^N->bool.
        s homotopy_equivalent t
        ==> {path_component s x | x | x IN s} =_c
            {path_component t x | x | x IN t}`,
  REWRITE_TAC[homotopy_equivalent] THEN REPEAT STRIP_TAC THEN
  REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THEN
  MATCH_MP_TAC HOMOTOPY_INVARIANT_CARD_PATH_COMPONENTS THEN ASM_MESON_TAC[]);;

let HOMEOMORPHIC_CARD_EQ_PATH_COMPONENTS = prove
 (`!s:real^M->bool t:real^N->bool.
        s homeomorphic t
        ==> {path_component s x | x | x IN s} =_c
            {path_component t x | x | x IN t}`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC HOMOTOPY_EQUIVALENT_CARD_EQ_PATH_COMPONENTS THEN
  MATCH_MP_TAC HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT THEN
  ASM_REWRITE_TAC[]);;

let FINITE_COMPONENTS_PUNCTURED_CONVEX = prove
 (`!s a:real^N. convex s ==> FINITE(components(s DELETE a))`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `aff_dim(s:real^N->bool) = &1` THENL
   [ALL_TAC;
    ASM_MESON_TAC[CONNECTED_PUNCTURED_CONVEX;
                  CONNECTED_EQ_CARD_COMPONENTS]] THEN
  ASM_CASES_TAC `(a:real^N) IN s` THENL
   [ALL_TAC;
    ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> s DELETE a = s`] THEN
    MATCH_MP_TAC(MESON[CONNECTED_EQ_CARD_COMPONENTS]
     `connected(c:real^N->bool) ==> FINITE(components c)`) THEN
    ASM_SIMP_TAC[CONVEX_CONNECTED]] THEN
  SUBGOAL_THEN `?t. (s:real^N->bool) homeomorphic (t:real^1->bool)`
  CHOOSE_TAC THENL
   [MP_TAC(ISPECL [`affine hull s:real^N->bool`; `(:real^1)`]
        HOMEOMORPHIC_AFFINE_SETS) THEN
    ASM_REWRITE_TAC[AFFINE_AFFINE_HULL; AFFINE_UNIV; AFF_DIM_AFFINE_HULL] THEN
    SIMP_TAC[AFF_DIM_UNIV; DIMINDEX_1; homeomorphic; LEFT_IMP_EXISTS_THM] THEN
    REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `s:real^N->bool` o MATCH_MP
     (ONCE_REWRITE_RULE [IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN
    REWRITE_TAC[HULL_SUBSET; SUBSET_UNIV] THEN MESON_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN
    `?b. b IN t /\ (s DELETE (a:real^N)) homeomorphic (t DELETE (b:real^1))`
  (X_CHOOSE_THEN `b:real^1` MP_TAC) THENL
   [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
    REWRITE_TAC[homeomorphic; RIGHT_AND_EXISTS_THM] THEN
    GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^1` THEN
    GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^1->real^N` THEN
    DISCH_TAC THEN EXISTS_TAC `(f:real^N->real^1) a` THEN CONJ_TAC THENL
     [ALL_TAC;
      FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
       (ONCE_REWRITE_RULE [IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS))] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
    DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN
    DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_CARD_EQ_COMPONENTS) THEN
    DISCH_THEN(SUBST1_TAC o MATCH_MP CARD_FINITE_CONG) THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_CONNECTEDNESS) THEN
    ASM_SIMP_TAC[CONVEX_CONNECTED] THEN
    REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1]] THEN
  POP_ASSUM_LIST(K ALL_TAC) THEN REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `connected(t DELETE (b:real^1))` THENL
   [ASM_MESON_TAC[CONNECTED_EQ_CARD_COMPONENTS]; ALL_TAC] THEN
  MP_TAC(ISPECL
   [`t DELETE (b:real^1)`;
    `t INTER {x | drop x < drop b}`; `t INTER {x | drop b < drop x}`]
   COMPONENTS_UNIQUE_2) THEN
  ANTS_TAC THENL [ALL_TAC; SIMP_TAC[FINITE_INSERT; FINITE_EMPTY]] THEN
  ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1] THEN
  ASM_SIMP_TAC[IS_INTERVAL_INTER;  IS_INTERVAL_1_CLAUSES] THEN
  MATCH_MP_TAC(SET_RULE
   `(!x. ~P x /\ ~Q x <=> x = b)
    ==> t INTER {x | P x} UNION t INTER {x | Q x} = t DELETE b`) THEN
  REWRITE_TAC[GSYM DROP_EQ] THEN REAL_ARITH_TAC);;

(* ------------------------------------------------------------------------- *)
(* Contractible sets.                                                        *)
(* ------------------------------------------------------------------------- *)

let contractible = new_definition
 `contractible s <=>
    ?a. homotopic_with (\x. T)
         (subtopology euclidean s,subtopology euclidean s) (\x. x) (\x. a)`;;

let CONTRACTIBLE_SPACE_EUCLIDEAN = prove
 (`!s:real^N->bool.
        contractible_space(subtopology euclidean s) <=> contractible s`,
  REWRITE_TAC[contractible; contractible_space]);;

let CONTRACTIBLE_IMP_SIMPLY_CONNECTED = prove
 (`!s:real^N->bool. contractible s ==> simply_connected s`,
  GEN_TAC THEN REWRITE_TAC[contractible] THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[SIMPLY_CONNECTED_EMPTY] THEN
  ASM_REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ALL] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN
  DISCH_TAC THEN REWRITE_TAC[homotopic_loops; PCROSS] THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
  MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN
  CONJ_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN
  X_GEN_TAC `p:real^1->real^N` THEN
  REWRITE_TAC[path; path_image; pathfinish; pathstart] THEN
  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMOTOPIC_WITH_EUCLIDEAN]) THEN
  REWRITE_TAC[HOMOTOPIC_WITH_EUCLIDEAN; SUBSET; FORALL_IN_IMAGE; PCROSS] THEN
  REWRITE_TAC[FORALL_IN_GSPEC] THEN
  DISCH_THEN(X_CHOOSE_THEN `h:real^(1,N)finite_sum->real^N`
    STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `(h o (\y. pastecart (fstcart y) (p(sndcart y):real^N)))
              :real^(1,1)finite_sum->real^N` THEN
  ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; linepath; o_THM] THEN
  CONJ_TAC THENL [ALL_TAC; CONV_TAC VECTOR_ARITH] THEN
  MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
   [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
    SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
    GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART];
    ALL_TAC] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE [IMP_CONJ]
     CONTINUOUS_ON_SUBSET)) THEN
  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
  ASM_SIMP_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART]);;

let CONTRACTIBLE_IMP_CONNECTED = prove
 (`!s:real^N->bool. contractible s ==> connected s`,
  SIMP_TAC[CONTRACTIBLE_IMP_SIMPLY_CONNECTED;
           SIMPLY_CONNECTED_IMP_CONNECTED]);;

let CONTRACTIBLE_IMP_PATH_CONNECTED = prove
 (`!s:real^N->bool. contractible s ==> path_connected s`,
  SIMP_TAC[CONTRACTIBLE_IMP_SIMPLY_CONNECTED;
           SIMPLY_CONNECTED_IMP_PATH_CONNECTED]);;

let NULLHOMOTOPIC_THROUGH_CONTRACTIBLE = prove
 (`!f:real^M->real^N g:real^N->real^P s t u.
        f continuous_on s /\ IMAGE f s SUBSET t /\
        g continuous_on t /\ IMAGE g t SUBSET u /\
        contractible t
        ==> ?c. homotopic_with (\h. T)
                 (subtopology euclidean s,subtopology euclidean u)
                 (g o f) (\x. c)`,
  REWRITE_TAC[GSYM CONTRACTIBLE_SPACE_EUCLIDEAN] THEN
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC NULLHOMOTOPIC_THROUGH_CONTRACTIBLE_SPACE THEN
  EXISTS_TAC `subtopology euclidean (t:real^N->bool)` THEN
  ASM_REWRITE_TAC[CONTINUOUS_MAP_EUCLIDEAN2]);;

let NULLHOMOTOPIC_INTO_CONTRACTIBLE = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\ IMAGE f s SUBSET t /\ contractible t
        ==> ?c. homotopic_with (\h. T)
                 (subtopology euclidean s,subtopology euclidean t) f (\x. c)`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `(f:real^M->real^N) = (\x. x) o f` SUBST1_TAC THENL
   [REWRITE_TAC[o_THM; FUN_EQ_THM];
    MATCH_MP_TAC NULLHOMOTOPIC_THROUGH_CONTRACTIBLE THEN
    EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN
    SET_TAC[]]);;

let NULLHOMOTOPIC_FROM_CONTRACTIBLE = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\ IMAGE f s SUBSET t /\ contractible s
        ==> ?c. homotopic_with (\h. T)
                 (subtopology euclidean s,subtopology euclidean t) f (\x. c)`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `(f:real^M->real^N) = f o (\x. x)` SUBST1_TAC THENL
   [REWRITE_TAC[o_THM; FUN_EQ_THM];
    MATCH_MP_TAC NULLHOMOTOPIC_THROUGH_CONTRACTIBLE THEN
    EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN
    SET_TAC[]]);;

let HOMOTOPIC_THROUGH_CONTRACTIBLE = prove
 (`!f1:real^M->real^N g1:real^N->real^P f2 g2 s t u.
        f1 continuous_on s /\ IMAGE f1 s SUBSET t /\
        g1 continuous_on t /\ IMAGE g1 t SUBSET u /\
        f2 continuous_on s /\ IMAGE f2 s SUBSET t /\
        g2 continuous_on t /\ IMAGE g2 t SUBSET u /\
        contractible t /\ path_connected u
        ==> homotopic_with (\h. T)
             (subtopology euclidean s,subtopology euclidean u)
             (g1 o f1) (g2 o f2)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_THROUGH_CONTRACTIBLE_SPACE THEN
  EXISTS_TAC `subtopology euclidean (t:real^N->bool)` THEN
  ASM_REWRITE_TAC[CONTINUOUS_MAP_EUCLIDEAN2] THEN
  ASM_REWRITE_TAC[CONTRACTIBLE_SPACE_EUCLIDEAN] THEN
  ASM_REWRITE_TAC[PATH_CONNECTED_SPACE_EUCLIDEAN_SUBTOPOLOGY]);;

let HOMOTOPIC_INTO_CONTRACTIBLE = prove
 (`!f:real^M->real^N g s t.
        f continuous_on s /\ IMAGE f s SUBSET t /\
        g continuous_on s /\ IMAGE g s SUBSET t /\
        contractible t
        ==> homotopic_with (\h. T)
             (subtopology euclidean s,subtopology euclidean t) f g`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_INTO_CONTRACTIBLE_SPACE THEN
  ASM_REWRITE_TAC[CONTINUOUS_MAP_EUCLIDEAN2; CONTRACTIBLE_SPACE_EUCLIDEAN]);;

let HOMOTOPIC_FROM_CONTRACTIBLE = prove
 (`!f:real^M->real^N g s t.
        f continuous_on s /\ IMAGE f s SUBSET t /\
        g continuous_on s /\ IMAGE g s SUBSET t /\
        contractible s /\ path_connected t
        ==> homotopic_with (\h. T)
             (subtopology euclidean s,subtopology euclidean t) f g`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_FROM_CONTRACTIBLE_SPACE THEN
  ASM_REWRITE_TAC[CONTINUOUS_MAP_EUCLIDEAN2; CONTRACTIBLE_SPACE_EUCLIDEAN;
                  PATH_CONNECTED_SPACE_EUCLIDEAN_SUBTOPOLOGY]);;

let HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS = prove
 (`!s:real^M->bool t:real^N->bool.
        contractible s /\ contractible t /\ (s = {} <=> t = {})
        ==> s homotopy_equivalent t`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN
  ASM_SIMP_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT; HOMEOMORPHIC_EMPTY] THEN
  FIRST_X_ASSUM(X_CHOOSE_TAC `b:real^N` o
    GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  STRIP_TAC THEN REWRITE_TAC[homotopy_equivalent] THEN
  FIRST_X_ASSUM(X_CHOOSE_TAC `a:real^M` o
    GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  EXISTS_TAC `(\x. b):real^M->real^N` THEN
  EXISTS_TAC `(\y. a):real^N->real^M` THEN
  REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
  REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
  CONJ_TAC THEN MATCH_MP_TAC HOMOTOPIC_INTO_CONTRACTIBLE THEN
  ASM_REWRITE_TAC[o_DEF; IMAGE_ID; I_DEF; SUBSET_REFL; CONTINUOUS_ON_ID;
                  CONTINUOUS_ON_CONST] THEN
  ASM SET_TAC[]);;

let STARLIKE_IMP_CONTRACTIBLE_GEN = prove
 (`!P s.
        (!a t. a IN s /\ &0 <= t /\ t <= &1 ==> P(\x. (&1 - t) % x + t % a)) /\
        starlike s
        ==> ?a:real^N. homotopic_with P
            (subtopology euclidean s,subtopology euclidean s) (\x. x) (\x. a)`,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  REWRITE_TAC[starlike] THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN
  REWRITE_TAC[segment; SUBSET; FORALL_IN_GSPEC] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN
  REWRITE_TAC[HOMOTOPIC_WITH_EUCLIDEAN; PCROSS] THEN
  EXISTS_TAC `\y:real^(1,N)finite_sum.
             (&1 - drop(fstcart y)) % sndcart y +
             drop(fstcart y) % a` THEN
  ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC; IN_INTERVAL_1;
    SUBSET; FORALL_IN_IMAGE; REAL_SUB_RZERO; REAL_SUB_REFL; FORALL_IN_GSPEC;
    VECTOR_MUL_LZERO; VECTOR_MUL_LID; VECTOR_ADD_LID; VECTOR_ADD_RID] THEN
  MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN
  MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
  SIMP_TAC[o_DEF; LIFT_DROP; ETA_AX; LIFT_SUB; CONTINUOUS_ON_SUB;
           CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; ETA_AX;
           LINEAR_FSTCART; LINEAR_SNDCART]);;

let STARLIKE_IMP_CONTRACTIBLE = prove
 (`!s:real^N->bool. starlike s ==> contractible s`,
  SIMP_TAC[contractible; STARLIKE_IMP_CONTRACTIBLE_GEN]);;

let CONTRACTIBLE_UNIV = prove
 (`contractible(:real^N)`,
  SIMP_TAC[STARLIKE_IMP_CONTRACTIBLE; STARLIKE_UNIV]);;

let STARLIKE_IMP_SIMPLY_CONNECTED = prove
 (`!s:real^N->bool. starlike s ==> simply_connected s`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTRACTIBLE_IMP_SIMPLY_CONNECTED THEN
  MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN ASM_REWRITE_TAC[]);;

let CONVEX_IMP_SIMPLY_CONNECTED = prove
 (`!s:real^N->bool. convex s ==> simply_connected s`,
  MESON_TAC[CONVEX_IMP_STARLIKE; STARLIKE_IMP_SIMPLY_CONNECTED;
            SIMPLY_CONNECTED_EMPTY]);;

let STARLIKE_IMP_PATH_CONNECTED = prove
 (`!s:real^N->bool. starlike s ==> path_connected s`,
  MESON_TAC[STARLIKE_IMP_SIMPLY_CONNECTED;
            SIMPLY_CONNECTED_IMP_PATH_CONNECTED]);;

let STARLIKE_IMP_CONNECTED = prove
 (`!s:real^N->bool. starlike s ==> connected s`,
  MESON_TAC[STARLIKE_IMP_PATH_CONNECTED; PATH_CONNECTED_IMP_CONNECTED]);;

let CONIC_IMP_PATH_CONNECTED = prove
 (`!s:real^N->bool. conic s ==> path_connected s`,
  MESON_TAC[STARLIKE_IMP_PATH_CONNECTED; CONIC_IMP_STARLIKE;
            PATH_CONNECTED_EMPTY]);;

let CONIC_IMP_CONNECTED = prove
 (`!s:real^N->bool. conic s ==> connected s`,
  MESON_TAC[CONIC_IMP_PATH_CONNECTED; PATH_CONNECTED_IMP_CONNECTED]);;

let IS_INTERVAL_SIMPLY_CONNECTED_1 = prove
 (`!s:real^1->bool. is_interval s <=> simply_connected s`,
  MESON_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED; IS_INTERVAL_PATH_CONNECTED_1;
            CONVEX_IMP_SIMPLY_CONNECTED; IS_INTERVAL_CONVEX_1]);;

let CONTRACTIBLE_EMPTY = prove
 (`contractible {}`,
  SIMP_TAC[contractible; HOMOTOPIC_WITH_EUCLIDEAN_ALT; PCROSS_EMPTY;
           NOT_IN_EMPTY] THEN
  REWRITE_TAC[CONTINUOUS_ON_EMPTY] THEN SET_TAC[]);;

let CONIC_IMP_CONTRACTIBLE = prove
 (`!s:real^N->bool. conic s ==> contractible s`,
  MESON_TAC[CONIC_IMP_STARLIKE; STARLIKE_IMP_CONTRACTIBLE;
            CONTRACTIBLE_EMPTY]);;

let CONIC_IMP_SIMPLY_CONNECTED = prove
 (`!s:real^N->bool. conic s ==> simply_connected s`,
  MESON_TAC[CONIC_IMP_CONTRACTIBLE; CONTRACTIBLE_IMP_SIMPLY_CONNECTED]);;

let CONTRACTIBLE_CONVEX_TWEAK_BOUNDARY_POINTS = prove
 (`!s t:real^N->bool.
        convex s /\ relative_interior s SUBSET t /\ t SUBSET closure s
        ==> contractible t`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_SIMP_TAC[SUBSET_EMPTY; CLOSURE_EMPTY; CONTRACTIBLE_EMPTY] THEN
  STRIP_TAC THEN MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN
  MATCH_MP_TAC STARLIKE_CONVEX_TWEAK_BOUNDARY_POINTS THEN ASM_MESON_TAC[]);;

let CONVEX_IMP_CONTRACTIBLE = prove
 (`!s:real^N->bool. convex s ==> contractible s`,
  MESON_TAC[CONVEX_IMP_STARLIKE; CONTRACTIBLE_EMPTY;
            STARLIKE_IMP_CONTRACTIBLE]);;

let CONTRACTIBLE_SING = prove
 (`!a:real^N. contractible {a}`,
  SIMP_TAC[CONVEX_IMP_CONTRACTIBLE; CONVEX_SING]);;

let SIMPLY_CONNECTED_SING = prove
 (`!a:real^N. simply_connected {a}`,
  SIMP_TAC[CONTRACTIBLE_SING; CONTRACTIBLE_IMP_SIMPLY_CONNECTED]);;

let IS_INTERVAL_CONTRACTIBLE_1 = prove
 (`!s:real^1->bool. is_interval s <=> contractible s`,
  MESON_TAC[CONTRACTIBLE_IMP_PATH_CONNECTED; IS_INTERVAL_PATH_CONNECTED_1;
            CONVEX_IMP_CONTRACTIBLE; IS_INTERVAL_CONVEX_1]);;

let CONTRACTIBLE_PCROSS = prove
 (`!s:real^M->bool t:real^N->bool.
        contractible s /\ contractible t ==> contractible(s PCROSS t)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[contractible; HOMOTOPIC_WITH_EUCLIDEAN] THEN
  REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN
  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
  MAP_EVERY X_GEN_TAC [`a:real^M`; `h:real^(1,M)finite_sum->real^M`] THEN
  REPEAT DISCH_TAC THEN
  MAP_EVERY X_GEN_TAC [`b:real^N`; `k:real^(1,N)finite_sum->real^N`] THEN
  REPEAT DISCH_TAC THEN
  EXISTS_TAC `pastecart (a:real^M) (b:real^N)` THEN
  EXISTS_TAC `\z. pastecart
                   ((h:real^(1,M)finite_sum->real^M)
                    (pastecart (fstcart z) (fstcart(sndcart z))))
                   ((k:real^(1,N)finite_sum->real^N)
                    (pastecart (fstcart z) (sndcart(sndcart z))))` THEN
  ASM_SIMP_TAC[FORALL_IN_IMAGE; FORALL_PASTECART; PASTECART_IN_PCROSS;
               FSTCART_PASTECART; SNDCART_PASTECART] THEN
  MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN CONJ_TAC THEN
  GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
  MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
  SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON;
           LINEAR_FSTCART; LINEAR_SNDCART; CONTINUOUS_ON_ID;
           GSYM o_DEF; CONTINUOUS_ON_COMPOSE] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN
  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN
  SIMP_TAC[PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART]);;

let CONTRACTIBLE_PCROSS_EQ = prove
 (`!s:real^M->bool t:real^N->bool.
        contractible(s PCROSS t) <=>
        s = {} \/ t = {} \/ contractible s /\ contractible t`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `s:real^M->bool = {}` THEN
  ASM_REWRITE_TAC[PCROSS_EMPTY; CONTRACTIBLE_EMPTY] THEN
  ASM_CASES_TAC `t:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[PCROSS_EMPTY; CONTRACTIBLE_EMPTY] THEN
  EQ_TAC THEN REWRITE_TAC[CONTRACTIBLE_PCROSS] THEN
  REWRITE_TAC[contractible; HOMOTOPIC_WITH_EUCLIDEAN; LEFT_IMP_EXISTS_THM] THEN
  SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
  MAP_EVERY X_GEN_TAC
   [`a:real^M`; `b:real^N`;
    `h:real^(1,(M,N)finite_sum)finite_sum->real^(M,N)finite_sum`] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN `(a:real^M) IN s /\ (b:real^N) IN t` STRIP_ASSUME_TAC THENL
   [REWRITE_TAC[GSYM PASTECART_IN_PCROSS] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN
    ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL];
    ALL_TAC] THEN
  CONJ_TAC THENL
   [EXISTS_TAC `a:real^M` THEN
    EXISTS_TAC
     `fstcart o
      (h:real^(1,(M,N)finite_sum)finite_sum->real^(M,N)finite_sum) o
      (\z. pastecart (fstcart z) (pastecart (sndcart z) b))`;
    EXISTS_TAC `b:real^N` THEN
    EXISTS_TAC
     `sndcart o
      (h:real^(1,(M,N)finite_sum)finite_sum->real^(M,N)finite_sum) o
      (\z. pastecart (fstcart z) (pastecart a (sndcart z)))`] THEN
  ASM_REWRITE_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART;
                  SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS; o_THM] THEN
  (CONJ_TAC THENL
    [ALL_TAC;  ASM_MESON_TAC[PASTECART_FST_SND; PASTECART_IN_PCROSS]]) THEN
  MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
  SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN
  MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
  SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST;
           LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN
  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
  ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS]);;

let HOMOTOPY_EQUIVALENT_EMPTY = prove
 (`(!s. (s:real^M->bool) homotopy_equivalent ({}:real^N->bool) <=> s = {}) /\
   (!t. ({}:real^M->bool) homotopy_equivalent (t:real^N->bool) <=> t = {})`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN
  SIMP_TAC[HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS; CONTRACTIBLE_EMPTY] THEN
  REWRITE_TAC[homotopy_equivalent] THEN SET_TAC[]);;

let HOMOTOPY_EQUIVALENT_CONTRACTIBILITY = prove
 (`!s:real^M->bool t:real^N->bool.
        s homotopy_equivalent t ==> (contractible s <=> contractible t)`,
  REWRITE_TAC[GSYM HOMOTOPY_EQUIVALENT_SPACE_EUCLIDEAN;
              GSYM CONTRACTIBLE_SPACE_EUCLIDEAN] THEN
  REWRITE_TAC[HOMOTOPY_EQUIVALENT_SPACE_CONTRACTIBILITY]);;

let HOMOTOPY_EQUIVALENT_SING = prove
 (`!s:real^M->bool a:real^N.
        s homotopy_equivalent {a} <=> ~(s = {}) /\ contractible s`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN
  ASM_REWRITE_TAC[HOMOTOPY_EQUIVALENT_EMPTY; NOT_INSERT_EMPTY] THEN
  EQ_TAC THENL
   [DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPY_EQUIVALENT_CONTRACTIBILITY) THEN
    REWRITE_TAC[CONTRACTIBLE_SING];
    DISCH_TAC THEN MATCH_MP_TAC HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS THEN
    ASM_REWRITE_TAC[CONTRACTIBLE_SING; NOT_INSERT_EMPTY]]);;

let HOMEOMORPHIC_CONTRACTIBLE_EQ = prove
 (`!s:real^M->bool t:real^N->bool.
        s homeomorphic t ==> (contractible s <=> contractible t)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPY_EQUIVALENT_CONTRACTIBILITY THEN
  ASM_SIMP_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT]);;

let HOMEOMORPHIC_CONTRACTIBLE = prove
 (`!s:real^M->bool t:real^N->bool.
        s homeomorphic t /\ contractible s ==> contractible t`,
  MESON_TAC[HOMEOMORPHIC_CONTRACTIBLE_EQ]);;

let CONTRACTIBLE_TRANSLATION = prove
 (`!a:real^N s. contractible (IMAGE (\x. a + x) s) <=> contractible s`,
  REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_CONTRACTIBLE_EQ THEN
  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
  REWRITE_TAC[HOMEOMORPHIC_TRANSLATION]);;

add_translation_invariants [CONTRACTIBLE_TRANSLATION];;

let CONTRACTIBLE_INJECTIVE_LINEAR_IMAGE = prove
 (`!f:real^M->real^N s.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (contractible (IMAGE f s) <=> contractible s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_CONTRACTIBLE_EQ THEN
  ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ;
                HOMEOMORPHIC_REFL]);;

add_linear_invariants [CONTRACTIBLE_INJECTIVE_LINEAR_IMAGE];;

let HOMEOMORPHISM_CONTRACTIBILITY = prove
 (`!f:real^M->real^N g s t k.
        homeomorphism (s,t) (f,g) /\ k SUBSET s
        ==> (contractible(IMAGE f k) <=> contractible k)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_CONTRACTIBLE_EQ THEN
  ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN
  MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
          HOMEOMORPHISM_OF_SUBSETS)) THEN
  RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Homeomorphisms between punctured spheres and affine sets.                 *)
(* ------------------------------------------------------------------------- *)

let HOMEOMORPHIC_PUNCTURED_AFFINE_SPHERE_AFFINE = prove
 (`!a r b t:real^N->bool p:real^M->bool.
        &0 < r /\ b IN sphere(a,r) /\ affine t /\ a IN t /\ b IN t /\
        affine p /\ aff_dim t = aff_dim p + &1
        ==> ((sphere(a:real^N,r) INTER t) DELETE b) homeomorphic p`,
  GEOM_ORIGIN_TAC `a:real^N` THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN
  REWRITE_TAC[sphere; DIST_0; IN_ELIM_THM] THEN
  SIMP_TAC[CONJ_ASSOC; NORM_ARITH
   `&0 < r /\ norm(b:real^N) = r <=> norm(b) = r /\ ~(b = vec 0)`] THEN
  GEOM_NORMALIZE_TAC `b:real^N` THEN REWRITE_TAC[] THEN
  GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN
  SIMP_TAC[NORM_MUL; real_abs; NORM_BASIS; LE_REFL; DIMINDEX_GE_1] THEN
  X_GEN_TAC `b:real` THEN REWRITE_TAC[REAL_MUL_RID; VECTOR_MUL_EQ_0] THEN
  DISCH_THEN(K ALL_TAC) THEN DISCH_THEN SUBST1_TAC THEN
  REPEAT GEN_TAC THEN REWRITE_TAC[VECTOR_MUL_LID] THEN
  ASM_CASES_TAC `r = &1` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(K ALL_TAC) THEN
  CONV_TAC REAL_RAT_REDUCE_CONV THEN
  SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN STRIP_TAC THEN
  SUBGOAL_THEN `subspace(t:real^N->bool)` ASSUME_TAC THENL
   [ASM_MESON_TAC[AFFINE_EQ_SUBSPACE]; ALL_TAC] THEN
  TRANS_TAC HOMEOMORPHIC_TRANS `{x:real^N | x$1 = &0} INTER t` THEN
  CONJ_TAC THENL
   [ALL_TAC;
    MATCH_MP_TAC HOMEOMORPHIC_AFFINE_SETS THEN
    ASM_SIMP_TAC[AFFINE_INTER; AFFINE_STANDARD_HYPERPLANE] THEN
    ONCE_REWRITE_TAC[INTER_COMM] THEN
    MP_TAC(ISPECL [`basis 1:real^N`; `&0`; `t:real^N->bool`]
        AFF_DIM_AFFINE_INTER_HYPERPLANE) THEN
    ASM_SIMP_TAC[DOT_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
    DISCH_THEN SUBST1_TAC THEN
    SUBGOAL_THEN `~(t INTER {x:real^N | x$1 = &0} = {})` ASSUME_TAC THENL
     [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_ELIM_THM] THEN
      EXISTS_TAC `vec 0:real^N` THEN ASM_REWRITE_TAC[VEC_COMPONENT];
      ALL_TAC] THEN
    SUBGOAL_THEN `~(t SUBSET {v:real^N | v$1 = &0})` ASSUME_TAC THENL
     [REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `basis 1:real^N`) THEN
      ASM_SIMP_TAC[IN_ELIM_THM; BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN
      REAL_ARITH_TAC;
      ASM_REWRITE_TAC[] THEN INT_ARITH_TAC]] THEN
  SUBGOAL_THEN
   `({x:real^N | norm x = &1} INTER t) DELETE (basis 1) =
    {x | norm x = &1 /\ ~(x$1 = &1)} INTER t`
  SUBST1_TAC THENL
   [MATCH_MP_TAC(SET_RULE
     `s DELETE a = s' ==> (s INTER t) DELETE a = s' INTER t`) THEN
    MATCH_MP_TAC(SET_RULE
     `Q a /\ (!x. P x /\ Q x ==> x = a)
      ==> {x | P x} DELETE a = {x | P x /\ ~Q x}`) THEN
    SIMP_TAC[BASIS_COMPONENT; CART_EQ; DIMINDEX_GE_1; LE_REFL] THEN
    REWRITE_TAC[NORM_EQ_SQUARE; REAL_POS; REAL_POW_ONE] THEN
    X_GEN_TAC `x:real^N` THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
    ASM_SIMP_TAC[dot; SUM_CLAUSES_LEFT; DIMINDEX_GE_1] THEN
    REWRITE_TAC[REAL_ARITH `&1 * &1 + s = &1 <=> s = &0`] THEN
    DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
      SUM_POS_EQ_0_NUMSEG)) THEN
    REWRITE_TAC[REAL_LE_SQUARE; REAL_ENTIRE] THEN
    REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
    ALL_TAC] THEN
  REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN MAP_EVERY ABBREV_TAC
   [`f = \x:real^N. &2 % basis 1 + &2 / (&1 - x$1) % (x - basis 1)`;
    `g = \y:real^N.
           basis 1 + &4 / (norm y pow 2 + &4) % (y - &2 % basis 1)`] THEN
  MAP_EVERY EXISTS_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC(MESON[CONTINUOUS_ON_SUBSET; INTER_SUBSET]
     `f continuous_on s ==> f continuous_on (s INTER t)`) THEN
    EXPAND_TAC "f" THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
    REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
    MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
    SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
    REWRITE_TAC[o_DEF; real_div; LIFT_CMUL] THEN
    MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
    MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
    SIMP_TAC[REAL_SUB_0; IN_ELIM_THM] THEN
    REWRITE_TAC[LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
    REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
    MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT THEN
    REWRITE_TAC[LE_REFL; DIMINDEX_GE_1];
    MATCH_MP_TAC(SET_RULE
     `IMAGE f s SUBSET s' /\ IMAGE f t SUBSET t
      ==> IMAGE f (s INTER t) SUBSET (s' INTER t)`) THEN
    EXPAND_TAC "f" THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
    ASM_SIMP_TAC[SUBSPACE_ADD; SUBSPACE_MUL; SUBSPACE_SUB] THEN
    REWRITE_TAC[IN_ELIM_THM; IN_DELETE] THEN
    SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT;
             LE_REFL; DIMINDEX_GE_1; VECTOR_SUB_COMPONENT] THEN
    CONV_TAC REAL_FIELD;
    MATCH_MP_TAC(MESON[CONTINUOUS_ON_SUBSET; INTER_SUBSET]
     `f continuous_on s ==> f continuous_on (s INTER t)`) THEN
    EXPAND_TAC "g" THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
    REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
    MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
    SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
    REWRITE_TAC[o_DEF; real_div; LIFT_CMUL] THEN
    MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
    MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
    SIMP_TAC[LIFT_ADD; REAL_POW_LE; NORM_POS_LE; REAL_ARITH
     `&0 <= x ==> ~(x + &4 = &0)`] THEN
    MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
    REWRITE_TAC[REAL_POW_2; LIFT_CMUL; CONTINUOUS_ON_CONST] THEN
    MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
    REWRITE_TAC[CONTINUOUS_ON_LIFT_NORM; GSYM o_DEF];
    MATCH_MP_TAC(SET_RULE
     `IMAGE f s SUBSET s' /\ IMAGE f t SUBSET t
      ==> IMAGE f (s INTER t) SUBSET (s' INTER t)`) THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
    REWRITE_TAC[NORM_EQ_SQUARE; REAL_POS] THEN EXPAND_TAC "g" THEN
    CONJ_TAC THENL
     [ALL_TAC; ASM_MESON_TAC[SUBSPACE_ADD; SUBSPACE_MUL; SUBSPACE_SUB]] THEN
    X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
    REWRITE_TAC[VECTOR_ARITH
     `b + a % (y - &2 % b):real^N = (&1 - &2 * a) % b + a % y`] THEN
    REWRITE_TAC[NORM_POW_2; VECTOR_ARITH
     `(a + b:real^N) dot (a + b) = (a dot a + b dot b) + &2 * a dot b`] THEN
    ASM_SIMP_TAC[DOT_LMUL; DOT_RMUL; DOT_BASIS; BASIS_COMPONENT; LE_REFL;
                VECTOR_ADD_COMPONENT; DIMINDEX_GE_1; VECTOR_MUL_COMPONENT] THEN
    REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID; GSYM REAL_POW_2] THEN
    SUBGOAL_THEN `~((y:real^N) dot y + &4 = &0)` MP_TAC THENL
     [MESON_TAC[DOT_POS_LE; REAL_ARITH `&0 <= x ==> ~(x + &4 = &0)`];
      CONV_TAC REAL_FIELD];
    SUBGOAL_THEN
     `!x. norm x = &1 /\ ~(x$1 = &1)
          ==> norm((f:real^N->real^N) x) pow 2 = &4 * (&1 + x$1) / (&1 - x$1)`
    ASSUME_TAC THENL
     [REPEAT STRIP_TAC THEN EXPAND_TAC "f" THEN
      REWRITE_TAC[VECTOR_ARITH
       `a % b + m % (x - b):real^N = (a - m) % b + m % x`] THEN
      REWRITE_TAC[NORM_POW_2; VECTOR_ARITH
       `(a + b:real^N) dot (a + b) = (a dot a + b dot b) + &2 * a dot b`] THEN
      SIMP_TAC[DOT_LMUL; DOT_RMUL; DOT_BASIS; BASIS_COMPONENT;
               DIMINDEX_GE_1; LE_REFL; VECTOR_MUL_COMPONENT] THEN
      ASM_REWRITE_TAC[GSYM NORM_POW_2; GSYM REAL_POW_2; REAL_MUL_RID;
                      REAL_POW_ONE] THEN
      UNDISCH_TAC `~((x:real^N)$1 = &1)` THEN CONV_TAC REAL_FIELD;
      ALL_TAC] THEN
    EXPAND_TAC "g" THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN
    ASM_SIMP_TAC[] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
    ASM_SIMP_TAC[REAL_FIELD
     `~(x = &1)
      ==> &4 * (&1 + x) / (&1 - x) + &4 = &8 / (&1 - x)`] THEN
    REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN
    REWRITE_TAC[REAL_ARITH `&4 * inv(&8) * x = x / &2`] THEN
    EXPAND_TAC "f" THEN
    REWRITE_TAC[VECTOR_ARITH `(a + x) - a:real^N = x`] THEN
    REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH
     `b + a % (x - b):real^N = x <=> (&1 - a) % (x - b) = vec 0`] THEN
    REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ1_TAC THEN
    UNDISCH_TAC `~((x:real^N)$1 = &1)` THEN CONV_TAC REAL_FIELD;
    X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN
    DISCH_TAC THEN
    SUBGOAL_THEN `~((y:real^N) dot y + &4 = &0)` ASSUME_TAC THENL
     [MESON_TAC[DOT_POS_LE; REAL_ARITH `&0 <= x ==> ~(x + &4 = &0)`];
      ALL_TAC] THEN
    SUBGOAL_THEN `((g:real^N->real^N) y)$1 =
                  (y dot y - &4) / (y dot y + &4)` ASSUME_TAC THENL
     [EXPAND_TAC "g" THEN REWRITE_TAC[VECTOR_ADD_COMPONENT] THEN
      REWRITE_TAC[VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT] THEN
      ASM_SIMP_TAC[BASIS_COMPONENT; LE_REFL; NORM_POW_2; DIMINDEX_GE_1] THEN
      UNDISCH_TAC `~((y:real^N) dot y + &4 = &0)` THEN
      CONV_TAC REAL_FIELD;
      ALL_TAC] THEN
    EXPAND_TAC "f" THEN REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN
    EXPAND_TAC "g" THEN SIMP_TAC[VECTOR_ARITH `(a + x) - a:real^N = x`] THEN
    REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH
     `b + a % (x - b):real^N = x <=> (&1 - a) % (x - b) = vec 0`] THEN
    REWRITE_TAC[VECTOR_MUL_EQ_0; NORM_POW_2] THEN DISJ1_TAC THEN
    UNDISCH_TAC `~((y:real^N) dot y + &4 = &0)` THEN CONV_TAC REAL_FIELD]);;

let HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN = prove
 (`!s:real^N->bool t:real^M->bool a.
        convex s /\ bounded s /\ a IN relative_frontier s /\
        affine t /\ aff_dim s = aff_dim t + &1
        ==> (relative_frontier s DELETE a) homeomorphic t`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_GE; INT_ARITH
   `--(&1):int <= s ==> ~(--(&1) = s + &1)`] THEN
  MP_TAC(ISPECL [`(:real^N)`; `aff_dim(s:real^N->bool)`]
    CHOOSE_AFFINE_SUBSET) THEN REWRITE_TAC[SUBSET_UNIV] THEN
  REWRITE_TAC[AFF_DIM_GE; AFF_DIM_LE_UNIV; AFF_DIM_UNIV; AFFINE_UNIV] THEN
  DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN `~(t:real^N->bool = {})` MP_TAC THENL
   [ASM_MESON_TAC[AFF_DIM_EQ_MINUS1]; ALL_TAC] THEN
  GEN_REWRITE_TAC LAND_CONV [GSYM MEMBER_NOT_EMPTY] THEN
  DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN STRIP_TAC THEN
  MP_TAC(ISPECL
   [`s:real^N->bool`; `ball(z:real^N,&1) INTER t`]
        HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS) THEN
  MP_TAC(ISPECL [`t:real^N->bool`; `ball(z:real^N,&1)`]
        (ONCE_REWRITE_RULE[INTER_COMM] AFF_DIM_CONVEX_INTER_OPEN)) THEN
  MP_TAC(ISPECL [`ball(z:real^N,&1)`; `t:real^N->bool`]
        RELATIVE_FRONTIER_CONVEX_INTER_AFFINE) THEN
  ASM_SIMP_TAC[CONVEX_INTER; BOUNDED_INTER; BOUNDED_BALL; CONVEX_BALL;
               AFFINE_IMP_CONVEX; INTERIOR_OPEN; OPEN_BALL;
               FRONTIER_BALL; REAL_LT_01] THEN
  SUBGOAL_THEN `~(ball(z:real^N,&1) INTER t = {})` ASSUME_TAC THENL
   [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
    EXISTS_TAC `z:real^N` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_01];
    ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN SUBST1_TAC) THEN SIMP_TAC[]] THEN
  REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN
  STRIP_TAC THEN REWRITE_TAC[GSYM homeomorphic] THEN
  TRANS_TAC HOMEOMORPHIC_TRANS
    `(sphere(z,&1) INTER t) DELETE (h:real^N->real^N) a` THEN
  CONJ_TAC THENL
   [REWRITE_TAC[homeomorphic] THEN
    MAP_EVERY EXISTS_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN
    REWRITE_TAC[HOMEOMORPHISM] THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL
     [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; DELETE_SUBSET];
      ASM SET_TAC[];
      ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; DELETE_SUBSET];
      ASM SET_TAC[];
      ASM SET_TAC[];
      ASM SET_TAC[]];
    MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_AFFINE_SPHERE_AFFINE THEN
    ASM_REWRITE_TAC[REAL_LT_01; GSYM IN_INTER] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN
    ASM SET_TAC[]]);;

let HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE = prove
 (`!a r b:real^N t:real^M->bool.
    &0 < r /\ b IN sphere(a,r) /\ affine t /\ aff_dim(t) + &1 = &(dimindex(:N))
    ==> (sphere(a:real^N,r) DELETE b) homeomorphic t`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`cball(a:real^N,r)`; `t:real^M->bool`; `b:real^N`]
        HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN) THEN
  ASM_SIMP_TAC[RELATIVE_FRONTIER_CBALL; REAL_LT_IMP_NZ; AFF_DIM_CBALL;
               CONVEX_CBALL; BOUNDED_CBALL]);;

let HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE = prove
 (`!a r b c d.
        &0 < r /\ b IN sphere(a,r) /\ ~(c = vec 0)
        ==> (sphere(a:real^N,r) DELETE b) homeomorphic
             {x:real^N | c dot x = d}`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE THEN
  ASM_SIMP_TAC[AFFINE_HYPERPLANE; AFF_DIM_HYPERPLANE] THEN INT_ARITH_TAC);;

let HOMEOMORPHIC_PUNCTURED_SPHERE_UNIV = prove
 (`!a r b.
        &0 < r /\ b IN sphere(a,r) /\ dimindex(:N) = dimindex(:M) + 1
        ==> (sphere(a:real^N,r) DELETE b) homeomorphic (:real^M)`,
  REPEAT STRIP_TAC THEN
  TRANS_TAC HOMEOMORPHIC_TRANS `{x:real^N | basis 1 dot x = &0}` THEN
  ASM_SIMP_TAC[HOMEOMORPHIC_HYPERPLANE_UNIV; BASIS_NONZERO; LE_REFL;
               DIMINDEX_GE_1; HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE]);;

let CONTRACTIBLE_PUNCTURED_SPHERE = prove
 (`!a r b:real^N.
        &0 < r /\ b IN sphere(a,r) ==> contractible(sphere(a,r) DELETE b)`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `contractible {x:real^N | basis 1 dot x = &0}` MP_TAC THENL
   [SIMP_TAC[CONVEX_IMP_CONTRACTIBLE; CONVEX_HYPERPLANE];
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_CONTRACTIBLE) THEN
    ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
    MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE THEN
    ASM_SIMP_TAC[BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1]]);;

let CONTRACTIBLE_PUNCTURED_SPHERE_GEN = prove
 (`!s a:real^N.
        convex s /\ bounded s /\ a IN relative_frontier s
        ==> contractible(relative_frontier s DELETE a)`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[RELATIVE_FRONTIER_EMPTY; EMPTY_DELETE;
                  CONTRACTIBLE_EMPTY] THEN
  MP_TAC(SPEC `aff_dim(s:real^N->bool) - &1` AFFINE_EXISTS) THEN
  REWRITE_TAC[INT_ARITH `--a:int <= s - a <=> &0 <= s`] THEN
  ASM_SIMP_TAC[AFF_DIM_POS_LE; AFF_DIM_LE_UNIV; LEFT_IMP_EXISTS_THM;
               INT_ARITH `s:int <= n ==> s - &1 <= n`] THEN
  X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`; `a:real^N`]
    HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN) THEN
  ASM_REWRITE_TAC[INT_SUB_ADD] THEN
  DISCH_THEN(SUBST1_TAC o MATCH_MP HOMEOMORPHIC_CONTRACTIBLE_EQ) THEN
  ASM_SIMP_TAC[AFFINE_IMP_CONVEX; CONVEX_IMP_CONTRACTIBLE]);;

let NULLHOMOTOPIC_NONSURJECTIVE_SPHERE_MAP_GEN = prove
 (`!f s:real^N->bool.
        convex s /\ bounded s /\
        f continuous_on (relative_frontier s) /\
        IMAGE f (relative_frontier s) PSUBSET relative_frontier s
        ==> ?a. homotopic_with (\x. T)
                 (subtopology euclidean (relative_frontier s),
                  subtopology euclidean (relative_frontier s)) f (\x. a)`,
  REPEAT STRIP_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC o
    GEN_REWRITE_RULE I [PSUBSET_ALT]) THEN
  DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL
   [`f:real^N->real^N`; `\x:real^N. x`;
    `relative_frontier s:real^N->bool`;
    `relative_frontier s DELETE (a:real^N)`;
    `relative_frontier s:real^N->bool`]
   NULLHOMOTOPIC_THROUGH_CONTRACTIBLE) THEN
  ASM_REWRITE_TAC[IMAGE_ID; SUBSET_DELETE; DELETE_SUBSET; o_DEF; ETA_AX] THEN
  DISCH_THEN MATCH_MP_TAC THEN
  ASM_SIMP_TAC[CONTINUOUS_ON_ID; CONTRACTIBLE_PUNCTURED_SPHERE_GEN]);;

let CONNECTED_PUNCTURED_SPHERE = prove
 (`!a r b:real^N.
     connected(sphere(a,r) DELETE b) <=>
     (dimindex(:N) = 1 /\ &0 < r ==> b IN sphere(a,r))`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `r < &0` THEN
  ASM_SIMP_TAC[SPHERE_EMPTY; EMPTY_DELETE; NOT_IN_EMPTY; CONNECTED_EMPTY] THENL
   [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
  ASM_CASES_TAC `r = &0` THEN ASM_SIMP_TAC[SPHERE_SING; REAL_LT_REFL] THENL
   [SUBGOAL_THEN `{a:real^N} DELETE b = {a} \/ {a} DELETE b = {}` MP_TAC THENL
     [SET_TAC[]; DISCH_THEN(DISJ_CASES_THEN SUBST1_TAC)] THEN
    REWRITE_TAC[CONNECTED_EMPTY; CONNECTED_SING];
    ALL_TAC] THEN
  SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
  ASM_CASES_TAC `dimindex(:N) = 1` THEN ASM_REWRITE_TAC[] THENL
   [MP_TAC(ISPECL [`a:real^N`; `r:real`] HAS_SIZE_SPHERE_2) THEN
    ASM_REWRITE_TAC[] THEN CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN STRIP_TAC THEN
    ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN
    ASM_CASES_TAC `b:real^N = u` THENL
     [SUBGOAL_THEN `{u:real^N,v} DELETE b = {v}` SUBST1_TAC THENL
       [ASM SET_TAC[]; ASM_REWRITE_TAC[CONNECTED_SING]];
      ALL_TAC] THEN
    ASM_CASES_TAC `b:real^N = v` THENL
     [SUBGOAL_THEN `{u:real^N,v} DELETE b = {u}` SUBST1_TAC THENL
       [ASM SET_TAC[]; ASM_REWRITE_TAC[CONNECTED_SING]];
      ALL_TAC] THEN
    SUBGOAL_THEN `{u:real^N,v} DELETE b = {u,v}` SUBST1_TAC THENL
     [ASM SET_TAC[]; ASM_REWRITE_TAC[CONNECTED_2] THEN ASM SET_TAC[]];
    ASM_CASES_TAC `b IN sphere(a:real^N,r)` THENL
     [MP_TAC(ISPECL [`a:real^N`; `r:real`; `b:real^N`; `basis 1:real^N`; `&0`]
       HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE) THEN
      ASM_SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN
      DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_CONNECTEDNESS) THEN
      SIMP_TAC[CONVEX_HYPERPLANE; CONVEX_CONNECTED];
      ASM_SIMP_TAC[SET_RULE `~(x IN s) ==> s DELETE x = s`] THEN
      MATCH_MP_TAC CONNECTED_SPHERE THEN
      MATCH_MP_TAC(ARITH_RULE `1 <= n /\ ~(n = 1) ==> 2 <= n`) THEN
      ASM_REWRITE_TAC[DIMINDEX_GE_1]]]);;

let CONNECTED_IN_SPHERE_DELETE_INTERIOR_POINT_EQ = prove
 (`!a b r u s:real^N->bool.
        3 <= dimindex(:N) /\ open_in (subtopology euclidean (sphere(a,r))) u /\
        b IN u /\ u SUBSET s /\ s SUBSET sphere(a,r)
        ==> (connected(s DELETE b) <=> connected s)`,
  REPEAT STRIP_TAC THEN
  STRIP_ASSUME_TAC (SET_RULE `s DELETE (b:real^N) = s \/ b IN s`) THEN
  ASM_REWRITE_TAC[] THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
  ASM_CASES_TAC `s = {b:real^N}` THEN
  ASM_REWRITE_TAC[CONNECTED_SING; CONNECTED_EMPTY;
                  SET_RULE `{b} DELETE b = {}`] THEN
  ASM_CASES_TAC `r < &0` THENL
   [MP_TAC(ISPECL [`a:real^N`; `r:real`] SPHERE_EQ_EMPTY) THEN
    ASM SET_TAC[];
    RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_NOT_LE])] THEN
  ASM_CASES_TAC `r = &0` THENL
   [MP_TAC(ISPECL [`a:real^N`; `r:real`; `a:real^N`] SPHERE_EQ_SING) THEN
    ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
    SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]] THEN
  ASM_CASES_TAC `s = sphere(a:real^N,r)` THENL
   [FIRST_X_ASSUM SUBST_ALL_TAC THEN
    ASM_REWRITE_TAC[CONNECTED_PUNCTURED_SPHERE; CONNECTED_SPHERE_EQ] THEN
    DISJ1_TAC THEN ASM_ARITH_TAC;
    ALL_TAC] THEN
  SUBGOAL_THEN `?c:real^N. c IN sphere(a,r) /\ ~(c IN s) /\ ~(c = b)`
  STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  SUBGOAL_THEN
   `sphere(a:real^N,r) DELETE c homeomorphic (:real^(N,1)finite_diff)`
  MP_TAC THENL
   [MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_SPHERE_UNIV THEN
    ASM_REWRITE_TAC[DIMINDEX_FINITE_DIFF; DIMINDEX_1] THEN ASM_ARITH_TAC;
    REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM]] THEN
  MAP_EVERY X_GEN_TAC
   [`f:real^N->real^(N,1)finite_diff`; `g:real^(N,1)finite_diff->real^N`] THEN
  STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
      HOMEOMORPHISM_CONNECTEDNESS)) THEN
  DISCH_THEN(fun th ->
    MP_TAC(SPEC `s DELETE (b:real^N)` th) THEN
    MP_TAC(SPEC `s:real^N->bool` th)) THEN
  REPEAT(ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)]) THEN
  SUBGOAL_THEN
   `IMAGE (f:real^N->real^(N,1)finite_diff) (s DELETE b) =
    IMAGE f s DELETE f b`
  SUBST1_TAC THENL
   [MATCH_MP_TAC IMAGE_DELETE_INJ_ALT THEN
    ASM_REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; IN_UNIV]) THEN
    ASM SET_TAC[];
    ALL_TAC] THEN
  MATCH_MP_TAC CONNECTED_DELETE_INTERIOR_POINT_EQ THEN
  REWRITE_TAC[DIMINDEX_FINITE_DIFF; DIMINDEX_1] THEN
  CONJ_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[OPEN_IN]] THEN
  MATCH_MP_TAC(SET_RULE `!u. b IN u /\ IMAGE f u SUBSET t ==> f b IN t`) THEN
  EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC INTERIOR_MAXIMAL THEN ASM_SIMP_TAC[IMAGE_SUBSET] THEN
  REWRITE_TAC[OPEN_IN] THEN
  ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
  SUBGOAL_THEN
    `open_in (subtopology euclidean (sphere(a:real^N,r) DELETE c)) u`
  MP_TAC THENL
   [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        OPEN_IN_SUBSET_TRANS)) THEN
    ASM SET_TAC[];
    MATCH_MP_TAC EQ_IMP THEN CONV_TAC SYM_CONV THEN
    MATCH_MP_TAC HOMEOMORPHISM_OPENNESS THEN
    EXISTS_TAC `g:real^(N,1)finite_diff->real^N` THEN
    ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);;

let CONNECTED_OPEN_IN_SPHERE_DELETE_EQ = prove
 (`!a b r s:real^N->bool.
        3 <= dimindex(:N) /\ open_in (subtopology euclidean (sphere(a,r))) s
        ==> (connected(s DELETE b) <=> connected s)`,
  REPEAT STRIP_TAC THEN
  STRIP_ASSUME_TAC (SET_RULE `s DELETE (b:real^N) = s \/ b IN s`) THEN
  ASM_REWRITE_TAC[] THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
  MATCH_MP_TAC CONNECTED_IN_SPHERE_DELETE_INTERIOR_POINT_EQ THEN
  MAP_EVERY EXISTS_TAC [`a:real^N`; `r:real`; `s:real^N->bool`] THEN
  ASM_REWRITE_TAC[SUBSET_REFL]);;

let FINITE_COMPONENTS_PUNCTURED_CONNECTED_SUBSET_SPHERE = prove
 (`!r s a b:real^N.
        connected s /\ s SUBSET sphere(a,r) /\
        b IN (subtopology euclidean (sphere (a,r))) interior_of s
        ==> FINITE(components(s DELETE b))`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `FINITE(sphere(a:real^N,r))` THENL
   [MATCH_MP_TAC FINITE_COMPONENTS_FINITE THEN
    ASM_MESON_TAC[FINITE_SUBSET; FINITE_DELETE];
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [FINITE_SPHERE])] THEN
  REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LE] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE
   `~(n = 1) ==> 1 <= n ==> 3 <= n \/ n = 2`)) THEN
  REWRITE_TAC[DIMINDEX_GE_1] THEN STRIP_TAC THENL
   [MP_TAC(ISPECL
     [`a:real^N`; `b:real^N`; `r:real`;
      `subtopology euclidean (sphere(a:real^N,r)) interior_of s`;
      `s:real^N->bool`] CONNECTED_IN_SPHERE_DELETE_INTERIOR_POINT_EQ) THEN
    ASM_REWRITE_TAC[OPEN_IN_INTERIOR_OF; INTERIOR_OF_SUBSET] THEN
    SIMP_TAC[CONNECTED_EQ_CARD_COMPONENTS];
    FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP
     (REWRITE_RULE[SUBSET] INTERIOR_OF_SUBSET))] THEN
  ASM_CASES_TAC `s = sphere(a:real^N,r)` THENL
   [MATCH_MP_TAC(MESON[CONNECTED_EQ_CARD_COMPONENTS]
     `connected(c:real^N->bool) ==> FINITE(components c)`) THEN
    MP_TAC(ISPECL
     [`a:real^N`; `r:real`; `b:real^N`; `basis 1:real^N`; `&0:real`]
        HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE) THEN
    ASM_SIMP_TAC[BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1] THEN
    ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    DISCH_THEN(SUBST1_TAC o MATCH_MP HOMEOMORPHIC_CONNECTEDNESS) THEN
    MATCH_MP_TAC CONVEX_CONNECTED THEN
    REWRITE_TAC[CONVEX_HYPERPLANE];
    FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
     `~(s = u) ==> s SUBSET u ==> ?z. z IN u /\ ~(z IN s)`))] THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `c:real^N` THEN STRIP_TAC THEN
  SUBGOAL_THEN `?t. (s:real^N->bool) homeomorphic (t:real^1->bool)`
  STRIP_ASSUME_TAC THENL
   [MP_TAC(ISPECL [`a:real^N`; `r:real`; `c:real^N`; `(:real^1)`]
        HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE) THEN
    ASM_REWRITE_TAC[AFFINE_UNIV; AFF_DIM_UNIV; DIMINDEX_1] THEN
    CONV_TAC INT_REDUCE_CONV THEN
    REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM] THEN
    REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP
     (ONCE_REWRITE_RULE [IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN
    REWRITE_TAC[SUBSET_DELETE; SUBSET_UNIV] THEN ASM_MESON_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN
    `?d. (s DELETE (b:real^N)) homeomorphic (t DELETE (d:real^1))`
  (X_CHOOSE_THEN `d:real^1` MP_TAC) THENL
   [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
    REWRITE_TAC[homeomorphic] THEN
    GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^1` THEN
    GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^1->real^N` THEN
    DISCH_TAC THEN EXISTS_TAC `(f:real^N->real^1) b` THEN
    FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
     (ONCE_REWRITE_RULE [IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
    DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_CARD_EQ_COMPONENTS) THEN
    DISCH_THEN(SUBST1_TAC o MATCH_MP CARD_FINITE_CONG) THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_CONNECTEDNESS) THEN
    ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM CONVEX_CONNECTED_1] THEN
    REWRITE_TAC[FINITE_COMPONENTS_PUNCTURED_CONVEX]]);;

let CARD_EQ_COMPONENTS_IN_COMPACTIFICATION = prove
 (`!f g (a:real^N) r s z.
        homeomorphism (sphere(a,r) DELETE z,(:real^M)) (f,g) /\
        s SUBSET sphere(a,r) /\ z IN sphere(a,r) /\ ~(z IN closure s)
        ==> components(sphere(a,r) DIFF s) =_c
            {1} +_c {c | c IN components((:real^M) DIFF IMAGE f s) /\
                         bounded c}`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `~((z:real^N) IN s)` ASSUME_TAC THENL
   [ASM_MESON_TAC[SUBSET; CLOSURE_SUBSET]; ALL_TAC] THEN
  ABBREV_TAC `c = connected_component (sphere(a:real^N,r) DIFF s) z` THEN
  SUBGOAL_THEN `c IN components(sphere(a:real^N,r) DIFF s)` ASSUME_TAC THENL
   [EXPAND_TAC "c" THEN REWRITE_TAC[components; SIMPLE_IMAGE] THEN
    REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC FUN_IN_IMAGE THEN
    ASM_REWRITE_TAC[IN_DIFF];
    ALL_TAC] THEN
  SUBGOAL_THEN `(z:real^N) IN c` ASSUME_TAC THENL
   [EXPAND_TAC "c" THEN REWRITE_TAC[IN] THEN
    ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
    ASM_REWRITE_TAC[IN_DIFF];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `components(sphere(a,r) DIFF s) =
    {c} UNION (components(sphere(a:real^N,r) DIFF s) DELETE c)`
  SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  W(MP_TAC o PART_MATCH (lhand o rand) CARD_DISJOINT_UNION o lhand o snd) THEN
  ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_EQ_TRANS) THEN
  MATCH_MP_TAC CARD_ADD_CONG THEN
  SIMP_TAC[CARD_EQ_CARD; CARD_SING; FINITE_SING] THEN
  REWRITE_TAC[EQ_C_BIJECTIONS] THEN
  EXISTS_TAC `IMAGE (f:real^N->real^M)` THEN
  EXISTS_TAC `IMAGE (g:real^M->real^N)` THEN
  REWRITE_TAC[IN_ELIM_THM] THEN
  FIRST_ASSUM(MP_TAC o
    MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] BOUNDED_IMAGE_IN_COMPACTIFICATION) o
    ONCE_REWRITE_RULE[SET_RULE `s DELETE z = s DIFF {z}`] o
    GEN_REWRITE_RULE I [HOMEOMORPHISM_SYM]) THEN
  REWRITE_TAC[COMPACT_SPHERE; CLOSED_UNIV; SUBSET_UNIV] THEN
  REWRITE_TAC[SET_RULE `s INTER {z} = {} <=> ~(z IN s)`] THEN
  DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN CONJ_TAC THENL
   [X_GEN_TAC `d:real^N->bool` THEN REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN
    SUBGOAL_THEN `~((z:real^N) IN closure d)` ASSUME_TAC THENL
     [MP_TAC(ISPEC
       `subtopology euclidean (sphere(a:real^N,r) DIFF s)`
       PAIRWISE_SEPARATED_CONNECTED_COMPONENTS_OF) THEN
      REWRITE_TAC[EUCLIDEAN_CONNECTED_COMPONENTS_OF; pairwise] THEN
      REWRITE_TAC[SEPARATED_IN_SUBTOPOLOGY] THEN
      REWRITE_TAC[separated_in; EUCLIDEAN_CLOSURE_OF] THEN ASM SET_TAC[];
      ALL_TAC] THEN
    SUBGOAL_THEN `~((z:real^N) IN d)` ASSUME_TAC THENL
     [ASM_MESON_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET]; ALL_TAC] THEN
    MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL
     [MATCH_MP_TAC(SET_RULE
       `(!x. x IN d ==> g(f x) = x) ==> IMAGE g (IMAGE f d) = d`) THEN
      REPEAT STRIP_TAC THEN
      FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN
      REWRITE_TAC[IN_DELETE] THEN
      REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN
      ASM SET_TAC[];
      DISCH_THEN SUBST1_TAC] THEN
    ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[IN_COMPONENTS_MAXIMAL_ALT] THEN REPEAT CONJ_TAC THENL
     [ASM_MESON_TAC[IMAGE_EQ_EMPTY; IN_COMPONENTS_NONEMPTY];
      REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN
      MATCH_MP_TAC(SET_RULE
       `DISJOINT d s /\ IMAGE f (d INTER s) = IMAGE f d INTER IMAGE f s
        ==> IMAGE f d SUBSET UNIV DIFF IMAGE f s`) THEN
      CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
       `(!x. x IN u ==> g(f x) = x)
        ==> d SUBSET u /\ s SUBSET u
            ==> IMAGE f (d INTER s) = IMAGE f d INTER IMAGE f s`)) THEN
      ASM SET_TAC[];
      MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
      CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]] THEN
      FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN
      REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN
      ASM SET_TAC[];
      X_GEN_TAC `c':real^M->bool` THEN STRIP_TAC THEN
      SUBGOAL_THEN `IMAGE (g:real^M->real^N) c' SUBSET d` MP_TAC THENL
       [ALL_TAC;
        FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I
         [homeomorphism]) THEN
        ASM SET_TAC[]] THEN
      MATCH_MP_TAC COMPONENTS_MAXIMAL THEN
      EXISTS_TAC `sphere (a:real^N,r) DIFF s` THEN
      ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
       [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
        FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I
         [homeomorphism]) THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN
        ASM SET_TAC[];
        FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I
         [homeomorphism]) THEN
        ASM SET_TAC[];
        FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I
          [homeomorphism]) THEN
        REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN
        ASM SET_TAC[]]];
    X_GEN_TAC `d:real^M->bool` THEN STRIP_TAC THEN CONJ_TAC THENL
     [ALL_TAC;
      FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I
       [homeomorphism]) THEN
      ASM SET_TAC[]] THEN
    REWRITE_TAC[IN_DELETE] THEN CONJ_TAC THENL
     [ALL_TAC; ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET]] THEN
    FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM_SYM]) THEN
    DISCH_THEN(MP_TAC o MATCH_MP
     (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN
    DISCH_THEN(MP_TAC o SPECL
     [`(:real^M) DIFF IMAGE (f:real^N->real^M) s`;
      `(sphere(a:real^N,r) DIFF s) DELETE z`]) THEN
    ANTS_TAC THENL
     [REPEAT(CONJ_TAC THENL [SET_TAC[]; ALL_TAC]) THEN
      TRANS_TAC EQ_TRANS
       `IMAGE (g:real^M->real^N) (:real^M) DIFF
        IMAGE g (IMAGE (f:real^N->real^M) s)` THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN
      ASM SET_TAC[];
      DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHISM_COMPONENTS)] THEN
    DISCH_THEN(MP_TAC o SPEC `d:real^M->bool` o MATCH_MP (SET_RULE
     `t = IMAGE f s ==> !d. d IN s ==> f d IN t`)) THEN
    ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[IN_COMPONENTS_MAXIMAL; SUBSET_DELETE] THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    X_GEN_TAC `c':real^N->bool` THEN
    ASM_CASES_TAC `(z:real^N) IN c'` THENL [STRIP_TAC; ASM_MESON_TAC[]] THEN
    SUBGOAL_THEN
     `IMAGE (g:real^M->real^N) d IN components(c DELETE z)`
    MP_TAC THENL
     [ASM_REWRITE_TAC[IN_COMPONENTS_MAXIMAL; SUBSET_DELETE] THEN
      CONJ_TAC THENL
       [TRANS_TAC SUBSET_TRANS `c':real^N->bool` THEN ASM_REWRITE_TAC[] THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
          COMPONENTS_MAXIMAL)) THEN
        ASM SET_TAC[];
        REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
        ASM_REWRITE_TAC[] THEN
        REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN
        ASM SET_TAC[]];
      MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN DISCH_TAC] THEN
    MP_TAC(ISPECL [`c:real^N->bool`; `z:real^N`]
        CONNECTED_EQ_COMPONENT_DELETE_NONSEPARATED) THEN
    ASM_REWRITE_TAC[NOT_IMP] THEN
    CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]] THEN
    REPEAT DISJ2_TAC THEN
    MATCH_MP_TAC FINITE_COMPONENTS_PUNCTURED_CONNECTED_SUBSET_SPHERE THEN
    MAP_EVERY EXISTS_TAC [`r:real`; `a:real^N`] THEN
    CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN
    CONJ_TAC THENL
     [REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN
      ASM SET_TAC[];
      ALL_TAC] THEN
    MP_TAC(ISPECL [`a:real^N`; `r:real`] LOCALLY_CONNECTED_SPHERE) THEN
    REWRITE_TAC[LOCALLY_CONNECTED] THEN
    DISCH_THEN(MP_TAC o SPECL
     [`sphere(a:real^N,r) DIFF closure s`; `z:real^N`]) THEN
    SIMP_TAC[OPEN_IN_DIFF_CLOSED; CLOSED_CLOSURE] THEN
    ASM_REWRITE_TAC[IN_DIFF; interior_of; IN_ELIM_THM] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
          COMPONENTS_MAXIMAL)) THEN
    MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]]);;

let CONNECTED_COMPLEMENT_SUBSET_SIMPLE_PATH_IMAGE = prove
 (`!g s:real^N->bool.
        simple_path g /\ pathfinish g = pathstart g /\ s SUBSET path_image g
        ==> (connected(path_image g DIFF s) <=> connected s)`,
  SUBGOAL_THEN
   `!g s:real^N->bool.
        simple_path g /\ pathfinish g = pathstart g /\ s SUBSET path_image g
        ==> ~connected s ==> ~connected(path_image g DIFF s)`
  MP_TAC THENL
   [ALL_TAC;
    MESON_TAC[SUBSET_DIFF; SET_RULE
      `s SUBSET t ==> t DIFF (t DIFF s) = s`]] THEN
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  GEN_REWRITE_TAC (LAND_CONV o RAND_CONV)
   [CONNECTED_IFF_CONNECTED_COMPONENT] THEN
  REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
  DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
  ASM_CASES_TAC `a:real^N = b` THEN
  ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN DISCH_TAC THEN
  MP_TAC(ISPECL [`g:real^1->real^N`; `a:real^N`; `b:real^N`]
        EXISTS_DOUBLE_ARC) THEN
  ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
  MAP_EVERY X_GEN_TAC [`g1:real^1->real^N`; `g2:real^1->real^N`] THEN
  STRIP_TAC THEN REWRITE_TAC[CONNECTED_CLOSED] THEN
  MAP_EVERY EXISTS_TAC
   [`path_image g1:real^N->bool`;`path_image g2:real^N->bool`] THEN
  ASM_SIMP_TAC[CLOSED_PATH_IMAGE; ARC_IMP_PATH] THEN
  REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
  REPEAT STRIP_TAC THEN
  UNDISCH_TAC `~connected_component s (a:real^N) b` THEN
  REWRITE_TAC[connected_component] THENL
   [EXISTS_TAC `path_image g1:real^N->bool`;
    EXISTS_TAC `path_image g2:real^N->bool`] THEN
  ASM_SIMP_TAC[CONNECTED_PATH_IMAGE; ARC_IMP_PATH] THEN
  (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
  ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]);;

let CONNECTED_COMPLEMENT_SUBSET_CIRCLE = prove
 (`!s a:real^N r.
        dimindex(:N) = 2 /\ s SUBSET sphere(a,r)
        ==> (connected(sphere(a,r) DIFF s) <=> connected s)`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `r < &0` THEN
  ASM_SIMP_TAC[SPHERE_EMPTY; SUBSET_EMPTY; DIFF_EQ_EMPTY] THEN
  ASM_CASES_TAC `r = &0` THENL
   [ASM_SIMP_TAC[SPHERE_SING;
                 SET_RULE `s SUBSET {a} <=> s = {} \/ s = {a}`] THEN
    STRIP_TAC THEN
    ASM_SIMP_TAC[DIFF_EMPTY; CONNECTED_EMPTY; CONNECTED_SING; DIFF_EQ_EMPTY];
    SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]] THEN
  STRIP_TAC THEN
  MP_TAC(ISPECL
   [`cball(a:real^N,r)`; `cball(vec 0:real^2,r)`]
   HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS) THEN
  REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL] THEN
  ASM_SIMP_TAC[RELATIVE_FRONTIER_CBALL; REAL_LT_IMP_NZ; AFF_DIM_CBALL] THEN
  ASM_REWRITE_TAC[DIMINDEX_2] THEN
  ASM_SIMP_TAC[HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE_EQ] THEN
  DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
  ASM_MESON_TAC[CONNECTED_COMPLEMENT_SUBSET_SIMPLE_PATH_IMAGE]);;

(* ------------------------------------------------------------------------- *)
(* When dealing with AR, ANR and ANR later, it's useful to know that any set *)
(* at all is homeomorphic to a closed subset of a convex set, and if the     *)
(* set is locally compact we can take the convex set to be the universe.     *)
(* ------------------------------------------------------------------------- *)

let HOMEOMORPHIC_CLOSED_IN_CONVEX = prove
 (`!s:real^M->bool.
        aff_dim s < &(dimindex(:N))
        ==> ?u t:real^N->bool.
                convex u /\
                ~(u = {}) /\
                closed_in (subtopology euclidean u) t /\
                s homeomorphic t`,
  GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL
   [REPEAT STRIP_TAC THEN
    MAP_EVERY EXISTS_TAC [`(:real^N)`; `{}:real^N->bool`] THEN
    REWRITE_TAC[CONVEX_UNIV; UNIV_NOT_EMPTY; CLOSED_IN_EMPTY] THEN
    ASM_REWRITE_TAC[HOMEOMORPHIC_EMPTY];
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY])] THEN
  DISCH_THEN(X_CHOOSE_THEN `a:real^M` MP_TAC) THEN
  GEOM_ORIGIN_TAC `a:real^M` THEN
  SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; INT_OF_NUM_LT] THEN REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`{x:real^N | x$1 = &0}`; `dim(s:real^M->bool)`]
        CHOOSE_SUBSPACE_OF_SUBSPACE) THEN
  SIMP_TAC[DIM_SPECIAL_HYPERPLANE; DIMINDEX_GE_1; LE_REFL; SUBSET; IN_ELIM_THM;
           SPAN_OF_SUBSPACE; SUBSPACE_SPECIAL_HYPERPLANE] THEN
  ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
  X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
  MP_TAC(ISPECL [`span s:real^M->bool`; `t:real^N->bool`]
    ISOMETRIES_SUBSPACES) THEN
  ASM_REWRITE_TAC[SUBSPACE_SPAN; DIM_SPAN; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`h:real^M->real^N`; `k:real^N->real^M`] THEN
  REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_IMAGE] THEN
  STRIP_TAC THEN
  MP_TAC(ISPECL [`vec 0:real^N`; `&1`; `basis 1:real^N`;
                 `{x:real^N | basis 1 dot x = &0}`]
        HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE) THEN
  SIMP_TAC[AFFINE_HYPERPLANE; AFF_DIM_HYPERPLANE; BASIS_NONZERO;
           DIMINDEX_GE_1; LE_REFL; REAL_LT_01; IN_SPHERE_0; NORM_BASIS] THEN
  ANTS_TAC THENL [INT_ARITH_TAC; ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM]] THEN
  SIMP_TAC[DOT_BASIS; DIMINDEX_GE_1; LE_REFL; homeomorphic] THEN
  REWRITE_TAC[HOMEOMORPHISM; LEFT_IMP_EXISTS_THM; IN_ELIM_THM;
              SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; IN_DELETE] THEN
  MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN
  STRIP_TAC THEN
  EXISTS_TAC `ball(vec 0,&1) UNION
              IMAGE ((f:real^N->real^N) o (h:real^M->real^N)) s` THEN
  EXISTS_TAC `IMAGE ((f:real^N->real^N) o (h:real^M->real^N)) s` THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC CONVEX_INTERMEDIATE_BALL THEN
    MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `&1`] THEN
    REWRITE_TAC[SUBSET_UNION; UNION_SUBSET; BALL_SUBSET_CBALL] THEN
    ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM; IN_CBALL_0] THEN
    ASM_MESON_TAC[SPAN_SUPERSET; REAL_LE_REFL];
    REWRITE_TAC[NOT_IN_EMPTY; IMAGE_o] THEN ASM SET_TAC[];
    REWRITE_TAC[CLOSED_IN_CLOSED] THEN
    EXISTS_TAC `sphere(vec 0:real^N,&1)` THEN
    REWRITE_TAC[CLOSED_SPHERE] THEN MATCH_MP_TAC(SET_RULE
     `b INTER t = {} /\ s SUBSET t ==> s = (b UNION s) INTER t`) THEN
    REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN
    CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[SUBSET]] THEN
    REWRITE_TAC[FORALL_IN_IMAGE; o_THM; IN_SPHERE_0] THEN
    ASM_MESON_TAC[SPAN_SUPERSET];
    MAP_EVERY EXISTS_TAC
     [`(k:real^N->real^M) o (g:real^N->real^N)`;
      `(f:real^N->real^N) o (h:real^M->real^N)`] THEN
    REWRITE_TAC[FORALL_IN_IMAGE; o_THM; IMAGE_o] THEN
    REPEAT CONJ_TAC THEN
    TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
        ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON]) THEN
    TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
     CONTINUOUS_ON_SUBSET))) THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; IN_DELETE] THEN
    MP_TAC(ISPEC `s:real^M->bool` SPAN_INC) THEN ASM SET_TAC[]]);;

let LOCALLY_COMPACT_HOMEOMORPHIC_CLOSED = prove
 (`!s:real^M->bool.
        locally compact s /\ dimindex(:M) < dimindex(:N)
        ==> ?t:real^N->bool. closed t /\ s homeomorphic t`,
  REPEAT STRIP_TAC THEN SUBGOAL_THEN
   `?t:real^(M,1)finite_sum->bool h.
            closed t /\ homeomorphism (s,t) (h,fstcart)`
  STRIP_ASSUME_TAC THENL
   [ASM_SIMP_TAC[LOCALLY_COMPACT_HOMEOMORPHISM_PROJECTION_CLOSED];
    ALL_TAC] THEN
  ABBREV_TAC
   `f:real^(M,1)finite_sum->real^N =
        \x. lambda i. if i <= dimindex(:M) then x$i
                      else x$(dimindex(:M)+1)` THEN
  ABBREV_TAC
   `g:real^N->real^(M,1)finite_sum = (\x. lambda i. x$i)` THEN
  EXISTS_TAC `IMAGE (f:real^(M,1)finite_sum->real^N) t` THEN
  SUBGOAL_THEN `linear(f:real^(M,1)finite_sum->real^N)` ASSUME_TAC THENL
   [EXPAND_TAC "f" THEN REWRITE_TAC[linear; CART_EQ] THEN
    SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
    MESON_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN `linear(g:real^N->real^(M,1)finite_sum)` ASSUME_TAC THENL
   [EXPAND_TAC "g" THEN REWRITE_TAC[linear; CART_EQ] THEN
    SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
    MESON_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `!x. (g:real^N->real^(M,1)finite_sum)((f:real^(M,1)finite_sum->real^N) x) =
        x`
  ASSUME_TAC THENL
   [MAP_EVERY EXPAND_TAC ["f"; "g"] THEN FIRST_ASSUM(MP_TAC o MATCH_MP
     (ARITH_RULE `m < n ==> !i. i <= m + 1 ==> i <= n`)) THEN
    SIMP_TAC[CART_EQ; LAMBDA_BETA; DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN
    REWRITE_TAC[ARITH_RULE `i <= n + 1 <=> i <= n \/ i = n + 1`] THEN
    MESON_TAC[];
    ALL_TAC] THEN
  CONJ_TAC THENL [ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE]; ALL_TAC] THEN
  TRANS_TAC HOMEOMORPHIC_TRANS `t:real^(M,1)finite_sum->bool` THEN
  CONJ_TAC THENL [ASM_MESON_TAC[homeomorphic]; ALL_TAC] THEN
  REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN MAP_EVERY EXISTS_TAC
   [`f:real^(M,1)finite_sum->real^N`; `g:real^N->real^(M,1)finite_sum`] THEN
  ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Simple connectedness of a union. This is essentially a stripped-down      *)
(* version of the Seifert - Van Kampen theorem.                              *)
(* ------------------------------------------------------------------------- *)

let SIMPLY_CONNECTED_UNION = prove
 (`!s t:real^N->bool.
    open_in (subtopology euclidean (s UNION t)) s /\
    open_in (subtopology euclidean (s UNION t)) t /\
    simply_connected s /\ simply_connected t /\
    path_connected (s INTER t) /\ ~(s INTER t = {})
    ==> simply_connected (s UNION t)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN
  DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `u:real^N->bool`
   (STRIP_ASSUME_TAC o GSYM)) MP_TAC) THEN
   DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `v:real^N->bool`
   (STRIP_ASSUME_TAC o GSYM)) MP_TAC) THEN
  SIMP_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH; PATH_CONNECTED_UNION] THEN
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `(pathstart p:real^N) IN s UNION t` MP_TAC THENL
   [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]; REWRITE_TAC[IN_UNION]] THEN
  POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
  ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`] THEN
  MAP_EVERY (fun s -> let x = mk_var(s,`:real^N->bool`) in SPEC_TAC(x,x))
   ["v"; "u"; "t"; "s"] THEN
  MATCH_MP_TAC(MESON[]
   `(!s t u v. x IN s ==> P x s t u v) /\
    (!x s t u v. P x s t u v ==> P x t s v u)
    ==> (!s t u v. x IN s \/ x IN t ==>  P x s t u v)`) THEN
  CONJ_TAC THENL
   [REPEAT STRIP_TAC;
    REPEAT GEN_TAC THEN REWRITE_TAC[UNION_COMM; INTER_COMM] THEN
    MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[]] THEN
  SUBGOAL_THEN
   `?e. &0 < e /\
        !x y. x IN interval[vec 0,vec 1] /\ y IN interval[vec 0,vec 1] /\
              norm(x - y) < e
              ==> path_image(subpath x y p) SUBSET (s:real^N->bool) \/
                  path_image(subpath x y p) SUBSET t`
  STRIP_ASSUME_TAC THENL
   [MP_TAC(ISPEC `path_image(p:real^1->real^N)` HEINE_BOREL_LEMMA) THEN
    ASM_SIMP_TAC[COMPACT_PATH_IMAGE] THEN
    DISCH_THEN(MP_TAC o SPEC `{u:real^N->bool,v}`) THEN
    SIMP_TAC[UNIONS_2; EXISTS_IN_INSERT; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN
    ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPECL [`p:real^1->real^N`; `interval[vec 0:real^1,vec 1]`]
        COMPACT_UNIFORMLY_CONTINUOUS) THEN
    ASM_REWRITE_TAC[GSYM path; COMPACT_INTERVAL; uniformly_continuous_on] THEN
    DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[dist] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN
    ASM_REWRITE_TAC[] THEN
    MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^1->real^N) x`) THEN
    ANTS_TAC THENL [REWRITE_TAC[path_image] THEN ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC(SET_RULE
     `!p'. p SUBSET b /\
           (s UNION t) INTER u = s /\ (s UNION t) INTER v = t /\
           p SUBSET p' /\ p' SUBSET s UNION t
           ==>  (b SUBSET u \/ b SUBSET v) ==> p SUBSET s \/ p SUBSET t`) THEN
    EXISTS_TAC `path_image(p:real^1->real^N)` THEN
    ASM_SIMP_TAC[PATH_IMAGE_SUBPATH_SUBSET] THEN
    REWRITE_TAC[PATH_IMAGE_SUBPATH_GEN; SUBSET; FORALL_IN_IMAGE] THEN
    SUBGOAL_THEN `segment[x,y] SUBSET ball(x:real^1,d)` MP_TAC THENL
     [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
      ASM_REWRITE_TAC[INSERT_SUBSET; CENTRE_IN_BALL] THEN
      ASM_REWRITE_TAC[IN_BALL; EMPTY_SUBSET; CONVEX_BALL; dist];
      REWRITE_TAC[IN_BALL; dist; SUBSET] THEN STRIP_TAC THEN
      X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[] THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SEGMENT_1]) THEN
      REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN
      COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
      ASM_REAL_ARITH_TAC];
    MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `N:num` THEN STRIP_TAC] THEN
  SUBGOAL_THEN
   `!n. n <= N /\ p(lift(&n / &N)) IN s
        ==> ?q. path(q:real^1->real^N) /\ path_image q SUBSET s /\
                homotopic_paths (s UNION t)
                                (subpath (vec 0) (lift(&n / &N)) p) q`
  MP_TAC THENL
   [ALL_TAC;
    DISCH_THEN(MP_TAC o SPEC `N:num`) THEN
    ASM_SIMP_TAC[REAL_DIV_REFL; REAL_OF_NUM_EQ; LE_REFL; LIFT_NUM] THEN
    ANTS_TAC THENL [ASM_MESON_TAC[pathfinish]; ALL_TAC] THEN
    DISCH_THEN(X_CHOOSE_THEN `q:real^1->real^N` MP_TAC) THEN
    REWRITE_TAC[SUBPATH_TRIVIAL] THEN
    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_PATHS_TRANS) THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN
    EXISTS_TAC `s:real^N->bool` THEN
    ASM_MESON_TAC[SUBSET_UNION]] THEN
  SUBGOAL_THEN
   `!n. n < N
        ==> path_image(subpath (lift(&n / &N)) (lift(&(SUC n) / &N)) p)
              SUBSET (s:real^N->bool) \/
            path_image(subpath (lift(&n / &N)) (lift(&(SUC n) / &N)) p)
              SUBSET t`
  ASSUME_TAC THENL
   [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; GSYM LIFT_SUB; DROP_VEC;
                NORM_REAL; GSYM drop;
                REAL_ARITH `abs(a / c - b / c) = abs((b - a) / c)`] THEN
    ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUC; REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ;
                 REAL_OF_NUM_LT; LE_1; REAL_ARITH `(x + &1) - x = &1`] THEN
    ASM_REWRITE_TAC[real_div; REAL_MUL_LID; REAL_MUL_LZERO; REAL_ABS_INV;
      REAL_ABS_NUM; REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
    ASM_ARITH_TAC;
    ALL_TAC] THEN
  MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN
  REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN STRIP_TAC THEN
  ASM_CASES_TAC `n = 0` THENL
   [ASM_REWRITE_TAC[REAL_ARITH `&0 / x = &0`; LIFT_NUM] THEN
    EXISTS_TAC `linepath((p:real^1->real^N)(vec 0),p(vec 0))` THEN
    REWRITE_TAC[SUBPATH_REFL; HOMOTOPIC_PATHS_REFL] THEN
    REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
    UNDISCH_TAC `(pathstart p:real^N) IN s` THEN REWRITE_TAC[pathstart] THEN
    SET_TAC[];
    ALL_TAC] THEN
  MP_TAC(ISPEC `\m. m < n /\ (p(lift(&m / &N)):real^N) IN s` num_MAX) THEN
  REWRITE_TAC[] THEN
  MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN
  CONJ_TAC THENL
   [CONJ_TAC THENL [EXISTS_TAC `0`; MESON_TAC[LT_IMP_LE]] THEN
    ASM_SIMP_TAC[REAL_ARITH `&0 / x = &0`; LIFT_NUM; LE_1] THEN
    ASM_MESON_TAC[pathstart];
    DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC)] THEN
  SUBGOAL_THEN
   `?q. path q /\
        path_image(q:real^1->real^N) SUBSET s /\
        homotopic_paths (s UNION t) (subpath (vec 0) (lift (&m / &N)) p) q`
  STRIP_ASSUME_TAC THENL
   [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC;
    ALL_TAC] THEN
  SUBGOAL_THEN
   `!i. m < i /\ i <= n
        ==> path_image(subpath (lift(&m / &N)) (lift(&i / &N)) p) SUBSET s \/
            path_image(subpath (lift(&m / &N)) (lift(&i / &N)) p) SUBSET
                 (t:real^N->bool)`
  MP_TAC THENL
   [MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[CONJUNCT1 LT] THEN
    X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
    ASM_CASES_TAC `i:num = m` THENL
     [DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[] THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
      ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC]] THEN
    SUBGOAL_THEN
     `p(lift(&i / &N)) IN t /\ ~((p(lift(&i / &N)):real^N) IN s)`
    STRIP_ASSUME_TAC THENL
     [MATCH_MP_TAC(SET_RULE
       `x IN s UNION t /\ ~(x IN s) ==> x IN t /\ ~(x IN s)`) THEN
      CONJ_TAC THENL
       [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
         `s SUBSET t ==> x IN s ==> x IN t`)) THEN
        REWRITE_TAC[path_image] THEN MATCH_MP_TAC FUN_IN_IMAGE THEN
        REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
        ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
                     LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
        ASM_ARITH_TAC;
        SUBGOAL_THEN `i < n /\ ~(i:num <= m)` MP_TAC THENL
         [ASM_ARITH_TAC; ASM_MESON_TAC[]]];
      ALL_TAC] THEN
    SUBGOAL_THEN
     `path_image(subpath (lift(&i / &N)) (lift (&(SUC i) / &N)) p) SUBSET s \/
      path_image(subpath (lift(&i / &N)) (lift (&(SUC i) / &N)) p) SUBSET
        (t:real^N->bool)`
    MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `~(x IN s)
      ==> (x IN p /\ x IN q) /\ (q UNION p = r)
          ==> p SUBSET s \/ p SUBSET t
              ==> q SUBSET s \/ q SUBSET t
                  ==> r SUBSET s \/ r SUBSET t`)) THEN
    SIMP_TAC[PATH_IMAGE_SUBPATH_GEN; FUN_IN_IMAGE; ENDS_IN_SEGMENT] THEN
    REWRITE_TAC[GSYM IMAGE_UNION] THEN AP_TERM_TAC THEN
    MATCH_MP_TAC UNION_SEGMENT THEN
    ASM_SIMP_TAC[SEGMENT_1; LIFT_DROP; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT;
                 LE_1; REAL_OF_NUM_LE; LT_IMP_LE; IN_INTERVAL_1] THEN
    ASM_ARITH_TAC;
    DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[LE_REFL]] THEN
  STRIP_TAC THENL
   [EXISTS_TAC `(q:real^1->real^N) ++
                subpath (lift(&m / &N)) (lift (&n / &N)) p` THEN
    REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC PATH_JOIN_IMP THEN
      FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN
      ASM_SIMP_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
      DISCH_TAC THEN MATCH_MP_TAC PATH_SUBPATH THEN
      ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
      ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
                   LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
      ASM_ARITH_TAC;
      MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN ASM_REWRITE_TAC[];
      MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
      EXISTS_TAC `subpath (vec 0) (lift(&m / &N)) (p:real^1->real^N) ++
                  subpath (lift(&m / &N)) (lift(&n / &N)) p` THEN
      CONJ_TAC THENL
       [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
        MATCH_MP_TAC HOMOTOPIC_JOIN_SUBPATHS THEN
        ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL];
        MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
        ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
        MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN
        EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_UNION] THEN
        ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN
        MATCH_MP_TAC PATH_SUBPATH] THEN
      ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
      ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
                   LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
      ASM_ARITH_TAC];
    SUBGOAL_THEN
     `(p(lift(&m / &N)):real^N) IN t /\ (p(lift(&n / &N)):real^N) IN t`
    STRIP_ASSUME_TAC THENL
     [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE;
                    PATHSTART_SUBPATH; PATHFINISH_SUBPATH; SUBSET];
      ALL_TAC] THEN
    UNDISCH_TAC `path_connected(s INTER t:real^N->bool)` THEN
    REWRITE_TAC[path_connected] THEN DISCH_THEN(MP_TAC o SPECL
     [`p(lift(&m / &N)):real^N`; `p(lift(&n / &N)):real^N`]) THEN
    ASM_REWRITE_TAC[IN_INTER; SUBSET_INTER] THEN
    DISCH_THEN(X_CHOOSE_THEN `r:real^1->real^N` STRIP_ASSUME_TAC) THEN
    UNDISCH_THEN
     `!p. path p /\ path_image p SUBSET t /\ pathfinish p:real^N = pathstart p
          ==> homotopic_paths t p (linepath (pathstart p,pathstart p))`
     (MP_TAC o SPEC `subpath (lift(&m / &N)) (lift(&n / &N)) p ++
                     reversepath(r:real^1->real^N)`) THEN
    ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH;
                PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH] THEN
    ANTS_TAC THENL
     [ASM_SIMP_TAC[SUBSET_PATH_IMAGE_JOIN; PATH_IMAGE_REVERSEPATH] THEN
      MATCH_MP_TAC PATH_JOIN_IMP THEN
      ASM_SIMP_TAC[PATH_REVERSEPATH; PATHFINISH_SUBPATH;
                   PATHSTART_REVERSEPATH] THEN
      MATCH_MP_TAC PATH_SUBPATH THEN
      ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
      ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
                   LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
      ASM_ARITH_TAC;
      ALL_TAC] THEN
     DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS)) THEN
     ASM_REWRITE_TAC[PATHFINISH_LINEPATH; PATHSTART_SUBPATH;
       PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH] THEN
     DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        HOMOTOPIC_PATHS_LOOP_PARTS)) THEN
     FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN
     FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN
     REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
     REPLICATE_TAC 2 (DISCH_THEN(ASSUME_TAC o SYM)) THEN
     ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
     EXISTS_TAC `(q:real^1->real^N) ++ r` THEN
     ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET] THEN
     MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN
     EXISTS_TAC `subpath (vec 0) (lift(&m / &N)) (p:real^1->real^N) ++
                 subpath (lift(&m / &N)) (lift(&n / &N)) p` THEN
     CONJ_TAC THENL
      [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN
       MATCH_MP_TAC HOMOTOPIC_JOIN_SUBPATHS THEN
       ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
       ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
       ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT;
                    LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
       ASM_ARITH_TAC;
       MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
       ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN
       MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN
       EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_UNION]]]);;

(* ------------------------------------------------------------------------- *)
(* Basic results about topological dimension.                                *)
(* ------------------------------------------------------------------------- *)

let dimension = new_definition
 `(dimension:(real^N->bool)->int) s =
        if s = {} then --(&1)
        else &(minimal n. (subtopology euclidean s) dimension_le &n)`;;

let DIMENSION_GE = prove
 (`!s:real^N->bool. -- &1 <= dimension s`,
  GEN_TAC THEN REWRITE_TAC[dimension; INT_LE_REFL] THEN INT_ARITH_TAC);;

let DIMENSION_LE_IMP_GE = prove
 (`!s:real^N->bool n. dimension s <= n ==> -- &1 <= n`,
  REWRITE_TAC[GSYM INT_LE_TRANS_LE; DIMENSION_GE]);;

let (HOMEOMORPHIC_DIMENSION,DIMENSION_LE_EQ, LOCALLY_DIMENSION_LE,
     DIMENSION_LE_AFF_DIM,DIMENSION_DIMENSION_LE) =
  let HOMEOMORPHIC_DIMENSION_LE' = prove
   (`!s:real^M->bool t:real^N->bool n.
          s homeomorphic t
          ==> (subtopology euclidean s dimension_le n <=>
               subtopology euclidean t dimension_le n)`,
    REWRITE_TAC[GSYM HOMEOMORPHIC_SPACE_EUCLIDEAN] THEN
    REWRITE_TAC[HOMEOMORPHIC_SPACE_DIMENSION_LE]) in
  let DIMENSION_LE_EQ' = prove
   (`!s:real^N->bool n.
          (subtopology euclidean s) dimension_le n <=>
          -- &1 <= n /\
          !v a. open v /\ a IN v /\ a IN s
                ==> ?u. a IN u /\ u SUBSET v /\ open u /\
                        subtopology euclidean (s INTER frontier u)
                        dimension_le (n - &1)`,
    REPEAT GEN_TAC THEN
    GEN_REWRITE_TAC LAND_CONV [DIMENSION_LE_EQ_SUBTOPOLOGY] THEN
    REWRITE_TAC[GSYM OPEN_IN] THEN AP_TERM_TAC THEN
    GEN_REWRITE_TAC
      (BINOP_CONV o funpow 2 BINDER_CONV o RAND_CONV o ONCE_DEPTH_CONV)
     [TAUT `open(u:real^N->bool) /\ p <=> ~(open u ==> ~p)`] THEN
    SIMP_TAC[frontier; INTERIOR_OPEN; FRONTIER_OF_CLOSURES] THEN
    REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
    REWRITE_TAC[SET_RULE `s DIFF s INTER u = s INTER (UNIV DIFF u)`] THEN
    SIMP_TAC[CLOSURE_OF_CLOSED_IN; CLOSED_IN_CLOSED_INTER;
             GSYM OPEN_CLOSED] THEN
    REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY] THEN
    REWRITE_TAC[TAUT `~(p ==> ~q) <=> p /\ q`] THEN
    REWRITE_TAC[SET_RULE `s INTER s INTER u = s INTER u`] THEN
    REWRITE_TAC[SET_RULE
     `(s INTER t) INTER (s INTER (UNIV DIFF u)) = (s INTER t) DIFF u`] THEN
    REWRITE_TAC[EUCLIDEAN_CLOSURE_OF] THEN
    EQ_TAC THEN DISCH_TAC THEN
    MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `a:real^N`] THEN STRIP_TAC THENL
     [ALL_TAC;
      FIRST_X_ASSUM(MP_TAC o SPECL [`v:real^N->bool`; `a:real^N`]) THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
      X_GEN_TAC `u:real^N->bool` THEN
      REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
      ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] DIMENSION_LE_SUBTOPOLOGIES) THEN
      MATCH_MP_TAC(SET_RULE
       `t SUBSET t' ==> s INTER t DIFF u SUBSET s INTER (t' DIFF u)`) THEN
      MATCH_MP_TAC SUBSET_CLOSURE THEN REWRITE_TAC[INTER_SUBSET]] THEN
    SUBGOAL_THEN
     `?w:real^N->bool. a IN w /\ open w /\ closure w SUBSET v`
    STRIP_ASSUME_TAC THENL
     [MP_TAC(ISPECL [`(:real^N)`; `v:real^N->bool`; `a:real^N`]
        LOCALLY_CLOSED_IN_EXPLICIT) THEN
      ASM_SIMP_TAC[GSYM OPEN_IN; SUBTOPOLOGY_UNIV; EUCLIDEAN_CLOSURE_OF] THEN
      MESON_TAC[];
      ALL_TAC] THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^N->bool`; `a:real^N`]) THEN
    ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPECL
     [`s INTER u:real^N->bool`; `s DIFF closure(s INTER u):real^N->bool`]
     SEPARATION_CLOSURES) THEN
    ANTS_TAC THENL
     [REWRITE_TAC[SEPARATION_OPEN_IN_UNION] THEN CONJ_TAC THENL
       [MATCH_MP_TAC(SET_RULE
          `s INTER t SUBSET u ==> DISJOINT (s INTER t) (s DIFF u)`) THEN
        REWRITE_TAC[CLOSURE_SUBSET];
        REWRITE_TAC[OPEN_IN_OPEN] THEN CONJ_TAC THENL
         [EXISTS_TAC `u:real^N->bool`;
          EXISTS_TAC `(:real^N) DIFF closure(s INTER u)`] THEN
        ASM_REWRITE_TAC[GSYM closed; CLOSED_CLOSURE] THEN SET_TAC[]];
      REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
    MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `c:real^N->bool`] THEN
    STRIP_TAC THEN EXISTS_TAC `t INTER v:real^N->bool` THEN
    ASM_SIMP_TAC[IN_INTER; INTER_SUBSET; OPEN_INTER] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
          DIMENSION_LE_SUBTOPOLOGIES)) THEN
    MATCH_MP_TAC(SET_RULE
     `s DIFF d SUBSET s DIFF c /\ s INTER u SUBSET t
      ==> s INTER (c DIFF t) SUBSET s INTER d DIFF u`) THEN
    CONJ_TAC THENL
     [ALL_TAC;
      MP_TAC(ISPEC `w:real^N->bool` CLOSURE_SUBSET) THEN
      ASM SET_TAC[]] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `s DIFF t SUBSET u ==> s INTER u SUBSET v ==> s DIFF t SUBSET v`)) THEN
    MATCH_MP_TAC(SET_RULE
     `d SUBSET UNIV DIFF c ==> s INTER c SUBSET s DIFF d`) THEN
    ASM_SIMP_TAC[CLOSURE_MINIMAL_EQ; GSYM OPEN_CLOSED] THEN
    ASM SET_TAC[]) in
  let LOCALLY_DIMENSION_LE' = prove
   (`!s:real^N->bool n.
          (subtopology euclidean s) dimension_le n <=>
          -- &1 <= n /\
          locally (\u. (subtopology euclidean u) dimension_le n) s`,
    REPEAT GEN_TAC THEN EQ_TAC THENL
     [DISCH_TAC THEN
      CONJ_TAC THENL [ASM_MESON_TAC[DIMENSION_LE_BOUND]; ALL_TAC] THEN
      REWRITE_TAC[locally] THEN
      MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN
      MAP_EVERY EXISTS_TAC [`v:real^N->bool`; `v:real^N->bool`] THEN
      ASM_REWRITE_TAC[SUBSET_REFL] THEN
      FIRST_ASSUM(MP_TAC o SPEC `v:real^N->bool` o MATCH_MP
        DIMENSION_LE_SUBTOPOLOGY) THEN
      REWRITE_TAC[SUBTOPOLOGY_SUBTOPOLOGY] THEN
      MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN
      AP_TERM_TAC THEN AP_TERM_TAC THEN
      FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SET_TAC[];
      ALL_TAC] THEN
    ONCE_REWRITE_TAC[DIMENSION_LE_EQ'] THEN
    REWRITE_TAC[locally] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`s INTER v:real^N->bool`; `a:real^N`]) THEN
    ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; LEFT_IMP_EXISTS_THM; IN_INTER] THEN
    MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `u:real^N->bool`] THEN
    STRIP_TAC THEN
    SUBGOAL_THEN
     `?b:real^N->bool. a IN b /\ open b /\ s INTER closure b SUBSET w`
    STRIP_ASSUME_TAC THENL
     [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_CBALL]) THEN
      DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `a:real^N`)) THEN
      ASM_REWRITE_TAC[] THEN
      DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
      EXISTS_TAC `ball(a:real^N,r)` THEN
      ASM_SIMP_TAC[CLOSURE_BALL; OPEN_BALL; CENTRE_IN_BALL] THEN
      ASM SET_TAC[];
      ALL_TAC] THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`b INTER v:real^N->bool`; `a:real^N`]) THEN
    ASM_SIMP_TAC[OPEN_INTER; IN_INTER] THEN
    ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    SUBGOAL_THEN `s INTER frontier c:real^N->bool = u INTER frontier c`
     (fun th -> ASM_REWRITE_TAC[th]) THEN
    MP_TAC(ISPECL [`c:real^N->bool`; `b:real^N->bool`] SUBSET_CLOSURE) THEN
    REWRITE_TAC[frontier] THEN ASM SET_TAC[]) in
  let DIMENSION_LE_AFF_DIM' = prove
   (`!s:real^N->bool. (subtopology euclidean s) dimension_le aff_dim s`,
    SUBGOAL_THEN
     `!n s:real^N->bool.
          -- &1 <= n
          ==> aff_dim s = n ==> (subtopology euclidean s) dimension_le n`
    MP_TAC THENL [ALL_TAC; MESON_TAC[AFF_DIM_GE]] THEN
    SIMP_TAC[RIGHT_FORALL_IMP_THM; INT_ARITH
     `--w:int <= x <=> &0 <= x + w`] THEN
    REWRITE_TAC[GSYM INT_OF_NUM_EXISTS; LEFT_IMP_EXISTS_THM] THEN
    ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
    SIMP_TAC[INT_ARITH `x + &1:int = &n <=> x = &n - &1`] THEN
    REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN
    INDUCT_TAC THEN CONV_TAC INT_REDUCE_CONV THEN
    SIMP_TAC[AFF_DIM_EQ_MINUS1; DIMENSION_LE_EQ_EMPTY] THEN
    REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; GSYM INT_OF_NUM_SUC] THEN
    REWRITE_TAC[INT_ARITH `(x + &1) - &1:int = x`] THEN
    X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN
    MATCH_MP_TAC DIMENSION_LE_SUBTOPOLOGIES THEN
    EXISTS_TAC `affine hull s:real^N->bool` THEN
    REWRITE_TAC[HULL_SUBSET] THEN
    ONCE_REWRITE_TAC[DIMENSION_LE_EQ'] THEN
    CONJ_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN
    MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN
    FIRST_ASSUM(MP_TAC o SPEC `a:real^N` o
      REWRITE_RULE[OPEN_CONTAINS_BALL]) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `r:real` THEN STRIP_TAC THEN
    EXISTS_TAC `ball(a:real^N,r)` THEN
    ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL; FRONTIER_BALL] THEN
    ONCE_REWRITE_TAC[LOCALLY_DIMENSION_LE'] THEN
    CONJ_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN
    ONCE_REWRITE_TAC[LOCALLY_ON_OPEN_SUBSETS] THEN
    X_GEN_TAC `b:real^N` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN
    EXISTS_TAC
      `(affine hull s INTER sphere(a,r)) DELETE (&2 % a - b:real^N)` THEN
    ASM_SIMP_TAC[OPEN_IN_DELETE; OPEN_IN_REFL; IN_DELETE; IN_INTER] THEN
    REWRITE_TAC[NORM_ARITH `b:real^N = &2 % a - b <=> dist(a,b) = &0`] THEN
    CONJ_TAC THENL [ASM_MESON_TAC[IN_SPHERE; REAL_LT_REFL]; ALL_TAC] THEN
    MATCH_MP_TAC(TAUT `!p. p /\ q ==> q`) THEN
    EXISTS_TAC `-- &1:int <= &n - &1` THEN
    REWRITE_TAC[GSYM LOCALLY_DIMENSION_LE'] THEN MATCH_MP_TAC
     (MESON[HOMEOMORPHIC_DIMENSION_LE']
       `!s:real^N->bool t:real^N->bool n.
          s homeomorphic t /\ subtopology euclidean t dimension_le n
          ==> subtopology euclidean s dimension_le n`) THEN
    SUBGOAL_THEN `?s:real^N->bool. affine s /\ aff_dim s = &n - &1`
    MP_TAC THENL
     [MATCH_MP_TAC AFFINE_EXISTS THEN
      MP_TAC(ISPEC `s:real^N->bool` AFF_DIM_LE_UNIV) THEN
      ASM_REWRITE_TAC[] THEN INT_ARITH_TAC;
      MATCH_MP_TAC MONO_EXISTS] THEN
    X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN
    ONCE_REWRITE_TAC[INTER_COMM] THEN
    MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_AFFINE_SPHERE_AFFINE THEN
    ASM_REWRITE_TAC[AFFINE_AFFINE_HULL; AFF_DIM_AFFINE_HULL] THEN
    SIMP_TAC[IN_SPHERE; NORM_ARITH
     `dist(a:real^N,&2 % a - b) = dist(a,b)`] THEN
    ASM_REWRITE_TAC[GSYM IN_SPHERE] THEN
    CONJ_TAC THENL [ALL_TAC; INT_ARITH_TAC] THEN
    REWRITE_TAC[VECTOR_ARITH `&2 % a - b:real^N = a - &1 % (b - a)`] THEN
    MATCH_MP_TAC IN_AFFINE_SUB_MUL_DIFF THEN
    ASM_REWRITE_TAC[AFFINE_AFFINE_HULL]) in
  let DIMENSION_DIMENSION_LE = prove
   (`!s:real^N->bool n.
          dimension s <= n <=> (subtopology euclidean s) dimension_le n`,
    REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
    ASM_REWRITE_TAC[dimension] THENL
     [EQ_TAC THEN REWRITE_TAC[DIMENSION_LE_BOUND] THEN
      DISCH_TAC THEN MATCH_MP_TAC DIMENSION_LE_MONO THEN
      EXISTS_TAC `-- &1:int` THEN
      ASM_REWRITE_TAC[DIMENSION_LE_EQ_EMPTY; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY];
      ALL_TAC] THEN
    ASM_CASES_TAC `--(&1):int <= n` THENL
     [ALL_TAC;
      ASM_MESON_TAC[DIMENSION_LE_BOUND;
                    INT_ARITH `&n:int <= x ==> --(&1):int <= x `]] THEN
    ASM_CASES_TAC `n:int = --(&1)` THENL
     [ASM_REWRITE_TAC[DIMENSION_LE_EQ_EMPTY;
                      TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
      ASM_INT_ARITH_TAC;
      ALL_TAC] THEN
    SUBGOAL_THEN `?k. n:int = &k` (CHOOSE_THEN SUBST1_TAC) THENL
     [REWRITE_TAC[INT_OF_NUM_EXISTS] THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN
    MP_TAC(fst(EQ_IMP_RULE(ISPEC
      `\n. subtopology euclidean (s:real^N->bool) dimension_le &n`
          MINIMAL))) THEN
    REWRITE_TAC[] THEN ANTS_TAC THENL
     [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM AFF_DIM_POS_LE]) THEN
      REWRITE_TAC[GSYM INT_OF_NUM_EXISTS] THEN MATCH_MP_TAC MONO_EXISTS THEN
      ASM_MESON_TAC[DIMENSION_LE_AFF_DIM'];
      ALL_TAC] THEN
    ABBREV_TAC
     `d = minimal n.
           subtopology euclidean (s:real^N->bool) dimension_le &n` THEN
    REWRITE_TAC[GSYM NOT_LE; CONTRAPOS_THM; INT_OF_NUM_LE] THEN
    MESON_TAC[INT_OF_NUM_LE; INT_LE_TRANS; DIMENSION_LE_MONO]) in
  let HOMEOMORPHIC_DIMENSION = prove
   (`!s:real^M->bool t:real^N->bool.
          s homeomorphic t ==> dimension s = dimension t`,
    REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN
    ONCE_REWRITE_TAC[INT_LE_TRANS_LE] THEN
    REWRITE_TAC[DIMENSION_DIMENSION_LE; AND_FORALL_THM] THEN
    GEN_TAC THEN ONCE_REWRITE_TAC[TAUT
     `(p ==> q) /\ (q ==> p) <=> (q <=> p)`] THEN
    MATCH_MP_TAC HOMEOMORPHIC_DIMENSION_LE' THEN
    ASM_REWRITE_TAC[]) in
  let DIMENSION_LE_EQ = prove
   (`!s:real^N->bool n.
          dimension s <= n <=>
          -- &1 <= n /\
          !v a. open v /\ a IN v /\ a IN s
                ==> ?u. a IN u /\ u SUBSET v /\ open u /\
                        dimension(s INTER frontier u) <= n - &1`,
    REWRITE_TAC[DIMENSION_DIMENSION_LE] THEN
    MATCH_ACCEPT_TAC DIMENSION_LE_EQ') in
  let LOCALLY_DIMENSION_LE = prove
   (`!s:real^N->bool n.
          dimension s <= n <=>
          -- &1 <= n /\ locally (\u. dimension u <= n) s`,
    REWRITE_TAC[DIMENSION_DIMENSION_LE] THEN
    MATCH_ACCEPT_TAC LOCALLY_DIMENSION_LE') in
  let DIMENSION_LE_AFF_DIM = prove
   (`!s:real^N->bool. dimension s <= aff_dim s`,
    REWRITE_TAC[DIMENSION_DIMENSION_LE] THEN
    MATCH_ACCEPT_TAC DIMENSION_LE_AFF_DIM') in
 (HOMEOMORPHIC_DIMENSION,DIMENSION_LE_EQ, LOCALLY_DIMENSION_LE,
     DIMENSION_LE_AFF_DIM,DIMENSION_DIMENSION_LE);;

let DIMENSION_TRANSLATION = prove
 (`!a:real^N s. dimension(IMAGE (\x. a + x) s) = dimension s`,
  REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_DIMENSION THEN
  REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);;

add_translation_invariants [DIMENSION_TRANSLATION];;

let DIMENSION_LINEAR_IMAGE = prove
 (`!f:real^M->real^N.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> dimension(IMAGE f s) = dimension s`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_DIMENSION THEN
  MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF THEN
  ASM_REWRITE_TAC[]);;

add_linear_invariants [DIMENSION_LINEAR_IMAGE];;

let DIMENSION_LE_DIMINDEX = prove
 (`!s:real^N->bool. dimension s <= &(dimindex(:N))`,
  MESON_TAC[INT_LE_TRANS; AFF_DIM_LE_UNIV; DIMENSION_LE_AFF_DIM]);;

let DIMENSION_LE_MINUS1 = prove
 (`!s:real^N->bool. dimension s <= -- &1 <=> s = {}`,
  REWRITE_TAC[DIMENSION_DIMENSION_LE; DIMENSION_LE_EQ_EMPTY;
              TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]);;

let DIMENSION_EQ_MINUS1 = prove
 (`!s:real^N->bool. dimension s = -- &1 <=> s = {}`,
  REWRITE_TAC[GSYM INT_LE_ANTISYM; DIMENSION_GE; DIMENSION_LE_MINUS1]);;

let DIMENSION_POS_LE = prove
 (`!s:real^N->bool. &0 <= dimension s <=> ~(s = {})`,
  SIMP_TAC[DIMENSION_GE; DIMENSION_EQ_MINUS1; INT_ARITH
    `-- &1:int <= d ==> (&0 <= d <=> ~(d = -- &1))`]);;

let DIMENSION_EMPTY = prove
 (`dimension {} = -- &1`,
  REWRITE_TAC[DIMENSION_EQ_MINUS1]);;

let DIMENSION_SUBSET = prove
 (`!s t:real^N->bool. s SUBSET t ==> dimension s <= dimension t`,
  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[INT_LE_TRANS_LE] THEN
  REWRITE_TAC[DIMENSION_DIMENSION_LE] THEN
  ASM_MESON_TAC[DIMENSION_LE_SUBTOPOLOGIES]);;

let DIMENSION_LE_DISCRETE = prove
 (`!s:real^N->bool.
        {x | x limit_point_of s} = {} ==> dimension s <= &0`,
  GEN_TAC THEN REWRITE_TAC[DIMENSION_DIMENSION_LE] THEN
  REWRITE_TAC[GSYM EUCLIDEAN_DERIVED_SET_OF_IFF_LIMIT_POINT_OF] THEN
  SIMP_TAC[SUBTOPOLOGY_EQ_DISCRETE_TOPOLOGY; INTER_EMPTY;
           TOPSPACE_EUCLIDEAN; SUBSET_UNIV; DIMENSION_LE_DISCRETE_TOPOLOGY]);;

let DIMENSION_EQ_ZERO_DISCRETE = prove
 (`!s:real^N->bool.
        ~(s = {}) /\ {x | x limit_point_of s} = {} ==> dimension s = &0`,
  SIMP_TAC[GSYM INT_LE_ANTISYM; DIMENSION_POS_LE; DIMENSION_LE_DISCRETE]);;

let DIMENSION_EQ_DISCRETE = prove
 (`!s:real^N->bool.
        {x | x limit_point_of s} = {}
        ==> dimension s = if s = {} then --(&1) else &0`,
  REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
  ASM_SIMP_TAC[DIMENSION_EMPTY; DIMENSION_EQ_ZERO_DISCRETE]);;

let DIMENSION_LE_EQ_ALT = prove
 (`!s:real^N->bool n.
       dimension s <= n <=>
       -- &1 <= n /\
       !v a. open v /\ a IN v /\ a IN s
             ==> ?u. a IN u /\ u SUBSET v /\ open u /\
                     dimension(subtopology euclidean s frontier_of (s INTER u))
                     <= n - &1`,
  REPEAT GEN_TAC THEN REWRITE_TAC[DIMENSION_DIMENSION_LE] THEN
  GEN_REWRITE_TAC LAND_CONV [DIMENSION_LE_EQ_SUBTOPOLOGY] THEN
  REWRITE_TAC[GSYM OPEN_IN]);;

let DIMENSION_LE_EQ_LOCAL = prove
 (`!s:real^N->bool n.
        dimension s <= n <=>
       -- &1 <= n /\
       !v a. open_in (subtopology euclidean s) v /\ a IN v
             ==> ?u. a IN u /\ u SUBSET v /\
                     open_in (subtopology euclidean s) u /\
                     dimension(subtopology euclidean s frontier_of u)
                     <= n - &1`,
  REPEAT GEN_TAC THEN REWRITE_TAC[DIMENSION_DIMENSION_LE] THEN
  GEN_REWRITE_TAC LAND_CONV [DIMENSION_LE_CASES] THEN
  REWRITE_TAC[SUBTOPOLOGY_SUBTOPOLOGY] THEN
  REWRITE_TAC[GSYM DIMENSION_DIMENSION_LE] THEN
  SIMP_TAC[FRONTIER_OF_SUBSET_SUBTOPOLOGY; SET_RULE
   `t SUBSET s ==> s INTER t = t`]);;

let DIMENSION_LE_EQ_GENERAL = prove
 (`!t s:real^N->bool n.
        s SUBSET t
        ==> (dimension s <= n <=>
             -- &1 <= n /\
             !v a. open_in (subtopology euclidean t) v /\ a IN v /\ a IN s
                   ==> ?u. a IN u /\
                           u SUBSET v /\
                           open_in (subtopology euclidean t) u /\
                           dimension(s INTER
                                     subtopology euclidean t frontier_of u)
                           <= n - &1)`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [GEN_REWRITE_TAC LAND_CONV [DIMENSION_LE_EQ];
    GEN_REWRITE_TAC RAND_CONV [DIMENSION_LE_EQ_LOCAL]] THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
  DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` MP_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN
  FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [IN_INTER]) THENL
   [FIRST_X_ASSUM(MP_TAC o SPECL [`v:real^N->bool`; `a:real^N`]) THEN
    ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `t INTER u:real^N->bool`;
    SUBGOAL_THEN `(a:real^N) IN t` ASSUME_TAC THENL
     [ASM SET_TAC[]; ALL_TAC] THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`t INTER v:real^N->bool`; `a:real^N`]) THEN
    ASM_SIMP_TAC[IN_INTER; OPEN_IN_OPEN_INTER] THEN
    DISCH_THEN(X_CHOOSE_THEN `uu:real^N->bool` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
    DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` MP_TAC) THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN
    FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [IN_INTER]) THEN
    EXISTS_TAC `s INTER u:real^N->bool`] THEN
 (ASM_SIMP_TAC[IN_INTER; OPEN_IN_OPEN_INTER] THEN
  CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
      INT_LE_TRANS)) THEN
  MATCH_MP_TAC DIMENSION_SUBSET THEN
  REWRITE_TAC[FRONTIER_OF_CLOSURES; FRONTIER_CLOSURES] THEN
  REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF] THEN
  REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY])
  THENL
   [MATCH_MP_TAC(SET_RULE
     `s SUBSET t /\ c1 SUBSET c1' /\ c2 SUBSET c2'
      ==> s INTER (t INTER c1) INTER t INTER c2 SUBSET
          s INTER c1' INTER c2'`);
    MATCH_MP_TAC(SET_RULE
     `s SUBSET t /\ c1 SUBSET c1' /\ c2 SUBSET c2'
      ==> (s INTER c1) INTER s INTER c2 SUBSET
          s INTER (t INTER c1') INTER (t INTER c2')`)] THEN
  ASM_REWRITE_TAC[] THEN
  CONJ_TAC THEN MATCH_MP_TAC SUBSET_CLOSURE THEN ASM SET_TAC[]);;

let DIMENSION_LE_EQ_LOCALLY = prove
 (`!s:real^N->bool n.
      dimension s <= n <=>
      --(&1) <= n /\
      locally (\u. open_in (subtopology euclidean s) u /\
                   dimension(subtopology euclidean s frontier_of u) <= n - &1)
              s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[locally] THEN
  GEN_REWRITE_TAC LAND_CONV [DIMENSION_LE_EQ_LOCAL] THEN
  MESON_TAC[SUBSET]);;

let LOCALLY_OPEN_AND_DIMENSION_LE = prove
 (`!s n. dimension s <= n <=>
         -- &1 <= n /\
         locally (\u. open_in (subtopology euclidean s) u /\
                      dimension u <= n) s`,
  REPEAT GEN_TAC THEN
  GEN_REWRITE_TAC LAND_CONV [LOCALLY_DIMENSION_LE] THEN
  AP_TERM_TAC THEN
  GEN_REWRITE_TAC RAND_CONV [LOCALLY_AND_OPEN_IN] THEN
  REWRITE_TAC[locally] THEN
  MESON_TAC[DIMENSION_SUBSET; INT_LE_TRANS; SUBSET_TRANS]);;

let DIMENSION_EQ_ON_NBDS = prove
 (`!s:real^N->bool n.
        ~(s = {}) /\
        (!x. x IN s
             ==> ?u v. x IN u /\ open_in (subtopology euclidean s) u /\
                       u SUBSET v /\ v SUBSET s /\ dimension v = n)
        ==> dimension s = n`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN
  FIRST_ASSUM(MP_TAC o SPEC `a:real^N`) THEN
  ANTS_TAC THENL [ASM_REWRITE_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
  MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN `dimension(v:real^N->bool) <= dimension(s:real^N->bool)`
  MP_TAC THENL [ASM_SIMP_TAC[DIMENSION_SUBSET]; ASM_REWRITE_TAC[]] THEN
  SIMP_TAC[GSYM INT_LE_ANTISYM] THEN DISCH_TAC THEN
  ONCE_REWRITE_TAC[LOCALLY_DIMENSION_LE] THEN
  CONJ_TAC THENL [ASM_MESON_TAC[DIMENSION_GE]; ALL_TAC] THEN
  ONCE_REWRITE_TAC[LOCALLY_ON_NBDS] THEN
  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
  ASM_REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM INT_LE_ANTISYM] THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [LOCALLY_DIMENSION_LE] THEN
  SIMP_TAC[]);;

let LOCALLY_DIMENSION_EQ = prove
 (`!s:real^N->bool n.
        ~(s = {}) /\ locally (\u. dimension u = n) s ==> dimension s = n`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [locally]) THEN
  DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN
  REWRITE_TAC[OPEN_IN_REFL] THEN DISCH_TAC THEN
  MATCH_MP_TAC DIMENSION_EQ_ON_NBDS THEN ASM_MESON_TAC[]);;

let DIMENSION_EQ_ON_OPEN_SUBSETS = prove
 (`!s:real^N->bool n.
        ~(s = {}) /\
        (!x. x IN s
             ==> ?u. x IN u /\ open_in (subtopology euclidean s) u /\
                     dimension u = n)
        ==> dimension s = n`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC DIMENSION_EQ_ON_NBDS THEN
  ASM_MESON_TAC[SUBSET_REFL; OPEN_IN_IMP_SUBSET]);;

let DIMENSION_EQ_LOCALLY_CLOPEN = prove
 (`!s:real^N->bool.
        dimension s <= &0 <=>
        locally (\u. closed_in (subtopology euclidean s) u /\
                     open_in (subtopology euclidean s) u) s`,
  REWRITE_TAC[GSYM NEIGHBOURHOOD_BASE_OF_EUCLIDEAN] THEN
  REWRITE_TAC[DIMENSION_DIMENSION_LE] THEN
  REWRITE_TAC[DIMENSION_LE_0_NEIGHBOURHOOD_BASE_OF_CLOPEN]);;

let SMALL_INDUCTIVE_DIMENSION = prove
 (`!s:real^N->bool n.
        dimension s <= n <=>
        -- &1 <= n /\
        !c a. a IN s /\ closed_in (subtopology euclidean s) c /\ ~(a IN c)
              ==> ?b. closed_in (subtopology euclidean s) b /\
                      dimension b <= n - &1 /\
                      ?u v. open_in (subtopology euclidean s) u /\
                            open_in (subtopology euclidean s) v /\
                            DISJOINT u v /\ u UNION v = s DIFF b /\
                            a IN u /\ c SUBSET v`,
  REPEAT GEN_TAC THEN
  GEN_REWRITE_TAC LAND_CONV [DIMENSION_LE_EQ_LOCAL] THEN
  EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
   [MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN
    SUBGOAL_THEN
     `?v:real^N->bool. a IN v /\
                       open_in (subtopology euclidean s) v /\
                       DISJOINT ((subtopology euclidean s) closure_of v) c`
    STRIP_ASSUME_TAC THENL
     [MP_TAC(ISPECL [`s:real^N->bool`; `s DIFF c:real^N->bool`; `a:real^N`]
        LOCALLY_CLOSED_IN_EXPLICIT) THEN
      ASM_SIMP_TAC[IN_DIFF; OPEN_IN_DIFF; OPEN_IN_REFL] THEN
      MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[];
      ALL_TAC] THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`v:real^N->bool`; `a:real^N`]) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN
    EXISTS_TAC `subtopology euclidean s frontier_of u:real^N->bool` THEN
    ASM_REWRITE_TAC[CLOSED_IN_FRONTIER_OF] THEN MAP_EVERY EXISTS_TAC
     [`u:real^N->bool`;
      `s DIFF (subtopology euclidean s closure_of u):real^N->bool`] THEN
    ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL; CLOSED_IN_CLOSURE_OF;
                 FRONTIER_OF_CLOSURES; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY;
                 CLOSED_IN_DIFF; CLOSED_IN_REFL; CLOSURE_OF_CLOSED_IN] THEN
    REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC(SET_RULE `u SUBSET t ==> DISJOINT u (s DIFF t)`) THEN
      MATCH_MP_TAC CLOSURE_OF_SUBSET THEN ASM_MESON_TAC[OPEN_IN_SUBSET];
      MATCH_MP_TAC(SET_RULE
       `u SUBSET u' /\ u' SUBSET s
        ==> u UNION (s DIFF u') = s DIFF (u' INTER (s DIFF u))`) THEN
      REWRITE_TAC[CLOSURE_OF_SUBSET_SUBTOPOLOGY] THEN
      ASM_SIMP_TAC[CLOSURE_OF_SUBSET; OPEN_IN_SUBSET];
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
       `DISJOINT v c
        ==> c SUBSET s /\ u SUBSET v ==> c SUBSET s DIFF u`)) THEN
      ASM_MESON_TAC[CLOSURE_OF_MONO; CLOSED_IN_IMP_SUBSET]];
    MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`s DIFF w:real^N->bool`; `a:real^N`]) THEN
    ASM_SIMP_TAC[IN_DIFF; CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
    ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC
     [`b:real^N->bool`; `u:real^N->bool`; `v:real^N->bool`] THEN
    STRIP_TAC THEN EXISTS_TAC `u:real^N->bool` THEN
    ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    TRANS_TAC INT_LE_TRANS `dimension(b:real^N->bool)` THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIMENSION_SUBSET THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `u UNION v = s DIFF b
      ==> f SUBSET s /\ DISJOINT f u /\ DISJOINT f v ==> f SUBSET b`)) THEN
    REWRITE_TAC[FRONTIER_OF_SUBSET_SUBTOPOLOGY] THEN
    ASM_SIMP_TAC[FRONTIER_OF_CLOSURES; CLOSURE_OF_CLOSED_IN; CLOSED_IN_REFL;
                 TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; CLOSED_IN_DIFF] THEN
    CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC(SET_RULE `v INTER s = {} ==> DISJOINT (s INTER c) v`) THEN
    ASM_SIMP_TAC[OPEN_IN_INTER_CLOSURE_OF_EQ_EMPTY; OPEN_IN_SUBSET] THEN
    ASM SET_TAC[]]);;

let SMALL_IMP_DIMENSION_LE_0 = prove
 (`!s:real^N->bool. s <_c (:real) ==> dimension s <= &0`,
  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[DIMENSION_LE_EQ] THEN
  CONV_TAC INT_REDUCE_CONV THEN
  SIMP_TAC[DIMENSION_GE; INT_ARITH `a:int <= d ==> (d <= a <=> d = a)`] THEN
  REWRITE_TAC[DIMENSION_EQ_MINUS1] THEN
  MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN
  DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN
   `~(interval(vec 0,lift r) SUBSET IMAGE (\x:real^N. lift(dist(a,x))) s)`
  MP_TAC THENL
   [DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN
    W(MP_TAC o PART_MATCH lhand CARD_LE_IMAGE o rand o lhand o snd) THEN
    PURE_REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN
    DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_TRANS) THEN
    REWRITE_TAC[CARD_NOT_LE] THEN
    TRANS_TAC CARD_LTE_TRANS `(:real)` THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
    MATCH_MP_TAC(CONJUNCT2 CARD_EQ_INTERVAL) THEN
    ASM_REWRITE_TAC[INTERVAL_NE_EMPTY_1; DROP_VEC; LIFT_DROP];
    REWRITE_TAC[SUBSET; NOT_FORALL_THM; LEFT_IMP_EXISTS_THM; NOT_IMP] THEN
    REWRITE_TAC[IN_IMAGE; NOT_EXISTS_THM; FORALL_LIFT; IN_INTERVAL_1] THEN
    X_GEN_TAC `p:real` THEN REWRITE_TAC[LIFT_EQ; LIFT_DROP; DROP_VEC] THEN
    REWRITE_TAC[TAUT `~(p /\ q) <=> q ==> ~p`] THEN STRIP_TAC THEN
    EXISTS_TAC `ball(a:real^N,p)` THEN
    ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; GSYM SUBSET] THEN
    ASM_SIMP_TAC[FRONTIER_BALL; sphere] THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    TRANS_TAC SUBSET_TRANS `ball(a:real^N,r)` THEN
    ASM_SIMP_TAC[SUBSET_BALL; REAL_LT_IMP_LE]]);;

let COUNTABLE_IMP_DIMENSION_LE_0 = prove
 (`!s:real^N->bool. COUNTABLE s ==> dimension s <= &0`,
  SIMP_TAC[COUNTABLE_IMP_CARD_LT_REAL; SMALL_IMP_DIMENSION_LE_0]);;

let FINITE_IMP_DIMENSION_LE_0 = prove
 (`!s:real^N->bool. FINITE s ==> dimension s <= &0`,
  SIMP_TAC[COUNTABLE_IMP_DIMENSION_LE_0; FINITE_IMP_COUNTABLE]);;

let DIMENSION_SING = prove
 (`!a:real^N. dimension {a} = &0`,
  GEN_TAC THEN MATCH_MP_TAC(INT_ARITH
   `-- &1:int <= x /\ x <= &0 /\ ~(x = -- &1) ==> x = &0`) THEN
  REWRITE_TAC[DIMENSION_GE; DIMENSION_EQ_MINUS1; NOT_INSERT_EMPTY] THEN
  SIMP_TAC[FINITE_IMP_DIMENSION_LE_0; FINITE_SING]);;

let CONNECTED_DIMENSION_EQ_SING = prove
 (`!s:real^N->bool. connected s ==> (dimension s = &0 <=> ?a. s = {a})`,
  REPEAT GEN_TAC THEN
  REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC[DIMENSION_SING] THEN
  MATCH_MP_TAC(SET_RULE
   `~(s = {}) /\ (!a b. ~(a = b) /\ a IN s /\ b IN s ==> F)
    ==> ?a. s = {a}`) THEN
  ASM_REWRITE_TAC[GSYM DIMENSION_EQ_MINUS1] THEN
  CONV_TAC INT_REDUCE_CONV THEN
  MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP (INT_ARITH `i:int = &0 ==> i <= &0`)) THEN
  REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SMALL_INDUCTIVE_DIMENSION] THEN
  CONV_TAC INT_REDUCE_CONV THEN
  SIMP_TAC[DIMENSION_GE; INT_ARITH `a:int <= d ==> (d <= a <=> d = a)`] THEN
  REWRITE_TAC[DIMENSION_EQ_MINUS1] THEN
  DISCH_THEN(MP_TAC o SPECL [`{b:real^N}`; `a:real^N`]) THEN
  ASM_REWRITE_TAC[CLOSED_IN_SING; IN_SING; SING_SUBSET] THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
  REWRITE_TAC[UNWIND_THM2; CLOSED_IN_EMPTY] THEN
  REWRITE_TAC[NOT_EXISTS_THM; DIFF_EMPTY] THEN
  MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
  STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_OPEN_IN_EQ]) THEN
  REWRITE_TAC[] THEN
  MAP_EVERY EXISTS_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
  ASM SET_TAC[]);;

let DIMENSION_SUBSET_EXISTS = prove
 (`!s:real^N->bool n.
        -- &1 <= n /\ n <= dimension s
        ==> ?t. closed_in (subtopology euclidean s) t /\
                t SUBSET s /\
                dimension t = n`,
  let lemma = prove
   (`!s:real^N->bool.
          ~(s = {})
          ==> ?t. closed_in (subtopology euclidean s) t /\
                  dimension t = dimension s - &1`,
    REPEAT STRIP_TAC THEN
    MP_TAC(INT_ARITH
     `dimension(s:real^N->bool) <= dimension(s) /\
      ~(dimension s <= dimension s - &1)`) THEN
    ONCE_REWRITE_TAC[DIMENSION_LE_EQ_ALT] THEN
    ASM_REWRITE_TAC[DIMENSION_GE; DIMENSION_POS_LE;
                    INT_ARITH `--a:int <= d - a <=> &0 <= d`] THEN
    DISCH_THEN(MP_TAC o MATCH_MP (MESON[]
     `(!x y. P x y ==> Q x y) /\ ~(!x y. P x y ==> R x y)
      ==> (?x y. P x y) ==> ~(!x y. Q x y ==> R x y)`)) THEN
    ANTS_TAC THENL
     [ASM_MESON_TAC[OPEN_UNIV; IN_UNIV; MEMBER_NOT_EMPTY]; ALL_TAC] THEN
    GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN
    REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(p /\ q) <=> p ==> ~q`] THEN
    DISCH_TAC THEN REPEAT GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN
    GEN_TAC THEN REPEAT(MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[]) THEN
    MATCH_MP_TAC(INT_ARITH
     `~(x:int = s - &1) ==> x <= s - &1 ==> x <= s - &1 - &1`) THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    REWRITE_TAC[CLOSED_IN_FRONTIER_OF]) in
  REPEAT GEN_TAC THEN
  ONCE_REWRITE_TAC[INT_ARITH
   `-- &1:int <= n /\ n <= s <=> &0 <= s - n /\ -- &1 <= s - (s - n)`] THEN
  ASM_CASES_TAC
   `!t:real^N->bool.
       dimension t = n <=>
       dimension t = dimension(s:real^N->bool) - (dimension s - n)`
  THENL
   [POP_ASSUM(fun th -> ONCE_REWRITE_TAC[th]); ASM_INT_ARITH_TAC] THEN
  SPEC_TAC(`dimension(s:real^N->bool) - n`,`d:int`) THEN
  REWRITE_TAC[IMP_CONJ; GSYM INT_FORALL_POS] THEN
  MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
   [REWRITE_TAC[INT_SUB_RZERO] THEN MESON_TAC[CLOSED_IN_REFL; SUBSET_REFL];
    X_GEN_TAC `d:num`] THEN
  REWRITE_TAC[GSYM INT_OF_NUM_SUC; INT_ARITH
   `--a:int <= d - (x + a) <=> x <= d`] THEN
  DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
  FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (INT_ARITH
   `d:int <= s ==> d = s \/ d < s`))
  THENL
   [DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `{}:real^N->bool` THEN
    ASM_REWRITE_TAC[CLOSED_IN_EMPTY; EMPTY_SUBSET; DIMENSION_EMPTY] THEN
    INT_ARITH_TAC;
    ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN
    DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPEC `t:real^N->bool` lemma) THEN
    ASM_REWRITE_TAC[GSYM DIMENSION_EQ_MINUS1] THEN
    ANTS_TAC THENL [ASM_INT_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN
    X_GEN_TAC `u:real^N->bool` THEN
    REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
     [ASM_MESON_TAC[CLOSED_IN_TRANS];
      ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET; SUBSET_TRANS];
      INT_ARITH_TAC]]);;

let DIMENSION_UNION_LE_BASIC = prove
 (`!s t:real^N->bool.
        dimension(s UNION t) <= dimension s + dimension t + &1`,
  SUBGOAL_THEN
   `!n s t. dimension s + dimension t + &2 <= &n
            ==> dimension(s UNION t:real^N->bool) <= &n - &1`
  ASSUME_TAC THENL
   [ALL_TAC;
    MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN
    SUBGOAL_THEN
      `?n. dimension(s:real^N->bool) + dimension(t:real^N->bool) + &2 = &n`
    CHOOSE_TAC THENL
     [REWRITE_TAC[INT_OF_NUM_EXISTS] THEN MATCH_MP_TAC(INT_ARITH
       `-- &1:int <= x /\ -- &1 <= y ==> &0 <= x + y + &2`) THEN
      REWRITE_TAC[DIMENSION_GE];
      ASM_SIMP_TAC[INT_LE_REFL; INT_ARITH
       `x:int <= a + b + &1 <=> x <= (a + b + &2) - &1`]]] THEN
  INDUCT_TAC THEN
  SIMP_TAC[DIMENSION_GE; DIMENSION_EQ_MINUS1; UNION_EMPTY; DIMENSION_EMPTY;
           INT_SUB_LZERO; INT_LE_REFL; GSYM INT_OF_NUM_SUC; INT_ARITH
            `-- &1:int <= x /\ -- &1 <= y
             ==> (x + y + &2 <= &0 <=> x = -- &1 /\ y = -- &1)`] THEN
  MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN
  REWRITE_TAC[INT_ARITH `(n + &1) - &1:int = n`] THEN
  REWRITE_TAC[INT_ARITH `s + t + &2:int <= n + &1 <=> s + t <= n - &1`] THEN
  DISCH_TAC THEN ONCE_REWRITE_TAC[DIMENSION_LE_EQ] THEN
  CONJ_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN
  MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `a:real^N`] THEN
  REWRITE_TAC[SET_RULE
   `p /\ q /\ x IN s UNION t ==> r <=>
    (x IN s \/ x IN t ==> p /\ q ==> r)`] THEN
  UNDISCH_TAC
   `dimension(s:real^N->bool) + dimension(t:real^N->bool) <= &n - &1` THEN
  MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`t:real^N->bool`; `s:real^N->bool`] THEN
  ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`] THEN
  MATCH_MP_TAC(MESON[]
   `(!s t. R s t ==> R t s) /\ (!s t. P s ==> R s t)
    ==> (!s t. P s \/ P t ==> R s t)`) THEN
  CONJ_TAC THENL [REWRITE_TAC[INT_ADD_SYM; UNION_COMM]; ALL_TAC] THEN
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC `dimension(s:real^N->bool)` INT_LE_REFL) THEN
  GEN_REWRITE_TAC LAND_CONV [DIMENSION_LE_EQ] THEN
  DISCH_THEN(MP_TAC o SPECL [`v:real^N->bool`; `a:real^N`] o CONJUNCT2) THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
  X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  REWRITE_TAC[ONCE_REWRITE_RULE[INTER_COMM] UNION_OVER_INTER] THEN
  FIRST_X_ASSUM MATCH_MP_TAC THEN
  MP_TAC(ISPECL [`t INTER frontier u:real^N->bool`; `t:real^N->bool`]
        DIMENSION_SUBSET) THEN
  REWRITE_TAC[INTER_SUBSET] THEN ASM_INT_ARITH_TAC);;

let DIMENSION_ZERO_REDUCTION_THEOREM = prove
 (`!s:real^N->bool v.
        dimension s <= &0 /\
        (!n:num. open_in (subtopology euclidean s) (v n))
        ==> ?u. (!n. open_in (subtopology euclidean s) (u n)) /\
                (!n. u n SUBSET v n) /\
                pairwise (\m n. DISJOINT (u m) (u n)) (:num) /\
                UNIONS {u n | n IN (:num)} = UNIONS {v n | n IN (:num)}`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC `\u:real^N->bool. closed_in (subtopology euclidean s) u /\
                                 open_in (subtopology euclidean s) u`
        GENERAL_REDUCTION_THEOREM) THEN
  REWRITE_TAC[OPEN_IN_EMPTY; CLOSED_IN_EMPTY] THEN ANTS_TAC THENL
   [SIMP_TAC[OPEN_IN_UNION; CLOSED_IN_UNION; CLOSED_IN_DIFF; OPEN_IN_DIFF];
    DISCH_THEN(MP_TAC o SPEC `v:num->real^N->bool`)] THEN
  ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
   [X_GEN_TAC `n:num` THEN
    FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIMENSION_EQ_LOCALLY_CLOPEN]) THEN
    DISCH_THEN(MP_TAC o SPEC `(v:num->real^N->bool) n` o MATCH_MP
     (REWRITE_RULE[IMP_CONJ] LOCALLY_OPEN_SUBSET)) THEN
    ASM_REWRITE_TAC[LOCALLY_IMP_COUNTABLE_UNION_OF];
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:num->real^N->bool` THEN
    MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN
    MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN
    REWRITE_TAC[UNION_OF] THEN MESON_TAC[OPEN_IN_UNIONS]]);;

let DIMENSION_ZERO_REDUCTION_THEOREM_2 = prove
 (`!u s t:real^N->bool.
        dimension u <= &0 /\
        open_in (subtopology euclidean u) s /\
        open_in (subtopology euclidean u) t
        ==> ?s' t'. open_in (subtopology euclidean u) s' /\
                    open_in (subtopology euclidean u) t' /\
                    s' SUBSET s /\ t' SUBSET t /\ DISJOINT s' t' /\
                    s' UNION t' = s UNION t`,
  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN
  MP_TAC(ISPEC `\v:real^N->bool. closed_in (subtopology euclidean u) v /\
                                 open_in (subtopology euclidean u) v`
        GENERAL_REDUCTION_THEOREM_2) THEN
  REWRITE_TAC[OPEN_IN_EMPTY; CLOSED_IN_EMPTY] THEN ANTS_TAC THENL
   [SIMP_TAC[OPEN_IN_UNION; CLOSED_IN_UNION; CLOSED_IN_DIFF; OPEN_IN_DIFF];
    DISCH_THEN(MP_TAC o SPECL [`s:real^N->bool`; `t:real^N->bool`])] THEN
  ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
   [REPEAT STRIP_TAC THEN
    MATCH_MP_TAC LOCALLY_IMP_COUNTABLE_UNION_OF THEN
    MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN EXISTS_TAC `u:real^N->bool` THEN
    ASM_REWRITE_TAC[GSYM DIMENSION_EQ_LOCALLY_CLOPEN];
    REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
    REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN
    REWRITE_TAC[UNION_OF] THEN MESON_TAC[OPEN_IN_UNIONS]]);;

let DIMENSION_ZERO_SEPARATION_THEOREM = prove
 (`!u s t:real^N->bool.
        dimension u <= &0 /\
        closed_in (subtopology euclidean u) s /\
        closed_in (subtopology euclidean u) t /\
        DISJOINT s t
        ==> ?s' t'. closed_in (subtopology euclidean u) s' /\
                    open_in (subtopology euclidean u) s' /\
                    closed_in (subtopology euclidean u) t' /\
                    open_in (subtopology euclidean u) t' /\
                    s SUBSET s' /\ t SUBSET t' /\ DISJOINT s' t' /\
                    s' UNION t' = u`,
  REPEAT STRIP_TAC THEN MP_TAC(ISPECL
   [`u:real^N->bool`; `u DIFF s:real^N->bool`; `u DIFF t:real^N->bool`]
   DIMENSION_ZERO_REDUCTION_THEOREM_2) THEN
  ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`s':real^N->bool`; `t':real^N->bool`] THEN
  STRIP_TAC THEN MAP_EVERY EXISTS_TAC
   [`u DIFF s':real^N->bool`; `u DIFF t':real^N->bool`] THEN
  ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN
  SUBGOAL_THEN
   `u DIFF s':real^N->bool = t' /\ u DIFF t' = s'`
  (CONJUNCTS_THEN SUBST1_TAC) THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN
  ASM SET_TAC[]);;

let DIMENSION_LE_CLOSED_IN_UNIONS,DIMENSION_DECOMPOSITION =
  let lemma = prove
   (`!s:real^N->bool n.
          dimension s <= n /\ &0 <= n
          ==> ?t. (COUNTABLE UNION_OF
                   (\c. closed_in (subtopology euclidean s) c /\
                        dimension c <= n - &1)) t /\
                  dimension(s DIFF t) <= &0`,
    REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIMENSION_LE_EQ_LOCALLY]) THEN
    DISCH_THEN(MP_TAC o REWRITE_RULE[LOCALLY_OPEN_BASIS] o CONJUNCT2) THEN
    DISCH_THEN(X_CHOOSE_THEN `b:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
    ABBREV_TAC
     `t = UNIONS(IMAGE
        (\c:real^N->bool. subtopology euclidean s frontier_of c) b)` THEN
    EXISTS_TAC `t:real^N->bool` THEN CONJ_TAC THENL
     [EXPAND_TAC "t" THEN MATCH_MP_TAC COUNTABLE_UNION_OF_UNIONS THEN
      ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
      X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN
      MATCH_MP_TAC COUNTABLE_UNION_OF_INC THEN
      ASM_SIMP_TAC[CLOSED_IN_FRONTIER_OF];
      GEN_REWRITE_TAC I [DIMENSION_LE_EQ_LOCAL] THEN
      CONV_TAC INT_REDUCE_CONV THEN REWRITE_TAC[DIMENSION_LE_MINUS1] THEN
      MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN
      FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
      DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool`
       (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTER]) THEN
      REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
      SUBGOAL_THEN `?c. c SUBSET b /\ s INTER w:real^N->bool = UNIONS c`
      MP_TAC THENL [ASM_SIMP_TAC[OPEN_IN_OPEN_INTER]; ALL_TAC] THEN
      DISCH_THEN(MP_TAC o SPEC `a:real^N` o MATCH_MP (SET_RULE
       `(?c. c SUBSET b /\ x = UNIONS c)
        ==> !a. a IN x ==> ?d. d IN b /\ d SUBSET x /\ a IN d`)) THEN
      ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_INTER; SUBSET_INTER] THEN
      X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN
      ANTE_RES_THEN MP_TAC (ASSUME `(d:real^N->bool) IN b`) THEN
      REPEAT(FIRST_X_ASSUM(K ALL_TAC o check (is_forall o concl))) THEN
      STRIP_TAC THEN EXISTS_TAC `d DIFF t:real^N->bool` THEN
      REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
      CONJ_TAC THENL
       [UNDISCH_TAC `open_in (subtopology euclidean s) (d:real^N->bool)` THEN
        REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN
        SET_TAC[];
        ALL_TAC] THEN
      REWRITE_TAC[FRONTIER_OF_CLOSURES; CLOSURE_OF_SUBTOPOLOGY;
                  EUCLIDEAN_CLOSURE_OF; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
      ASM_SIMP_TAC[SET_RULE
       `d SUBSET s ==> (s DIFF t) INTER (d DIFF t) = d DIFF t`] THEN
      ASM_SIMP_TAC[SET_RULE
       `d SUBSET s
        ==> (s DIFF t) INTER (s DIFF t DIFF (d DIFF t)) =
            s DIFF (t UNION d)`] THEN
      REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_DIFF] THEN
      X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
      MP_TAC(ASSUME `~((x:real^N) IN t)`) THEN EXPAND_TAC "t" THEN
      REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM] THEN
      EXISTS_TAC `d:real^N->bool` THEN
      ASM_REWRITE_TAC[CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF;
        FRONTIER_OF_CLOSURES; IN_INTER; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
      ASM_SIMP_TAC[SET_RULE
       `d SUBSET s ==> s INTER d = d /\ s INTER (s DIFF d) = s DIFF d`] THEN
      CONJ_TAC THENL
       [UNDISCH_TAC `(x:real^N) IN closure (d DIFF t)`;
        UNDISCH_TAC `(x:real^N) IN closure (s DIFF (t UNION d))`] THEN
      MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN
      MATCH_MP_TAC SUBSET_CLOSURE THEN SET_TAC[]])
  and case0 = prove
   (`!u:real^N->bool c.
          COUNTABLE c /\
          (!s. s IN c
               ==> closed_in (subtopology euclidean u) s /\ dimension s <= &0)
          ==> dimension(UNIONS c) <= &0`,
    MAP_EVERY X_GEN_TAC [`uu:real^N->bool`; `cc:(real^N->bool)->bool`] THEN
    ASM_CASES_TAC `cc:(real^N->bool)->bool = {}` THEN
    ASM_REWRITE_TAC[UNIONS_0; DIMENSION_EMPTY] THEN
    CONV_TAC INT_REDUCE_CONV THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    MP_TAC(ISPEC `cc:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN
    ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(K ALL_TAC) THEN
    DISCH_THEN(X_CHOOSE_THEN `c:num->real^N->bool` SUBST1_TAC) THEN
    REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; FORALL_AND_THM] THEN STRIP_TAC THEN
    REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN
    ABBREV_TAC `u:real^N->bool = UNIONS {c n | n IN (:num)}` THEN
    SUBGOAL_THEN
     `!n. closed_in (subtopology euclidean u) ((c:num->real^N->bool) n)`
    ASSUME_TAC THENL
     [GEN_TAC THEN MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN
      EXISTS_TAC `uu:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
      FIRST_ASSUM(MP_TAC o GEN `n:num` o MATCH_MP CLOSED_IN_IMP_SUBSET o
          SPEC `n:num`) THEN ASM SET_TAC[];
      UNDISCH_THEN
       `!n. closed_in (subtopology euclidean uu) ((c:num->real^N->bool) n)`
       (K ALL_TAC)] THEN
    GEN_REWRITE_TAC I [SMALL_INDUCTIVE_DIMENSION] THEN
    CONV_TAC INT_REDUCE_CONV THEN
    MAP_EVERY X_GEN_TAC [`l:real^N->bool`; `aa:real^N`] THEN
    REWRITE_TAC[SET_RULE `~(a IN l) <=> DISJOINT {a} l`] THEN
    GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM CLOSED_IN_SING] THEN
    REWRITE_TAC[GSYM SING_SUBSET] THEN
    SPEC_TAC(`{aa:real^N}`,`k:real^N->bool`) THEN
    REPEAT STRIP_TAC THEN REWRITE_TAC[DIMENSION_LE_MINUS1] THEN
    ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
    REWRITE_TAC[UNWIND_THM2; CLOSED_IN_EMPTY; DIFF_EMPTY] THEN
    SUBGOAL_THEN
     `?g h:num->real^N->bool.
          (!n. open_in (subtopology euclidean u) (g n) /\
               open_in (subtopology euclidean u) (h n) /\
               DISJOINT (g n) (h n) /\
               DISJOINT ((subtopology euclidean u) closure_of g n)
                        ((subtopology euclidean u) closure_of h n) /\
               k SUBSET g n /\ l SUBSET h n /\ c n SUBSET g n UNION h n) /\
          (!n. (subtopology euclidean u) closure_of (g n) SUBSET g(SUC n) /\
               (subtopology euclidean u) closure_of (h n) SUBSET h(SUC n))`
    STRIP_ASSUME_TAC THENL
     [ALL_TAC;
      MAP_EVERY EXISTS_TAC
       [`UNIONS {g n | n IN (:num)}:real^N->bool`;
        `UNIONS {h n | n IN (:num)}:real^N->bool`] THEN
      ASM_SIMP_TAC[OPEN_IN_UNIONS; FORALL_IN_GSPEC] THEN
      ONCE_REWRITE_TAC[CONJ_ASSOC] THEN
      CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THENL
       [REWRITE_TAC[SET_RULE
         `DISJOINT (UNIONS a) (UNIONS b) <=>
          !s. s IN a ==> !t. t IN b ==> DISJOINT s t`] THEN
        REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN
        MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN
        DISJ_CASES_TAC(ARITH_RULE `i:num <= j \/ j <= i`) THENL
         [MATCH_MP_TAC(SET_RULE
           `!s'. DISJOINT s' t /\ s SUBSET s' ==> DISJOINT s t`) THEN
          EXISTS_TAC `(g:num->real^N->bool) j` THEN ASM_REWRITE_TAC[] THEN
          UNDISCH_TAC `i:num <= j` THEN
          MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`j:num`; `i:num`];
          MATCH_MP_TAC(SET_RULE
           `!t'. DISJOINT s t' /\ t SUBSET t' ==> DISJOINT s t`) THEN
          EXISTS_TAC `(h:num->real^N->bool) i` THEN ASM_REWRITE_TAC[] THEN
          UNDISCH_TAC `j:num <= i` THEN
          MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`i:num`; `j:num`]] THEN
        MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
        REWRITE_TAC[SUBSET_TRANS; SUBSET_REFL] THEN
        ASM_MESON_TAC[CLOSURE_OF_SUBSET; SUBSET_TRANS; OPEN_IN_SUBSET];
        REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; UNION_SUBSET; UNIONS_SUBSET] THEN
        REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN CONJ_TAC THENL
         [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]; ASM SET_TAC[]]]] THEN
    MATCH_MP_TAC(MESON[] `(?f. R (FST o f) (SND o f)) ==> ?g h. R g h`) THEN
    REWRITE_TAC[o_THM] THEN MATCH_MP_TAC DEPENDENT_CHOICE THEN
    REWRITE_TAC[NOT_SUC; EXISTS_PAIR_THM; FORALL_PAIR_THM] THEN CONJ_TAC THENL
     [MP_TAC(ISPECL [`c 0:real^N->bool`;
                     `c 0 INTER k:real^N->bool`; `c 0 INTER l:real^N->bool`]
          DIMENSION_ZERO_SEPARATION_THEOREM) THEN
      ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
       [ONCE_REWRITE_TAC[CONJ_ASSOC] THEN
        CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
        CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN
        EXISTS_TAC `u:real^N->bool` THEN ASM_SIMP_TAC[CLOSED_IN_INTER] THEN
        ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET; INTER_SUBSET];
        REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
      MAP_EVERY X_GEN_TAC [`a:real^N->bool`; `b:real^N->bool`] THEN
      STRIP_TAC THEN
      MP_TAC(ISPECL [`k UNION a:real^N->bool`; `l UNION b:real^N->bool`;
                  `u:real^N->bool`] SEPARATION_NORMAL_LOCAL_CLOSURES) THEN
      ANTS_TAC THENL
       [ONCE_REWRITE_TAC[CONJ_ASSOC] THEN
        CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THEN
        MATCH_MP_TAC CLOSED_IN_UNION THEN ASM_REWRITE_TAC[] THEN
        MATCH_MP_TAC CLOSED_IN_TRANS THEN EXISTS_TAC `c 0:real^N->bool` THEN
        ASM_REWRITE_TAC[];
        REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN ASM SET_TAC[]];
      MAP_EVERY X_GEN_TAC [`n:num`; `g:real^N->bool`; `h:real^N->bool`] THEN
      STRIP_TAC THEN
      MP_TAC(ISPECL [`c (SUC n):real^N->bool`;
       `c(SUC n) INTER (subtopology euclidean u closure_of g):real^N->bool`;
       `c(SUC n) INTER (subtopology euclidean u closure_of h):real^N->bool`]
          DIMENSION_ZERO_SEPARATION_THEOREM) THEN
      ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
       [ONCE_REWRITE_TAC[CONJ_ASSOC] THEN
        CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
        CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN
        EXISTS_TAC `u:real^N->bool` THEN
        ASM_SIMP_TAC[CLOSED_IN_INTER; CLOSED_IN_CLOSURE_OF] THEN
        ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET; INTER_SUBSET];
        REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
      MAP_EVERY X_GEN_TAC [`a:real^N->bool`; `b:real^N->bool`] THEN
      STRIP_TAC THEN
      MP_TAC(ISPECL
       [`(subtopology euclidean u closure_of g) UNION a:real^N->bool`;
        `(subtopology euclidean u closure_of h) UNION b:real^N->bool`;
        `u:real^N->bool`] SEPARATION_NORMAL_LOCAL_CLOSURES) THEN
      ANTS_TAC THENL
       [ONCE_REWRITE_TAC[CONJ_ASSOC] THEN
        CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THEN
        MATCH_MP_TAC CLOSED_IN_UNION THEN
        REWRITE_TAC[CLOSED_IN_CLOSURE_OF] THEN
        MATCH_MP_TAC CLOSED_IN_TRANS THEN
        EXISTS_TAC `c(SUC n):real^N->bool` THEN ASM_REWRITE_TAC[];
        REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN
        ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
        ONCE_REWRITE_TAC[CONJ_ASSOC] THEN
        CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          SUBSET_TRANS)) THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
          SUBSET_TRANS)) THEN
        MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s SUBSET t UNION u`) THEN
        MATCH_MP_TAC CLOSURE_OF_SUBSET THEN ASM_MESON_TAC[OPEN_IN_SUBSET]]]) in
  let DIMENSION_LE_CLOSED_IN_UNIONS = prove
   (`!u:real^N->bool c n.
       -- &1 <= n /\ COUNTABLE c /\
       (!s. s IN c
            ==> closed_in (subtopology euclidean u) s /\ dimension s <= n)
       ==> dimension(UNIONS c) <= n`,
    REPEAT GEN_TAC THEN ASM_CASES_TAC `n:int = -- &1` THENL
     [ASM_REWRITE_TAC[DIMENSION_LE_MINUS1] THEN SET_TAC[]; ALL_TAC] THEN
    ASM_CASES_TAC `&0:int <= n` THENL [ALL_TAC; ASM_INT_ARITH_TAC] THEN
    DISCH_THEN(MP_TAC o CONJUNCT2) THEN MAP_EVERY (fun t -> SPEC_TAC(t,t))
     [`c:(real^N->bool)->bool`; `u:real^N->bool`] THEN
    FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM INT_OF_NUM_EXISTS]) THEN
    POP_ASSUM_LIST(K ALL_TAC) THEN
    DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN
    SPEC_TAC(`n:num`,`d:num`) THEN
    INDUCT_TAC THEN REWRITE_TAC[case0] THEN
    MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `c:(real^N->bool)->bool`] THEN
    STRIP_TAC THEN
    SUBGOAL_THEN
     `!u. u IN c
          ==> ?t r. DISJOINT t r /\ t UNION r = u /\
                    dimension(t) <= &d /\
                    dimension(r:real^N->bool) <= &0 /\
                    (COUNTABLE UNION_OF closed_in (subtopology euclidean s)) t`
    MP_TAC THENL
     [X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN
      MP_TAC(ISPECL [`u:real^N->bool`; `&(SUC d):int`] lemma) THEN
      ASM_SIMP_TAC[INT_POS] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
      STRIP_TAC THEN EXISTS_TAC `u DIFF t:real^N->bool` THEN
      ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
      ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
       [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RATOR_CONV [UNION_OF]) THEN
        REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
        X_GEN_TAC `b:(real^N->bool)->bool` THEN
        REWRITE_TAC[GSYM INT_OF_NUM_SUC; INT_ARITH `(x + y) - y:int = x`] THEN
        REPEAT STRIP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
        MATCH_MP_TAC(SET_RULE `t SUBSET u ==> t UNION (u DIFF t) = u`) THEN
        EXPAND_TAC "t" THEN REWRITE_TAC[UNIONS_SUBSET] THEN
        ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET];
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          UNION_OF_MONO)) THEN
        REWRITE_TAC[] THEN ASM_MESON_TAC[CLOSED_IN_TRANS]];
      REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN
    MAP_EVERY X_GEN_TAC
     [`t:(real^N->bool)->(real^N->bool)`;
      `r:(real^N->bool)->(real^N->bool)`] THEN
    DISCH_TAC THEN
    SUBGOAL_THEN
     `UNIONS c = UNIONS (IMAGE (t:(real^N->bool)->(real^N->bool)) c) UNION
                 (UNIONS (IMAGE r c) DIFF UNIONS (IMAGE t c))`
    SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN
    W(MP_TAC o PART_MATCH lhand DIMENSION_UNION_LE_BASIC o lhand o snd) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INT_LE_TRANS) THEN
    MATCH_MP_TAC(INT_ARITH
     `x:int <= d /\ y <= &0 ==> x + y + &1 <= d + &1`) THEN
    CONJ_TAC THENL
     [SUBGOAL_THEN
       `(COUNTABLE UNION_OF
          (\c. closed_in (subtopology euclidean s) c /\ dimension c <= &d))
        (UNIONS (IMAGE (t:(real^N->bool)->(real^N->bool)) c))`
      MP_TAC THENL
       [MATCH_MP_TAC COUNTABLE_UNION_OF_UNIONS THEN
        ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
        X_GEN_TAC `d:real^N->bool` THEN DISCH_TAC THEN
        REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `d:real^N->bool`)) THEN
        ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
        FIRST_X_ASSUM(MP_TAC  o GEN_REWRITE_RULE RATOR_CONV [UNION_OF]) THEN
        REWRITE_TAC[UNION_OF] THEN MATCH_MP_TAC MONO_EXISTS THEN
        X_GEN_TAC `v:(real^N->bool)->bool` THEN
        STRIP_TAC THEN ASM_SIMP_TAC[] THEN
        X_GEN_TAC `b:real^N->bool` THEN DISCH_TAC THEN TRANS_TAC INT_LE_TRANS
         `dimension((t:(real^N->bool)->(real^N->bool)) d)` THEN
        ASM_SIMP_TAC[] THEN MATCH_MP_TAC DIMENSION_SUBSET THEN
        ASM SET_TAC[];
        REWRITE_TAC[UNION_OF] THEN
        DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN
        FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]];
      REWRITE_TAC[UNIONS_DIFF] THEN
      MATCH_MP_TAC case0 THEN
      EXISTS_TAC `UNIONS (IMAGE (r:(real^N->bool)->(real^N->bool)) c) DIFF
                  UNIONS (IMAGE t c)` THEN
      ASM_SIMP_TAC[COUNTABLE_IMAGE; SIMPLE_IMAGE; FORALL_IN_IMAGE] THEN
      X_GEN_TAC `d:real^N->bool` THEN DISCH_TAC THEN CONJ_TAC THENL
       [SUBGOAL_THEN
         `r d DIFF UNIONS (IMAGE (t:(real^N->bool)->(real^N->bool)) c) =
          (UNIONS (IMAGE r c) DIFF UNIONS (IMAGE t c)) INTER d`
        SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
        MATCH_MP_TAC CLOSED_IN_SUBTOPOLOGY_INTER_SUBSET THEN
        EXISTS_TAC `s:real^N->bool` THEN
        ASM_SIMP_TAC[CLOSED_IN_INTER; CLOSED_IN_REFL] THEN
        MATCH_MP_TAC(SET_RULE
         `(!x. x IN c ==> x SUBSET s) ==> UNIONS c DIFF t SUBSET s`) THEN
        REWRITE_TAC[FORALL_IN_IMAGE] THEN
        X_GEN_TAC `b:real^N->bool` THEN STRIP_TAC THEN
        TRANS_TAC SUBSET_TRANS `b:real^N->bool` THEN CONJ_TAC THENL
         [ASM SET_TAC[]; ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]];
        TRANS_TAC INT_LE_TRANS
         `dimension((r:(real^N->bool)->(real^N->bool)) d)` THEN
        ASM_SIMP_TAC[] THEN MATCH_MP_TAC DIMENSION_SUBSET THEN
        SET_TAC[]]]) in
  let DIMENSION_DECOMPOSITION = prove
   (`!s:real^N->bool n.
          &0 <= n
          ==> (dimension s <= n <=>
               ?t u. t UNION u = s /\ DISJOINT t u /\
                     (fsigma relative_to s) t /\
                     dimension t <= n - &1 /\
                     dimension u <= &0)`,
    REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL
     [MP_TAC(ISPECL [`s:real^N->bool`; `n:int`] lemma) THEN
      ASM_REWRITE_TAC[COUNTABLE_UNION_OF_RELATIVE_TO;
                      REWRITE_RULE[GSYM FUN_EQ_THM; ETA_AX] fsigma] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
      STRIP_TAC THEN EXISTS_TAC `s DIFF t:real^N->bool` THEN
      ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
       [MATCH_MP_TAC(SET_RULE `t SUBSET s ==> t UNION (s DIFF t) = s`) THEN
        FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RATOR_CONV [UNION_OF]) THEN
        REWRITE_TAC[] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
        ASM_REWRITE_TAC[UNIONS_SUBSET] THEN ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET];
        SET_TAC[];
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          UNION_OF_MONO)) THEN
        SIMP_TAC[CLOSED_RELATIVE_TO];
        FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RATOR_CONV [UNION_OF]) THEN
        REWRITE_TAC[] THEN
        DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool`
          (STRIP_ASSUME_TAC o GSYM)) THEN
        ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIMENSION_LE_CLOSED_IN_UNIONS THEN
        EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
        ASM_INT_ARITH_TAC];
      EXPAND_TAC "s" THEN
      W(MP_TAC o PART_MATCH lhand DIMENSION_UNION_LE_BASIC o lhand o snd) THEN
      ASM_INT_ARITH_TAC]) in
  DIMENSION_LE_CLOSED_IN_UNIONS,DIMENSION_DECOMPOSITION;;

let DIMENSION_LE_UNIONS_RELATIVE = prove
 (`!u:real^N->bool c n.
        -- &1 <= n /\
        COUNTABLE c /\
        (!s. s IN c ==> (fsigma relative_to u) s /\ dimension s <= n)
        ==> dimension(UNIONS c) <= n`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `(COUNTABLE UNION_OF
     (\t. closed_in (subtopology euclidean u) t /\ dimension t <= n))
     (UNIONS c:real^N->bool)`
  MP_TAC THENL
   [MATCH_MP_TAC COUNTABLE_UNION_OF_UNIONS THEN ASM_REWRITE_TAC[] THEN
    X_GEN_TAC `t:real^N->bool` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
    REWRITE_TAC[COUNTABLE_UNION_OF_RELATIVE_TO;
                REWRITE_RULE[GSYM FUN_EQ_THM; ETA_AX] fsigma] THEN
    REWRITE_TAC[UNION_OF] THEN MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `u:(real^N->bool)->bool` THEN SIMP_TAC[CLOSED_RELATIVE_TO] THEN
    STRIP_TAC THEN X_GEN_TAC `d:real^N->bool` THEN DISCH_TAC THEN
    TRANS_TAC INT_LE_TRANS `dimension(UNIONS u:real^N->bool)` THEN
    CONJ_TAC THENL [MATCH_MP_TAC DIMENSION_SUBSET; ASM_REWRITE_TAC[]] THEN
    ASM SET_TAC[];
    REWRITE_TAC[UNION_OF] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIMENSION_LE_CLOSED_IN_UNIONS THEN
    EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[]]);;

let DIMENSION_LE_UNIONS = prove
 (`!c:(real^N->bool)->bool n.
        -- &1 <= n /\
        COUNTABLE c /\
        (!s. s IN c ==> fsigma s /\ dimension s <= n)
        ==> dimension(UNIONS c) <= n`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC DIMENSION_LE_UNIONS_RELATIVE THEN
  EXISTS_TAC `(:real^N)` THEN
  ASM_REWRITE_TAC[RELATIVE_TO_UNIV]);;

let DIMENSION_LE_UNION_RELATIVE = prove
 (`!u s t:real^N->bool n.
        (fsigma relative_to u) s /\ (fsigma relative_to u) t /\
        dimension s <= n /\ dimension t <= n
        ==> dimension(s UNION t) <= n`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM UNIONS_2] THEN
  MATCH_MP_TAC DIMENSION_LE_UNIONS_RELATIVE THEN
  EXISTS_TAC `u:real^N->bool` THEN
  ASM_REWRITE_TAC[COUNTABLE_INSERT; COUNTABLE_EMPTY] THEN
  ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN
  ASM_MESON_TAC[DIMENSION_LE_IMP_GE]);;

let DIMENSION_LE_UNION = prove
 (`!s t:real^N->bool n.
        fsigma s /\ fsigma t /\ dimension s <= n /\ dimension t <= n
        ==> dimension(s UNION t) <= n`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC DIMENSION_LE_UNION_RELATIVE THEN
  EXISTS_TAC `(:real^N)` THEN ASM_REWRITE_TAC[RELATIVE_TO_UNIV]);;

let DIMENSION_LE_UNION_RELATIVE_GEN = prove
 (`!u s t:real^N->bool n.
        ((fsigma relative_to u) s /\ (gdelta relative_to u) s /\ t SUBSET u \/
         (fsigma relative_to u) t /\ (gdelta relative_to u) t /\ s SUBSET u) /\
        dimension s <= n /\ dimension t <= n
        ==> dimension(s UNION t) <= n`,
  ONCE_REWRITE_TAC[MESON[]
   `(!u s t n. P u s t n) <=> (!u n s t. P u s t n)`] THEN
  GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC(MESON[]
   `(!x y. Q x y ==> Q y x) /\ (!x y. R x y ==> R y x) /\
    (!x y. P x y /\ Q x y ==> R x y)
    ==> !x y. (P x y \/ P y x) /\ Q x y ==> R x y`) THEN
  SIMP_TAC[] THEN CONJ_TAC THENL [REWRITE_TAC[UNION_COMM]; ALL_TAC] THEN
  MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN
  REPEAT STRIP_TAC THEN
  ONCE_REWRITE_TAC[SET_RULE `s UNION t = s UNION (t DIFF s)`] THEN
  MATCH_MP_TAC DIMENSION_LE_UNION_RELATIVE THEN
  EXISTS_TAC `s UNION t:real^N->bool` THEN
  ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC RELATIVE_TO_SUBSET_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN
    ASM_REWRITE_TAC[] THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP RELATIVE_TO_IMP_SUBSET)) THEN
    ASM SET_TAC[];
    ONCE_REWRITE_TAC[SET_RULE `t DIFF s = (s UNION t) DIFF s`] THEN
    SIMP_TAC[RELATIVE_TO_COMPL; SUBSET_UNION; FSIGMA_COMPLEMENT; ETA_AX] THEN
    MATCH_MP_TAC RELATIVE_TO_SUBSET_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN
    ASM_REWRITE_TAC[] THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP RELATIVE_TO_IMP_SUBSET)) THEN
    ASM SET_TAC[];
    TRANS_TAC INT_LE_TRANS `dimension(t:real^N->bool)` THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIMENSION_SUBSET THEN SET_TAC[]]);;

let DIMENSION_LE_UNION_GEN = prove
 (`!s t:real^N->bool.
        (fsigma s /\ gdelta s \/ fsigma t /\ gdelta t) /\
        dimension s <= n /\ dimension t <= n
        ==> dimension(s UNION t) <= n`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  MATCH_MP_TAC DIMENSION_LE_UNION_RELATIVE_GEN THEN
  EXISTS_TAC `(:real^N)` THEN
  ASM_REWRITE_TAC[RELATIVE_TO_UNIV; SUBSET_UNIV]);;

let DIMENSION_LE_UNION_CLOSED_IN = prove
 (`!u s t:real^N->bool n.
        (closed_in (subtopology euclidean u) s /\ t SUBSET u \/
         closed_in (subtopology euclidean u) t /\ s SUBSET u) /\
        dimension s <= n /\ dimension t <= n
        ==> dimension(s UNION t) <= n`,
  REWRITE_TAC[GSYM CLOSED_RELATIVE_TO] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN
  MATCH_MP_TAC DIMENSION_LE_UNION_RELATIVE_GEN THEN
  EXISTS_TAC `u:real^N->bool` THEN
  ASM_MESON_TAC[RELATIVE_TO_MONO; CLOSED_IMP_GDELTA; CLOSED_IMP_FSIGMA]);;

let DIMENSION_LE_UNIONS_ZERODIMENSIONAL = prove
 (`!f:(real^N->bool)->bool.
        FINITE f /\ (!s. s IN f ==> dimension s <= &0)
        ==> dimension(UNIONS f) <= &(CARD f) - &1`,
  REWRITE_TAC[IMP_CONJ] THEN
  MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
  REWRITE_TAC[UNIONS_0; CARD_CLAUSES; DIMENSION_EMPTY] THEN
  CONV_TAC INT_REDUCE_CONV THEN
  SIMP_TAC[FORALL_IN_INSERT; UNIONS_INSERT; CARD_CLAUSES] THEN
  MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `f:(real^N->bool)->bool`] THEN
  DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
  ASM_REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN STRIP_TAC THEN
  TRANS_TAC INT_LE_TRANS
   `dimension(s:real^N->bool) + dimension(UNIONS f:real^N->bool) + &1` THEN
  CONJ_TAC THENL [ALL_TAC; ASM_INT_ARITH_TAC] THEN
  REWRITE_TAC[DIMENSION_UNION_LE_BASIC]);;

let DIMENSION_LE_UNIONS_ZERODIMENSIONAL_EQ = prove
 (`!s:real^N->bool n.
        dimension s <= n <=>
        ?f. FINITE f /\ &(CARD f) <= n + &1 /\
            (!d. d IN f ==> dimension d <= &0) /\
            UNIONS f = s`,
  REWRITE_TAC[TAUT `(p <=> q) <=> (q ==> p) /\ (p ==> q)`; FORALL_AND_THM] THEN
  CONJ_TAC THENL
   [MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `n:int`] THEN
    DISCH_THEN(X_CHOOSE_THEN `f:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
    TRANS_TAC INT_LE_TRANS `&(CARD(f:(real^N->bool)->bool)) - &1:int` THEN
    CONJ_TAC THENL
     [ASM_MESON_TAC[DIMENSION_LE_UNIONS_ZERODIMENSIONAL];
      ASM_INT_ARITH_TAC];
    ONCE_REWRITE_TAC[MESON[DIMENSION_LE_IMP_GE]
     `dimension(s:real^N->bool) <= n <=> -- &1 <= n /\ dimension s <= n`] THEN
    GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN
    REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
    ONCE_REWRITE_TAC[INT_ARITH `i:int <= n <=> i + &1 <= n + &1`] THEN
    X_GEN_TAC `m:int` THEN SPEC_TAC(`m + &1:int`,`n:int`) THEN
    REWRITE_TAC[INT_ADD_LINV; GSYM INT_FORALL_POS] THEN
    REWRITE_TAC[INT_LE_RADD; INT_ARITH `d + &1:int <= &1 <=> d <= &0`] THEN
    CONV_TAC INT_REDUCE_CONV THEN REWRITE_TAC[GSYM INT_LE_SUB_LADD] THEN
    MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
     [CONV_TAC INT_REDUCE_CONV THEN
      REWRITE_TAC[DIMENSION_LE_MINUS1; FORALL_UNWIND_THM2] THEN
      EXISTS_TAC `{}:(real^N->bool)->bool` THEN
      REWRITE_TAC[FINITE_RULES; UNIONS_0; NOT_IN_EMPTY; CARD_CLAUSES] THEN
      REWRITE_TAC[INT_LE_REFL];
      X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `s:real^N->bool` THEN
      REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN
      REWRITE_TAC[INT_ARITH `(n + &1) - &1:int = n`] THEN
      W(MP_TAC o PART_MATCH (lhand o rand) DIMENSION_DECOMPOSITION o
        lhand o snd) THEN
      REWRITE_TAC[INT_POS] THEN DISCH_THEN SUBST1_TAC THEN
      REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
      MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->bool`] THEN
      STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`) THEN
      ASM_REWRITE_TAC[] THEN
      DISCH_THEN(X_CHOOSE_THEN `f:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
      EXISTS_TAC `(u:real^N->bool) INSERT f` THEN
      ASM_REWRITE_TAC[FORALL_IN_INSERT; FINITE_INSERT] THEN
      ASM_REWRITE_TAC[UNIONS_INSERT] THEN
      ONCE_REWRITE_TAC[UNION_COMM] THEN ASM_REWRITE_TAC[] THEN
      ASM_SIMP_TAC[CARD_CLAUSES] THEN
      COND_CASES_TAC THEN ASM_REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN
      ASM_INT_ARITH_TAC]]);;

let DIMENSION_INSERT = prove
 (`!s a:real^N. dimension(a INSERT s) = if s = {} then &0 else dimension s`,
  REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[DIMENSION_SING] THEN
  SIMP_TAC[GSYM INT_LE_ANTISYM; DIMENSION_SUBSET;
           SET_RULE `s SUBSET a INSERT s`] THEN
  ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN
  MATCH_MP_TAC DIMENSION_LE_UNION_GEN THEN
  REWRITE_TAC[FSIGMA_SING; GDELTA_SING; DIMENSION_SING] THEN
  ASM_REWRITE_TAC[INT_LE_REFL; DIMENSION_POS_LE]);;

let DIMENSION_DELETE = prove
 (`!s a:real^N. dimension(s DELETE a) =
                if s DELETE a = {} then --(&1) else dimension s`,
  REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
  ASM_REWRITE_TAC[DIMENSION_EMPTY] THEN
  SIMP_TAC[GSYM INT_LE_ANTISYM; DIMENSION_SUBSET; DELETE_SUBSET] THEN
  TRANS_TAC INT_LE_TRANS `dimension((a:real^N) INSERT (s DELETE a))` THEN
  SIMP_TAC[DIMENSION_SUBSET; SET_RULE `s SUBSET a INSERT (s DELETE a)`] THEN
  ASM_REWRITE_TAC[DIMENSION_INSERT; INT_LE_REFL]);;

let DIMENSION_LE_EQ_GEN = prove
 (`!s:real^N->bool n.
        dimension s <= n <=>
        if s = {} then -- &1 <= n else
        !v a. open v /\ a IN v
              ==> ?u. a IN u /\ u SUBSET v /\ open u /\
                      dimension (s INTER frontier u) <= n - &1`,
  REPEAT GEN_TAC THEN COND_CASES_TAC THEN
  ASM_REWRITE_TAC[DIMENSION_EMPTY] THEN EQ_TAC THENL
   [DISCH_TAC THEN
    MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `a:real^N`] THEN STRIP_TAC THEN
    MP_TAC(ISPECL [`(a:real^N) INSERT s`; `n:int`] DIMENSION_LE_EQ) THEN
    ASM_REWRITE_TAC[DIMENSION_INSERT; IN_INSERT] THEN
    DISCH_THEN(MP_TAC o SPECL [`v:real^N->bool`; `a:real^N`] o CONJUNCT2) THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
    REPEAT(MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[]) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] INT_LE_TRANS) THEN
    MATCH_MP_TAC DIMENSION_SUBSET THEN SET_TAC[];
    DISCH_TAC THEN GEN_REWRITE_TAC I [DIMENSION_LE_EQ] THEN CONJ_TAC THENL
     [FIRST_X_ASSUM(MP_TAC o SPECL [`(:real^N)`; `vec 0:real^N`]) THEN
      ASM_REWRITE_TAC[OPEN_UNIV; IN_UNIV] THEN STRIP_TAC THEN
      FIRST_ASSUM(MP_TAC o MATCH_MP DIMENSION_LE_IMP_GE) THEN ASM_ARITH_TAC;
      ASM_MESON_TAC[]]]);;

let DIMENSION_PCROSS_LE = prove
 (`!s:real^M->bool t:real^N->bool.
       ~(s = {} /\ t = {})
       ==> dimension(s PCROSS t) <= dimension s + dimension t`,
  SUBGOAL_THEN
   `!n s:real^M->bool t:real^N->bool.
        dimension s + dimension t <= &n - &1
        ==> dimension(s PCROSS t) <= &n - &1`
  ASSUME_TAC THENL
   [ALL_TAC;
    MAP_EVERY X_GEN_TAC [`s:real^M->bool`; `t:real^N->bool`] THEN
    REWRITE_TAC[GSYM DIMENSION_POS_LE; DE_MORGAN_THM] THEN
    DISCH_THEN(MP_TAC o MATCH_MP (INT_ARITH
     `&0:int <= s \/ &0 <= t
      ==> -- &1 <= s /\ -- &1 <= t ==> &0 <= (s + t) + &1`)) THEN
    REWRITE_TAC[DIMENSION_GE; GSYM INT_OF_NUM_EXISTS] THEN
    REWRITE_TAC[INT_ARITH `x + &1:int = n <=> x = n - &1`] THEN
    ASM_MESON_TAC[INT_LE_REFL]] THEN
  INDUCT_TAC THENL
   [REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (INT_ARITH
     `s + t:int <= &0 - &1
      ==> -- &1 <= s /\ -- &1 <= t ==> s = -- &1 \/ t = -- &1`)) THEN
    REWRITE_TAC[DIMENSION_GE; DIMENSION_EQ_MINUS1; INT_SUB_LZERO] THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[PCROSS_EMPTY; DIMENSION_EMPTY; INT_LE_REFL];
    ALL_TAC] THEN
  MAP_EVERY X_GEN_TAC [`s:real^M->bool`; `t:real^N->bool`] THEN
  REWRITE_TAC[GSYM INT_OF_NUM_SUC; INT_ARITH `(x + y) - y:int = x`] THEN
  DISCH_TAC THEN ONCE_REWRITE_TAC[DIMENSION_LE_EQ] THEN
  CONJ_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN
  X_GEN_TAC `w:real^(M,N)finite_sum->bool` THEN SIMP_TAC[FORALL_PASTECART] THEN
  MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^N`] THEN
  REWRITE_TAC[PASTECART_IN_PCROSS] THEN STRIP_TAC THEN
  MP_TAC(ISPECL [ `w:real^(M,N)finite_sum->bool`; `a:real^M`; `b:real^N`]
        PASTECART_IN_INTERIOR) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`v1:real^M->bool`; `v2:real^N->bool`] THEN
  STRIP_TAC THEN
  MP_TAC(ISPEC `dimension(s:real^M->bool)` INT_LE_REFL) THEN
  GEN_REWRITE_TAC LAND_CONV [DIMENSION_LE_EQ] THEN
  DISCH_THEN(MP_TAC o SPECL [`v1:real^M->bool`; `a:real^M`] o CONJUNCT2) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `u1:real^M->bool` THEN STRIP_TAC THEN
  MP_TAC(ISPEC `dimension(t:real^N->bool)` INT_LE_REFL) THEN
  GEN_REWRITE_TAC LAND_CONV [DIMENSION_LE_EQ] THEN
  DISCH_THEN(MP_TAC o SPECL [`v2:real^N->bool`; `b:real^N`] o CONJUNCT2) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `u2:real^N->bool` THEN STRIP_TAC THEN
  EXISTS_TAC `(u1:real^M->bool) PCROSS (u2:real^N->bool)` THEN
  ASM_REWRITE_TAC[OPEN_PCROSS_EQ; PASTECART_IN_PCROSS] THEN CONJ_TAC THENL
   [ASM_MESON_TAC[SUBSET_TRANS; SUBSET_PCROSS]; ALL_TAC] THEN
  REWRITE_TAC[FRONTIER_PCROSS; UNION_OVER_INTER; INTER_PCROSS] THEN
  MATCH_MP_TAC DIMENSION_LE_UNION_CLOSED_IN THEN
  EXISTS_TAC `(s:real^M->bool) PCROSS (t:real^N->bool)` THEN
  CONJ_TAC THENL
   [DISJ1_TAC THEN REWRITE_TAC[SUBSET_PCROSS; INTER_SUBSET] THEN
    MATCH_MP_TAC CLOSED_IN_PCROSS THEN
    SIMP_TAC[CLOSED_IN_CLOSED_INTER; FRONTIER_CLOSED; CLOSED_CLOSURE];
    CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    MATCH_MP_TAC INT_LE_TRANS THENL
     [EXISTS_TAC `(dimension(s:real^M->bool) - &1) +
                  dimension(t:real^N->bool)`;
      EXISTS_TAC `dimension(s:real^M->bool) +
                  (dimension(t:real^N->bool) - &1)`] THEN
    (CONJ_TAC THENL [ALL_TAC; ASM_INT_ARITH_TAC]) THEN
    MATCH_MP_TAC INT_LE_ADD2 THEN ASM_REWRITE_TAC[] THEN
    SIMP_TAC[DIMENSION_SUBSET; INTER_SUBSET]]);;

let DIMENSION_PCROSS_EQ_0 = prove
 (`!s:real^M->bool t:real^N->bool.
        dimension(s PCROSS t) = &0 <=> dimension s = &0 /\ dimension t = &0`,
  REPEAT GEN_TAC THEN
  MAP_EVERY ASM_CASES_TAC [`s:real^M->bool = {}`; `t:real^N->bool = {}`] THEN
  ASM_REWRITE_TAC[PCROSS_EMPTY; DIMENSION_EMPTY] THEN
  CONV_TAC INT_REDUCE_CONV THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
   [MP_TAC(ASSUME `~(t:real^N->bool = {})`) THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN
    SUBGOAL_THEN `dimension((s:real^M->bool) PCROSS {b:real^N}) = &0`
    MP_TAC THENL
     [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH
       `d2:int = &0 ==> d <= d2 /\ ~(d <= -- &1) ==> d = &0`)) THEN
      ASM_REWRITE_TAC[DIMENSION_LE_MINUS1; PCROSS_EQ_EMPTY;
                      NOT_INSERT_EMPTY] THEN
      MATCH_MP_TAC DIMENSION_SUBSET THEN
      REWRITE_TAC[SUBSET_PCROSS] THEN ASM SET_TAC[];
      MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
      CONV_TAC SYM_CONV THEN MATCH_MP_TAC HOMEOMORPHIC_DIMENSION THEN
      REWRITE_TAC[HOMEOMORPHIC_PCROSS_SING]];
    MP_TAC(ASSUME `~(s:real^M->bool = {})`) THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `a:real^M` THEN DISCH_TAC THEN
    SUBGOAL_THEN `dimension({a:real^M} PCROSS (t:real^N->bool)) = &0`
    MP_TAC THENL
     [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH
       `d2:int = &0 ==> d <= d2 /\ ~(d <= -- &1) ==> d = &0`)) THEN
      ASM_REWRITE_TAC[DIMENSION_LE_MINUS1; PCROSS_EQ_EMPTY;
                      NOT_INSERT_EMPTY] THEN
      MATCH_MP_TAC DIMENSION_SUBSET THEN
      REWRITE_TAC[SUBSET_PCROSS] THEN ASM SET_TAC[];
      MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
      CONV_TAC SYM_CONV THEN MATCH_MP_TAC HOMEOMORPHIC_DIMENSION THEN
      REWRITE_TAC[HOMEOMORPHIC_PCROSS_SING]];
    MP_TAC(ISPECL [`s:real^M->bool`; `t:real^N->bool`]
        DIMENSION_PCROSS_LE) THEN
    MP_TAC(ISPEC `(s:real^M->bool) PCROSS (t:real^N->bool)`
        DIMENSION_LE_MINUS1) THEN
    ASM_REWRITE_TAC[PCROSS_EQ_EMPTY] THEN ASM_INT_ARITH_TAC]);;

let DIMENSION_SEPARATION_THEOREM = prove
 (`!t s:real^N->bool n c d.
        &0 <= n /\
        s SUBSET t /\ dimension s <= n /\
        closed_in (subtopology euclidean t) c /\
        closed_in (subtopology euclidean t) d /\
        DISJOINT c d
        ==> ?b. closed_in (subtopology euclidean t) b /\
                dimension(b INTER s) <= n - &1 /\
                ?u v. open_in (subtopology euclidean t) u /\
                      open_in (subtopology euclidean t) v /\
                      DISJOINT u v /\ u UNION v = t DIFF b /\
                      c SUBSET u /\ d SUBSET v`,
  GEN_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
  ONCE_REWRITE_TAC[IMP_CONJ] THEN
  REWRITE_TAC[RIGHT_FORALL_IMP_THM; GSYM INT_FORALL_POS] THEN
  MATCH_MP_TAC(MESON[num_CASES]
   `P 0 /\ (P 0 ==> !n. P(SUC n)) ==> !n. P n`) THEN
  CONJ_TAC THENL
   [REPEAT STRIP_TAC THEN
    MP_TAC(ISPECL [`c:real^N->bool`; `d:real^N->bool`; `t:real^N->bool`]
        SEPARATION_NORMAL_LOCAL_CLOSURES) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
    STRIP_TAC THEN
    MP_TAC(ISPECL [`s:real^N->bool`;
        `s INTER (subtopology euclidean t closure_of u):real^N->bool`;
        `s INTER (subtopology euclidean t closure_of v):real^N->bool`]
        DIMENSION_ZERO_SEPARATION_THEOREM) THEN
    ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
     [REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
      CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_SUBTOPOLOGY_INTER_SUBSET THEN
      EXISTS_TAC `t:real^N->bool` THEN
      ASM_SIMP_TAC[CLOSED_IN_INTER; CLOSED_IN_REFL; CLOSED_IN_CLOSURE_OF];
      REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
    MAP_EVERY X_GEN_TAC [`c':real^N->bool`; `d':real^N->bool`] THEN
    STRIP_TAC THEN
    SUBGOAL_THEN
     `c SUBSET t /\ d SUBSET t /\ u SUBSET t /\ v SUBSET (t:real^N->bool) /\
      c' SUBSET t /\ d' SUBSET t`
    STRIP_ASSUME_TAC THENL
     [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; CLOSED_IN_IMP_SUBSET; SUBSET_TRANS];
      ALL_TAC] THEN
    RULE_ASSUM_TAC(REWRITE_RULE
     [CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF]) THEN
    SUBGOAL_THEN
     `t INTER u:real^N->bool = u /\ t INTER v = v`
    (CONJUNCTS_THEN SUBST_ALL_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MP_TAC(ISPECL [`c UNION c':real^N->bool`; `d UNION d':real^N->bool`]
        SEPARATION_CLOSURES) THEN
    ANTS_TAC THENL
     [REWRITE_TAC[CLOSURE_UNION] THEN
      SUBGOAL_THEN
       `c' INTER closure v:real^N->bool = {} /\
        d' INTER closure u:real^N->bool = {}`
      STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      SUBGOAL_THEN
       `c' INTER closure d':real^N->bool = {} /\
        d' INTER closure c':real^N->bool = {}`
      STRIP_ASSUME_TAC THENL
       [ASM_REWRITE_TAC[SEPARATION_CLOSED_IN_UNION]; ALL_TAC] THEN
      SUBGOAL_THEN
       `c' INTER closure d:real^N->bool = {} /\
        d' INTER closure c:real^N->bool = {}`
      STRIP_ASSUME_TAC THENL
       [REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP SUBSET_CLOSURE)) THEN
        ASM SET_TAC[];
        ALL_TAC] THEN
      SUBGOAL_THEN
       `v INTER closure c':real^N->bool = {} /\
        u INTER closure d':real^N->bool = {}`
      STRIP_ASSUME_TAC THENL
       [MP_TAC(ISPEC `subtopology euclidean (t:real^N->bool)`
           OPEN_IN_INTER_CLOSURE_OF_EQ_EMPTY) THEN
        DISCH_THEN(fun th ->
          MP_TAC(SPECL [`v:real^N->bool`; `c':real^N->bool`] th) THEN
          MP_TAC(SPECL [`u:real^N->bool`; `d':real^N->bool`] th)) THEN
        MP_TAC(ISPEC `subtopology euclidean (t:real^N->bool)`
         CLOSURE_OF_SUBSET) THEN
        DISCH_THEN(fun th ->
          MP_TAC(SPEC `u:real^N->bool` th) THEN
          MP_TAC(SPEC `v:real^N->bool` th)) THEN
        ASM_REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
        ASM_SIMP_TAC[CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF;
                     SET_RULE `s SUBSET t ==> t INTER s = s`] THEN
        ASM SET_TAC[];
        ALL_TAC] THEN
      SUBGOAL_THEN
       `d INTER closure c':real^N->bool = {} /\
        c INTER closure d':real^N->bool = {}`
      STRIP_ASSUME_TAC THENL
       [ASM SET_TAC[];
        ALL_TAC] THEN
      REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSURE_OF_CLOSED_IN)) THEN
      ASM_SIMP_TAC[CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF;
                     SET_RULE `s SUBSET t ==> t INTER s = s`] THEN
      ASM SET_TAC[];
      REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
      MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `z:real^N->bool`] THEN
      REWRITE_TAC[UNION_SUBSET] THEN STRIP_TAC THEN
      EXISTS_TAC `t INTER frontier w:real^N->bool` THEN
      SIMP_TAC[CLOSED_IN_CLOSED_INTER; FRONTIER_CLOSED] THEN
      CONV_TAC INT_REDUCE_CONV THEN ASM_REWRITE_TAC[DIMENSION_LE_MINUS1] THEN
      ASM_SIMP_TAC[frontier; INTERIOR_OPEN] THEN CONJ_TAC THENL
       [MP_TAC(ISPECL [`z:real^N->bool`; `w:real^N->bool`]
          OPEN_INTER_CLOSURE_EQ_EMPTY) THEN
        ASM SET_TAC[];
        MAP_EVERY EXISTS_TAC
         [`t INTER w:real^N->bool`;
          `t INTER ((:real^N) DIFF closure w):real^N->bool`] THEN
        ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; GSYM closed; CLOSED_CLOSURE] THEN
        REPEAT CONJ_TAC THENL
         [MP_TAC(ISPEC `w:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[];
          ASM SET_TAC[];
          ASM SET_TAC[];
          MP_TAC(ISPECL [`z:real^N->bool`; `w:real^N->bool`]
            OPEN_INTER_CLOSURE_EQ_EMPTY) THEN
          ASM SET_TAC[]]]];

    REPEAT STRIP_TAC THEN
    MP_TAC(ISPECL [`s:real^N->bool`; `&(SUC n):int`]
      DIMENSION_DECOMPOSITION) THEN
    ASM_REWRITE_TAC[INT_POS; LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`l:real^N->bool`; `z:real^N->bool`] THEN
    REWRITE_TAC[GSYM INT_OF_NUM_SUC; INT_ARITH `(x + y) - y:int = x`] THEN
    STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL
     [`z:real^N->bool`; `c:real^N->bool`; `d:real^N->bool`]) THEN
    ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV THEN
    ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[DIMENSION_LE_MINUS1]] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N->bool` THEN
    DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
    ASM_REWRITE_TAC[] THEN
    TRANS_TAC INT_LE_TRANS `dimension(l:real^N->bool)` THEN
    ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC DIMENSION_SUBSET THEN ASM SET_TAC[]]);;

let LARGE_INDUCTIVE_DIMENSION = prove
 (`!s:real^N->bool n.
        dimension s <= n <=>
        if s = {} then -- &1 <= n else
        !c d. closed_in (subtopology euclidean s) c /\
              closed_in (subtopology euclidean s) d /\
              DISJOINT c d
              ==> ?b. closed_in (subtopology euclidean s) b /\
                      dimension b <= n - &1 /\
                      ?u v. open_in (subtopology euclidean s) u /\
                            open_in (subtopology euclidean s) v /\
                            DISJOINT u v /\ u UNION v = s DIFF b /\
                            c SUBSET u /\ d SUBSET v`,
  REPEAT GEN_TAC THEN COND_CASES_TAC THEN
  ASM_REWRITE_TAC[DIMENSION_EMPTY] THEN EQ_TAC THENL
   [REPEAT STRIP_TAC THEN
    MP_TAC(ISPECL [`s:real^N->bool`; `s:real^N->bool`;
                   `n:int`; `c:real^N->bool`; `d:real^N->bool`]
        DIMENSION_SEPARATION_THEOREM) THEN
    ASM_REWRITE_TAC[SUBSET_REFL] THEN ANTS_TAC THENL
     [RULE_ASSUM_TAC(REWRITE_RULE[GSYM DIMENSION_POS_LE]) THEN
      ASM_INT_ARITH_TAC;
      MESON_TAC[CLOSED_IN_IMP_SUBSET;
                SET_RULE `b SUBSET s ==> b INTER s = b`]];
    STRIP_TAC THEN GEN_REWRITE_TAC I [SMALL_INDUCTIVE_DIMENSION] THEN
    CONJ_TAC THENL
     [FIRST_X_ASSUM(MP_TAC o SPECL [`{}:real^N->bool`; `{}:real^N->bool`]) THEN
      REWRITE_TAC[CLOSED_IN_EMPTY; DISJOINT_EMPTY] THEN STRIP_TAC THEN
      FIRST_ASSUM(MP_TAC o MATCH_MP DIMENSION_LE_IMP_GE) THEN ASM_ARITH_TAC;
      ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
      REWRITE_TAC[GSYM SING_SUBSET] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      ASM_REWRITE_TAC[CLOSED_IN_SING] THEN ASM SET_TAC[]]]);;

let TINY_INDUCTIVE_DIMENSION = prove
 (`!s:real^N->bool n.
        locally compact s
        ==> (dimension s <= n <=>
             if s = {} then -- &1 <= n else
             &0 <= n /\
             !x y. x IN s /\ y IN s /\ ~(x = y)
                   ==> ?b. closed_in (subtopology euclidean s) b /\
                           dimension b <= n - &1 /\
                           ?u v. open_in (subtopology euclidean s) u /\
                                 open_in (subtopology euclidean s) v /\
                                 DISJOINT u v /\ u UNION v = s DIFF b /\
                                 x IN u /\ y IN v)`,
  REPEAT GEN_TAC THEN COND_CASES_TAC THEN
  ASM_REWRITE_TAC[DIMENSION_EMPTY] THEN
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [DISCH_TAC THEN CONJ_TAC THENL
     [RULE_ASSUM_TAC(REWRITE_RULE[GSYM DIMENSION_LE_MINUS1]) THEN
      FIRST_ASSUM(MP_TAC o MATCH_MP DIMENSION_LE_IMP_GE) THEN
      ASM_INT_ARITH_TAC;
      MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
       [SMALL_INDUCTIVE_DIMENSION]) THEN
      DISCH_THEN(MP_TAC o SPECL [`{b:real^N}`; `a:real^N`] o CONJUNCT2) THEN
      ASM_REWRITE_TAC[IN_SING; CLOSED_IN_SING] THEN
      REWRITE_TAC[SING_SUBSET; CONJ_ACI]];
    STRIP_TAC] THEN
  ONCE_REWRITE_TAC[LOCALLY_DIMENSION_LE] THEN
  CONJ_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_AND_SUBSET]) THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_MONO) THEN
  X_GEN_TAC `k:real^N->bool` THEN REWRITE_TAC[] THEN STRIP_TAC THEN
  ONCE_REWRITE_TAC[SMALL_INDUCTIVE_DIMENSION] THEN
  CONJ_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN
  MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `p:real^N`] THEN STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
  FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        CLOSED_IN_COMPACT)) THEN
  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `!q. q IN c
        ==> ?u. open_in (subtopology euclidean k) u /\
                q IN u /\ ~((p:real^N) IN closure u) /\
                dimension(subtopology euclidean k frontier_of u) <= n - &1`
  MP_TAC THENL
   [X_GEN_TAC `q:real^N` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`p:real^N`; `q:real^N`]) THEN
    ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
    X_GEN_TAC `b:real^N->bool` THEN
    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
    STRIP_TAC THEN EXISTS_TAC `k INTER v:real^N->bool` THEN CONJ_TAC THENL
     [ASM_MESON_TAC[OPEN_IN_INTER; OPEN_IN_REFL;
        OPEN_IN_SUBTOPOLOGY_INTER_SUBSET];
      ALL_TAC] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MP_TAC(snd(EQ_IMP_RULE(ISPECL
     [`k INTER u:real^N->bool`; `k INTER v:real^N->bool`]
     SEPARATION_OPEN_IN_UNION))) THEN
    ANTS_TAC THENL
     [CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL
       [UNDISCH_TAC `open_in (subtopology euclidean s) (u:real^N->bool)`;
        UNDISCH_TAC `open_in (subtopology euclidean s) (v:real^N->bool)`] THEN
      REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN
      ASM SET_TAC[];
      STRIP_TAC] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    TRANS_TAC INT_LE_TRANS `dimension(b:real^N->bool)` THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIMENSION_SUBSET THEN
    REWRITE_TAC[FRONTIER_OF_CLOSURES; CLOSURE_OF_SUBTOPOLOGY;
                TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF] THEN
    REWRITE_TAC[SET_RULE `k INTER k INTER v = k INTER v`;
                SET_RULE `k INTER (k DIFF k INTER v) = k DIFF v`] THEN
    SUBGOAL_THEN
     `closure(k DIFF v):real^N->bool = k DIFF v /\
      (k INTER v) SUBSET closure(k INTER v)`
    MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    REWRITE_TAC[CLOSURE_SUBSET; CLOSURE_EQ] THEN
    MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN
    EXISTS_TAC `k:real^N->bool` THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN
    SUBGOAL_THEN `k DIFF v:real^N->bool = k INTER (s DIFF v)` SUBST1_TAC THENL
     [ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC CLOSED_IN_SUBTOPOLOGY_INTER_SUBSET THEN
    EXISTS_TAC `s:real^N->bool` THEN
    ASM_SIMP_TAC[CLOSED_IN_INTER; CLOSED_IN_DIFF; CLOSED_IN_REFL];
    FIRST_X_ASSUM(K ALL_TAC o SPEC `vec 0:real^N`)] THEN
  GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN
  REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `u:real^N->real^N->bool` THEN DISCH_TAC THEN
  MP_TAC(ISPEC `c:real^N->bool` COMPACT_EQ_HEINE_BOREL_GEN) THEN
  ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPECL
   [`IMAGE (u:real^N->real^N->bool) c`; `k:real^N->bool`]) THEN
  ASM_SIMP_TAC[FORALL_IN_IMAGE; UNIONS_IMAGE] THEN
  ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
   [TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
  REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN
  DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN
  ABBREV_TAC `v = UNIONS (IMAGE (u:real^N->real^N->bool) d)` THEN
  EXISTS_TAC `subtopology euclidean k frontier_of v:real^N->bool` THEN
  REWRITE_TAC[CLOSED_IN_FRONTIER_OF; RIGHT_AND_EXISTS_THM] THEN
  EXISTS_TAC `k DIFF subtopology euclidean k closure_of v:real^N->bool` THEN
  EXISTS_TAC `v:real^N->bool` THEN
  SUBGOAL_THEN `open_in (subtopology euclidean k) (v:real^N->bool)`
  ASSUME_TAC THENL
   [EXPAND_TAC "v" THEN MATCH_MP_TAC OPEN_IN_UNIONS THEN
    REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL; CLOSED_IN_CLOSURE_OF] THEN
  ASM_REWRITE_TAC[IN_DIFF] THEN
  FIRST_ASSUM(ASSUME_TAC o SYM o MATCH_MP FRONTIER_OF_OPEN_IN) THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
  MP_TAC(ISPECL [`subtopology euclidean (k:real^N->bool)`; `v:real^N->bool`]
    CLOSURE_OF_SUBSET) THEN
  ASM_REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN DISCH_TAC THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (q /\ r) /\ p /\ s`] THEN
  CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  SUBGOAL_THEN
   `subtopology euclidean k frontier_of (v:real^N->bool) SUBSET
    UNIONS {subtopology euclidean k frontier_of (u q) | (q:real^N) IN d}`
  ASSUME_TAC THENL
   [EXPAND_TAC "v" THEN
    W(MP_TAC o PART_MATCH (lhand o rand) FRONTIER_OF_UNIONS_SUBSET o
      lhand o snd) THEN
    ASM_SIMP_TAC[FINITE_IMAGE; SET_RULE
     `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`];
    ALL_TAC] THEN
  CONJ_TAC THENL
    [TRANS_TAC INT_LE_TRANS
      `dimension(UNIONS { subtopology euclidean k frontier_of (u q) |
                          (q:real^N) IN d}:real^N->bool)` THEN
     ASM_SIMP_TAC[DIMENSION_SUBSET] THEN
     MATCH_MP_TAC DIMENSION_LE_CLOSED_IN_UNIONS THEN
     EXISTS_TAC `k:real^N->bool` THEN
     ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMP_COUNTABLE; COUNTABLE_IMAGE] THEN
     CONJ_TAC THENL [ASM_INT_ARITH_TAC; REWRITE_TAC[FORALL_IN_IMAGE]] THEN
     REWRITE_TAC[CLOSED_IN_FRONTIER_OF] THEN ASM SET_TAC[];
     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
      `c DIFF v = f ==> ~(p IN v) /\ ~(p IN f) ==> ~(p IN c)`)) THEN
     CONJ_TAC THENL
      [EXPAND_TAC "v";
       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
        `s SUBSET t ==> ~(p IN t) ==> ~(p IN s)`))] THEN
     (REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE; EXISTS_IN_GSPEC] THEN
       DISCH_THEN(X_CHOOSE_THEN `q:real^N` STRIP_ASSUME_TAC) THEN
       FIRST_X_ASSUM(MP_TAC o SPEC `q:real^N`) THEN
       ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC])
     THENL
      [MP_TAC(ISPEC `(u:real^N->real^N->bool) q` CLOSURE_SUBSET) THEN
       ASM SET_TAC[];
       DISCH_THEN(MP_TAC o el 2 o CONJUNCTS) THEN
       FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV
         [FRONTIER_OF_CLOSURES]) THEN
       REWRITE_TAC[IN_INTER; CLOSURE_OF_SUBTOPOLOGY; EUCLIDEAN_CLOSURE_OF] THEN
       MATCH_MP_TAC(SET_RULE
        `s SUBSET t ==> (x IN k /\ x IN s) /\ P ==> x IN t`) THEN
       MATCH_MP_TAC SUBSET_CLOSURE THEN REWRITE_TAC[INTER_SUBSET]]]);;

let DIMENSION_LE_RATIONAL_COORDINATES = prove
 (`!n. dimension {x:real^N | {i | i IN 1..dimindex(:N) /\ rational(x$i)}
                             HAS_SIZE n} <= &0`,
  GEN_TAC THEN MATCH_MP_TAC(MESON[]
   `(!x. t = x ==> dimension x <= &0) ==> dimension t <= &0`) THEN
  X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `s =
    UNIONS {s INTER h |
            h IN  { INTERS {{x:real^N | x$i = q$i} | i IN k} |
       k IN {l | l SUBSET 1..dimindex(:N) /\ l HAS_SIZE n} /\
       q IN {y:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(y$i)}}}`
  SUBST1_TAC THENL
   [REWRITE_TAC[UNIONS_GSPEC; INTERS_GSPEC; EXISTS_IN_GSPEC] THEN
    EXPAND_TAC "s" THEN GEN_REWRITE_TAC I [EXTENSION] THEN
    X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM; IN_INTER] THEN
    ABBREV_TAC `k = {i | i IN 1..dimindex(:N) /\ rational((x:real^N)$i)}` THEN
    EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    EXISTS_TAC `k:num->bool` THEN ASM_REWRITE_TAC[] THEN
    EXISTS_TAC `(lambda i. if i IN k then (x:real^N)$i else &0):real^N` THEN
    SIMP_TAC[LAMBDA_BETA] THEN EXPAND_TAC "k" THEN
    REWRITE_TAC[IN_ELIM_THM; SUBSET_RESTRICT] THEN
    SIMP_TAC[IN_NUMSEG; LAMBDA_BETA] THEN MESON_TAC[RATIONAL_NUM];
    ALL_TAC] THEN
  MATCH_MP_TAC DIMENSION_LE_CLOSED_IN_UNIONS THEN
  EXISTS_TAC `s:real^N->bool` THEN CONV_TAC INT_REDUCE_CONV THEN CONJ_TAC THENL
   [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC COUNTABLE_IMAGE THEN
    MATCH_MP_TAC COUNTABLE_PRODUCT_DEPENDENT THEN
    REWRITE_TAC[COUNTABLE_RATIONAL_COORDINATES] THEN
    MATCH_MP_TAC COUNTABLE_SUBSET THEN
    EXISTS_TAC `{k | k SUBSET (:num) /\ FINITE k}` THEN
    SIMP_TAC[COUNTABLE_FINITE_SUBSETS; NUM_COUNTABLE] THEN
    REWRITE_TAC[HAS_SIZE] THEN SET_TAC[];
    ALL_TAC] THEN
  REWRITE_TAC[FORALL_IN_GSPEC] THEN
  MAP_EVERY X_GEN_TAC [`k:num->bool`; `q:real^N`] THEN
  REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THENL
   [MATCH_MP_TAC CLOSED_IN_CLOSED_INTER THEN MATCH_MP_TAC CLOSED_INTERS THEN
    REWRITE_TAC[FORALL_IN_GSPEC; CLOSED_STANDARD_HYPERPLANE];
    ALL_TAC] THEN
  TRANS_TAC INT_LE_TRANS
   `dimension {x:real^N | !i. 1 <= i /\ i <= dimindex(:N)
                              ==> (rational(x$i) <=> i IN k)}` THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC DIMENSION_SUBSET THEN
    REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_ELIM_THM; IN_INTER] THEN
    X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
    MP_TAC(ISPECL [`k:num->bool`;
                   `{i | i IN 1..dimindex(:N) /\ rational((x:real^N)$i)}`]
      CARD_SUBSET_LE) THEN
    ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[IN_NUMSEG] THEN SET_TAC[]] THEN
    SIMP_TAC[FINITE_RESTRICT; FINITE_NUMSEG] THEN CONJ_TAC THENL
     [RULE_ASSUM_TAC(REWRITE_RULE[GSYM IN_NUMSEG]) THEN ASM SET_TAC[];
      UNDISCH_TAC `(x:real^N) IN s` THEN EXPAND_TAC "s" THEN
      UNDISCH_TAC `(k:num->bool) HAS_SIZE n` THEN
      SIMP_TAC[IN_ELIM_THM; HAS_SIZE; LE_REFL]];
    ALL_TAC] THEN
  GEN_REWRITE_TAC I [DIMENSION_LE_EQ] THEN CONV_TAC INT_REDUCE_CONV THEN
  MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `a:real^N`] THEN
  REWRITE_TAC[DIMENSION_LE_MINUS1; IN_ELIM_THM] THEN STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o SPEC `a:real^N` o
    GEN_REWRITE_RULE I [OPEN_CONTAINS_INTERVAL]) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`l:real^N`; `r:real^N`] THEN
  REWRITE_TAC[IN_INTERVAL] THEN STRIP_TAC THEN
  SUBGOAL_THEN
   `!i. 1 <= i /\ i <= dimindex(:N)
        ==> ?u v. (rational u <=> ~(i IN k)) /\
                  (rational v <=> ~(i IN k)) /\
                  u < (a:real^N)$i /\ a$i < v /\
                  abs(v - u) < min ((r:real^N)$i - a$i) (a$i - (l:real^N)$i)`
  MP_TAC THENL
   [X_GEN_TAC `i:num` THEN STRIP_TAC THEN
    ASM_CASES_TAC `(i:num) IN k` THEN ASM_REWRITE_TAC[] THENL
     [MATCH_MP_TAC IRRATIONAL_APPROXIMATION_STRADDLE;
      MATCH_MP_TAC RATIONAL_APPROXIMATION_STRADDLE] THEN
    ASM_SIMP_TAC[REAL_LT_MIN; REAL_SUB_LT];
    REWRITE_TAC[LAMBDA_SKOLEM; LEFT_IMP_EXISTS_THM]] THEN
  MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
  EXISTS_TAC `interval(x:real^N,y)` THEN
  ASM_SIMP_TAC[IN_INTERVAL; OPEN_INTERVAL] THEN CONJ_TAC THENL
   [TRANS_TAC SUBSET_TRANS `interval[l:real^N,r]` THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[SUBSET_INTERVAL] THEN DISCH_THEN(K ALL_TAC) THEN
    X_GEN_TAC `i:num` THEN STRIP_TAC THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN
    ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
    ALL_TAC] THEN
  REWRITE_TAC[FRONTIER_OPEN_INTERVAL; INTERVAL_EQ_EMPTY] THEN
  COND_CASES_TAC THEN REWRITE_TAC[INTER_EMPTY] THEN
  REWRITE_TAC[EXTENSION; IN_DIFF; IN_INTER; NOT_IN_EMPTY; IN_ELIM_THM] THEN
  X_GEN_TAC `z:real^N` THEN REWRITE_TAC[IN_INTERVAL] THEN
  MATCH_MP_TAC(MESON[]
   `(!x. ~R x ==> ~(P x /\ Q x))
    ==> ~((!x. P x) /\ (!x. Q x) /\ ~(!x. R x))`) THEN
  X_GEN_TAC `i:num` THEN REWRITE_TAC[NOT_IMP] THEN STRIP_TAC THEN
  ASM_REWRITE_TAC[] THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN
  ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LE_LT]);;

let DIMENSION_EXACTLY_RATIONAL_COORDINATES = prove
 (`!n. 1 <= n /\ n <= dimindex(:N)
       ==> dimension {x:real^N | {i | i IN 1..dimindex(:N) /\ rational(x$i)}
                                 HAS_SIZE n} = &0`,
  GEN_TAC THEN REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN
  REWRITE_TAC[DIMENSION_POS_LE; DIMENSION_LE_RATIONAL_COORDINATES] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN `?q r. rational q /\ ~rational r` STRIP_ASSUME_TAC THENL
   [ASM_MESON_TAC[RATIONAL_APPROXIMATION; IRRATIONAL_APPROXIMATION;
                  REAL_LT_01];
    REWRITE_TAC[EXTENSION; NOT_FORALL_THM; IN_ELIM_THM; NOT_IN_EMPTY] THEN
    EXISTS_TAC `(lambda i. if i <= n then q else r):real^N` THEN
    ONCE_REWRITE_TAC[TAUT `p /\ q <=> ~(p ==> ~q)`] THEN
    SIMP_TAC[IN_NUMSEG; LAMBDA_BETA] THEN ONCE_REWRITE_TAC[COND_RAND] THEN
    ASM_REWRITE_TAC[TAUT `(if p then T else F) <=> p`; NOT_IMP] THEN
    ASM_SIMP_TAC[ARITH_RULE
     `n <= m ==> ((1 <= i /\ i <= m) /\ i <= n <=> 1 <= i /\ i <= n)`] THEN
    REWRITE_TAC[GSYM numseg; HAS_SIZE_NUMSEG_1]]);;

(* ------------------------------------------------------------------------- *)
(* Covering spaces and lifting results for them.                             *)
(* ------------------------------------------------------------------------- *)

let covering_space = new_definition
 `covering_space(c,(p:real^M->real^N)) s <=>
        p continuous_on c /\ IMAGE p c = s /\
        !x. x IN s
            ==> ?t. x IN t /\ open_in (subtopology euclidean s) t /\
                    ?v. UNIONS v = {x | x IN c /\ p(x) IN t} /\
                        (!u. u IN v ==> open_in (subtopology euclidean c) u) /\
                        pairwise DISJOINT v /\
                        (!u. u IN v ==> ?q. homeomorphism (u,t) (p,q))`;;

let COVERING_SPACE_IMP_CONTINUOUS = prove
 (`!p:real^M->real^N c s. covering_space (c,p) s ==> p continuous_on c`,
  SIMP_TAC[covering_space]);;

let COVERING_SPACE_IMP_SURJECTIVE = prove
 (`!p:real^M->real^N c s. covering_space (c,p) s ==> IMAGE p c = s`,
  SIMP_TAC[covering_space]);;

let HOMEOMORPHISM_IMP_COVERING_SPACE = prove
 (`!f:real^M->real^N g s t.
        homeomorphism (s,t) (f,g) ==> covering_space (s,f) t`,
  REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN
  ASM_REWRITE_TAC[covering_space] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
  EXISTS_TAC `t:real^N->bool` THEN
  ASM_SIMP_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN
  EXISTS_TAC `{s:real^M->bool}` THEN
  REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; UNIONS_1; PAIRWISE_SING] THEN
  ASM_SIMP_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN
  CONJ_TAC THENL [ASM SET_TAC[]; EXISTS_TAC `g:real^N->real^M`] THEN
  ASM_REWRITE_TAC[homeomorphism]);;

let COVERING_SPACE_LOCAL_HOMEOMORPHISM = prove
 (`!p:real^M->real^N c s.
        covering_space (c,p) s
        ==> !x. x IN c
                ==> ?t u. x IN t /\ open_in (subtopology euclidean c) t /\
                          p(x) IN u /\ open_in (subtopology euclidean s) u /\
                          ?q. homeomorphism (t,u) (p,q)`,
  REWRITE_TAC[covering_space] THEN REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^M->real^N) x`) THEN
  ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` MP_TAC) THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  DISCH_THEN(X_CHOOSE_THEN `v:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN `(x:real^M) IN UNIONS v` MP_TAC THENL
   [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^M->bool` THEN
  STRIP_TAC THEN EXISTS_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[]);;

let COVERING_SPACE_LOCAL_HOMEOMORPHISM_ALT = prove
 (`!p:real^M->real^N c s.
        covering_space (c,p) s
        ==> !y. y IN s
                ==> ?x t u. p(x) = y /\
                            x IN t /\ open_in (subtopology euclidean c) t /\
                            y IN u /\ open_in (subtopology euclidean s) u /\
                            ?q. homeomorphism (t,u) (p,q)`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `?x. x IN c /\ (p:real^M->real^N) x = y` MP_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
    ASM SET_TAC[];
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
    FIRST_ASSUM(MP_TAC o SPEC `x:real^M` o MATCH_MP
     COVERING_SPACE_LOCAL_HOMEOMORPHISM) THEN
    ASM_MESON_TAC[]]);;

let COVERING_SPACE_OPEN_MAP = prove
 (`!p:real^M->real^N c s t.
        covering_space (c,p) s /\
        open_in (subtopology euclidean c) t
        ==> open_in (subtopology euclidean s) (IMAGE p t)`,
  REWRITE_TAC[covering_space] THEN REPEAT STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
  ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `y:real^N` THEN
  DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN
  ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` MP_TAC) THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  DISCH_THEN(X_CHOOSE_THEN `vs:(real^M->bool)->bool`
   (STRIP_ASSUME_TAC o GSYM)) THEN
  SUBGOAL_THEN
   `?x. x IN {x | x IN c /\ (p:real^M->real^N) x IN u} /\ x IN t /\ p x = y`
  MP_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN
  DISCH_THEN(X_CHOOSE_THEN `x:real^M` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNIONS]) THEN
  DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `v:real^M->bool`)) THEN
  ASM_REWRITE_TAC[homeomorphism] THEN REPEAT DISCH_TAC THEN
  FIRST_X_ASSUM(X_CHOOSE_THEN `q:real^N->real^M` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `IMAGE (p:real^M->real^N) (t INTER v)` THEN CONJ_TAC THENL
   [ALL_TAC; ASM SET_TAC[]] THEN
  SUBGOAL_THEN
   `IMAGE (p:real^M->real^N) (t INTER v) =
    {z | z IN u /\ q z IN (t INTER v)}`
  SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN
  ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN
  ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN
  MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN
  EXISTS_TAC `c:real^M->bool` THEN
  CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_INTER; ASM_MESON_TAC[open_in]] THEN
  ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV]);;

let COVERING_SPACE_QUOTIENT_MAP = prove
 (`!p:real^M->real^N c s.
    covering_space (c,p) s
    ==> !u. u SUBSET s
            ==> (open_in (subtopology euclidean c) {x | x IN c /\ p x IN u} <=>
                 open_in (subtopology euclidean s) u)`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
  MATCH_MP_TAC OPEN_MAP_IMP_QUOTIENT_MAP THEN
  CONJ_TAC THENL [ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS]; ALL_TAC] THEN
  FIRST_ASSUM(SUBST1_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
  ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP]);;

let COVERING_SPACE_LOCALIZED_HOMEOMORPHISM = prove
 (`!p:real^M->real^N c s.
        covering_space (c,p) s
        ==> !w x. x IN w /\ open_in (subtopology euclidean c) w
                  ==> ?t u. x IN t /\ open_in (subtopology euclidean c) t /\
                            p(x) IN u /\ open_in (subtopology euclidean s) u /\
                            t SUBSET w /\
                            ?q. homeomorphism (t,u) (p,q)`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o SPEC `x:real^M` o MATCH_MP
    COVERING_SPACE_LOCAL_HOMEOMORPHISM) THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
  ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
  MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^N->bool`] THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  DISCH_THEN(X_CHOOSE_TAC `q:real^N->real^M`) THEN
  MAP_EVERY EXISTS_TAC
   [`u INTER w:real^M->bool`; `IMAGE (p:real^M->real^N) (u INTER w)`] THEN
  ASM_SIMP_TAC[IN_INTER; OPEN_IN_INTER; INTER_SUBSET] THEN
  REPEAT CONJ_TAC THENL
   [ASM_SIMP_TAC[FUN_IN_IMAGE; IN_INTER];
    ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP; OPEN_IN_INTER];
    EXISTS_TAC `q:real^N->real^M` THEN
    FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
      HOMEOMORPHISM_OF_SUBSETS)) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]]);;

let COVERING_SPACE_LOCALIZED_HOMEOMORPHISM_ALT = prove
 (`!p:real^M->real^N c s.
        covering_space (c,p) s
        ==> !w y. y IN w /\ open_in (subtopology euclidean s) w
                ==> ?x t u. p(x) = y /\
                            x IN t /\ open_in (subtopology euclidean c) t /\
                            y IN u /\ open_in (subtopology euclidean s) u /\
                            u SUBSET w /\
                            ?q. homeomorphism (t,u) (p,q)`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
  SUBGOAL_THEN `?x. x IN c /\ (p:real^M->real^N) x = y` MP_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
    ASM SET_TAC[];
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
    FIRST_ASSUM(MP_TAC o
      SPECL [`{x | x IN c /\ (p:real^M->real^N) x IN w}`; `x:real^M`] o
      MATCH_MP COVERING_SPACE_LOCALIZED_HOMEOMORPHISM) THEN
    ASM_REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
      RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN
      ASM_MESON_TAC[SUBSET_REFL];
      REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
      SIMP_TAC[] THEN REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN
      REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
      ASM SET_TAC[]]]);;

let COVERING_SPACE_LOCALLY_HOMEOMORPHIC = prove
 (`!P Q p:real^M->real^N c s.
           covering_space (c,p) s /\
           (!q u v. ~(u = {}) /\ u SUBSET c /\ v SUBSET s /\
                    homeomorphism (u,v) (p,q) /\ P u
                    ==> Q v) /\
           locally P c
           ==> locally Q s`,
  REPEAT GEN_TAC THEN REWRITE_TAC[locally] THEN STRIP_TAC THEN
  MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o SPECL [`w:real^N->bool`; `y:real^N`] o
    MATCH_MP COVERING_SPACE_LOCALIZED_HOMEOMORPHISM_ALT) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`x:real^M`; `u:real^M->bool`; `v:real^N->bool`] THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  DISCH_THEN(X_CHOOSE_TAC `q:real^N->real^M`) THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^M->bool`; `x:real^M`]) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`n:real^M->bool`; `l:real^M->bool`] THEN STRIP_TAC THEN
  EXISTS_TAC `IMAGE (p:real^M->real^N) n` THEN
  EXISTS_TAC `IMAGE (p:real^M->real^N) l` THEN
  ONCE_REWRITE_TAC[CONJ_ASSOC] THEN REPEAT CONJ_TAC THENL
   [ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP; OPEN_IN_INTER];
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    MAP_EVERY EXISTS_TAC [`q:real^N->real^M`; `l:real^M->bool`] THEN
    ASM_REWRITE_TAC[] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
     [ALL_TAC;
      FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
       HOMEOMORPHISM_OF_SUBSETS))] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN
    REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
    ASM SET_TAC[];
    ASM SET_TAC[];
    ASM SET_TAC[];
    RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[]]);;

let COVERING_SPACE_LOCALLY_HOMEOMORPHIC_EQ = prove
 (`!P Q p:real^M->real^N c s.
           covering_space (c,p) s /\
           (!q u v. ~(u = {}) /\ u SUBSET c /\ v SUBSET s /\
                    homeomorphism (u,v) (p,q)
                    ==> (P u <=> Q v))
           ==> (locally P c <=> locally Q s)`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [ASM_MESON_TAC[COVERING_SPACE_LOCALLY_HOMEOMORPHIC]; ALL_TAC] THEN
  REWRITE_TAC[locally] THEN STRIP_TAC THEN
  MAP_EVERY X_GEN_TAC [`w:real^M->bool`; `x:real^M`] THEN STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
  FIRST_ASSUM(MP_TAC o SPECL [`w:real^M->bool`; `x:real^M`] o
    MATCH_MP COVERING_SPACE_LOCALIZED_HOMEOMORPHISM) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^N->bool`] THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  DISCH_THEN(X_CHOOSE_TAC `q:real^N->real^M`) THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`v:real^N->bool`; `(p:real^M->real^N) x`]) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`n:real^N->bool`; `l:real^N->bool`] THEN STRIP_TAC THEN
  MAP_EVERY EXISTS_TAC
   [`{x | x IN u /\ (p:real^M->real^N) x IN n}`;
    `{x | x IN u /\ (p:real^M->real^N) x IN l}`] THEN
  ASM_REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL
   [MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `u:real^M->bool` THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
    EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
    REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN
    CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]];
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(MP_TAC o
      SPECL [`q:real^N->real^M`; `{x | x IN u /\ (p:real^M->real^N) x IN l}`;
             `l:real^N->bool`]) THEN
    ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN
    REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN
    REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
       HOMEOMORPHISM_OF_SUBSETS)) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHISM]) THEN ASM SET_TAC[]]);;

let COVERING_SPACE_LOCALLY = prove
 (`!P Q p:real^M->real^N c s.
        covering_space (c,p) s /\ (!t. t SUBSET c /\ P t ==> Q(IMAGE p t)) /\
        locally P c
        ==> locally Q s`,
  MP_TAC COVERING_SPACE_LOCALLY_HOMEOMORPHIC THEN
  REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
  REWRITE_TAC[homeomorphism] THEN MESON_TAC[]);;

let COVERING_SPACE_LOCALLY_EQ = prove
 (`!P Q p:real^M->real^N c s.
        covering_space (c,p) s /\
        (!t. t SUBSET c /\ P t ==> Q(IMAGE p t)) /\
        (!q u. u SUBSET s /\ q continuous_on u /\ Q u ==> P(IMAGE q u))
        ==> (locally Q s <=> locally P c)`,
  MP_TAC COVERING_SPACE_LOCALLY_HOMEOMORPHIC_EQ THEN
  REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
  REWRITE_TAC[homeomorphism] THEN MESON_TAC[]);;

let COVERING_SPACE_LOCALLY_COMPACT_EQ = prove
 (`!p:real^M->real^N c s.
        covering_space (c,p) s
        ==> (locally compact s <=> locally compact c)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_LOCALLY_EQ THEN
  EXISTS_TAC `p:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN
  ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; COMPACT_CONTINUOUS_IMAGE]);;

let COVERING_SPACE_LOCALLY_CONNECTED_EQ = prove
 (`!p:real^M->real^N c s.
        covering_space (c,p) s
        ==> (locally connected s <=> locally connected c)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_LOCALLY_EQ THEN
  EXISTS_TAC `p:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN
  ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; CONNECTED_CONTINUOUS_IMAGE]);;

let COVERING_SPACE_LOCALLY_PATH_CONNECTED_EQ = prove
 (`!p:real^M->real^N c s.
        covering_space (c,p) s
        ==> (locally path_connected s <=> locally path_connected c)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_LOCALLY_EQ THEN
  EXISTS_TAC `p:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN
  ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; PATH_CONNECTED_CONTINUOUS_IMAGE]);;

let COVERING_SPACE_LOCALLY_COMPACT = prove
 (`!p:real^M->real^N c s.
        covering_space (c,p) s /\ locally compact c
        ==> locally compact s`,
  MESON_TAC[COVERING_SPACE_LOCALLY_COMPACT_EQ]);;

let COVERING_SPACE_LOCALLY_CONNECTED = prove
 (`!p:real^M->real^N c s.
        covering_space (c,p) s /\ locally connected c ==> locally connected s`,
  MESON_TAC[COVERING_SPACE_LOCALLY_CONNECTED_EQ]);;

let COVERING_SPACE_LOCALLY_PATH_CONNECTED = prove
 (`!p:real^M->real^N c s.
        covering_space (c,p) s /\ locally path_connected c
        ==> locally path_connected s`,
  MESON_TAC[COVERING_SPACE_LOCALLY_PATH_CONNECTED_EQ]);;

let COVERING_SPACE_LIFT_UNIQUE_GEN = prove
 (`!p:real^M->real^N f:real^P->real^N g1 g2 c s t u a x.
        covering_space (c,p) s /\
        f continuous_on t /\ IMAGE f t SUBSET s /\
        g1 continuous_on t /\ IMAGE g1 t SUBSET c /\
        (!x. x IN t ==> f(x) = p(g1 x)) /\
        g2 continuous_on t /\ IMAGE g2 t SUBSET c /\
        (!x. x IN t ==> f(x) = p(g2 x)) /\
        u IN components t /\ a IN u /\ g1(a) = g2(a) /\ x IN u
        ==> g1(x) = g2(x)`,
  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
  UNDISCH_TAC `(x:real^P) IN u` THEN SPEC_TAC(`x:real^P`,`x:real^P`) THEN
  MATCH_MP_TAC(SET_RULE
   `(?a. a IN u /\ g a = z) /\
    ({x | x IN u /\ g x = z} = {} \/ {x | x IN u /\ g x = z} = u)
    ==> !x. x IN u ==> g x = z`) THEN
  CONJ_TAC THENL [ASM_MESON_TAC[VECTOR_SUB_EQ]; ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN
  REWRITE_TAC[CONNECTED_CLOPEN] THEN DISCH_THEN MATCH_MP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN CONJ_TAC THENL
   [ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN REWRITE_TAC[IN_ELIM_THM] THEN
    X_GEN_TAC `x:real^P` THEN STRIP_TAC THEN
    FIRST_ASSUM(MP_TAC o SPEC `(g1:real^P->real^M) x` o
        MATCH_MP COVERING_SPACE_LOCAL_HOMEOMORPHISM) THEN
    ANTS_TAC THENL [ASM SET_TAC[]; SIMP_TAC[LEFT_IMP_EXISTS_THM]] THEN
    MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `w:real^N->bool`] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_SUB_EQ]) THEN
    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    REWRITE_TAC[homeomorphism] THEN
    DISCH_THEN(X_CHOOSE_THEN `q:real^N->real^M` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `{x | x IN u /\ (g1:real^P->real^M) x IN v} INTER
                {x | x IN u /\ (g2:real^P->real^M) x IN v}` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC OPEN_IN_INTER THEN ONCE_REWRITE_TAC[SET_RULE
       `{x | x IN u /\ g x IN v} =
        {x | x IN u /\ g x IN (v INTER IMAGE g u)}`] THEN
      CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN
      (CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC]) THEN
      UNDISCH_TAC `open_in (subtopology euclidean c) (v:real^M->bool)` THEN
      REWRITE_TAC[OPEN_IN_OPEN] THEN
      MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN ASM SET_TAC[];
      REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTER; VECTOR_SUB_EQ] THEN
      ASM SET_TAC[]];
    MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT THEN
    MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
    ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]);;

let COVERING_SPACE_LIFT_UNIQUE = prove
 (`!p:real^M->real^N f:real^P->real^N g1 g2 c s t a x.
        covering_space (c,p) s /\
        f continuous_on t /\ IMAGE f t SUBSET s /\
        g1 continuous_on t /\ IMAGE g1 t SUBSET c /\
        (!x. x IN t ==> f(x) = p(g1 x)) /\
        g2 continuous_on t /\ IMAGE g2 t SUBSET c /\
        (!x. x IN t ==> f(x) = p(g2 x)) /\
        connected t /\ a IN t /\ g1(a) = g2(a) /\ x IN t
        ==> g1(x) = g2(x)`,
  REPEAT STRIP_TAC THEN MP_TAC(ISPECL
   [`p:real^M->real^N`; `f:real^P->real^N`;
    `g1:real^P->real^M`; `g2:real^P->real^M`;
    `c:real^M->bool`; `s:real^N->bool`; `t:real^P->bool`; `t:real^P->bool`;
    `a:real^P`; `x:real^P`] COVERING_SPACE_LIFT_UNIQUE_GEN) THEN
  ASM_REWRITE_TAC[IN_COMPONENTS_SELF] THEN ASM SET_TAC[]);;

let COVERING_SPACE_LIFT_UNIQUE_IDENTITY = prove
 (`!p:real^M->real^N c f s a.
     covering_space (c,p) s /\
     path_connected c /\
     f continuous_on c /\ IMAGE f c SUBSET c /\
     (!x. x IN c ==> p(f x) = p x) /\
     a IN c /\ f(a) = a
     ==> !x. x IN c ==> f x = x`,
  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
  DISCH_THEN(MP_TAC o SPECL [`a:real^M`; `x:real^M`]) THEN
  ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish] THEN
  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
  DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL
   [`p:real^M->real^N`; `(p:real^M->real^N) o (g:real^1->real^M)`;
    `(f:real^M->real^M) o (g:real^1->real^M)`; `g:real^1->real^M`;
    `c:real^M->bool`; `s:real^N->bool`;
    `interval[vec 0:real^1,vec 1]`;
    `vec 0:real^1`; `vec 1:real^1`]
   COVERING_SPACE_LIFT_UNIQUE) THEN
  ASM_REWRITE_TAC[o_THM; IMAGE_o] THEN DISCH_THEN MATCH_MP_TAC THEN
  ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; CONNECTED_INTERVAL] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [covering_space]) THEN
  STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE
   `IMAGE p c = s ==> !x. x IN c ==> p(x) IN s`)) THEN
  ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN
  CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
  ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN
  ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE]);;

let COVERING_SPACE_LIFT_HOMOTOPY = prove
 (`!p:real^M->real^N c s (h:real^(1,P)finite_sum->real^N) f u.
        covering_space (c,p) s /\
        h continuous_on (interval[vec 0,vec 1] PCROSS u) /\
        IMAGE h (interval[vec 0,vec 1] PCROSS u) SUBSET s /\
        (!y. y IN u ==> h (pastecart (vec 0) y) = p(f y)) /\
        f continuous_on u /\ IMAGE f u SUBSET c
        ==> ?k. k continuous_on (interval[vec 0,vec 1] PCROSS u) /\
                IMAGE k (interval[vec 0,vec 1] PCROSS u) SUBSET c /\
                (!y. y IN u ==> k(pastecart (vec 0) y) = f y) /\
                (!z. z IN interval[vec 0,vec 1] PCROSS u ==> h z = p(k z))`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `!y. y IN u
        ==> ?v. open_in (subtopology euclidean u) v /\ y IN v /\
                ?k:real^(1,P)finite_sum->real^M.
                    k continuous_on (interval[vec 0,vec 1] PCROSS v) /\
                    IMAGE k (interval[vec 0,vec 1] PCROSS v) SUBSET c /\
                    (!y. y IN v ==> k(pastecart (vec 0) y) = f y) /\
                    (!z. z IN interval[vec 0,vec 1] PCROSS v
                         ==> h z :real^N = p(k z))`
  MP_TAC THENL
   [ALL_TAC;
    GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV)
     [RIGHT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN
    REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC
     [`v:real^P->real^P->bool`; `fs:real^P->real^(1,P)finite_sum->real^M`] THEN
    DISCH_THEN(LABEL_TAC "*") THEN
    MP_TAC(ISPECL
     [`subtopology euclidean
        ((interval[vec 0,vec 1] PCROSS u):real^(1,P)finite_sum->bool)`;
      `euclidean:(real^M)topology`;
      `fs:real^P->real^(1,P)finite_sum->real^M`;
      `(\x. interval[vec 0,vec 1] PCROSS (v x))
          :real^P->real^(1,P)finite_sum->bool`;
      `u:real^P->bool`] PASTING_LEMMA_EXISTS) THEN
    REWRITE_TAC[CONTINUOUS_MAP_EUCLIDEAN; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY;
                SUBTOPOLOGY_SUBTOPOLOGY] THEN
    ONCE_REWRITE_TAC[TAUT `open_in a b /\ c <=> ~(open_in a b ==> ~c)`] THEN
    SIMP_TAC[ISPEC `euclidean` OPEN_IN_IMP_SUBSET;
             SET_RULE `s SUBSET u ==> u INTER s = s`] THEN
    REWRITE_TAC[NOT_IMP] THEN
    ASM_SIMP_TAC[SUBSET_UNIV] THEN ANTS_TAC THENL
     [ALL_TAC;
      MATCH_MP_TAC MONO_EXISTS THEN
      X_GEN_TAC `k:real^(1,P)finite_sum->real^M` THEN STRIP_TAC THEN
      ASM_REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS; SUBSET] THEN
      REPEAT CONJ_TAC THEN TRY(X_GEN_TAC `t:real^1`) THEN
      X_GEN_TAC `y:real^P` THEN STRIP_TAC THENL
       [FIRST_X_ASSUM(MP_TAC o SPECL
         [`pastecart (t:real^1) (y:real^P)`; `y:real^P`]);
        FIRST_X_ASSUM(MP_TAC o SPECL
         [`pastecart (vec 0:real^1) (y:real^P)`; `y:real^P`]);
        FIRST_X_ASSUM(MP_TAC o SPECL
         [`pastecart (t:real^1) (y:real^P)`; `y:real^P`])] THEN
      ASM_SIMP_TAC[PASTECART_IN_PCROSS; IN_INTER; ENDS_IN_UNIT_INTERVAL] THEN
      DISCH_THEN SUBST1_TAC THEN
      REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
      ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
      REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      ASM_REWRITE_TAC[PASTECART_IN_PCROSS]] THEN
    REPEAT CONJ_TAC THENL
     [REWRITE_TAC[SUBSET; FORALL_IN_PCROSS; UNIONS_GSPEC; IN_ELIM_THM] THEN
      MAP_EVERY X_GEN_TAC [`t:real^1`; `y:real^P`] THEN STRIP_TAC THEN
      EXISTS_TAC `y:real^P` THEN ASM_SIMP_TAC[PASTECART_IN_PCROSS];
      X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
      REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
      ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN
      REWRITE_TAC[OPEN_IN_OPEN] THEN
      DISCH_THEN(X_CHOOSE_THEN `t:real^P->bool` STRIP_ASSUME_TAC) THEN
      EXISTS_TAC `(:real^1) PCROSS (t:real^P->bool)` THEN
      ASM_SIMP_TAC[REWRITE_RULE[GSYM PCROSS] OPEN_PCROSS; OPEN_UNIV] THEN
      REWRITE_TAC[EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS;
                    IN_INTER; IN_UNIV] THEN
      REPEAT GEN_TAC THEN CONV_TAC TAUT;
      REWRITE_TAC[FORALL_PASTECART; IN_INTER; PASTECART_IN_PCROSS] THEN
      MAP_EVERY X_GEN_TAC
       [`x:real^P`; `z:real^P`; `t:real^1`; `y:real^P`] THEN
      REWRITE_TAC[CONJ_ACI] THEN STRIP_TAC THEN
      FIRST_ASSUM(MP_TAC o
        ISPECL [`h:real^(1,P)finite_sum->real^N`;
                `(fs:real^P->real^(1,P)finite_sum->real^M) x`;
                `(fs:real^P->real^(1,P)finite_sum->real^M) z`;
                `interval[vec 0:real^1,vec 1] PCROSS {y:real^P}`;
                `pastecart (vec 0:real^1) (y:real^P)`;
                `pastecart (t:real^1) (y:real^P)`] o
        MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN
      DISCH_THEN MATCH_MP_TAC THEN
      ASM_SIMP_TAC[PASTECART_IN_PCROSS; IN_SING; ENDS_IN_UNIT_INTERVAL] THEN
      SIMP_TAC[REWRITE_RULE[GSYM PCROSS] CONNECTED_PCROSS;
               CONNECTED_INTERVAL; CONNECTED_SING] THEN
      CONJ_TAC THENL
       [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN
        REWRITE_TAC[FORALL_PASTECART; SUBSET; PASTECART_IN_PCROSS] THEN
        ASM_SIMP_TAC[IN_SING];
        ALL_TAC] THEN
      CONJ_TAC THENL
       [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
         (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN
        MATCH_MP_TAC IMAGE_SUBSET THEN
        REWRITE_TAC[FORALL_PASTECART; SUBSET; PASTECART_IN_PCROSS] THEN
        ASM_SIMP_TAC[IN_SING];
        ALL_TAC] THEN
      ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (p /\ q /\ r) /\ s`] THEN
      CONJ_TAC THENL
       [REMOVE_THEN "*" (MP_TAC o SPEC `x:real^P`);
        REMOVE_THEN "*" (MP_TAC o SPEC `z:real^P`)] THEN
      ASM_REWRITE_TAC[FORALL_IN_GSPEC; SUBSET; FORALL_IN_IMAGE] THEN
      ASM_SIMP_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS; IN_SING] THEN
      STRIP_TAC THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN
      REWRITE_TAC[FORALL_PASTECART; SUBSET; PASTECART_IN_PCROSS] THEN
      ASM_SIMP_TAC[IN_SING]]] THEN
  X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o last o CONJUNCTS o
    GEN_REWRITE_RULE I [covering_space]) THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
  REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `uu:real^N->real^N->bool` THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `!t. t IN interval[vec 0,vec 1]
        ==> ?k n i:real^N.
                open_in (subtopology euclidean (interval[vec 0,vec 1])) k /\
                open_in (subtopology euclidean u) n /\
                t IN k /\ y IN n /\ i IN s /\
                IMAGE (h:real^(1,P)finite_sum->real^N) (k PCROSS n) SUBSET uu i`
  MP_TAC THENL
   [X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
    SUBGOAL_THEN `(h:real^(1,P)finite_sum->real^N) (pastecart t y) IN s`
    ASSUME_TAC THENL
     [FIRST_X_ASSUM(MATCH_MP_TAC o ONCE_REWRITE_RULE[FORALL_IN_IMAGE] o
        GEN_REWRITE_RULE I [SUBSET]) THEN
      ASM_REWRITE_TAC[PASTECART_IN_PCROSS];
      ALL_TAC] THEN
    SUBGOAL_THEN
     `open_in (subtopology euclidean (interval[vec 0,vec 1] PCROSS u))
              {z | z IN (interval[vec 0,vec 1] PCROSS u) /\
                   (h:real^(1,P)finite_sum->real^N) z IN
                   uu(h(pastecart t y))}`
    MP_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
      EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[];
      ALL_TAC] THEN
    DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
        PASTECART_IN_INTERIOR_SUBTOPOLOGY)) THEN
    DISCH_THEN(MP_TAC o SPECL [`t:real^1`; `y:real^P`]) THEN
    ASM_SIMP_TAC[IN_ELIM_THM; PASTECART_IN_PCROSS] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^1->bool` THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:real^P->bool` THEN
    STRIP_TAC THEN
    EXISTS_TAC `(h:real^(1,P)finite_sum->real^N) (pastecart t y)` THEN
    ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [OPEN_IN_OPEN] THEN
  REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
  REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
  REWRITE_TAC[MESON[]
   `(?x y. (P y /\ x = f y) /\ Q x) <=> ?y. P y /\ Q(f y)`] THEN
  REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
  GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
  REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC
   [`kk:real^1->real^1->bool`; `nn:real^1->real^P->bool`;
    `xx:real^1->real^N`] THEN
  DISCH_THEN(LABEL_TAC "+") THEN
  MP_TAC(ISPEC `interval[vec 0:real^1,vec 1] PCROSS {y:real^P}`
    COMPACT_IMP_HEINE_BOREL) THEN
  SIMP_TAC[COMPACT_PCROSS; COMPACT_INTERVAL; COMPACT_SING] THEN
  DISCH_THEN(MP_TAC o SPEC
   `IMAGE ((\i. kk i PCROSS nn i):real^1->real^(1,P)finite_sum->bool)
          (interval[vec 0,vec 1])`) THEN
  ASM_SIMP_TAC[FORALL_IN_IMAGE; OPEN_PCROSS] THEN ANTS_TAC THENL
   [REWRITE_TAC[SUBSET; FORALL_IN_PCROSS; IN_SING] THEN
    MAP_EVERY X_GEN_TAC [`t:real^1`; `z:real^P`] THEN STRIP_TAC THEN
    ASM_REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; PASTECART_IN_PCROSS] THEN
    ASM_MESON_TAC[IN_INTER];
    GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
     [TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
    REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN
    DISCH_THEN(X_CHOOSE_THEN `tk:real^1->bool` STRIP_ASSUME_TAC)] THEN
  ABBREV_TAC `n = INTERS (IMAGE (nn:real^1->real^P->bool) tk)` THEN
  SUBGOAL_THEN `(y:real^P) IN n /\ open n` STRIP_ASSUME_TAC THENL
   [EXPAND_TAC "n" THEN CONJ_TAC THENL
     [REWRITE_TAC[INTERS_IMAGE; IN_ELIM_THM];
      MATCH_MP_TAC OPEN_INTERS THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN
      ASM_SIMP_TAC[FINITE_IMAGE]] THEN
    X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
    REMOVE_THEN "+" (MP_TAC o SPEC `t:real^1`) THEN
    (ANTS_TAC THENL [ASM SET_TAC[]; SIMP_TAC[IN_INTER]]);
    ALL_TAC] THEN
  MP_TAC(ISPECL
   [`interval[vec 0:real^1,vec 1]`; `IMAGE (kk:real^1->real^1->bool) tk`]
   LEBESGUE_COVERING_LEMMA) THEN
  REWRITE_TAC[COMPACT_INTERVAL; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN
  MATCH_MP_TAC(TAUT
   `q /\ (p ==> ~q) /\ (q ==> (r ==> s) ==> t)
    ==> (~p /\ q /\ r ==> s) ==> t`) THEN
  SIMP_TAC[UNIONS_0; IMAGE_CLAUSES; SUBSET_EMPTY; UNIT_INTERVAL_NONEMPTY] THEN
  CONJ_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [UNIONS_IMAGE]) THEN
    REWRITE_TAC[SUBSET; FORALL_IN_PCROSS; IMP_CONJ; IN_SING] THEN
    REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN
    REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; PASTECART_IN_PCROSS] THEN
    MESON_TAC[];
    DISCH_TAC] THEN
  ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPEC `d:real` REAL_ARCH_INV) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN
   `!n. n <= N
        ==> ?v k:real^(1,P)finite_sum->real^M.
                open_in (subtopology euclidean u) v /\
                y IN v /\
                k continuous_on interval[vec 0,lift(&n / &N)] PCROSS v /\
                IMAGE k (interval[vec 0,lift(&n / &N)] PCROSS v) SUBSET c /\
                (!y. y IN v ==> k (pastecart (vec 0) y) = f y) /\
                (!z. z IN interval[vec 0,lift(&n / &N)] PCROSS v
                     ==> h z:real^N = p (k z))`
  MP_TAC THENL
   [ALL_TAC;
    DISCH_THEN(MP_TAC o SPEC `N:num`) THEN REWRITE_TAC[LE_REFL] THEN
    ASM_SIMP_TAC[REAL_DIV_REFL; REAL_OF_NUM_EQ; LIFT_NUM]] THEN
  MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
   [DISCH_TAC THEN REWRITE_TAC[real_div; REAL_MUL_LZERO; LIFT_NUM] THEN
    EXISTS_TAC `u:real^P->bool` THEN
    EXISTS_TAC `(f o sndcart):real^(1,P)finite_sum->real^M` THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS; INTERVAL_SING] THEN
    REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_SING; o_THM] THEN
    ASM_REWRITE_TAC[FORALL_UNWIND_THM2; SNDCART_PASTECART] THEN
    REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
    SIMP_TAC[SNDCART_PASTECART];
    ALL_TAC] THEN
  X_GEN_TAC `m:num` THEN ASM_CASES_TAC `SUC m <= N` THEN
  ASM_SIMP_TAC[ARITH_RULE `SUC m <= N ==> m <= N`; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC
   [`v:real^P->bool`; `k:real^(1,P)finite_sum->real^M`] THEN
  STRIP_TAC THEN FIRST_X_ASSUM
   (MP_TAC o SPEC `interval[lift(&m / &N),lift(&(SUC m) / &N)]`) THEN
  ANTS_TAC THENL
   [REWRITE_TAC[DIAMETER_INTERVAL; SUBSET_INTERVAL_1] THEN
    REWRITE_TAC[LIFT_DROP; DROP_VEC; INTERVAL_EQ_EMPTY_1;
                GSYM LIFT_SUB; NORM_LIFT] THEN
    ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; LE_1;
                 REAL_FIELD `&0 < x ==> a / x - b / x = (a - b) / x`] THEN
    SIMP_TAC[GSYM NOT_LE; ARITH_RULE `m <= SUC m`; REAL_OF_NUM_SUB] THEN
    ASM_SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_LE_DIV; REAL_POS;
                 REAL_ABS_NUM; ARITH_RULE `SUC m - m = 1`] THEN
    ASM_SIMP_TAC[REAL_ARITH `&1 / n = inv(n)`; REAL_LT_IMP_LE] THEN
    ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN
    ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE] THEN ARITH_TAC;
    ALL_TAC] THEN
  REWRITE_TAC[EXISTS_IN_IMAGE] THEN
  DISCH_THEN(X_CHOOSE_THEN `t:real^1` STRIP_ASSUME_TAC) THEN
  REMOVE_THEN "+" (MP_TAC o SPEC `t:real^1`) THEN
  ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `(xx:real^1->real^N) t`) THEN
  ASM_REWRITE_TAC[] THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` MP_TAC) THEN
  ONCE_REWRITE_TAC[IMP_CONJ] THEN
  GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN
  DISCH_THEN(MP_TAC o SPEC
   `(k:real^(1,P)finite_sum->real^M) (pastecart (lift(&m / &N)) y)`) THEN
  REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC(TAUT
   `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN
  REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [IN_INTER])) THEN
  SUBGOAL_THEN
   `lift(&m / &N) IN interval[vec 0,lift (&m / &N)] /\
    lift(&m / &N) IN interval[lift(&m / &N),lift(&(SUC m) / &N)]`
  STRIP_ASSUME_TAC THENL
   [REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
    SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LE_REFL] THEN
    ASM_SIMP_TAC[REAL_LE_DIV2_EQ; LE_1; REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN
    ARITH_TAC;
    ALL_TAC] THEN
  REPEAT CONJ_TAC THENL
   [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
    MATCH_MP_TAC FUN_IN_IMAGE THEN
    ASM_REWRITE_TAC[PASTECART_IN_PCROSS];
    FIRST_X_ASSUM(MP_TAC o SPEC `pastecart(lift(&m / &N)) (y:real^P)`) THEN
    ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN
    DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
     (SET_RULE `IMAGE h s SUBSET t ==> x IN s ==> h x IN t`)) THEN
    ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_INTER] THEN
    ASM_SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; REAL_LE_DIV; REAL_LE_LDIV_EQ;
                 REAL_POS; REAL_OF_NUM_LT; LE_1; DROP_VEC] THEN
    REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE] THEN
    CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
    ASM_REWRITE_TAC[];
    GEN_REWRITE_TAC LAND_CONV [IN_UNIONS] THEN
    DISCH_THEN(X_CHOOSE_THEN `w:real^M->bool` STRIP_ASSUME_TAC) THEN
    DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `w:real^M->bool`) MP_TAC) THEN
    DISCH_THEN(MP_TAC o SPEC `w:real^M->bool` o CONJUNCT2) THEN
    ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `p':real^N->real^M`) THEN
    DISCH_TAC THEN UNDISCH_THEN `(w:real^M->bool) IN vv` (K ALL_TAC)] THEN
  ABBREV_TAC `w' = (uu:real^N->real^N->bool)(xx(t:real^1))` THEN
  SUBGOAL_THEN
   `?n'. open_in (subtopology euclidean u) n' /\ y IN n' /\
         IMAGE (k:real^(1,P)finite_sum->real^M) ({lift(&m / &N)} PCROSS n')
         SUBSET w`
  STRIP_ASSUME_TAC THENL
   [EXISTS_TAC
     `{z | z IN v /\ ((k:real^(1,P)finite_sum->real^M) o
                     pastecart (lift(&m / &N))) z IN w}` THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
    ASM_SIMP_TAC[IN_ELIM_THM; IN_SING; o_THM] THEN
    MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `v:real^P->bool` THEN
    ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
    EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
    ONCE_REWRITE_TAC[GSYM o_DEF] THEN CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
      SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST;
               CONTINUOUS_ON_ID] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET));
      REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
       `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`))] THEN
    ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `?q q':real^P->bool.
        open_in (subtopology euclidean u) q /\
        closed_in (subtopology euclidean u) q' /\
        y IN q /\ y IN q' /\ q SUBSET q' /\
        q SUBSET (u INTER nn(t:real^1)) INTER n' INTER v /\
        q' SUBSET (u INTER nn(t:real^1)) INTER n' INTER v`
  STRIP_ASSUME_TAC THENL
   [REWRITE_TAC[SET_RULE
     `y IN q /\ y IN q' /\ q SUBSET q' /\ q SUBSET s /\ q' SUBSET s <=>
      y IN q /\ q SUBSET q' /\ q' SUBSET s`] THEN
    UNDISCH_TAC `open_in (subtopology euclidean u) (v:real^P->bool)` THEN
    UNDISCH_TAC `open_in (subtopology euclidean u) (n':real^P->bool)` THEN
    REWRITE_TAC[OPEN_IN_OPEN] THEN
    DISCH_THEN(X_CHOOSE_THEN `vo:real^P->bool` STRIP_ASSUME_TAC) THEN
    DISCH_THEN(X_CHOOSE_THEN `vx:real^P->bool` STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPEC `nn(t:real^1) INTER vo INTER vx:real^P->bool`
      OPEN_CONTAINS_CBALL) THEN
    ASM_SIMP_TAC[OPEN_INTER] THEN DISCH_THEN(MP_TAC o SPEC `y:real^P`) THEN
    ASM_REWRITE_TAC[IN_INTER] THEN
    ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `u INTER ball(y:real^P,e)` THEN
    EXISTS_TAC `u INTER cball(y:real^P,e)` THEN
    REWRITE_TAC[CLOSED_IN_CLOSED] THEN
    CONJ_TAC THENL [MESON_TAC[OPEN_BALL]; ALL_TAC] THEN
    CONJ_TAC THENL [MESON_TAC[CLOSED_CBALL]; ALL_TAC] THEN
    ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL] THEN
    MP_TAC(ISPECL [`y:real^P`; `e:real`] BALL_SUBSET_CBALL) THEN
    ASM SET_TAC[];
    ALL_TAC] THEN
  FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN
  EXISTS_TAC `q:real^P->bool` THEN ASM_REWRITE_TAC[] THEN
  MP_TAC(ISPECL
   [`\x:real^(1,P)finite_sum.
       x IN interval[vec 0,lift(&m / &N)] PCROSS (q':real^P->bool)`;
    `k:real^(1,P)finite_sum->real^M`;
    `(p':real^N->real^M) o (h:real^(1,P)finite_sum->real^N)`;
    `interval[vec 0,lift(&m / &N)] PCROSS (q':real^P->bool)`;
    `interval[lift(&m / &N),lift(&(SUC m) / &N)] PCROSS (q':real^P->bool)`]
   CONTINUOUS_ON_CASES_LOCAL) THEN
  REWRITE_TAC[TAUT `~(p /\ ~p)`] THEN ANTS_TAC THENL
   [REPEAT CONJ_TAC THENL
     [REWRITE_TAC[CLOSED_IN_CLOSED] THEN
      EXISTS_TAC `interval[vec 0,lift(&m / &N)] PCROSS (:real^P)` THEN
      SIMP_TAC[CLOSED_PCROSS; CLOSED_INTERVAL; CLOSED_UNIV] THEN
      REWRITE_TAC[EXTENSION; IN_INTER; IN_UNION; FORALL_PASTECART] THEN
      REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV] THEN CONV_TAC TAUT;
      REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC
       `interval[lift(&m / &N),lift(&(SUC m) / &N)] PCROSS (:real^P)` THEN
      SIMP_TAC[CLOSED_PCROSS; CLOSED_INTERVAL; CLOSED_UNIV] THEN
      REWRITE_TAC[EXTENSION; IN_INTER; IN_UNION; FORALL_PASTECART] THEN
      REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV] THEN CONV_TAC TAUT;
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN
      REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
      ASM SET_TAC[];
      MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET))
      THENL
       [ALL_TAC;
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
         `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`))] THEN
      MATCH_MP_TAC PCROSS_MONO THEN
      (CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN
      ASM_REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC;
                      SUBSET_INTER] THEN
      REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
      ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT;
                   LE_1] THEN
      ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1;
                   REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
      DISJ2_TAC THEN ARITH_TAC;
      REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
      MAP_EVERY X_GEN_TAC [`r:real^1`; `z:real^P`] THEN
      ASM_CASES_TAC `(z:real^P) IN q'` THEN ASM_REWRITE_TAC[] THEN
      REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN DISCH_THEN(MP_TAC o MATCH_MP
       (REAL_ARITH `(b <= x /\ x <= c) /\ (a <= x /\ x <= b) ==> x = b`)) THEN
      REWRITE_TAC[DROP_EQ; o_THM] THEN DISCH_THEN SUBST1_TAC THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
       `(!x. x IN w ==> p' (p x) = x)
        ==> h z = p(k z) /\ k z IN w
            ==> k z = p' (h z)`)) THEN
      CONJ_TAC THENL
       [FIRST_X_ASSUM MATCH_MP_TAC THEN
        ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM SET_TAC[];
        FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
        MATCH_MP_TAC FUN_IN_IMAGE THEN
        REWRITE_TAC[PASTECART_IN_PCROSS; IN_SING] THEN ASM SET_TAC[]]];
    SUBGOAL_THEN
     `interval[vec 0,lift(&m / &N)] UNION
      interval [lift(&m / &N),lift(&(SUC m) / &N)] =
      interval[vec 0,lift(&(SUC m) / &N)]`
    ASSUME_TAC THENL
     [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN GEN_TAC THEN
      MATCH_MP_TAC(REAL_ARITH `a <= b /\ b <= c ==>
       (a <= x /\ x <= b \/ b <= x /\ x <= c <=> a <= x /\ x <= c)`) THEN
      SIMP_TAC[LIFT_DROP; DROP_VEC; REAL_LE_DIV; REAL_POS] THEN
      ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; REAL_OF_NUM_LE; LE_1] THEN
      ARITH_TAC;
      ALL_TAC] THEN
    SUBGOAL_THEN
     `interval[vec 0,lift(&m / &N)] PCROSS (q':real^P->bool) UNION
      interval [lift(&m / &N),lift(&(SUC m) / &N)] PCROSS q' =
      interval[vec 0,lift(&(SUC m) / &N)] PCROSS q'`
    SUBST1_TAC THENL
     [SIMP_TAC[EXTENSION; IN_UNION; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
      ASM SET_TAC[];
      ALL_TAC] THEN
    MATCH_MP_TAC(MESON[CONTINUOUS_ON_SUBSET]
     `t SUBSET s /\ (f continuous_on s ==> P f)
      ==> f continuous_on s ==> ?g. g continuous_on t /\ P g`) THEN
    ASM_SIMP_TAC[PCROSS_MONO; SUBSET_REFL] THEN DISCH_TAC THEN
    REPEAT CONJ_TAC THENL
     [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
      MAP_EVERY X_GEN_TAC [`r:real^1`; `z:real^P`] THEN STRIP_TAC THEN
      SUBGOAL_THEN `(z:real^P) IN q'` ASSUME_TAC THENL
       [ASM SET_TAC[]; ASM_REWRITE_TAC[PASTECART_IN_PCROSS]] THEN
      COND_CASES_TAC THEN REWRITE_TAC[o_THM] THENL
       [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
        MATCH_MP_TAC FUN_IN_IMAGE THEN
        REWRITE_TAC[PASTECART_IN_PCROSS; IN_SING] THEN ASM SET_TAC[];
        FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET] o
          CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
         `IMAGE p w' = w ==> x IN w' ==> p x IN w`))];
      X_GEN_TAC `z:real^P` THEN REWRITE_TAC[PASTECART_IN_PCROSS] THEN
      DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN
      SUBGOAL_THEN `(z:real^P) IN q'` ASSUME_TAC THENL
       [ASM SET_TAC[]; ASM_REWRITE_TAC[LIFT_DROP; DROP_VEC]] THEN
      SIMP_TAC[REAL_LE_DIV; REAL_POS] THEN ASM SET_TAC[];
      REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
      MAP_EVERY X_GEN_TAC [`r:real^1`; `z:real^P`] THEN STRIP_TAC THEN
      SUBGOAL_THEN `(z:real^P) IN q'` ASSUME_TAC THENL
       [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN
      COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
       [FIRST_X_ASSUM MATCH_MP_TAC THEN
        ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM SET_TAC[];
        REWRITE_TAC[o_THM] THEN CONV_TAC SYM_CONV THEN
        FIRST_X_ASSUM MATCH_MP_TAC]] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
      (SET_RULE `IMAGE h s SUBSET t ==> x IN s ==> h x IN t`)) THEN
    ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_INTER] THEN
    REPEAT(CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN
    REWRITE_TAC[IN_INTERVAL_1] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
     (REAL_ARITH `a <= x /\ x <= b ==> b <= c ==> a <= x /\ x <= c`)) THEN
    ASM_SIMP_TAC[LIFT_DROP; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN
    ASM_REWRITE_TAC[DROP_VEC; REAL_MUL_LID; REAL_OF_NUM_LE]]);;

let COVERING_SPACE_LIFT_HOMOTOPIC_FUNCTION = prove
 (`!p:real^M->real^N c s f f' g u:real^P->bool.
        covering_space (c,p) s /\
        g continuous_on u /\ IMAGE g u SUBSET c /\
        (!y. y IN u ==> p(g y) = f y) /\
        homotopic_with (\x. T)
         (subtopology euclidean u,subtopology euclidean s) f f'
        ==> ?g'. g' continuous_on u /\ IMAGE g' u SUBSET c /\
                 (!y. y IN u ==> p(g' y) = f' y)`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(X_CHOOSE_THEN `h:real^(1,P)finite_sum->real^N`
    STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMOTOPIC_WITH_EUCLIDEAN]) THEN
  FIRST_ASSUM(MP_TAC o
    ISPECL [`h:real^(1,P)finite_sum->real^N`;
            `g:real^P->real^M`; `u:real^P->bool`] o
    MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY)) THEN
  ASM_SIMP_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `k:real^(1,P)finite_sum->real^M`
        STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `(k:real^(1,P)finite_sum->real^M) o
              (\x. pastecart (vec 1) x)` THEN
  ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST;
             CONTINUOUS_ON_ID] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS;
                ENDS_IN_UNIT_INTERVAL];
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`)) THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS;
                ENDS_IN_UNIT_INTERVAL];
    ASM_MESON_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL]]);;

let COVERING_SPACE_LIFT_INESSENTIAL_FUNCTION = prove
 (`!p:real^M->real^N c s f a u:real^P->bool.
        covering_space (c,p) s /\
        homotopic_with (\x. T)
         (subtopology euclidean u,subtopology euclidean s) f (\x. a)
        ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\
                (!y. y IN u ==> p(g y) = f y)`,
  ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN
  ASM_CASES_TAC `u:real^P->bool = {}` THEN
  ASM_REWRITE_TAC[NOT_IN_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET;
                  CONTINUOUS_ON_EMPTY] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE
     [TAUT `a /\ b /\ c /\ d /\ e ==> f <=> a /\ e ==> b /\ c /\ d ==> f`]
     COVERING_SPACE_LIFT_HOMOTOPIC_FUNCTION)) THEN
  FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC) THEN
  FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
  SUBGOAL_THEN `?b. b IN c /\ (p:real^M->real^N) b = a` CHOOSE_TAC THENL
   [ASM SET_TAC[];
    EXISTS_TAC `(\x. b):real^P->real^M`] THEN
  REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]);;

let COVERING_SPACE_LIFT_HOMOTOPY_ALT = prove
 (`!p:real^M->real^N c s (h:real^(P,1)finite_sum->real^N) f u.
        covering_space (c,p) s /\
        h continuous_on (u PCROSS interval[vec 0,vec 1]) /\
        IMAGE h (u PCROSS interval[vec 0,vec 1]) SUBSET s /\
        (!y. y IN u ==> h (pastecart y (vec 0)) = p(f y)) /\
        f continuous_on u /\ IMAGE f u SUBSET c
        ==> ?k. k continuous_on (u PCROSS interval[vec 0,vec 1]) /\
                IMAGE k (u PCROSS interval[vec 0,vec 1]) SUBSET c /\
                (!y. y IN u ==> k(pastecart y (vec 0)) = f y) /\
                (!z. z IN u PCROSS interval[vec 0,vec 1] ==> h z = p(k z))`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o ISPECL
   [`(h:real^(P,1)finite_sum->real^N) o
     (\z. pastecart (sndcart z) (fstcart z))`;
    `f:real^P->real^M`; `u:real^P->bool`] o
      MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY)) THEN
  ASM_SIMP_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN ANTS_TAC THENL
   [CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
      SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON;
               LINEAR_FSTCART; LINEAR_SNDCART] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET));
      REWRITE_TAC[IMAGE_o] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
       `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`))] THEN
    SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; FORALL_IN_PCROSS;
             FSTCART_PASTECART; SNDCART_PASTECART];
    DISCH_THEN(X_CHOOSE_THEN `k:real^(1,P)finite_sum->real^M`
        STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `(k:real^(1,P)finite_sum->real^M) o
                (\z. pastecart (sndcart z) (fstcart z))` THEN
    ASM_SIMP_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART;
                 FORALL_IN_PCROSS; PASTECART_IN_PCROSS] THEN
    REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
      SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON;
               LINEAR_FSTCART; LINEAR_SNDCART] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET));
      REWRITE_TAC[IMAGE_o] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
       `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`));
      MAP_EVERY X_GEN_TAC [`x:real^P`; `t:real^1`] THEN STRIP_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (t:real^1) (x:real^P)`)] THEN
    ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS;
                 FSTCART_PASTECART; SNDCART_PASTECART; FORALL_IN_PCROSS]]);;

let COVERING_SPACE_LIFT_PATH_STRONG = prove
 (`!p:real^M->real^N c s g a.
     covering_space (c,p) s /\
     path g /\ path_image g SUBSET s /\ pathstart g = p(a) /\ a IN c
     ==> ?h. path h /\ path_image h SUBSET c /\ pathstart h = a /\
             !t. t IN interval[vec 0,vec 1] ==> p(h t) = g t`,
  REWRITE_TAC[path_image; path; pathstart] THEN
  REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o
    ISPECL [`(g:real^1->real^N) o (fstcart:real^(1,P)finite_sum->real^1)`;
            `(\y. a):real^P->real^M`; `{arb:real^P}`] o
    MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY)) THEN
  REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; o_THM; FSTCART_PASTECART] THEN
  ANTS_TAC THENL
   [ASM_REWRITE_TAC[IMAGE_o; CONTINUOUS_ON_CONST] THEN
    ASM_REWRITE_TAC[SET_RULE `IMAGE (\y. a) {b} SUBSET s <=> a IN s`] THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
      SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_ON] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET));
      ALL_TAC] THEN
    ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
    SIMP_TAC[FSTCART_PASTECART] THEN ASM SET_TAC[];
    DISCH_THEN(X_CHOOSE_THEN `k:real^(1,P)finite_sum->real^M`
        STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `(k:real^(1,P)finite_sum->real^M) o (\t. pastecart t arb)` THEN
    ASM_REWRITE_TAC[o_THM; IMAGE_o] THEN REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
      SIMP_TAC[CONTINUOUS_ON_PASTECART;
               CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN
      SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; IN_SING];
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
       `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`)) THEN
      SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; IN_SING];
      X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (t:real^1) (arb:real^P)`) THEN
      ASM_SIMP_TAC[PASTECART_IN_PCROSS; FSTCART_PASTECART; IN_SING]]]);;

let COVERING_SPACE_LIFT_PATH = prove
 (`!p:real^M->real^N c s g.
     covering_space (c,p) s /\ path g /\ path_image g SUBSET s
     ==> ?h. path h /\ path_image h SUBSET c /\
             !t. t IN interval[vec 0,vec 1] ==> p(h t) = g t`,
  REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE
   `IMAGE g i SUBSET s ==> vec 0 IN i ==> g(vec 0) IN s`) o
   GEN_REWRITE_RULE LAND_CONV [path_image]) THEN
  REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
  FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
  REWRITE_TAC[IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `a:real^M` THEN STRIP_TAC THEN
  MP_TAC(ISPECL [`p:real^M->real^N`; `c:real^M->bool`; `s:real^N->bool`;
                `g:real^1->real^N`; `a:real^M`]
    COVERING_SPACE_LIFT_PATH_STRONG) THEN
  ASM_REWRITE_TAC[pathstart] THEN MATCH_MP_TAC MONO_EXISTS THEN
  REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]);;

let COVERING_SPACE_LIFT_HOMOTOPIC_PATHS = prove
 (`!p:real^M->real^N c s g1 g2 h1 h2.
     covering_space (c,p) s /\
     path g1 /\ path_image g1 SUBSET s /\
     path g2 /\ path_image g2 SUBSET s /\
     homotopic_paths s g1 g2 /\
     path h1 /\ path_image h1 SUBSET c /\
     (!t. t IN interval[vec 0,vec 1] ==> p(h1 t) = g1 t) /\
     path h2 /\ path_image h2 SUBSET c /\
     (!t. t IN interval[vec 0,vec 1] ==> p(h2 t) = g2 t) /\
     pathstart h1 = pathstart h2
     ==> homotopic_paths c h1 h2`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[HOMOTOPIC_PATHS] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_paths]) THEN
  REWRITE_TAC[HOMOTOPIC_WITH_EUCLIDEAN; pathstart; pathfinish] THEN
  DISCH_THEN(X_CHOOSE_THEN
   `h:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC) THEN
  FIRST_ASSUM(MP_TAC o ISPECL
   [`h:real^(1,1)finite_sum->real^N`; `(\x. pathstart h2):real^1->real^M`;
    `interval[vec 0:real^1,vec 1]`] o
   MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY_ALT)) THEN
  ASM_SIMP_TAC[] THEN ANTS_TAC THENL
   [REWRITE_TAC[CONTINUOUS_ON_CONST; SUBSET; FORALL_IN_IMAGE] THEN
    ASM_MESON_TAC[pathstart; ENDS_IN_UNIT_INTERVAL; PATHSTART_IN_PATH_IMAGE;
                  SUBSET];
    ALL_TAC] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^(1,1)finite_sum->real^M` THEN
  STRIP_TAC THEN ASM_SIMP_TAC[o_DEF] THEN
  MATCH_MP_TAC(TAUT `(p /\ q) /\ (p /\ q ==> r) ==> p /\ q /\ r`) THEN
  CONJ_TAC THENL
   [CONJ_TAC THEN
    FIRST_ASSUM(MATCH_MP_TAC o
      REWRITE_RULE[RIGHT_FORALL_IMP_THM] o
      ONCE_REWRITE_RULE[IMP_CONJ] o
      REWRITE_RULE[CONJ_ASSOC] o MATCH_MP
       (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN
    REWRITE_TAC[GSYM CONJ_ASSOC] THENL
     [MAP_EVERY EXISTS_TAC [`g1:real^1->real^N`; `vec 0:real^1`];
      MAP_EVERY EXISTS_TAC [`g2:real^1->real^N`; `vec 0:real^1`]] THEN
    ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[path_image; pathstart; pathfinish; path]) THEN
    ASM_REWRITE_TAC[CONNECTED_INTERVAL; pathstart; pathfinish] THEN
    REWRITE_TAC[CONJ_ASSOC] THEN
    (REPEAT CONJ_TAC THENL
     [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
      MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
      SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST;
               CONTINUOUS_ON_ID] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET));
      GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN
      REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
       `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`));
      ASM_MESON_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL]] THEN
     SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; FORALL_IN_PCROSS;
              FSTCART_PASTECART; SNDCART_PASTECART; ENDS_IN_UNIT_INTERVAL]);
     STRIP_TAC THEN
     REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN
     REWRITE_TAC[FORALL_AND_THM] THEN CONJ_TAC THENL
      [ASM_MESON_TAC[pathstart; ENDS_IN_UNIT_INTERVAL]; ALL_TAC] THEN
     FIRST_ASSUM(MATCH_MP_TAC o
      REWRITE_RULE[RIGHT_FORALL_IMP_THM] o
      ONCE_REWRITE_RULE[IMP_CONJ] o
      REWRITE_RULE[CONJ_ASSOC] o MATCH_MP
       (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN
     MAP_EVERY EXISTS_TAC
      [`(\x. pathfinish g1):real^1->real^N`; `vec 0:real^1`] THEN
     ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL; CONNECTED_INTERVAL] THEN
     REWRITE_TAC[CONTINUOUS_ON_CONST; pathfinish] THEN
     REPEAT CONJ_TAC THENL
      [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
       ASM_MESON_TAC[SUBSET; pathfinish; PATHFINISH_IN_PATH_IMAGE];
       GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
       SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST;
                CONTINUOUS_ON_ID] THEN
       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
           CONTINUOUS_ON_SUBSET)) THEN
       SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; FORALL_IN_PCROSS;
                FSTCART_PASTECART; SNDCART_PASTECART; ENDS_IN_UNIT_INTERVAL];
       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
       X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
       FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (t:real^1) (vec 1:real^1)` o
         REWRITE_RULE[FORALL_IN_IMAGE] o GEN_REWRITE_RULE I [SUBSET]) THEN
       ASM_REWRITE_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL];
       ASM_MESON_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL];
       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
       ASM_MESON_TAC[SUBSET; pathfinish; PATHFINISH_IN_PATH_IMAGE]]]);;

let COVERING_SPACE_MONODROMY = prove
 (`!p:real^M->real^N c s g1 g2 h1 h2.
     covering_space (c,p) s /\
     path g1 /\ path_image g1 SUBSET s /\
     path g2 /\ path_image g2 SUBSET s /\
     homotopic_paths s g1 g2 /\
     path h1 /\ path_image h1 SUBSET c /\
     (!t. t IN interval[vec 0,vec 1] ==> p(h1 t) = g1 t) /\
     path h2 /\ path_image h2 SUBSET c /\
     (!t. t IN interval[vec 0,vec 1] ==> p(h2 t) = g2 t) /\
     pathstart h1 = pathstart h2
     ==> pathfinish h1 = pathfinish h2`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP COVERING_SPACE_LIFT_HOMOTOPIC_PATHS) THEN
  REWRITE_TAC[HOMOTOPIC_PATHS_IMP_PATHFINISH]);;

let COVERING_SPACE_LIFT_HOMOTOPIC_PATH = prove
 (`!p:real^M->real^N c s f f' g a b.
        covering_space (c,p) s /\
        homotopic_paths s f f' /\
        path g /\ path_image g SUBSET c /\
        pathstart g = a /\ pathfinish g = b /\
        (!t. t IN interval[vec 0,vec 1] ==> p(g t) = f t)
        ==> ?g'. path g' /\ path_image g' SUBSET c /\
                 pathstart g' = a /\ pathfinish g' = b /\
                 (!t. t IN interval[vec 0,vec 1] ==> p(g' t) = f' t)`,
  ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN REPEAT STRIP_TAC THEN
  FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN
  FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN
  FIRST_ASSUM(MP_TAC o ISPECL [`f':real^1->real^N`; `a:real^M`] o
   MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_PATH_STRONG)) THEN
  ANTS_TAC THENL
   [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
     [ASM_MESON_TAC[pathstart; ENDS_IN_UNIT_INTERVAL;
                    HOMOTOPIC_PATHS_IMP_PATHSTART];
      ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]];
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g':real^1->real^M` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    SUBST1_TAC(SYM(ASSUME `pathfinish g:real^M = b`)) THEN
    FIRST_ASSUM(MATCH_MP_TAC o
     MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_MONODROMY)) THEN
    MAP_EVERY EXISTS_TAC [`f':real^1->real^N`; `f:real^1->real^N`] THEN
    ASM_REWRITE_TAC[]]);;

let COVERING_SPACE_INESSENTIAL_LOOP_LIFT_IS_LOOP = prove
 (`!p:real^M->real^N c s g h a.
        covering_space (c,p) s /\
        path g /\ path_image g SUBSET s /\ pathfinish g = pathstart g /\
        homotopic_paths s g (linepath(a,a)) /\
        path h /\ path_image h SUBSET c /\
        (!t. t IN interval[vec 0,vec 1] ==> p(h t) = g t)
        ==> pathfinish h = pathstart h`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN
  REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN
  REWRITE_TAC[PATHSTART_LINEPATH] THEN REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o
    ISPECL [`g:real^1->real^N`; `linepath(a:real^N,a)`;
            `h:real^1->real^M`; `linepath(pathstart h:real^M,pathstart h)`] o
    MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        COVERING_SPACE_MONODROMY)) THEN
  ASM_REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
  ASM_REWRITE_TAC[SING_SUBSET; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
  DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[LINEPATH_REFL] THEN CONJ_TAC THENL
   [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET];
    REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
    REWRITE_TAC[pathstart] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]]);;

let COVERING_SPACE_SIMPLY_CONNECTED_LOOP_LIFT_IS_LOOP = prove
 (`!p:real^M->real^N c s g h.
        covering_space (c,p) s /\ simply_connected s /\
        path g /\ path_image g SUBSET s /\ pathfinish g = pathstart g /\
        path h /\ path_image h SUBSET c /\
        (!t. t IN interval[vec 0,vec 1] ==> p(h t) = g t)
        ==> pathfinish h = pathstart h`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o
    MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        COVERING_SPACE_INESSENTIAL_LOOP_LIFT_IS_LOOP)) THEN
  EXISTS_TAC `g:real^1->real^N` THEN ASM_REWRITE_TAC[] THEN
  ASM_MESON_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH]);;

let COVERING_SPACE_HOMOTOPIC_PATHS_CANCEL = prove
 (`!p:real^M->real^N c s g h.
        covering_space (c,p) s /\
        path g /\ path_image g SUBSET c /\
        path h /\ path_image h SUBSET c /\
        pathstart g = pathstart h /\
        homotopic_paths s (p o g) (p o h)
        ==> homotopic_paths c g h`,
  REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
   (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPIC_PATHS)) THEN
  MAP_EVERY EXISTS_TAC
   [`(p:real^M->real^N) o (g:real^1->real^M)`;
    `(p:real^M->real^N) o (h:real^1->real^M)`] THEN
  ASM_REWRITE_TAC[o_THM] THEN
  ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_PATH; HOMOTOPIC_PATHS_IMP_SUBSET]);;

let COVERING_SPACE_HOMOTOPIC_PATHS_CANCEL_EQ = prove
 (`!p:real^M->real^N c s g h.
        covering_space (c,p) s /\
        path g /\ path_image g SUBSET c /\
        path h /\ path_image h SUBSET c /\
        pathstart g = pathstart h
        ==> (homotopic_paths s (p o g) (p o h) <=> homotopic_paths c g h)`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [ASM_MESON_TAC[COVERING_SPACE_HOMOTOPIC_PATHS_CANCEL]; DISCH_TAC] THEN
  MATCH_MP_TAC HOMOTOPIC_PATHS_CONTINUOUS_IMAGE THEN
  EXISTS_TAC `c:real^M->bool` THEN
  RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN
  ASM_REWRITE_TAC[SUBSET_REFL]);;

(* ------------------------------------------------------------------------- *)
(* Lifting of general functions to covering space                            *)
(* ------------------------------------------------------------------------- *)

let COVERING_SPACE_LIFT_GENERAL = prove
 (`!p:real^M->real^N c s f:real^P->real^N u a z.
        covering_space (c,p) s /\ a IN c /\ z IN u /\
        path_connected u /\ locally path_connected u /\
        f continuous_on u /\ IMAGE f u SUBSET s /\ f z = p a /\
        (!r. path r /\ path_image r SUBSET u /\
             pathstart r = z /\ pathfinish r = z
             ==> ?q. path q /\ path_image q SUBSET c /\
                     pathstart q = a /\ pathfinish q = a /\
                     homotopic_paths s (f o r) (p o q))
        ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ g z = a /\
                (!y. y IN u ==> p(g y) = f y)`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `!y. y IN u
        ==> ?g h. path g /\ path_image g SUBSET u /\
                  pathstart g = z /\ pathfinish g = y /\
                  path h /\ path_image h SUBSET c /\ pathstart h = a /\
                  (!t. t IN interval[vec 0,vec 1]
                       ==> (p:real^M->real^N)(h t) = (f:real^P->real^N)(g t))`
   (LABEL_TAC "*")
  THENL
   [X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
    DISCH_THEN(MP_TAC o SPECL [`z:real^P`; `y:real^P`]) THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `g:real^1->real^P` THEN STRIP_TAC THEN
    ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC  COVERING_SPACE_LIFT_PATH_STRONG THEN
    EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[GSYM o_DEF] THEN
    ASM_REWRITE_TAC[PATH_IMAGE_COMPOSE; PATHSTART_COMPOSE] THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN
      ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
      ASM SET_TAC[]];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `?l. !y g h. path g /\ path_image g SUBSET u /\
                pathstart g = z /\ pathfinish g = y /\
                path h /\ path_image h SUBSET c /\ pathstart h = a /\
                (!t. t IN interval[vec 0,vec 1]
                     ==> (p:real^M->real^N)(h t) = (f:real^P->real^N)(g t))
                ==> pathfinish h = l y`
  MP_TAC THENL
   [REWRITE_TAC[GSYM SKOLEM_THM] THEN X_GEN_TAC `y:real^P` THEN
    MATCH_MP_TAC(MESON[]
      `(!g h g' h'. P g h /\ P g' h' ==> f h = f h')
       ==> ?z. !g h. P g h ==> f h = z`) THEN
    REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `(g ++ reversepath g'):real^1->real^P`) THEN
    ASM_SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN;
      PATH_REVERSEPATH; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH;
      SUBSET_PATH_IMAGE_JOIN; PATH_IMAGE_REVERSEPATH] THEN
    DISCH_THEN(X_CHOOSE_THEN `q:real^1->real^M` STRIP_ASSUME_TAC) THEN
    FIRST_ASSUM(MP_TAC o
     ISPECL [`(p:real^M->real^N) o (q:real^1->real^M)`;
             `(f:real^P->real^N) o (g ++ reversepath g')`;
             `q:real^1->real^M`; `pathstart q:real^M`; `pathfinish q:real^M`] o
      MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ]
       (ONCE_REWRITE_RULE[HOMOTOPIC_PATHS_SYM]
         COVERING_SPACE_LIFT_HOMOTOPIC_PATH))) THEN
    ASM_REWRITE_TAC[o_THM] THEN
    DISCH_THEN(X_CHOOSE_THEN `q':real^1->real^M` STRIP_ASSUME_TAC) THEN
    SUBGOAL_THEN `path(h ++ reversepath h':real^1->real^M)` MP_TAC THENL
     [ALL_TAC;
      ASM_SIMP_TAC[PATH_JOIN_EQ; PATH_REVERSEPATH; PATHSTART_REVERSEPATH]] THEN
    MATCH_MP_TAC PATH_EQ THEN EXISTS_TAC `q':real^1->real^M` THEN
    ASM_REWRITE_TAC[] THEN
    X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
    STRIP_TAC THEN REWRITE_TAC[joinpaths] THEN COND_CASES_TAC THENL
     [FIRST_ASSUM(MP_TAC o
        ISPECL [`(f:real^P->real^N) o (g:real^1->real^P) o (\t. &2 % t)`;
                `q':real^1->real^M`;
                `(h:real^1->real^M) o (\t. &2 % t)`;
                `interval[vec 0,lift(&1 / &2)]`;
                `vec 0:real^1`; `t:real^1`] o
        MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN
      REWRITE_TAC[o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN
      REPEAT CONJ_TAC THENL
       [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
        EXISTS_TAC `(f:real^P->real^N) o (g ++ reversepath g')` THEN
        CONJ_TAC THENL
         [SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; joinpaths; o_THM];
          ALL_TAC] THEN
        MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
        EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL
         [ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_PATH; path];
          REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
          REAL_ARITH_TAC];
        MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC
         `path_image ((f:real^P->real^N) o (g ++ reversepath g'))` THEN
        CONJ_TAC THENL[ALL_TAC; ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_SUBSET]] THEN
        REWRITE_TAC[path_image] THEN MATCH_MP_TAC(SET_RULE
         `(!x. x IN s ==> f x = g x) /\ s SUBSET t
          ==> IMAGE f s SUBSET IMAGE g t`) THEN
        REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC; IN_INTERVAL_1] THEN
        CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[joinpaths; o_THM];
        MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
        EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
        ASM_REWRITE_TAC[GSYM path] THEN
        REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
        REAL_ARITH_TAC;
        MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC
         `path_image(q':real^1->real^M)` THEN
        ASM_REWRITE_TAC[] THEN REWRITE_TAC[path_image] THEN
        MATCH_MP_TAC IMAGE_SUBSET THEN
        REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
        REAL_ARITH_TAC;
        X_GEN_TAC `t':real^1` THEN
        REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN STRIP_TAC THEN
        FIRST_X_ASSUM(fun th ->
         W(MP_TAC o PART_MATCH (lhand o rand) th o rand o snd)) THEN
        ASM_SIMP_TAC[IN_INTERVAL_1; joinpaths; DROP_VEC] THEN
        ANTS_TAC THENL [ASM_REAL_ARITH_TAC; SIMP_TAC[]];
        MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
        SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN
        MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
        EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
        ASM_SIMP_TAC[GSYM path] THEN
        REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
        REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; LIFT_DROP] THEN
        REAL_ARITH_TAC;
        MATCH_MP_TAC SUBSET_TRANS THEN
        EXISTS_TAC `path_image(h:real^1->real^M)` THEN
        CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[]] THEN
        REWRITE_TAC[path_image; IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
        REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN
        REWRITE_TAC[DROP_VEC; DROP_CMUL; LIFT_DROP] THEN
        REAL_ARITH_TAC;
        X_GEN_TAC `t':real^1` THEN
        REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN STRIP_TAC THEN
        CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
        REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL] THEN
        ASM_REAL_ARITH_TAC;
        REWRITE_TAC[CONNECTED_INTERVAL];
        REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN REAL_ARITH_TAC;
        GEN_REWRITE_TAC LAND_CONV [GSYM pathstart] THEN
        ASM_REWRITE_TAC[] THEN
        SUBST1_TAC(SYM(ASSUME `pathstart h:real^M = a`)) THEN
        REWRITE_TAC[pathstart] THEN AP_TERM_TAC THEN
        REWRITE_TAC[VECTOR_MUL_RZERO];
        REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
        ASM_REAL_ARITH_TAC];
      FIRST_ASSUM(MP_TAC o
        ISPECL [`(f:real^P->real^N) o reversepath(g':real^1->real^P) o
                 (\t. &2 % t - vec 1)`;
                `q':real^1->real^M`;
                `reversepath(h':real^1->real^M) o (\t. &2 % t - vec 1)`;
                `{t | &1 / &2 < drop t /\ drop t <= &1}`;
                `vec 1:real^1`; `t:real^1`] o
        MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN
      REWRITE_TAC[o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN
      REPEAT CONJ_TAC THENL
       [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
        EXISTS_TAC `(f:real^P->real^N) o (g ++ reversepath g')` THEN
        CONJ_TAC THENL
         [SIMP_TAC[IN_ELIM_THM; GSYM REAL_NOT_LE; joinpaths; o_THM];
          ALL_TAC] THEN
        MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
        EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL
         [ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_PATH; path];
          REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
          REAL_ARITH_TAC];
        MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC
         `path_image ((f:real^P->real^N) o (g ++ reversepath g'))` THEN
        CONJ_TAC THENL[ALL_TAC; ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_SUBSET]] THEN
        REWRITE_TAC[path_image] THEN MATCH_MP_TAC(SET_RULE
         `(!x. x IN s ==> f x = g x) /\ s SUBSET t
          ==> IMAGE f s SUBSET IMAGE g t`) THEN
        SIMP_TAC[IN_ELIM_THM; GSYM REAL_NOT_LE; joinpaths; o_THM] THEN
        REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
        REAL_ARITH_TAC;
        MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
        EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
        ASM_REWRITE_TAC[GSYM path] THEN
        REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
        REAL_ARITH_TAC;
        MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC
         `path_image(q':real^1->real^M)` THEN
        ASM_REWRITE_TAC[] THEN REWRITE_TAC[path_image] THEN
        MATCH_MP_TAC IMAGE_SUBSET THEN
        REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN
        REAL_ARITH_TAC;
        X_GEN_TAC `t':real^1` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
        FIRST_X_ASSUM(fun th ->
         W(MP_TAC o PART_MATCH (lhand o rand) th o rand o snd)) THEN
        ASM_SIMP_TAC[IN_INTERVAL_1; joinpaths; DROP_VEC; GSYM REAL_NOT_LT] THEN
        ANTS_TAC THENL [ASM_REAL_ARITH_TAC; SIMP_TAC[]];
        MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
        SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID;
                 CONTINUOUS_ON_CONST] THEN
        MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
        EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
        ASM_SIMP_TAC[GSYM path; PATH_REVERSEPATH] THEN
        REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
        REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN
        REAL_ARITH_TAC;
        MATCH_MP_TAC SUBSET_TRANS THEN
        EXISTS_TAC `path_image(reversepath h':real^1->real^M)` THEN
        CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[PATH_IMAGE_REVERSEPATH]] THEN
        REWRITE_TAC[path_image; IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
        REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
        REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN
        REAL_ARITH_TAC;
        X_GEN_TAC `t':real^1` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
        REWRITE_TAC[reversepath] THEN CONV_TAC SYM_CONV THEN
        FIRST_X_ASSUM MATCH_MP_TAC THEN
        REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; DROP_CMUL] THEN
        ASM_REAL_ARITH_TAC;
        REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_1] THEN
        REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC;
        REWRITE_TAC[IN_ELIM_THM; DROP_VEC] THEN REAL_ARITH_TAC;
        GEN_REWRITE_TAC LAND_CONV [GSYM pathfinish] THEN
        ASM_REWRITE_TAC[reversepath] THEN
        SUBST1_TAC(SYM(ASSUME `pathstart h':real^M = a`)) THEN
        REWRITE_TAC[pathstart] THEN AP_TERM_TAC THEN
        REWRITE_TAC[GSYM DROP_EQ; DROP_SUB; DROP_CMUL; DROP_VEC] THEN
        REAL_ARITH_TAC;
        REWRITE_TAC[IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC]];
    ALL_TAC] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^P->real^M` THEN
  DISCH_THEN(LABEL_TAC "+") THEN
  MATCH_MP_TAC(TAUT `(q ==> p) /\ q ==> p /\ q`) THEN REPEAT CONJ_TAC THENL
   [STRIP_TAC;
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
    X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
    REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
    ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE; SUBSET];
    FIRST_ASSUM(MP_TAC o SPECL
     [`z:real^P`; `linepath(z:real^P,z)`; `linepath(a:real^M,a)`]) THEN
    REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN
    REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
    ASM_SIMP_TAC[LINEPATH_REFL; SING_SUBSET];
    X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN
    REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`g:real^1->real^P`; `h:real^1->real^M`] THEN
    STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
     [`y:real^P`; `g:real^1->real^P`; `h:real^1->real^M`]) THEN
    ASM_MESON_TAC[pathfinish; ENDS_IN_UNIT_INTERVAL]] THEN
  FIRST_ASSUM(fun th ->
   GEN_REWRITE_TAC I [MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) THEN
  X_GEN_TAC `n:real^M->bool` THEN DISCH_TAC THEN
  ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `y:real^P` THEN
  REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
  FIRST_ASSUM(MP_TAC o SPEC `(f:real^P->real^N) y` o last o CONJUNCTS o
        GEN_REWRITE_RULE I [covering_space]) THEN
  ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool` MP_TAC) THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` MP_TAC) THEN
  ONCE_REWRITE_TAC[IMP_CONJ] THEN
  GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN
  DISCH_THEN(MP_TAC o SPEC `(l:real^P->real^M) y`) THEN
  MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN
  CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN
  DISCH_THEN(X_CHOOSE_THEN `w':real^M->bool` STRIP_ASSUME_TAC) THEN
  DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `w':real^M->bool`) MP_TAC) THEN
  DISCH_THEN(MP_TAC o SPEC `w':real^M->bool` o CONJUNCT2) THEN
  ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `p':real^N->real^M`) THEN
  DISCH_TAC THEN UNDISCH_THEN `(w':real^M->bool) IN vv` (K ALL_TAC) THEN
  SUBGOAL_THEN
   `?v. y IN v /\ y IN u /\ IMAGE (f:real^P->real^N) v SUBSET w /\
        v SUBSET u /\ path_connected v /\ open_in (subtopology euclidean u) v`
  STRIP_ASSUME_TAC THENL
   [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_PATH_CONNECTED]) THEN
    DISCH_THEN(MP_TAC o SPECL
     [`{x | x IN u /\ (f:real^P->real^N) x IN w}`; `y:real^P`]) THEN
    ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]] THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
    EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[];
    ALL_TAC] THEN
  FIRST_X_ASSUM(STRIP_ASSUME_TAC o
   GEN_REWRITE_RULE I [homeomorphism]) THEN
  SUBGOAL_THEN `(w':real^M->bool) SUBSET c /\ (w:real^N->bool) SUBSET s`
  STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[open_in]; ALL_TAC] THEN
  EXISTS_TAC
   `v INTER
    {x | x IN u /\ (f:real^P->real^N) x IN
                   {x | x IN w /\ (p':real^N->real^M) x IN w' INTER n}}` THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC OPEN_IN_INTER THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
    EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `w:real^N->bool` THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
    EXISTS_TAC `w':real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN
    UNDISCH_TAC `open_in (subtopology euclidean c) (n:real^M->bool)` THEN
    REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[];
    ASM SET_TAC[];
    ALL_TAC] THEN
  SIMP_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN
  X_GEN_TAC `y':real^P` THEN STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
  DISCH_THEN(MP_TAC o SPECL [`y:real^P`; `y':real^P`]) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `r:real^1->real^P` STRIP_ASSUME_TAC) THEN
  REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`pp:real^1->real^P`; `qq:real^1->real^M`] THEN
  STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o SPECL
   [`y':real^P`; `(pp:real^1->real^P) ++ r`;
    `(qq:real^1->real^M) ++ ((p':real^N->real^M) o (f:real^P->real^N) o
                            (r:real^1->real^P))`]) THEN
  FIRST_X_ASSUM(MP_TAC o SPECL
   [`y:real^P`; `pp:real^1->real^P`; `qq:real^1->real^M`]) THEN
  ASM_SIMP_TAC[o_THM; PATHSTART_JOIN; PATHFINISH_JOIN] THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `path_image ((pp:real^1->real^P) ++ r) SUBSET u`
  ASSUME_TAC THENL
   [MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN ASM SET_TAC[]; ALL_TAC] THEN
  ANTS_TAC THENL
   [ALL_TAC;
    ASM_REWRITE_TAC[PATHFINISH_COMPOSE] THEN ASM_MESON_TAC[]] THEN
  REPEAT CONJ_TAC THENL
   [ASM_SIMP_TAC[PATH_JOIN];
    ASM_SIMP_TAC[SUBSET_PATH_IMAGE_JOIN];
    MATCH_MP_TAC PATH_JOIN_IMP THEN ASM_SIMP_TAC[PATHSTART_COMPOSE] THEN
    CONJ_TAC THENL
     [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
      CONJ_TAC THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
             CONTINUOUS_ON_SUBSET)) THEN
      ASM SET_TAC[];
      REWRITE_TAC[pathfinish] THEN ASM SET_TAC[]];
    MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN ASM_SIMP_TAC[] THEN
    REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN ASM SET_TAC[];
    X_GEN_TAC `tt:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN
    STRIP_TAC THEN REWRITE_TAC[joinpaths; o_THM] THEN COND_CASES_TAC THEN
    ASM_REWRITE_TAC[] THENL
     [ABBREV_TAC `t:real^1 = &2 % tt`;
      ABBREV_TAC `t:real^1 = &2 % tt - vec 1`] THEN
    (SUBGOAL_THEN `t IN interval[vec 0:real^1,vec 1]` ASSUME_TAC THENL
      [EXPAND_TAC "t" THEN
       REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN
       ASM_REAL_ARITH_TAC;
       ALL_TAC]) THEN
    ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
    RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN ASM SET_TAC[]]);;

let COVERING_SPACE_LIFT_STRONGER = prove
 (`!p:real^M->real^N c s f:real^P->real^N u a z.
        covering_space (c,p) s /\ a IN c /\ z IN u /\
        path_connected u /\ locally path_connected u /\
        f continuous_on u /\ IMAGE f u SUBSET s /\ f z = p a /\
        (!r. path r /\ path_image r SUBSET u /\
             pathstart r = z /\ pathfinish r = z
             ==> ?b. homotopic_paths s (f o r) (linepath(b,b)))
        ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ g z = a /\
                (!y. y IN u ==> p(g y) = f y)`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        COVERING_SPACE_LIFT_GENERAL)) THEN ASM_REWRITE_TAC[] THEN
  X_GEN_TAC `r:real^1->real^P` THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC  `r:real^1->real^P`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_TAC `b:real^N`) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN
  ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHSTART_LINEPATH] THEN
  DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
  EXISTS_TAC `linepath(a:real^M,a)` THEN
  REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
  ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[o_DEF; LINEPATH_REFL]) THEN
  ASM_REWRITE_TAC[o_DEF; LINEPATH_REFL]);;

let COVERING_SPACE_LIFT_STRONG = prove
 (`!p:real^M->real^N c s f:real^P->real^N u a z.
        covering_space (c,p) s /\ a IN c /\ z IN u /\
        simply_connected u /\ locally path_connected u /\
        f continuous_on u /\ IMAGE f u SUBSET s /\ f z = p a
        ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ g z = a /\
                (!y. y IN u ==> p(g y) = f y)`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        COVERING_SPACE_LIFT_STRONGER)) THEN
  ASM_SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED] THEN
  X_GEN_TAC `r:real^1->real^P` THEN STRIP_TAC THEN
  EXISTS_TAC `(f:real^P->real^N) z` THEN
  SUBGOAL_THEN
   `linepath(f z,f z) = (f:real^P->real^N) o linepath(z,z)`
  SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LINEPATH_REFL]; ALL_TAC] THEN
  MATCH_MP_TAC HOMOTOPIC_PATHS_CONTINUOUS_IMAGE THEN
  EXISTS_TAC `u:real^P->bool` THEN ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I
   [SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS]) THEN
  ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN
  ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET]);;

let COVERING_SPACE_LIFT = prove
 (`!p:real^M->real^N c s f:real^P->real^N u.
        covering_space (c,p) s /\
        simply_connected u /\ locally path_connected u /\
        f continuous_on u /\ IMAGE f u SUBSET s
        ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\
                (!y. y IN u ==> p(g y) = f y)`,
  MP_TAC COVERING_SPACE_LIFT_STRONG THEN
  REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
  DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th THEN ASM_REWRITE_TAC[]) THEN
  ASM_CASES_TAC `u:real^P->bool = {}` THEN
  ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET;
                  NOT_IN_EMPTY] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
  DISCH_THEN(X_CHOOSE_TAC `a:real^P`) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
  GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN
  DISCH_THEN(MP_TAC o SPEC `(f:real^P->real^N) a`) THEN
  MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN
  CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_IMAGE]] THEN
  ASM_MESON_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Some additional lemmas about covering spaces.                             *)
(* ------------------------------------------------------------------------- *)

let CARD_EQ_COVERING_MAP_FIBRES = prove
 (`!p:real^M->real^N c s a b.
        covering_space (c,p) s /\ path_connected s /\ a IN s /\ b IN s
        ==> {x | x IN c /\ p(x) = a} =_c {x | x IN c /\ p(x) = b}`,
  REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
  REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN
  REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN
  REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; FORALL_AND_THM;
              TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN
  GEN_REWRITE_TAC (LAND_CONV o funpow 2 BINDER_CONV o LAND_CONV)
   [CONJ_SYM] THEN
  MATCH_MP_TAC(MESON[]
   `(!a b. P a b) ==> (!a b. P a b) /\ (!a b. P b a)`) THEN
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`] o
    GEN_REWRITE_RULE I [path_connected]) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `g:real^1->real^N` THEN STRIP_TAC THEN
  SUBGOAL_THEN
   `!z. ?h. z IN c /\ p z = a
            ==> path h /\ path_image h SUBSET c /\ pathstart h = z /\
                !t. t IN interval[vec 0,vec 1]
                    ==> (p:real^M->real^N)(h t) = g t`
  MP_TAC THENL
   [REWRITE_TAC[RIGHT_EXISTS_IMP_THM] THEN
    REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_LIFT_PATH_STRONG THEN
    REWRITE_TAC[ETA_AX] THEN ASM_MESON_TAC[];
    REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `h:real^M->real^1->real^M` THEN DISCH_TAC] THEN
  REWRITE_TAC[le_c; IN_ELIM_THM] THEN
  EXISTS_TAC `\z. pathfinish((h:real^M->real^1->real^M) z)` THEN
  ASM_REWRITE_TAC[pathfinish] THEN CONJ_TAC THENL
   [X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN
    ASM_REWRITE_TAC[SUBSET; path_image; pathstart; FORALL_IN_IMAGE] THEN
    ASM_MESON_TAC[pathfinish; ENDS_IN_UNIT_INTERVAL];
    MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN
    MP_TAC(ISPECL
     [`p:real^M->real^N`; `c:real^M->bool`; `s:real^N->bool`;
      `reversepath(g:real^1->real^N)`; `reversepath(g:real^1->real^N)`;
      `reversepath((h:real^M->real^1->real^M) x)`;
      `reversepath((h:real^M->real^1->real^M) y)`]
    COVERING_SPACE_MONODROMY) THEN
    ASM_SIMP_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH] THEN
    DISCH_THEN MATCH_MP_TAC THEN
    ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH;
                 HOMOTOPIC_PATHS_REFL] THEN
    ASM_REWRITE_TAC[pathfinish; reversepath; IN_INTERVAL_1; DROP_VEC] THEN
    REPEAT STRIP_TAC THENL
     [FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`);
      FIRST_X_ASSUM(MP_TAC o SPEC `y:real^M`)] THEN
    ASM_REWRITE_TAC[] THEN DISCH_THEN(MATCH_MP_TAC o last o CONJUNCTS) THEN
    REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN ASM_REAL_ARITH_TAC]);;

let COVERING_SPACE_INJECTIVE = prove
 (`!p:real^M->real^N c s.
        covering_space (c,p) s /\ path_connected c /\ simply_connected s
        ==> (!x y. x IN c /\ y IN c /\ p x = p y ==> x = y)`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_CONTINUOUS) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
  DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `y:real^M`]) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC) THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        COVERING_SPACE_LIFT_PATH_STRONG)) THEN
  GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN
  DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(fun th ->
    MP_TAC(SPEC `(p:real^M->real^N) o (g:real^1->real^M)` th) THEN
    MP_TAC(SPEC `(p:real^M->real^N) o linepath(x:real^M,x)` th)) THEN
  SUBGOAL_THEN
   `(path ((p:real^M->real^N) o linepath(x,x)) /\
     path (p o g)) /\
    (path_image (p o linepath(x:real^M,x)) SUBSET s /\
     path_image (p o g) SUBSET s)`
  STRIP_ASSUME_TAC THENL
   [CONJ_TAC THENL
     [CONJ_TAC THEN MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN
      REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH] THEN
      ASM_REWRITE_TAC[CONTINUOUS_ON_SING; SEGMENT_REFL] THEN
      ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
      REWRITE_TAC[PATH_IMAGE_COMPOSE; PATH_IMAGE_LINEPATH] THEN
      REWRITE_TAC[SEGMENT_REFL] THEN ASM SET_TAC[]];
    ALL_TAC] THEN
  ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHSTART_LINEPATH] THEN
  DISCH_THEN(X_CHOOSE_THEN `h1:real^1->real^M` STRIP_ASSUME_TAC) THEN
  DISCH_THEN(X_CHOOSE_THEN `h2:real^1->real^M` STRIP_ASSUME_TAC) THEN
  FIRST_ASSUM(MP_TAC o
    SPECL [`(p:real^M->real^N) o linepath(x:real^M,x)`;
           `(p:real^M->real^N) o (g:real^1->real^M)`;
           `h1:real^1->real^M`; `h2:real^1->real^M`] o
  MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        COVERING_SPACE_MONODROMY)) THEN
  ASM_SIMP_TAC[] THEN ANTS_TAC THENL
   [FIRST_X_ASSUM(MATCH_MP_TAC o CONJUNCT2 o
        GEN_REWRITE_RULE I [SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS]) THEN
    ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN
    ASM_REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH];
    ALL_TAC] THEN
  MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL
   [MATCH_MP_TAC EQ_TRANS THEN
    EXISTS_TAC `pathfinish(linepath(x:real^M,x))` THEN
    CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[PATHFINISH_LINEPATH]];
    FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th])] THEN
  REWRITE_TAC[pathfinish] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        COVERING_SPACE_LIFT_UNIQUE))
  THENL
   [EXISTS_TAC `(p:real^M->real^N) o (h1:real^1->real^M)`;
    EXISTS_TAC `(p:real^M->real^N) o (h2:real^1->real^M)`] THEN
  MAP_EVERY EXISTS_TAC [`interval[vec 0:real^1,vec 1]`; `vec 0:real^1`] THEN
  REWRITE_TAC[CONNECTED_INTERVAL; ENDS_IN_UNIT_INTERVAL] THEN
  ASM_REWRITE_TAC[GSYM path; PATH_LINEPATH; GSYM path_image] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[o_THM]) THEN ASM_REWRITE_TAC[o_THM] THEN
  ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[pathstart]) THEN
  ASM_REWRITE_TAC[LINEPATH_REFL; PATH_IMAGE_COMPOSE] THEN
  (CONJ_TAC THENL
    [ASM_MESON_TAC[PATH_CONTINUOUS_IMAGE; CONTINUOUS_ON_SUBSET];
     ASM SET_TAC[]]));;

let COVERING_SPACE_HOMEOMORPHISM = prove
 (`!p:real^M->real^N c s.
        covering_space (c,p) s /\ path_connected c /\ simply_connected s
        ==> ?q. homeomorphism (c,s) (p,q)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN
  REPEAT CONJ_TAC THENL
   [ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS];
    ASM_MESON_TAC[COVERING_SPACE_IMP_SURJECTIVE];
    ASM_MESON_TAC[COVERING_SPACE_INJECTIVE];
    ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP]]);;

(* ------------------------------------------------------------------------- *)
(* Results on finiteness of the number of sheets in a covering space.        *)
(* ------------------------------------------------------------------------- *)

let COVERING_SPACE_FIBRE_NO_LIMPT = prove
 (`!p:real^M->real^N c s a b.
        covering_space (c,p) s /\ a IN c
        ==> ~(a limit_point_of {x | x IN c /\ p x = b})`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [covering_space]) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^M->real^N) a`) THEN
  ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` MP_TAC) THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` MP_TAC) THEN
  GEN_REWRITE_TAC I [IMP_CONJ] THEN
  REWRITE_TAC[EXTENSION; IN_UNIONS; IN_ELIM_THM] THEN
  DISCH_THEN(MP_TAC o SPEC `a:real^M`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN
  STRIP_TAC THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `t:real^M->bool`)) THEN
  ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN
  FIRST_X_ASSUM(X_CHOOSE_THEN `q:real^N->real^M` MP_TAC) THEN
  REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN
  UNDISCH_TAC `open_in (subtopology euclidean c) (t:real^M->bool)` THEN
  REWRITE_TAC[OPEN_IN_OPEN] THEN
  DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `v:real^M->bool` o
        GEN_REWRITE_RULE I [LIMPT_INFINITE_OPEN]) THEN
  ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[INFINITE]] THEN
  MATCH_MP_TAC(MESON[FINITE_SING; FINITE_SUBSET]
   `(?a. s SUBSET {a}) ==> FINITE s`) THEN
  ASM SET_TAC[]);;

let COVERING_SPACE_COUNTABLE_SHEETS = prove
 (`!p:real^M->real^N c s b.
        covering_space (c,p) s ==> COUNTABLE {x | x IN c /\ p x = b}`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC(REWRITE_RULE[] (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM]
        UNCOUNTABLE_CONTAINS_LIMIT_POINT)) THEN
  REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[COVERING_SPACE_FIBRE_NO_LIMPT]);;

let COVERING_SPACE_FINITE_EQ_COMPACT_FIBRE = prove
 (`!p:real^M->real^N c s b.
        covering_space (c,p) s
        ==> (FINITE {x | x IN c /\ p x = b} <=>
             compact {x | x IN c /\ p x = b})`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[FINITE_IMP_COMPACT] THEN
  DISCH_TAC THEN ASM_CASES_TAC `(b:real^N) IN s` THENL
   [ONCE_REWRITE_TAC[TAUT `p <=> (~p ==> F)`] THEN DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o
     SPEC `{x | x IN c /\ (p:real^M->real^N) x = b}` o
     GEN_REWRITE_RULE I [COMPACT_EQ_BOLZANO_WEIERSTRASS]) THEN
    ASM_REWRITE_TAC[INFINITE; SUBSET_REFL; IN_ELIM_THM] THEN
    DISCH_THEN(X_CHOOSE_THEN `a:real^M` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^M`; `b:real^N`] o
       MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        COVERING_SPACE_FIBRE_NO_LIMPT)) THEN
    ASM_REWRITE_TAC[];
    SUBGOAL_THEN `{x  | x IN c /\ (p:real^M->real^N) x = b} = {}`
     (fun th -> REWRITE_TAC[th; FINITE_EMPTY]) THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
    ASM SET_TAC[]]);;

let COVERING_SPACE_CLOSED_MAP = prove
 (`!p:real^M->real^N c s t.
        covering_space (c,p) s /\
        (!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) /\
        closed_in (subtopology euclidean c) t
        ==> closed_in (subtopology euclidean s) (IMAGE p t)`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
  REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN CONJ_TAC THENL
   [ASM SET_TAC[]; ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN]] THEN
  X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o SPEC `y:real^N` o last o CONJUNCTS o
    GEN_REWRITE_RULE I [covering_space]) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `v:real^N->bool` THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN
  DISCH_TAC THEN
  DISCH_THEN(X_CHOOSE_THEN `uu:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
  ASM_CASES_TAC `uu:(real^M->bool)->bool = {}` THENL
   [ASM_REWRITE_TAC[UNIONS_0; NOT_IN_EMPTY] THEN ASM SET_TAC[]; ALL_TAC] THEN
  EXISTS_TAC `INTERS {IMAGE (p:real^M->real^N) (u DIFF t) | u IN uu}` THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC OPEN_IN_INTERS THEN
    ASM_REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC FINITE_IMAGE THEN
      SUBGOAL_THEN
       `!u. u IN uu ==> ?x. x IN u /\ (p:real^M->real^N) x = y`
      ASSUME_TAC THENL
       [RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
        ALL_TAC] THEN
      SUBGOAL_THEN
       `FINITE (IMAGE (\u. @x. x IN u /\ (p:real^M->real^N) x = y) uu)`
      MP_TAC THENL
       [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          FINITE_SUBSET)) THEN ASM SET_TAC[];
        MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC FINITE_IMAGE_INJ_EQ THEN
        FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
        REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN ASM SET_TAC[]];
      X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN
      MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `v:real^N->bool` THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
      ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `u:real^M->bool` THEN
      ASM_SIMP_TAC[LEFT_EXISTS_AND_THM] THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN
      DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC) THEN
      ASM_REWRITE_TAC[OPEN_IN_OPEN] THEN
      EXISTS_TAC `(:real^M) DIFF k` THEN
      ASM_REWRITE_TAC[GSYM closed] THEN ASM SET_TAC[]];
    REWRITE_TAC[IN_INTERS; FORALL_IN_GSPEC] THEN
    X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`)) THEN
    ASM_REWRITE_TAC[homeomorphism] THEN ASM SET_TAC[];
    REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_DIFF; IN_ELIM_THM] THEN
    X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN
    CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_IMAGE]] THEN
    DISCH_THEN(X_CHOOSE_THEN `w:real^M` STRIP_ASSUME_TAC) THEN
    FIRST_X_ASSUM SUBST_ALL_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN
    DISCH_THEN(MP_TAC o SPEC `w:real^M`) THEN
    REWRITE_TAC[IN_ELIM_THM] THEN
    MATCH_MP_TAC(TAUT `q /\ r /\ ~s ==> ~(s <=> q /\ r)`) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN
    REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
    REWRITE_TAC[IN_UNIONS] THEN ASM SET_TAC[]]);;

let COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP_STRONG = prove
 (`!p:real^M->real^N c s.
        covering_space (c,p) s /\ (!b. b IN s ==> b limit_point_of s)
        ==> ((!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) <=>
             (!t. closed_in (subtopology euclidean c) t
                  ==> closed_in (subtopology euclidean s) (IMAGE p t)))`,
  let lemma = prove
   (`!f:num->real^N.
          (!n. ~(s = v n) ==> DISJOINT s (v n))
          ==> (!n. f n IN v n) /\
              (!m n. v m = v n <=> m = n)
              ==> ?n. IMAGE f (:num) INTER s SUBSET {f n}`,
    ASM_CASES_TAC `?n. s = (v:num->real^N->bool) n` THENL
     [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th ->
        MP_TAC th THEN MATCH_MP_TAC MONO_EXISTS);
      RULE_ASSUM_TAC(REWRITE_RULE[NOT_EXISTS_THM]) THEN
      ASM_REWRITE_TAC[]] THEN
    ASM SET_TAC[]) in
  REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
   [MATCH_MP_TAC COVERING_SPACE_CLOSED_MAP THEN
    EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[];
    ALL_TAC] THEN
  REWRITE_TAC[MESON[INFINITE] `FINITE s <=> ~INFINITE s`] THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o SPEC `b:real^N` o last o CONJUNCTS o
    GEN_REWRITE_RULE I [covering_space]) THEN
  ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `t:real^N->bool` THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN `(b:real^N) limit_point_of t` MP_TAC THENL
   [MATCH_MP_TAC LIMPT_OF_OPEN_IN THEN ASM_MESON_TAC[];
    PURE_REWRITE_TAC[LIMPT_SEQUENTIAL_INJ]] THEN
  DISCH_THEN(X_CHOOSE_THEN `y:num->real^N` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN `INFINITE(vv:(real^M->bool)->bool)` MP_TAC THENL
   [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CARD_LE_INFINITE)) THEN REWRITE_TAC[le_c] THEN
    SUBGOAL_THEN
      `!x. ?v. x IN c /\ (p:real^M->real^N) x = b ==> v IN vv /\ x IN v`
    MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[SKOLEM_THM]] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^M->bool` THEN
    REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN CONJ_TAC THENL
     [ASM SET_TAC[]; ALL_TAC] THEN
    MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(fun th ->
      MP_TAC(SPEC `x:real^M` th) THEN MP_TAC(SPEC `y:real^M` th)) THEN
    ASM_REWRITE_TAC[] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
    ALL_TAC] THEN
  REWRITE_TAC[INFINITE_CARD_LE; le_c; INJECTIVE_ON_ALT] THEN
  REWRITE_TAC[IN_UNIV] THEN
  DISCH_THEN(X_CHOOSE_THEN `v:num->real^M->bool` STRIP_ASSUME_TAC) THEN
  UNDISCH_THEN
    `!u. u IN vv ==> ?q:real^N->real^M. homeomorphism (u,t) (p,q)`
    (MP_TAC o GEN `n:num` o SPEC `(v:num->real^M->bool) n`) THEN
  ASM_REWRITE_TAC[SKOLEM_THM; homeomorphism; FORALL_AND_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN `q:num->real^N->real^M` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN
   `closed_in (subtopology euclidean s)
              (IMAGE (p:real^M->real^N) (IMAGE (\n. q n (y n:real^N)) (:num)))`
  MP_TAC THENL
   [FIRST_X_ASSUM MATCH_MP_TAC THEN
    REWRITE_TAC[CLOSED_IN_LIMPT; SUBSET; FORALL_IN_IMAGE] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `a:real^M`] THEN STRIP_TAC THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP LIMPT_OF_SEQUENCE_SUBSEQUENCE) THEN
    DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN
    SUBGOAL_THEN `(p:real^M->real^N) a = b` ASSUME_TAC THENL
     [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
      EXISTS_TAC
       `(p:real^M->real^N) o (\n:num. q n (y n :real^N)) o (r:num->num)` THEN
      REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL
       [MATCH_MP_TAC(GEN_ALL(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP]
        (fst(EQ_IMP_RULE(SPEC_ALL CONTINUOUS_ON_SEQUENTIALLY))))) THEN
        EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
         [ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS];
          REWRITE_TAC[o_DEF] THEN ASM SET_TAC[]];
        REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC LIM_SUBSEQUENCE THEN
        ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
         (REWRITE_RULE[IMP_CONJ_ALT] LIM_TRANSFORM_EVENTUALLY)) THEN
        MATCH_MP_TAC ALWAYS_EVENTUALLY THEN REWRITE_TAC[o_DEF] THEN
        ASM SET_TAC[]];
      SUBGOAL_THEN `?u. u IN vv /\ (a:real^M) IN u` STRIP_ASSUME_TAC THENL
       [ASM SET_TAC[]; ALL_TAC] THEN
      SUBGOAL_THEN `?w:real^M->bool. open w /\ u = c INTER w`
       (CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC))
      THENL [ASM_MESON_TAC[OPEN_IN_OPEN]; ALL_TAC] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_INTER]) THEN
      FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_INFINITE_OPEN]) THEN
      DISCH_THEN(MP_TAC o SPEC `w:real^M->bool`) THEN
      ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[]
       `INFINITE s ==> !k. s INTER k = s ==> INFINITE(s INTER k)`)) THEN
      DISCH_THEN(MP_TAC o SPEC `c:real^M->bool`) THEN ANTS_TAC THENL
       [ASM SET_TAC[]; REWRITE_TAC[INTER_ASSOC]] THEN
      ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
      REWRITE_TAC[INFINITE] THEN DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
      DISCH_THEN(MP_TAC o SPEC `c INTER w:real^M->bool`) THEN
      ASM_REWRITE_TAC[] THEN
      DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `(v:num->real^M->bool) n`) THEN
      ASM_REWRITE_TAC[] THEN
      DISCH_THEN(MP_TAC o SPEC `\n. (q:num->real^N->real^M) n (y n)` o
        MATCH_MP lemma) THEN
      ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      MESON_TAC[FINITE_SUBSET; FINITE_SING; INTER_COMM]];
    SUBGOAL_THEN
     `IMAGE (p:real^M->real^N) (IMAGE (\n. q n (y n:real^N)) (:num)) =
      IMAGE y (:num)`
    SUBST1_TAC THENL
     [REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN ASM SET_TAC[]; ALL_TAC] THEN
    REWRITE_TAC[CLOSED_IN_LIMPT] THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `b:real^N`)) THEN
    ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    REWRITE_TAC[LIMPT_SEQUENTIAL_INJ] THEN
    EXISTS_TAC `y:num->real^N` THEN ASM SET_TAC[]]);;

let COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP = prove
 (`!p:real^M->real^N c s.
        covering_space (c,p) s /\ connected s /\ ~(?a. s = {a})
        ==> ((!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) <=>
             (!t. closed_in (subtopology euclidean c) t
                  ==> closed_in (subtopology euclidean s) (IMAGE p t)))`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL
   [SUBGOAL_THEN `c:real^M->bool = {}` ASSUME_TAC THENL
     [FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
      ASM_REWRITE_TAC[IMAGE_EQ_EMPTY];
      ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_EMPTY; CLOSED_IN_SUBTOPOLOGY_EMPTY;
                      IMAGE_EQ_EMPTY; NOT_IN_EMPTY]];
    MATCH_MP_TAC COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP_STRONG THEN
    ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
    MATCH_MP_TAC CONNECTED_IMP_PERFECT THEN ASM SET_TAC[]]);;

let COVERING_SPACE_FINITE_SHEETS_EQ_PROPER_MAP = prove
 (`!p:real^M->real^N c s.
        covering_space (c,p) s
        ==> ((!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) <=>
             (!k. k SUBSET s /\ compact k
                  ==> compact {x | x IN c /\ p(x) IN k}))`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
  DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN
  DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP PROPER_MAP th]) THEN
  FIRST_ASSUM(fun th -> REWRITE_TAC
   [GSYM(MATCH_MP COVERING_SPACE_FINITE_EQ_COMPACT_FIBRE th)]) THEN
  REWRITE_TAC[TAUT `(p <=> q /\ p) <=> (p ==> q)`] THEN
  ASM_MESON_TAC[COVERING_SPACE_CLOSED_MAP]);;

(* ------------------------------------------------------------------------- *)
(* Special cases where one or both of the sets is compact.                   *)
(* ------------------------------------------------------------------------- *)

let COVERING_SPACE_FINITE_SHEETS = prove
 (`!p:real^M->real^N c s b.
      covering_space (c,p) s /\ compact c ==> FINITE {x | x IN c /\ p x = b}`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC BOLZANO_WEIERSTRASS_CONTRAPOS THEN
  EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN
  ASM_MESON_TAC[COVERING_SPACE_FIBRE_NO_LIMPT]);;

let COVERING_SPACE_COMPACT = prove
 (`!p:real^M->real^N c s.
        covering_space (c,p) s
        ==> (compact c <=>
             compact s /\ (!b. b IN s ==> FINITE {x | x IN c /\ p x = b}))`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
   [ASM_MESON_TAC[covering_space; COMPACT_CONTINUOUS_IMAGE];
    MATCH_MP_TAC COVERING_SPACE_FINITE_SHEETS THEN ASM_MESON_TAC[];
    FIRST_ASSUM(MP_TAC o
      MATCH_MP COVERING_SPACE_FINITE_SHEETS_EQ_PROPER_MAP) THEN
    ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN
    ASM_REWRITE_TAC[SUBSET_REFL] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
    SET_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* A proper (or closed) local homeomorphism is in fact a covering map.       *)
(* ------------------------------------------------------------------------- *)

let PROPER_LOCAL_HOMEOMORPHISM_IMP_COVERING_MAP = prove
 (`!p:real^M->real^N c s.
        IMAGE p c = s /\
        (!k. k SUBSET s /\ compact k ==> compact {x | x IN c /\ p x IN k}) /\
        (!x. x IN c
             ==> ?t u q. x IN t /\
                         open_in (subtopology euclidean c) t /\
                         open_in (subtopology euclidean s) u /\
                         homeomorphism (t,u) (p,q))
        ==> covering_space (c,p) s`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `(p:real^M->real^N) continuous_on c` ASSUME_TAC THENL
   [REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
    X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN
    UNDISCH_TAC `open_in (subtopology euclidean c) (t:real^M->bool)` THEN
    REWRITE_TAC[CONTINUOUS_WITHIN_OPEN; OPEN_IN_OPEN] THEN
    DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN
    X_GEN_TAC `w:real^N->bool` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN
    REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
    REWRITE_TAC[CONTINUOUS_WITHIN_OPEN] THEN
    DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(MP_TAC o SPEC `w:real^N->bool`) THEN
    ASM_REWRITE_TAC[IN_INTER] THEN
    DISCH_THEN(X_CHOOSE_THEN `y:real^M->bool` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `y INTER v:real^M->bool` THEN
    ASM_SIMP_TAC[OPEN_INTER; IN_INTER] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  ASM_REWRITE_TAC[covering_space] THEN
  SUBGOAL_THEN
   `!y. y IN s ==> FINITE {x | x IN c /\ (p:real^M->real^N) x = y}`
  ASSUME_TAC THENL
   [REPEAT STRIP_TAC THEN MATCH_MP_TAC BOLZANO_WEIERSTRASS_CONTRAPOS THEN
    EXISTS_TAC `{x | x IN c /\ (p:real^M->real^N) x = y}` THEN
    REWRITE_TAC[SUBSET_REFL; FORALL_IN_GSPEC] THEN CONJ_TAC THENL
     [ONCE_REWRITE_TAC[GSYM IN_SING] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      ASM_REWRITE_TAC[SING_SUBSET; COMPACT_SING];
      X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN
      ASM_REWRITE_TAC[limit_point_of; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY
      X_GEN_TAC [`t:real^M->bool`; `v:real^N->bool`; `q:real^N->real^M`] THEN
      DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
      DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
      REWRITE_TAC[OPEN_IN_OPEN] THEN
      DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool`
       (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN
      FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [IN_INTER]) THEN
      DISCH_THEN(MP_TAC o SPEC `u:real^M->bool`) THEN
      ASM_REWRITE_TAC[IN_ELIM_THM] THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN
      ASM SET_TAC[]];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `!y. y IN s
        ==> ?v uu. y IN v /\ open_in (subtopology euclidean s) v /\
                   pairwise DISJOINT (IMAGE uu {x | x IN c /\ p x = y}) /\
                   !x. x IN c /\ (p:real^M->real^N) x = y
                       ==> x IN uu x /\
                           open_in (subtopology euclidean c) (uu x) /\
                           ?q. homeomorphism (uu x,v) (p,q)`
  ASSUME_TAC THENL
   [X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
    SUBGOAL_THEN
     `?uu:real^M->real^M->bool vv:real^M->real^N->bool.
        pairwise DISJOINT (IMAGE uu {x | x IN c /\ p x = y}) /\
        !x. x IN c /\ (p:real^M->real^N) x = y
            ==> x IN uu x /\
                open_in (subtopology euclidean c) (uu x) /\
                open_in (subtopology euclidean s) (vv x) /\
                (?q. homeomorphism (uu x,vv x) (p,q))`
    STRIP_ASSUME_TAC THENL
     [MP_TAC(ISPEC `{x | x IN c /\ (p:real^M->real^N) x = y}`
        FINITE_EQ_BOUNDED_DISCRETE) THEN
      ASM_SIMP_TAC[IN_ELIM_THM] THEN
      DISCH_THEN(X_CHOOSE_THEN `r:real` MP_TAC o CONJUNCT2) THEN
      ONCE_REWRITE_TAC[TAUT
       `p /\ q /\ r ==> s <=> p /\ q /\ ~s ==> ~r`] THEN
      REWRITE_TAC[GSYM CONJ_ASSOC; REAL_NOT_LT] THEN STRIP_TAC THEN
      SUBGOAL_THEN
       `!x. x IN c /\ (p:real^M->real^N) x = y
            ==> ?u v. x IN u /\
                      open_in (subtopology euclidean c) u /\
                      open_in (subtopology euclidean s) v /\
                      ?q. homeomorphism (u,v) (p,q)`
      MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
      GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
      REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC
       [`uu:real^M->real^M->bool`; `vv:real^M->real^N->bool`] THEN
      DISCH_TAC THEN
      EXISTS_TAC `\x:real^M. ball(x,r / &2) INTER uu x` THEN
      EXISTS_TAC
       `\x. IMAGE (p:real^M->real^N) (ball(x,r / &2) INTER uu x)` THEN
      ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_HALF] THEN CONJ_TAC THENL
       [REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
        REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
        X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
        X_GEN_TAC `x':real^M` THEN STRIP_TAC THEN
        FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `x':real^M`]) THEN
        ASM_CASES_TAC `x':real^M = x` THEN ASM_REWRITE_TAC[] THEN
        MATCH_MP_TAC(SET_RULE
         `(!y. y IN s /\ y IN t ==> ~P)
          ==> P ==> Q ==> DISJOINT (s INTER s') (t INTER t')`) THEN
        REWRITE_TAC[IN_BALL] THEN CONV_TAC NORM_ARITH;
        ALL_TAC] THEN
      X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
      REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
      X_GEN_TAC `q:real^N->real^M` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
      REPEAT CONJ_TAC THENL
       [ASM_SIMP_TAC[OPEN_BALL;
                     ONCE_REWRITE_RULE[INTER_COMM]OPEN_IN_INTER_OPEN];
        MATCH_MP_TAC OPEN_IN_TRANS THEN
        EXISTS_TAC `(vv:real^M->real^N->bool) x` THEN
        ASM_REWRITE_TAC[] THEN
        FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
          HOMEOMORPHISM_IMP_OPEN_MAP)) THEN
        ONCE_REWRITE_TAC[INTER_COMM] THEN
        SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL];
        FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
          HOMEOMORPHISM_OF_SUBSETS)) THEN
        FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN
        SET_TAC[]];
      ALL_TAC] THEN
    ABBREV_TAC `v = INTERS (IMAGE (vv:real^M->real^N->bool)
                              {x | x IN c /\ (p:real^M->real^N) x = y})` THEN
    EXISTS_TAC `v:real^N->bool` THEN
    EXISTS_TAC `\x:real^M. {w | w IN uu x /\ (p:real^M->real^N) w IN v}` THEN
    REWRITE_TAC[] THEN
    MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
     [EXPAND_TAC "v" THEN REWRITE_TAC[INTERS_IMAGE; IN_ELIM_THM] THEN
      X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN
      ASM_REWRITE_TAC[HOMEOMORPHISM] THEN ASM SET_TAC[];
      DISCH_TAC] THEN
    MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
     [EXPAND_TAC "v" THEN MATCH_MP_TAC OPEN_IN_INTERS THEN
      ASM_SIMP_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_GSPEC;
                   FINITE_IMAGE] THEN
      ASM SET_TAC[];
      DISCH_TAC] THEN
    CONJ_TAC THENL
     [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
      REWRITE_TAC[pairwise; RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN
      REWRITE_TAC[FORALL_IN_IMAGE] THEN SET_TAC[];
      ALL_TAC] THEN
    X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN
    ASM_REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^N->real^M` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL
     [MATCH_MP_TAC OPEN_IN_TRANS THEN
      EXISTS_TAC `(uu:real^M->real^M->bool) x` THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
      EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
      REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
      CONJ_TAC THENL
       [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET));
        FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM])] THEN
      ASM SET_TAC[];
      FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
         HOMEOMORPHISM_OF_SUBSETS)) THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN
      REPEAT STRIP_TAC THENL [ASM SET_TAC[]; ASM SET_TAC[]; ALL_TAC] THEN
      REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN CONJ_TAC THENL
       [SET_TAC[]; ALL_TAC] THEN
      EXPAND_TAC "v" THEN REWRITE_TAC[INTERS_IMAGE; IN_ELIM_THM; SUBSET] THEN
      X_GEN_TAC `z:real^N` THEN DISCH_THEN(fun th ->
        MP_TAC th THEN MP_TAC(SPEC `x:real^M` th)) THEN
      ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE
       `z IN IMAGE p s /\ P z ==> z IN IMAGE p {x | x IN s /\ P(p x)}`) THEN
      ASM SET_TAC[]];
    ALL_TAC] THEN
  X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`)) THEN
  ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN
  FIRST_X_ASSUM(X_CHOOSE_THEN `v:real^N->bool` MP_TAC) THEN
  DISCH_THEN(X_CHOOSE_THEN `uu:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN
   `?w. y IN w /\ open_in (subtopology euclidean s) w /\ w SUBSET v /\
        {x | x IN c /\ (p:real^M->real^N) x IN w} SUBSET
        UNIONS (IMAGE uu {x | x IN c /\ p x = y})`
  MP_TAC THENL
   [SUBGOAL_THEN
     `?w. y IN w /\ open_in (subtopology euclidean s) w /\
          {x | x IN c /\ (p:real^M->real^N) x IN w} SUBSET
          UNIONS (IMAGE uu {x | x IN c /\ p x = y})`
    STRIP_ASSUME_TAC THENL
     [MATCH_MP_TAC(MESON[]
       `~(!w. P w /\ Q w ==> ~R w)
        ==> ?w. P w /\ Q w /\ R w`) THEN
      DISCH_THEN(MP_TAC o GEN `n:num` o SPEC
        `s INTER ball(y:real^N,inv(&n + &1))`) THEN
      SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; IN_INTER; CENTRE_IN_BALL] THEN
      ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
      REWRITE_TAC[UNIONS_IMAGE; SKOLEM_THM; SET_RULE
       `~(s SUBSET t) <=> ?x. x IN s /\ ~(x IN t)`] THEN
      REWRITE_TAC[IN_ELIM_THM; IN_BALL; FORALL_AND_THM] THEN
      REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(p /\ q) <=> p ==> ~q`] THEN
      X_GEN_TAC `z:num->real^M` THEN REPEAT STRIP_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC
       `y INSERT IMAGE ((p:real^M->real^N) o (z:num->real^M)) (:num)`) THEN
      REWRITE_TAC[NOT_IMP] THEN
      SUBGOAL_THEN
       `(((p:real^M->real^N) o (z:num->real^M)) --> y) sequentially`
      ASSUME_TAC THENL
       [REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN
        X_GEN_TAC `e:real` THEN DISCH_TAC THEN
        MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN
        ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
        X_GEN_TAC `N:num` THEN STRIP_TAC THEN EXISTS_TAC `N:num` THEN
        X_GEN_TAC `n:num` THEN DISCH_TAC THEN
        ONCE_REWRITE_TAC[DIST_SYM] THEN
        TRANS_TAC REAL_LTE_TRANS `inv(&n + &1)` THEN ASM_REWRITE_TAC[] THEN
        TRANS_TAC REAL_LE_TRANS `inv(&N)` THEN
        ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN
        MATCH_MP_TAC REAL_LE_INV2 THEN
        ASM_REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN
        ASM_ARITH_TAC;
        ALL_TAC] THEN
      CONJ_TAC THENL
       [ASM_REWRITE_TAC[SUBSET; FORALL_IN_INSERT; FORALL_IN_IMAGE; o_THM] THEN
        MATCH_MP_TAC COMPACT_SEQUENCE_WITH_LIMIT THEN ASM_REWRITE_TAC[];
        ALL_TAC] THEN
      REWRITE_TAC[compact] THEN DISCH_THEN(MP_TAC o SPEC `z:num->real^M`) THEN
      ASM_REWRITE_TAC[IN_ELIM_THM; NOT_IMP] THEN CONJ_TAC THENL
       [REWRITE_TAC[IN_INSERT; IN_IMAGE; o_DEF] THEN SET_TAC[]; ALL_TAC] THEN
      REWRITE_TAC[NOT_EXISTS_THM] THEN
      MAP_EVERY X_GEN_TAC [`x:real^M`; `r:num->num`] THEN STRIP_TAC THEN
      SUBGOAL_THEN `(p:real^M->real^N) x = y` ASSUME_TAC THENL
       [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
        EXISTS_TAC `(p:real^M->real^N) o (z:num->real^M) o (r:num->num)` THEN
        REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL
         [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
           [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN
          DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
          ASM_REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY] THEN
          DISCH_THEN(MP_TAC o SPEC `(z:num->real^M) o (r:num->num)`) THEN
          ASM_REWRITE_TAC[o_THM];
          REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC LIM_SUBSEQUENCE THEN
          ASM_REWRITE_TAC[]];
        FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPECL [`n:num`; `x:real^M`]) THEN
        ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
        REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`)) THEN
        ASM_REWRITE_TAC[] THEN
        REPEAT(DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN
        UNDISCH_TAC
         `open_in (subtopology euclidean c) ((uu:real^M->real^M->bool) x)` THEN
        REWRITE_TAC[open_in] THEN
        DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:real^M`)) THEN
        ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN
        X_GEN_TAC `e:real` THEN STRIP_TAC THEN
        UNDISCH_TAC
         `(((z:num->real^M) o (r:num->num)) --> x) sequentially` THEN
        REWRITE_TAC[LIM_SEQUENTIALLY] THEN
        DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[o_THM] THEN
        ASM_MESON_TAC[LE_REFL]];
      EXISTS_TAC `v INTER w:real^N->bool` THEN
      ASM_SIMP_TAC[IN_INTER; OPEN_IN_INTER; INTER_SUBSET] THEN ASM SET_TAC[]];
    ALL_TAC] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
  ASM_REWRITE_TAC[] THEN
  EXISTS_TAC
   `IMAGE (\x:real^M. {w | w IN uu x /\ (p:real^M->real^N) w IN t})
          {x | x IN c /\ p x = y}` THEN
  REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN REPEAT CONJ_TAC THENL
   [REWRITE_TAC[UNIONS_IMAGE; EXTENSION; IN_ELIM_THM] THEN
    X_GEN_TAC `x:real^M` THEN
    RULE_ASSUM_TAC(REWRITE_RULE[UNIONS_IMAGE]) THEN
    EQ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    DISCH_THEN(X_CHOOSE_THEN `z:real^M` STRIP_ASSUME_TAC) THEN
    ASM_REWRITE_TAC[] THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `z:real^M`)) THEN ASM_REWRITE_TAC[] THEN
    REPEAT STRIP_TAC THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
    ASM SET_TAC[];
    X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
    MATCH_MP_TAC OPEN_IN_TRANS THEN
    EXISTS_TAC `(uu:real^M->real^M->bool) x` THEN ASM_SIMP_TAC[] THEN
    MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
    EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`)) THEN ASM_REWRITE_TAC[] THEN
    REPEAT STRIP_TAC THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
    REPEAT STRIP_TAC THENL
     [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET));
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM])] THEN
      ASM SET_TAC[];
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN
    REWRITE_TAC[pairwise; RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN
    REWRITE_TAC[FORALL_IN_IMAGE] THEN SET_TAC[];
    X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`)) THEN ASM_REWRITE_TAC[] THEN
    REPEAT(DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
     (REWRITE_RULE[IMP_IMP] MONO_EXISTS))) THEN
    GEN_TAC THEN DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC th) THEN
    GEN_REWRITE_TAC LAND_CONV [HOMEOMORPHISM] THEN STRIP_TAC THEN
    DISCH_THEN(MATCH_MP_TAC o MATCH_MP
     (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN
    ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN ASM SET_TAC[]]);;

let CLOSED_LOCAL_HOMEOMORPHISM_IMP_COVERING_MAP = prove
 (`!p:real^M->real^N c s.
        (!x. connected_component c x = {x} ==> c = {x}) /\
        IMAGE p c = s /\
        (!k. closed_in (subtopology euclidean c) k
             ==> closed_in (subtopology euclidean s) (IMAGE p k)) /\
        (!x. x IN c
             ==> ?t u q. x IN t /\
                         open_in (subtopology euclidean c) t /\
                         open_in (subtopology euclidean s) u /\
                         homeomorphism (t,u) (p,q))
        ==> covering_space (c,p) s`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC PROPER_LOCAL_HOMEOMORPHISM_IMP_COVERING_MAP THEN
  ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC CLOSED_LOCAL_HOMEOMORPHISM_IMP_PROPER THEN
  ASM_REWRITE_TAC[SUBSET_REFL]);;

let PROPER_LOCAL_HOMEOMORPHISM_GLOBAL = prove
 (`!f:real^M->real^N s t.
        path_connected s /\ simply_connected t /\ (s = {} ==> t = {}) /\
        (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) /\
        (!x. x IN s
             ==> ?u v q. x IN u /\
                         open_in (subtopology euclidean s) u /\
                         open_in (subtopology euclidean t) v /\
                         homeomorphism (u,v) (f,q))
        ==> ?g. homeomorphism (s,t) (f,g)`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[] THENL
   [ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN STRIP_TAC THEN
    ASM_REWRITE_TAC[HOMEOMORPHISM; NOT_IN_EMPTY; CONTINUOUS_ON_EMPTY] THEN
    SET_TAC[];
    STRIP_TAC] THEN
  MATCH_MP_TAC COVERING_SPACE_HOMEOMORPHISM THEN
  ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC PROPER_LOCAL_HOMEOMORPHISM_IMP_COVERING_MAP THEN
  ASM_REWRITE_TAC[] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP SIMPLY_CONNECTED_IMP_CONNECTED) THEN
  REWRITE_TAC[CONNECTED_CLOPEN] THEN
  DISCH_THEN(MP_TAC o SPEC `IMAGE (f:real^M->real^N) s`) THEN
  ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN DISCH_THEN MATCH_MP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP LOCAL_HOMEOMORPHISM_IMP_OPEN_MAP) THEN
  DISCH_THEN(MP_TAC o SPEC `s:real^M->bool`) THEN
  REWRITE_TAC[OPEN_IN_REFL] THEN
  DISCH_THEN(MP_TAC o MATCH_MP PROPER_MAP o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
  ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_SIMP_TAC[CLOSED_IN_REFL] THEN
  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP LOCAL_HOMEOMORPHISM_IMP_OPEN_MAP) THEN
  REWRITE_TAC[OPEN_IN_REFL]);;

let CLOSED_LOCAL_HOMEOMORPHISM_GLOBAL = prove
 (`!f:real^M->real^N s t.
        path_connected s /\ simply_connected t /\ (s = {} ==> t = {}) /\
        (!c. closed_in (subtopology euclidean s) c
             ==> closed_in (subtopology euclidean t) (IMAGE f c)) /\
        (!x. x IN s
             ==> ?u v g. x IN u /\
                         open_in (subtopology euclidean s) u /\
                         open_in (subtopology euclidean t) v /\
                         homeomorphism (u,v) (f,g))
        ==> ?g. homeomorphism (s,t) (f,g)`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL
   [ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN STRIP_TAC THEN
    ASM_REWRITE_TAC[HOMEOMORPHISM; NOT_IN_EMPTY; CONTINUOUS_ON_EMPTY] THEN
    SET_TAC[];
    STRIP_TAC] THEN
  MATCH_MP_TAC COVERING_SPACE_HOMEOMORPHISM THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC CLOSED_LOCAL_HOMEOMORPHISM_IMP_COVERING_MAP THEN
  ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
   [X_GEN_TAC `x:real^M` THEN
    ASM_CASES_TAC `connected_component s (x:real^M) = {}` THEN
    ASM_REWRITE_TAC[NOT_INSERT_EMPTY] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[CONNECTED_COMPONENT_EQ_EMPTY]) THEN
    ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT_SET;
                  PATH_CONNECTED_IMP_CONNECTED];
    FIRST_ASSUM(MP_TAC o MATCH_MP SIMPLY_CONNECTED_IMP_CONNECTED) THEN
    REWRITE_TAC[CONNECTED_CLOPEN] THEN
    DISCH_THEN(MP_TAC o SPEC `IMAGE (f:real^M->real^N) s`) THEN
    ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN DISCH_THEN MATCH_MP_TAC THEN
    ASM_SIMP_TAC[CLOSED_IN_REFL] THEN
    FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP LOCAL_HOMEOMORPHISM_IMP_OPEN_MAP) THEN
    REWRITE_TAC[OPEN_IN_REFL]]);;

let PROPER_LOCALLY_INJECTIVE_OPEN_IMP_COVERING_MAP = prove
 (`!p:real^M->real^N c s.
        p continuous_on c /\ IMAGE p c = s /\
        (!k. k SUBSET s /\ compact k ==> compact {x | x IN c /\ p x IN k}) /\
        (!u. open_in (subtopology euclidean c) u
             ==> open_in (subtopology euclidean s) (IMAGE p u)) /\
        (!x. x IN c
             ==> ?t. x IN t /\ open_in (subtopology euclidean c) t /\
                     (!y z. y IN t /\ z IN t /\ p y = p z ==> y = z))
        ==> covering_space (c,p) s`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC PROPER_LOCAL_HOMEOMORPHISM_IMP_COVERING_MAP THEN
  ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^M->bool` THEN STRIP_TAC THEN
  ASM_REWRITE_TAC[] THEN
  EXISTS_TAC `IMAGE (p:real^M->real^N) t` THEN ASM_SIMP_TAC[] THEN
  MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN
  ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
   [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN
    FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[];
    X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN
    MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN
    CONJ_TAC THENL
     [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[OPEN_IN_TRANS];
      REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
      ASM SET_TAC[]]]);;

let PROPER_LOCALLY_INJECTIVE_OPEN_IMP_COVERING_MAP_GEN = prove
 (`!p:real^M->real^N c s.
        p continuous_on c /\ IMAGE p c = s /\
        (!k. k SUBSET s /\ compact k ==> compact {x | x IN c /\ p x IN k}) /\
        (!u. open_in (subtopology euclidean c) u
             ==> open_in (subtopology euclidean c)
                         {x | x IN c /\ p x IN IMAGE p u}) /\
        (!x. x IN c
             ==> ?t. x IN t /\ open_in (subtopology euclidean c) t /\
                     (!y z. y IN t /\ z IN t /\ p y = p z ==> y = z))
        ==> covering_space (c,p) s`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC PROPER_LOCALLY_INJECTIVE_OPEN_IMP_COVERING_MAP THEN
  ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC CLOSED_MAP_IMP_OPEN_MAP THEN
  ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[PROPER_MAP; SUBSET_REFL]);;

let PROPER_LOCALLY_INJECTIVE_OPEN_IMP_HOMEOMORPHISM = prove
 (`!f:real^M->real^N s t.
        path_connected s /\ simply_connected t /\
        f continuous_on s /\ IMAGE f s = t /\
        (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) /\
        (!u. open_in (subtopology euclidean s) u
             ==> open_in (subtopology euclidean t) (IMAGE f u)) /\
        (!x. x IN s
             ==> ?u. x IN u /\ open_in (subtopology euclidean s) u /\
                     !y z. y IN u /\ z IN u /\ f y = f z ==> y = z)
        ==> ?g. homeomorphism (s,t) (f,g)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_HOMEOMORPHISM THEN
  ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC PROPER_LOCALLY_INJECTIVE_OPEN_IMP_COVERING_MAP THEN
  ASM_REWRITE_TAC[]);;

let PROPER_LOCALLY_INJECTIVE_OPEN_IMP_HOMEOMORPHISM_GEN = prove
 (`!f:real^M->real^N s t.
        path_connected s /\ simply_connected t /\
        f continuous_on s /\ IMAGE f s = t /\
        (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) /\
        (!u. open_in (subtopology euclidean s) u
             ==> open_in (subtopology euclidean s)
                         {x | x IN s /\ f x IN IMAGE f u}) /\
        (!x. x IN s
             ==> ?u. x IN u /\ open_in (subtopology euclidean s) u /\
                     !y z. y IN u /\ z IN u /\ f y = f z ==> y = z)
        ==> ?g. homeomorphism (s,t) (f,g)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_HOMEOMORPHISM THEN
  ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC PROPER_LOCALLY_INJECTIVE_OPEN_IMP_COVERING_MAP_GEN THEN
  ASM_REWRITE_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* A simply connected covering space is universal.                           *)
(* ------------------------------------------------------------------------- *)

let UNIVERSAL_COVERING_SPACE = prove
 (`!c p:real^M->real^P c' p':real^N->real^P s.
        covering_space (c,p) s /\ covering_space (c',p') s /\
        locally path_connected c /\ simply_connected c /\ connected c'
        ==> ?q. covering_space (c,q) c' /\ !x. x IN c ==> p'(q x) = p x`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^P->bool = {}` THENL
   [ASM_SIMP_TAC[covering_space; IMAGE_EQ_EMPTY; NOT_IN_EMPTY] THEN
    REWRITE_TAC[CONTINUOUS_ON_EMPTY];
    FIRST_X_ASSUM(X_CHOOSE_TAC `a:real^P` o
      GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY])] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN `path_connected(c':real^N->bool)` ASSUME_TAC THENL
   [ASM_MESON_TAC[COVERING_SPACE_LOCALLY_PATH_CONNECTED_EQ;
                  PATH_CONNECTED_EQ_CONNECTED_LPC];
    ALL_TAC] THEN
  SUBGOAL_THEN `locally connected (s:real^P->bool)` ASSUME_TAC THENL
   [ASM_MESON_TAC[LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED;
                  COVERING_SPACE_LOCALLY_PATH_CONNECTED_EQ];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `?b:real^M b':real^N.
        b IN c /\ b' IN c' /\ (p:real^M->real^P) b = a /\ p' b' = a`
  STRIP_ASSUME_TAC THENL
   [RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM SET_TAC[];
    ALL_TAC] THEN
  MP_TAC(ISPECL
   [`p':real^N->real^P`; `c':real^N->bool`; `s:real^P->bool`;
    `p:real^M->real^P`; `c:real^M->bool`; `b':real^N`; `b:real^M`]
        COVERING_SPACE_LIFT_STRONG) THEN
  ASM_REWRITE_TAC[] THEN
  ANTS_TAC THENL [ASM_MESON_TAC[covering_space; SUBSET_REFL]; ALL_TAC] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^M->real^N` THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[covering_space] THEN
  MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
   [ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
    REWRITE_TAC[SUBSET; IN_IMAGE] THEN X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN
    DISCH_THEN(MP_TAC o SPECL [`b':real^N`; `z:real^N`]) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `g':real^1->real^N` THEN STRIP_TAC THEN
    MP_TAC(ISPECL [`p:real^M->real^P`; `c:real^M->bool`; `s:real^P->bool`;
                   `(p':real^N->real^P) o (g':real^1->real^N)`; `b:real^M`]
      COVERING_SPACE_LIFT_PATH_STRONG) THEN
    ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
     [ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATH_IMAGE_COMPOSE] THEN
      CONJ_TAC THENL [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE; ALL_TAC] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THENL
       [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]];
      REWRITE_TAC[o_THM] THEN
      DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC)] THEN
    MP_TAC(ISPECL [`p':real^N->real^P`; `c':real^N->bool`; `s:real^P->bool`;
                   `(p':real^N->real^P) o (g':real^1->real^N)`;
                   `(p':real^N->real^P) o q o (g:real^1->real^M)`;
                   `g':real^1->real^N`;
                   `(q:real^M->real^N) o (g:real^1->real^M)`]
      COVERING_SPACE_MONODROMY) THEN
    ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN
    ANTS_TAC THENL
     [REWRITE_TAC[o_THM; PATH_IMAGE_COMPOSE] THEN REPEAT CONJ_TAC THENL
       [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN
        RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN
        ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
        RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM SET_TAC[];
        MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN
        REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN CONJ_TAC THENL
         [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN
          RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN
          ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
          REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o
           GEN_REWRITE_RULE I [covering_space])) THEN
          FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
            CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]];
        RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM SET_TAC[];
        MATCH_MP_TAC HOMOTOPIC_PATHS_EQ THEN ASM_SIMP_TAC[o_THM] THEN
        REPEAT CONJ_TAC THENL
         [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN
          RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN
          ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
          REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN
          RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM SET_TAC[];
          RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN ASM SET_TAC[]];
        MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN
        RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN
        ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
        RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM SET_TAC[]];
      DISCH_THEN SUBST1_TAC THEN
      EXISTS_TAC `pathfinish(g:real^1->real^M)` THEN
      ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE; SUBSET]];
    DISCH_TAC] THEN
  X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `?t vv vv'.
        connected t /\
        open_in (subtopology euclidean s) t /\
        (p':real^N->real^P) z IN t /\
        UNIONS vv = {x:real^M | x IN c /\ p x IN t} /\
        (!u. u IN vv ==> open_in (subtopology euclidean c) u) /\
        pairwise DISJOINT vv /\
        (!u. u IN vv ==> (?r. homeomorphism (u,t) (p,r))) /\
        UNIONS vv' = {x:real^N | x IN c' /\ p' x IN t} /\
        (!u. u IN vv' ==> open_in (subtopology euclidean c') u) /\
        pairwise DISJOINT vv' /\
        (!u. u IN vv' ==> (?r'. homeomorphism (u,t) (p',r')))`
  STRIP_ASSUME_TAC THENL
   [UNDISCH_TAC `covering_space (c,p:real^M->real^P) s` THEN
    REWRITE_TAC[covering_space] THEN
    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    DISCH_THEN(MP_TAC o SPEC `(p':real^N->real^P) z`) THEN ANTS_TAC THENL
     [FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN
      ASM SET_TAC[];
      DISCH_THEN(X_CHOOSE_THEN `t:real^P->bool` MP_TAC) THEN
      REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
      DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool`
        STRIP_ASSUME_TAC)] THEN
    UNDISCH_TAC `covering_space (c',p':real^N->real^P) s` THEN
    REWRITE_TAC[covering_space] THEN
    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    DISCH_THEN(MP_TAC o SPEC `(p':real^N->real^P) z`) THEN ANTS_TAC THENL
     [ASM SET_TAC[];
      DISCH_THEN(X_CHOOSE_THEN `t':real^P->bool` MP_TAC) THEN
      REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
      DISCH_THEN(X_CHOOSE_THEN `vv':(real^N->bool)->bool`
        STRIP_ASSUME_TAC)] THEN
    ABBREV_TAC
      `u = connected_component (t INTER t') ((p':real^N->real^P) z)` THEN
    SUBGOAL_THEN `(u:real^P->bool) SUBSET t INTER t'` STRIP_ASSUME_TAC THENL
     [ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET]; ALL_TAC] THEN
    MAP_EVERY EXISTS_TAC
     [`u:real^P->bool`;
      `{{x | x IN v /\ (p:real^M->real^P) x IN u} | v IN vv}`;
      `{{x | x IN v /\ (p':real^N->real^P) x IN u} | v IN vv'}`] THEN
    REPEAT CONJ_TAC THENL
     [ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT];
      MATCH_MP_TAC OPEN_IN_TRANS THEN
      EXISTS_TAC `t INTER t':real^P->bool` THEN
      ASM_SIMP_TAC[OPEN_IN_INTER] THEN EXPAND_TAC "u" THEN
      MATCH_MP_TAC OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED THEN
      ASM_MESON_TAC[LOCALLY_INTER_OPEN; LOCALLY_OPEN_SUBSET];
      REWRITE_TAC[IN] THEN EXPAND_TAC "u" THEN
      REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
      ASM_REWRITE_TAC[IN_INTER];
      REWRITE_TAC[SET_RULE `{x | x IN v /\ P x} = v INTER {x | P x}`] THEN
      ASM_REWRITE_TAC[GSYM INTER_UNIONS] THEN ASM SET_TAC[];
      REWRITE_TAC[FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN
      MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_SUBSET THEN
      EXISTS_TAC `s:real^P->bool` THEN ASM_SIMP_TAC[SUBSET_REFL] THEN
      MATCH_MP_TAC OPEN_IN_TRANS THEN
      EXISTS_TAC `t INTER t':real^P->bool` THEN
      ASM_SIMP_TAC[OPEN_IN_INTER] THEN EXPAND_TAC "u" THEN
      MATCH_MP_TAC OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED THEN
      ASM_MESON_TAC[LOCALLY_INTER_OPEN; LOCALLY_OPEN_SUBSET];
      REWRITE_TAC[PAIRWISE_IMAGE; SIMPLE_IMAGE] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        PAIRWISE_IMP)) THEN SET_TAC[];
      REWRITE_TAC[FORALL_IN_GSPEC] THEN
      X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN
      REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `v:real^M->bool`)) THEN
      ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o check(is_exists o concl)) THEN
      MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
      DISCH_THEN(fun th ->
        STRIP_ASSUME_TAC(REWRITE_RULE[homeomorphism] th) THEN
        MP_TAC th THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT]
          HOMEOMORPHISM_OF_SUBSETS)) THEN ASM SET_TAC[];
      REWRITE_TAC[SET_RULE `{x | x IN v /\ P x} = v INTER {x | P x}`] THEN
      ASM_REWRITE_TAC[GSYM INTER_UNIONS] THEN ASM SET_TAC[];
      REWRITE_TAC[FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN
      MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_SUBSET THEN
      EXISTS_TAC `s:real^P->bool` THEN ASM_SIMP_TAC[SUBSET_REFL] THEN
      MATCH_MP_TAC OPEN_IN_TRANS THEN
      EXISTS_TAC `t INTER t':real^P->bool` THEN
      ASM_SIMP_TAC[OPEN_IN_INTER] THEN EXPAND_TAC "u" THEN
      MATCH_MP_TAC OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED THEN
      ASM_MESON_TAC[LOCALLY_INTER_OPEN; LOCALLY_OPEN_SUBSET];
      REWRITE_TAC[PAIRWISE_IMAGE; SIMPLE_IMAGE] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        PAIRWISE_IMP)) THEN SET_TAC[];
      REWRITE_TAC[FORALL_IN_GSPEC] THEN
      X_GEN_TAC `v:real^N->bool` THEN DISCH_TAC THEN
      REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `v:real^N->bool`)) THEN
      ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o check(is_exists o concl)) THEN
      MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
      DISCH_THEN(fun th ->
        STRIP_ASSUME_TAC(REWRITE_RULE[homeomorphism] th) THEN
        MP_TAC th THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT]
          HOMEOMORPHISM_OF_SUBSETS)) THEN ASM SET_TAC[]];
    ALL_TAC] THEN
  SUBGOAL_THEN `?v':real^N->bool. v' IN vv' /\ z IN v'` STRIP_ASSUME_TAC THENL
   [ASM SET_TAC[]; ALL_TAC] THEN
  SUBGOAL_THEN `v' SUBSET {x | x IN c' /\ (p':real^N->real^P) x IN t}`
  ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  SUBGOAL_THEN `open_in (subtopology euclidean c') (v':real^N->bool) /\
                ?r':real^P->real^N. homeomorphism (v',t) (p',r')`
  STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
  EXISTS_TAC `v':real^N->bool` THEN ASM_REWRITE_TAC[] THEN
  SUBGOAL_THEN
   `!u. u IN vv ==> ?u'. u' IN vv' /\ IMAGE (q:real^M->real^N) u SUBSET u'`
  ASSUME_TAC THENL
   [X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN
    SUBGOAL_THEN `IMAGE (q:real^M->real^N) u SUBSET UNIONS vv'` MP_TAC THENL
     [ASM_REWRITE_TAC[IN_ELIM_THM; SUBSET; FORALL_IN_IMAGE] THEN ASM SET_TAC[];
      ALL_TAC] THEN
    MATCH_MP_TAC(SET_RULE
     `~(UNIONS uu = {}) /\
      (!u. u IN uu
              ==> DISJOINT s u \/ DISJOINT s (UNIONS(uu DELETE u)))
      ==> s SUBSET UNIONS uu ==> ?u. u IN uu /\ s SUBSET u`) THEN
    ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    X_GEN_TAC `v:real^N->bool` THEN DISCH_TAC THEN
    SUBGOAL_THEN `connected(IMAGE (q:real^M->real^N) u)` MP_TAC THENL
     [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN CONJ_TAC THENL
       [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; OPEN_IN_IMP_SUBSET]; ALL_TAC] THEN
      UNDISCH_TAC `connected(t:real^P->bool)` THEN MATCH_MP_TAC EQ_IMP THEN
      CONV_TAC SYM_CONV THEN MATCH_MP_TAC HOMEOMORPHIC_CONNECTEDNESS THEN
      REWRITE_TAC[homeomorphic] THEN ASM_MESON_TAC[];
      REWRITE_TAC[CONNECTED_OPEN_IN; NOT_EXISTS_THM; TAUT
       `~(p /\ q /\ r /\ s /\ t) <=> p /\ q /\ r /\ s ==> ~t`] THEN
      REWRITE_TAC[DE_MORGAN_THM; DISJOINT]] THEN
    DISCH_THEN MATCH_MP_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN
    CONJ_TAC THENL
     [CONJ_TAC THEN MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN
      EXISTS_TAC `c':real^N->bool` THEN
      (CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN
      MATCH_MP_TAC OPEN_IN_INTER THEN ASM_SIMP_TAC[OPEN_IN_REFL] THEN
      MATCH_MP_TAC OPEN_IN_UNIONS THEN ASM_SIMP_TAC[IN_DELETE];
      REWRITE_TAC[GSYM UNION_OVER_INTER] THEN
      ASM_SIMP_TAC[GSYM UNIONS_INSERT; SET_RULE
       `a IN s ==> a INSERT (s DELETE a) = s`] THEN
      CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      MATCH_MP_TAC(SET_RULE
       `s INTER t = {} ==> (u INTER s) INTER (u INTER t) = {}`) THEN
      GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM UNIONS_1] THEN
      W(MP_TAC o PART_MATCH (lhand o rand) INTER_UNIONS_PAIRWISE_DISJOINT o
        lhand o snd) THEN
      ASM_SIMP_TAC[SET_RULE `a IN s ==> {a} UNION (s DELETE a) = s`] THEN
      SET_TAC[]];
    ALL_TAC] THEN
  EXISTS_TAC `{v:real^M->bool | v IN vv /\
                                IMAGE (q:real^M->real^N) v SUBSET v'}` THEN
  ASM_SIMP_TAC[FORALL_IN_GSPEC] THEN REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
     [ASM SET_TAC[]; GEN_REWRITE_TAC I [SUBSET]] THEN
    REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN X_GEN_TAC `x:real^M` THEN
    STRIP_TAC THEN
    SUBGOAL_THEN `(x:real^M) IN UNIONS vv` MP_TAC THENL
     [ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^M->bool` THEN
    RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM SET_TAC[];
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        PAIRWISE_MONO)) THEN SET_TAC[];
    X_GEN_TAC `v:real^M->bool` THEN STRIP_TAC THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `v:real^M->bool`)) THEN
    ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN
    FIRST_X_ASSUM(X_CHOOSE_TAC `r:real^P->real^M`) THEN
    EXISTS_TAC `(r:real^P->real^M) o (p':real^N->real^P)` THEN
    MATCH_MP_TAC HOMEOMORPHISM_EQ THEN MAP_EVERY EXISTS_TAC
     [`(r':real^P->real^N) o (p:real^M->real^P)`;
      `(r:real^P->real^M) o (p':real^N->real^P)`] THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN
      ASM_MESON_TAC[HOMEOMORPHISM_SYM];
      RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN
      REWRITE_TAC[o_DEF] THEN ASM SET_TAC[]]]);;

(* ------------------------------------------------------------------------- *)
(* Size of fundamental group of a covering space (this could be generalized  *)
(* with structural properties of the bijections of course).                  *)
(* ------------------------------------------------------------------------- *)

let CARD_EQ_FUNDAMENTAL_GROUP_COVERING_SPACE_ALT = prove
 (`!p:real^M->real^N c s a.
        covering_space(c,p) s /\ path_connected c /\ a IN c
        ==> fundamental_group(s,p a) =_c
            {homotopic_paths c g |g| path g /\ path_image g SUBSET c /\
                                     pathstart g = a /\
                                     p(pathfinish g) = p a}`,
  let tac =
    REPEAT
     (FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN
      FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN
      FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN
      FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH)) THEN
    ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN CONJ_TAC THENL
     [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; PATH_CONTINUOUS_IMAGE]; ALL_TAC] THEN
    REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN ASM SET_TAC[] in
  REPEAT STRIP_TAC THEN REWRITE_TAC[fundamental_group] THEN
  ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN REWRITE_TAC[eq_c] THEN
  EXISTS_TAC `homotopic_paths s o ((o) (p:real^M->real^N)) o (@)` THEN
  REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC; EXISTS_UNIQUE_DEF;
              GSYM CONJ_ASSOC; IMP_CONJ; o_THM; RIGHT_FORALL_IMP_THM] THEN
  REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL
   [X_GEN_TAC `g:real^1->real^M` THEN STRIP_TAC THEN
    SUBGOAL_THEN `homotopic_paths (c:real^M->bool) g
                                  ((@) (homotopic_paths c g))`
    MP_TAC THENL
     [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN
      CONV_TAC SELECT_CONV THEN ASM_MESON_TAC[HOMOTOPIC_PATHS_REFL];
      ABBREV_TAC `h:real^1->real^M = (@) (homotopic_paths c g)` THEN
      ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN DISCH_TAC] THEN
    MATCH_MP_TAC(SET_RULE
     `P q ==> homotopic_paths s q IN {homotopic_paths s p | P p}`) THEN
    tac;
    X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THEN CONJ_TAC THENL
     [FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        COVERING_SPACE_LIFT_PATH_STRONG)) THEN
      DISCH_THEN(MP_TAC o SPECL [`h:real^1->real^N`; `a:real^M`]) THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
      X_GEN_TAC `g:real^1->real^M` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
      CONJ_TAC THENL
       [ASM_MESON_TAC[pathfinish; ENDS_IN_UNIT_INTERVAL]; ALL_TAC] THEN
      SUBGOAL_THEN `homotopic_paths (c:real^M->bool) g
                                  ((@) (homotopic_paths c g))`
      MP_TAC THENL
       [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN
        CONV_TAC SELECT_CONV THEN ASM_MESON_TAC[HOMOTOPIC_PATHS_REFL];
        ABBREV_TAC `g':real^1->real^M = (@) (homotopic_paths c g)` THEN
        ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN DISCH_TAC] THEN
      ONCE_REWRITE_TAC[FUN_EQ_THM] THEN
      MATCH_MP_TAC(MESON[HOMOTOPIC_PATHS_SYM; HOMOTOPIC_PATHS_TRANS]
        `homotopic_paths s p q
         ==> !r. homotopic_paths s p r <=> homotopic_paths s q r`) THEN
      TRANS_TAC HOMOTOPIC_PATHS_TRANS
        `(p:real^M->real^N) o (g:real^1->real^M)` THEN
      CONJ_TAC THENL
       [MATCH_MP_TAC HOMOTOPIC_PATHS_CONTINUOUS_IMAGE THEN
        EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
        RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM SET_TAC[];
        MATCH_MP_TAC HOMOTOPIC_PATHS_EQ THEN
        ASM_REWRITE_TAC[o_THM] THEN tac];
      X_GEN_TAC `g:real^1->real^M` THEN
      REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
      DISCH_THEN(SUBST1_TAC o SYM) THEN
      X_GEN_TAC `g':real^1->real^M` THEN
      REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
      SUBGOAL_THEN `homotopic_paths (c:real^M->bool) g
                                    ((@) (homotopic_paths c g))`
      MP_TAC THENL
       [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN
        CONV_TAC SELECT_CONV THEN ASM_MESON_TAC[HOMOTOPIC_PATHS_REFL];
        ABBREV_TAC `k:real^1->real^M = (@) (homotopic_paths c g)` THEN
        ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN DISCH_TAC] THEN
      SUBGOAL_THEN `homotopic_paths (c:real^M->bool) g'
                                    ((@) (homotopic_paths c g'))`
      MP_TAC THENL
       [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN
        CONV_TAC SELECT_CONV THEN ASM_MESON_TAC[HOMOTOPIC_PATHS_REFL];
        ABBREV_TAC `k':real^1->real^M = (@) (homotopic_paths c g')` THEN
        ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN DISCH_TAC] THEN
      DISCH_THEN(MP_TAC o C AP_THM
       `(p:real^M->real^N) o (k:real^1->real^M)`) THEN
      DISCH_THEN(MP_TAC o snd o EQ_IMP_RULE) THEN
      REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN ANTS_TAC THENL [tac; ALL_TAC] THEN
      W(MP_TAC o PART_MATCH (lhand o rand)
        COVERING_SPACE_HOMOTOPIC_PATHS_CANCEL_EQ o lhand o snd) THEN
      ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [tac; DISCH_THEN SUBST1_TAC] THEN
      REWRITE_TAC[FUN_EQ_THM] THEN
      ASM_MESON_TAC[HOMOTOPIC_PATHS_SYM; HOMOTOPIC_PATHS_TRANS]]]);;

let CARD_EQ_FUNDAMENTAL_GROUP_COVERING_SPACE = prove
 (`!p:real^M->real^N c s a.
        covering_space(c,p) s /\ path_connected c /\ a IN c
        ==> fundamental_group(s,p a) =_c
            fundamental_group(c,a) *_c {a' | a' IN c /\ p a' = p a}`,
  let lemma = prove
   (`!g:real^1->real^N.
        path g /\ path_image g SUBSET c
        ==> homotopic_paths c g ((@) (homotopic_paths c g)) /\
            path ((@) (homotopic_paths c g)) /\
            path_image ((@) (homotopic_paths c g)) SUBSET c /\
            pathstart ((@) (homotopic_paths c g)) = pathstart g /\
            pathfinish ((@) (homotopic_paths c g)) = pathfinish g`,
    REPEAT GEN_TAC THEN STRIP_TAC THEN
    MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
     [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN
      CONV_TAC SELECT_CONV THEN ASM_MESON_TAC[HOMOTOPIC_PATHS_REFL];
      ASM MESON_TAC[HOMOTOPIC_PATHS_IMP_PATH; HOMOTOPIC_PATHS_IMP_SUBSET;
                HOMOTOPIC_PATHS_IMP_PATHSTART;
                HOMOTOPIC_PATHS_IMP_PATHFINISH]]) in
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `!b:real^M. b IN c
               ==> ?g. path g /\ path_image g SUBSET c /\
                       pathstart g = a /\ pathfinish g = b`
  MP_TAC THENL [ASM_MESON_TAC[path_connected]; ALL_TAC] THEN
  REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `f:real^M->real^1->real^M` THEN DISCH_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `a:real^M` o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CARD_EQ_FUNDAMENTAL_GROUP_COVERING_SPACE_ALT)) THEN
  ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_EQ_TRANS) THEN
  REWRITE_TAC[EQ_C_BIJECTIONS] THEN REWRITE_TAC[mul_c; FORALL_IN_GSPEC] THEN
  MAP_EVERY EXISTS_TAC
    [`\g. homotopic_paths c
      ((@) g ++ reversepath(f(pathfinish((@) g):real^M))),pathfinish((@) g)`;
     `\(g,b:real^M). homotopic_paths (c:real^M->bool) ((@) g ++ f b)`] THEN
  REWRITE_TAC[fundamental_group; IMP_CONJ; RIGHT_FORALL_IMP_THM;
              FORALL_IN_GSPEC; IN_ELIM_PAIR_THM] THEN
  CONJ_TAC THEN X_GEN_TAC `g:real^1->real^M` THEN REPEAT DISCH_TAC THEN
  (SUBGOAL_THEN `(pathfinish g:real^M) IN c` ASSUME_TAC THENL
    [ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE; SUBSET]; ALL_TAC]) THEN
  MP_TAC(ISPEC `g:real^1->real^M` lemma) THEN
  ABBREV_TAC `g':real^1->real^M = (@) (homotopic_paths c g)` THEN
  ASM_REWRITE_TAC[GSYM CONJ_ASSOC] THEN STRIP_TAC THEN
  TRY(X_GEN_TAC `b:real^M` THEN REPEAT DISCH_TAC) THEN
  (CONJ_TAC THENL
    [MATCH_MP_TAC(SET_RULE
      `P q ==> homotopic_paths s q IN {homotopic_paths s p | P p}`) THEN
     ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH;
                  PATH_JOIN; PATH_REVERSEPATH; SUBSET_PATH_IMAGE_JOIN;
                  PATHSTART_REVERSEPATH; PATH_IMAGE_REVERSEPATH];
     ALL_TAC]) THEN
  ASM_REWRITE_TAC[IN_ELIM_THM] THENL
   [MP_TAC(ISPEC `g' ++ reversepath(f(pathfinish g')):real^1->real^M`
        lemma) THEN
    ASM_SIMP_TAC[PATH_JOIN; SUBSET_PATH_IMAGE_JOIN; PATH_IMAGE_REVERSEPATH;
                 PATH_REVERSEPATH; PATHSTART_REVERSEPATH] THEN
    ABBREV_TAC
     `g'':real^1->real^M =
      (@) (homotopic_paths c
        (g' ++ reversepath(f(pathfinish(g:real^1->real^M)))))` THEN
    ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH] THEN
    STRIP_TAC;
    MP_TAC(ISPEC `g' ++ f(b:real^M):real^1->real^M` lemma) THEN
    ASM_SIMP_TAC[PATH_JOIN; SUBSET_PATH_IMAGE_JOIN] THEN
    ABBREV_TAC `g'':real^1->real^M =
      (@) (homotopic_paths c (g' ++ f(b:real^M):real^1->real^M))` THEN
    ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PAIR_EQ] THEN STRIP_TAC] THEN
  ONCE_REWRITE_TAC[FUN_EQ_THM] THEN
  MATCH_MP_TAC(MESON[HOMOTOPIC_PATHS_SYM; HOMOTOPIC_PATHS_TRANS]
   `homotopic_paths s p q
    ==> !r. homotopic_paths s p r <=> homotopic_paths s q r`)
  THENL
   [TRANS_TAC HOMOTOPIC_PATHS_TRANS
     `(g' ++ reversepath(f(pathfinish g:real^M))) ++
      f(pathfinish g):real^1->real^M` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
      ASM_SIMP_TAC[HOMOTOPIC_PATHS_REFL] THEN
      ASM_MESON_TAC[HOMOTOPIC_PATHS_SYM];
      ALL_TAC] THEN
    W(MP_TAC o PART_MATCH (rator o rand)
      (ONCE_REWRITE_RULE[HOMOTOPIC_PATHS_SYM] HOMOTOPIC_PATHS_ASSOC) o
      rator o snd) THEN
    ASM_SIMP_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH;
                 PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_PATHS_TRANS) THEN
    TRANS_TAC HOMOTOPIC_PATHS_TRANS
     `g' ++ linepath(pathfinish(f(pathfinish g:real^M)):real^M,
                     pathfinish(f(pathfinish g)))` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
      ASM_SIMP_TAC[HOMOTOPIC_PATHS_LINV; HOMOTOPIC_PATHS_REFL;
                   PATHSTART_REVERSEPATH; PATHSTART_JOIN];
      ALL_TAC] THEN
    TRANS_TAC HOMOTOPIC_PATHS_TRANS `g':real^1->real^M` THEN
    CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[HOMOTOPIC_PATHS_SYM]] THEN
    ASM_SIMP_TAC[] THEN
    SUBST1_TAC(SYM(ASSUME `pathfinish g':real^M = pathfinish g`)) THEN
    MATCH_MP_TAC HOMOTOPIC_PATHS_RID THEN ASM_REWRITE_TAC[];
    TRANS_TAC HOMOTOPIC_PATHS_TRANS
     `(g' ++ f(b:real^M)) ++ reversepath(f b):real^1->real^M` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
      ASM_SIMP_TAC[HOMOTOPIC_PATHS_REFL; PATH_REVERSEPATH;
                   PATH_IMAGE_REVERSEPATH; PATHSTART_REVERSEPATH] THEN
      ASM_MESON_TAC[HOMOTOPIC_PATHS_SYM];
      ALL_TAC] THEN
    W(MP_TAC o PART_MATCH (rator o rand)
      (ONCE_REWRITE_RULE[HOMOTOPIC_PATHS_SYM] HOMOTOPIC_PATHS_ASSOC) o
      rator o snd) THEN
    ASM_SIMP_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH;
                 PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_PATHS_TRANS) THEN
    TRANS_TAC HOMOTOPIC_PATHS_TRANS
     `g' ++ linepath(pathstart(f(b:real^M)),pathstart(f b))
      :real^1->real^M` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN
      ASM_SIMP_TAC[HOMOTOPIC_PATHS_RINV; HOMOTOPIC_PATHS_REFL;
                   PATHSTART_REVERSEPATH; PATHSTART_JOIN];
      ALL_TAC] THEN
    TRANS_TAC HOMOTOPIC_PATHS_TRANS `g':real^1->real^M` THEN
    CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[HOMOTOPIC_PATHS_SYM]] THEN
    ASM_SIMP_TAC[] THEN
    SUBST1_TAC(SYM(ASSUME `pathfinish g':real^M = a`)) THEN
    MATCH_MP_TAC HOMOTOPIC_PATHS_RID THEN ASM_REWRITE_TAC[]]);;

let COVERING_SPACE_SELF_FINITE_FUNDAMENTAL_GROUP = prove
 (`!p s a:real^N.
        covering_space (s,p) s /\ path_connected s /\
        a IN s /\ FINITE(fundamental_group(s,a))
        ==> ?q. homeomorphism (s,s) (p,q)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN
  REPEAT CONJ_TAC THENL
   [RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM_MESON_TAC[];
    RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM_MESON_TAC[];
    ALL_TAC;
    ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP]] THEN
  MAP_EVERY X_GEN_TAC [`b:real^N`; `c:real^N`] THEN STRIP_TAC THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `b:real^N`]
        CARD_EQ_FUNDAMENTAL_GROUPS_BASEPOINTS) THEN
  ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP CARD_FINITE_CONG) THEN
  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `(p:real^N->real^N) b`; `b:real^N`]
        CARD_EQ_FUNDAMENTAL_GROUPS_BASEPOINTS) THEN
  ANTS_TAC THENL
   [RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN ASM SET_TAC[];
    DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CARD_FINITE_CONG)] THEN
  ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
  MP_TAC(ISPECL [`p:real^N->real^N`; `s:real^N->bool`;` s:real^N->bool`;
                 `b:real^N`] CARD_EQ_FUNDAMENTAL_GROUP_COVERING_SPACE) THEN
  ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th ->
    MP_TAC(MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] CARD_EQ_CARD_IMP) th) THEN
    MP_TAC(MATCH_MP CARD_FINITE_CONG th)) THEN
  ASM_REWRITE_TAC[CARD_MUL_FINITE_EQ; FUNDAMENTAL_GROUP_EQ_EMPTY] THEN
  DISCH_THEN(ASSUME_TAC o MATCH_MP (MESON[FINITE_EMPTY]
   `s = {} \/ FINITE s ==> FINITE s`)) THEN
  ASM_SIMP_TAC[CARD_MUL_C] THEN FIRST_ASSUM
   (MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] CARD_EQ_CARD_IMP)) THEN
  ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN
  ASM_REWRITE_TAC[NUM_RING `a = a * b <=> a = 0 \/ b = 1`] THEN
  ASM_SIMP_TAC[CARD_EQ_0; FUNDAMENTAL_GROUP_EQ_EMPTY] THEN
  ASM_SIMP_TAC[MESON[HAS_SIZE]
   `FINITE s ==> (CARD s = n <=> s HAS_SIZE n)`] THEN
  CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN ASM SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Invariance of dimension and domain in setting of R^n.                     *)
(* ------------------------------------------------------------------------- *)

let HOMEOMORPHIC_SUBSPACE_EUCLIDEAN_SPACE = prove
 (`!(s:real^N->bool) n.
        subspace s
        ==> (subtopology euclidean s homeomorphic_space euclidean_space n <=>
             dim s = n)`,
  REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `subtopology euclidean (s:real^N->bool) homeomorphic_space
    euclidean_space (dim s)`
  ASSUME_TAC THENL
   [TRANS_TAC HOMEOMORPHIC_SPACE_TRANS
     `subtopology euclidean
        (span (IMAGE basis (1..dim(s:real^N->bool))):real^N->bool)` THEN
    CONJ_TAC THENL
     [REWRITE_TAC[HOMEOMORPHIC_SPACE_EUCLIDEAN] THEN
      MATCH_MP_TAC HOMEOMORPHIC_SUBSPACES THEN
      ASM_REWRITE_TAC[SUBSPACE_SPAN; DIM_SPAN; DIM_BASIS_IMAGE] THEN
      REWRITE_TAC[INTER_NUMSEG; ARITH_RULE `MAX 1 1 = 1`] THEN
      SIMP_TAC[DIM_SUBSET_UNIV; ARITH_RULE `s <= n ==> MIN n s = s`] THEN
      REWRITE_TAC[CARD_NUMSEG_1];
      ONCE_REWRITE_TAC[HOMEOMORPHIC_SPACE_SYM] THEN
      MP_TAC(SPEC `dim(s:real^N->bool)`
        HOMEOMORPHIC_MAPS_EUCLIDEAN_SPACE_EUCLIDEAN_GEN) THEN
      REWRITE_TAC[homeomorphic_space; DIM_SUBSET_UNIV] THEN
      MESON_TAC[]];
    X_GEN_TAC `n:num` THEN EQ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
    REWRITE_TAC[GSYM INVARIANCE_OF_DIMENSION_EUCLIDEAN_SPACE] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_SPACE_TRANS) THEN
    ONCE_REWRITE_TAC[HOMEOMORPHIC_SPACE_SYM] THEN
    ASM_REWRITE_TAC[]]);;

let HOMEOMORPHIC_SUBSPACE_EUCLIDEAN_SPACE_DIM = prove
 (`!(s:real^N->bool).
       subspace s
       ==> subtopology euclidean s homeomorphic_space euclidean_space (dim s)`,
  SIMP_TAC[HOMEOMORPHIC_SUBSPACE_EUCLIDEAN_SPACE]);;

let HOMEOMORPHIC_SUBSPACES_EQ = prove
 (`!s:real^M->bool t:real^N->bool.
        subspace s /\ subspace t ==> (s homeomorphic t <=> dim s = dim t)`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [DISCH_TAC; ASM_MESON_TAC[HOMEOMORPHIC_SUBSPACES]] THEN
  REWRITE_TAC[GSYM INVARIANCE_OF_DIMENSION_EUCLIDEAN_SPACE] THEN
  TRANS_TAC HOMEOMORPHIC_SPACE_TRANS
   `subtopology euclidean (t:real^N->bool)` THEN
  ASM_SIMP_TAC[HOMEOMORPHIC_SUBSPACE_EUCLIDEAN_SPACE] THEN
  TRANS_TAC HOMEOMORPHIC_SPACE_TRANS
   `subtopology euclidean (s:real^M->bool)` THEN
  ASM_REWRITE_TAC[HOMEOMORPHIC_SPACE_EUCLIDEAN] THEN
  ONCE_REWRITE_TAC[HOMEOMORPHIC_SPACE_SYM] THEN
  ASM_SIMP_TAC[HOMEOMORPHIC_SUBSPACE_EUCLIDEAN_SPACE]);;

let HOMEOMORPHIC_AFFINE_EUCLIDEAN_SPACE = prove
 (`!(s:real^N->bool) n.
        affine s
        ==> (subtopology euclidean s homeomorphic_space euclidean_space n <=>
             aff_dim s = &n)`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL
   [ASM_SIMP_TAC[HOMEOMORPHIC_EMPTY_SPACE_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY;
                 NONEMPTY_EUCLIDEAN_SPACE; AFF_DIM_EMPTY] THEN
    INT_ARITH_TAC;
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY])] THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^N` THEN
  DISCH_TAC THEN
  TRANS_TAC EQ_TRANS
   `subtopology euclidean (IMAGE (\x:real^N. --a + x) s) homeomorphic_space
    euclidean_space n` THEN
  CONJ_TAC THENL
   [EQ_TAC THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_SPACE_TRANS) THEN
    REWRITE_TAC[HOMEOMORPHIC_SPACE_EUCLIDEAN] THEN
    REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_LEFT_EQ;
                HOMEOMORPHIC_TRANSLATION_RIGHT_EQ; HOMEOMORPHIC_REFL];
    W(MP_TAC o PART_MATCH (lhand o rand)
     HOMEOMORPHIC_SUBSPACE_EUCLIDEAN_SPACE o lhand o snd) THEN
    SIMP_TAC[GSYM INT_OF_NUM_EQ; GSYM AFF_DIM_DIM_SUBSPACE] THEN
    REWRITE_TAC[AFF_DIM_TRANSLATION_EQ] THEN DISCH_THEN MATCH_MP_TAC THEN
    MATCH_MP_TAC AFFINE_IMP_SUBSPACE THEN
    ASM_SIMP_TAC[AFFINE_TRANSLATION; GSYM IN_TRANSLATION_GALOIS_ALT] THEN
    ASM_REWRITE_TAC[VECTOR_ADD_RID]]);;

let HOMEOMORPHIC_AFFINE_SETS_EQ = prove
 (`!s:real^M->bool t:real^N->bool.
        affine s /\ affine t ==> (s homeomorphic t <=> aff_dim s = aff_dim t)`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `t:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; HOMEOMORPHIC_EMPTY] THEN
  POP_ASSUM MP_TAC THEN
  GEN_REWRITE_TAC (funpow 3 RAND_CONV) [EQ_SYM_EQ] THEN
  ASM_CASES_TAC `s:real^M->bool = {}` THEN
  ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; HOMEOMORPHIC_EMPTY] THEN
  POP_ASSUM MP_TAC THEN REWRITE_TAC
   [GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM; RIGHT_IMP_FORALL_THM] THEN
  MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^N`] THEN
  GEOM_ORIGIN_TAC `a:real^M` THEN GEOM_ORIGIN_TAC `b:real^N` THEN
  SIMP_TAC[AFFINE_EQ_SUBSPACE; HOMEOMORPHIC_SUBSPACES_EQ; AFF_DIM_DIM_0;
           HULL_INC; INT_OF_NUM_EQ] THEN
  MESON_TAC[]);;

let INVARIANCE_OF_DOMAIN_SUBSPACES = prove
 (`!f:real^M->real^N u v s.
        subspace u /\ subspace v /\ dim v <= dim u /\
        f continuous_on s /\ IMAGE f s SUBSET v /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
        open_in (subtopology euclidean u) s
        ==> open_in (subtopology euclidean v) (IMAGE f s)`,
  X_GEN_TAC `h:real^M->real^N` THEN REPEAT STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
  MAP_EVERY (MP_TAC o C ISPEC HOMEOMORPHIC_SUBSPACE_EUCLIDEAN_SPACE_DIM)
   [`v:real^N->bool`; `u:real^M->bool`] THEN
  ASM_REWRITE_TAC[homeomorphic_space; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`f:real^M->num->real`; `f':(num->real)->real^M`] THEN
  REWRITE_TAC[HOMEOMORPHIC_MAPS_MAP; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  STRIP_TAC THEN
  MAP_EVERY X_GEN_TAC [`g:real^N->num->real`; `g':(num->real)->real^N`] THEN
  STRIP_TAC THEN FIRST_ASSUM(fun th ->
    GEN_REWRITE_TAC I [MATCH_MP HOMEOMORPHIC_MAP_OPENNESS_EQ th]) THEN
  CONJ_TAC THENL
   [ALL_TAC;
    MP_TAC(ISPECL
     [`dim(u:real^M->bool)`; `dim(v:real^N->bool)`;
      `IMAGE (f:real^M->num->real) s`;
      `(g:real^N->num->real) o h o (f':(num->real)->real^M)`]
          INVARIANCE_OF_DOMAIN_EUCLIDEAN_SPACE_GEN) THEN
    ASM_REWRITE_TAC[GSYM IMAGE_o; GSYM o_ASSOC] THEN
    ANTS_TAC THEN REPEAT CONJ_TAC THENL
     [ASM_MESON_TAC[HOMEOMORPHIC_MAP_OPENNESS_EQ];
      MATCH_MP_TAC CONTINUOUS_MAP_COMPOSE THEN
      EXISTS_TAC `subtopology euclidean (v:real^N->bool)` THEN
      ASM_SIMP_TAC[HOMEOMORPHIC_IMP_CONTINUOUS_MAP] THEN
      MATCH_MP_TAC CONTINUOUS_MAP_COMPOSE THEN
      EXISTS_TAC `subtopology euclidean (s:real^M->bool)` THEN
      ASM_REWRITE_TAC[CONTINUOUS_MAP_EUCLIDEAN2] THEN
      SUBGOAL_THEN
       `subtopology euclidean (s:real^M->bool) =
        subtopology (subtopology euclidean u) (s:real^M->bool)`
      SUBST1_TAC THENL
       [REWRITE_TAC[SUBTOPOLOGY_SUBTOPOLOGY] THEN
        AP_TERM_TAC THEN ASM SET_TAC[];
        ONCE_REWRITE_TAC[CONTINUOUS_MAP_IN_SUBTOPOLOGY] THEN
        ASM_SIMP_TAC[CONTINUOUS_MAP_FROM_SUBTOPOLOGY;
                     HOMEOMORPHIC_IMP_CONTINUOUS_MAP]];
      REWRITE_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[o_THM];
      MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
      REWRITE_TAC[IMAGE_o] THEN AP_TERM_TAC THEN AP_TERM_TAC]] THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP
     HOMEOMORPHIC_IMP_CONTINUOUS_MAP)) THEN
  REPEAT(POP_ASSUM MP_TAC) THEN
  REWRITE_TAC[continuous_map; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY;
              TOPSPACE_SUBTOPOLOGY; o_DEF] THEN
  SET_TAC[]);;

let INVARIANCE_OF_DOMAIN = prove
 (`!f:real^N->real^N s.
        f continuous_on s /\ open s /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
        ==> open(IMAGE f s)`,
  ONCE_REWRITE_TAC[OPEN_IN] THEN
  ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INVARIANCE_OF_DOMAIN_SUBSPACES THEN
  EXISTS_TAC `(:real^N)` THEN
  ASM_REWRITE_TAC[SUBSPACE_UNIV; SUBSET_UNIV; LE_REFL]);;

let INVARIANCE_OF_DIMENSION_SUBSPACES = prove
 (`!f:real^M->real^N u v s.
      subspace u /\ subspace v /\
      ~(s = {}) /\ open_in (subtopology euclidean u) s /\
      f continuous_on s /\ IMAGE f s SUBSET v /\
      (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
      ==> dim u <= dim v`,
  REWRITE_TAC[GSYM NOT_LT] THEN REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`u:real^M->bool`; `dim(v:real^N->bool)`]
    CHOOSE_SUBSPACE_OF_SUBSPACE) THEN
  ASM_SIMP_TAC[SPAN_OF_SUBSPACE; LE_LT] THEN
  DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL [`v:real^N->bool`; `t:real^M->bool`]
        HOMEOMORPHIC_SUBSPACES) THEN
  FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
  ASM_REWRITE_TAC[homeomorphic; homeomorphism; NOT_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`h:real^N->real^M`; `k:real^M->real^N`] THEN
  STRIP_TAC THEN MP_TAC(ISPECL
   [`(h:real^N->real^M) o (f:real^M->real^N)`; `u:real^M->bool`;
    `u:real^M->bool`; `s:real^M->bool`]
        INVARIANCE_OF_DOMAIN_SUBSPACES) THEN
  ASM_REWRITE_TAC[LE_LT; NOT_IMP] THEN REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
    ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
    REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
    REWRITE_TAC[o_THM] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN `IMAGE ((h:real^N->real^M) o (f:real^M->real^N)) s SUBSET t`
  ASSUME_TAC THENL [REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; ALL_TAC] THEN
  ABBREV_TAC `w = IMAGE ((h:real^N->real^M) o (f:real^M->real^N)) s` THEN
  DISCH_TAC THEN UNDISCH_TAC `dim(t:real^M->bool) < dim(u:real^M->bool)` THEN
  REWRITE_TAC[NOT_LT] THEN MP_TAC(ISPECL
   [`w:real^M->bool`; `u:real^M->bool`] DIM_OPEN_IN) THEN
  ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
   [ASM_MESON_TAC[IMAGE_EQ_EMPTY]; DISCH_THEN(SUBST1_TAC o SYM)] THEN
  ASM_SIMP_TAC[DIM_SUBSET]);;

let INVARIANCE_OF_DOMAIN_AFFINE_SETS = prove
 (`!f:real^M->real^N u v s.
        affine u /\ affine v /\ aff_dim v <= aff_dim u /\
        f continuous_on s /\ IMAGE f s SUBSET v /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
        open_in (subtopology euclidean u) s
        ==> open_in (subtopology euclidean v) (IMAGE f s)`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN
  ASM_REWRITE_TAC[IMAGE_CLAUSES; OPEN_IN_EMPTY; INJECTIVE_ON_ALT] THEN
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `?a:real^M b:real^N. a IN s /\ a IN u /\ b IN v`
  STRIP_ASSUME_TAC THENL
   [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
    ASM SET_TAC[];
    ALL_TAC] THEN
  MP_TAC(ISPECL
   [`(\x. --b + x) o (f:real^M->real^N) o (\x. a + x)`;
    `IMAGE (\x:real^M. --a + x) u`; `IMAGE (\x:real^N. --b + x) v`;
    `IMAGE (\x:real^M. --a + x) s`] INVARIANCE_OF_DOMAIN_SUBSPACES) THEN
  REWRITE_TAC[IMAGE_o; INJECTIVE_ON_ALT; OPEN_IN_TRANSLATION_EQ] THEN
  SIMP_TAC[IMP_CONJ; GSYM INT_OF_NUM_LE; GSYM AFF_DIM_DIM_SUBSPACE] THEN
  ASM_REWRITE_TAC[AFF_DIM_TRANSLATION_EQ; RIGHT_FORALL_IMP_THM] THEN
  SIMP_TAC[FORALL_IN_IMAGE; o_THM; GSYM IMAGE_o; IMP_IMP; GSYM CONJ_ASSOC] THEN
  ANTS_TAC THENL
   [ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
     [CONJ_TAC THEN MATCH_MP_TAC AFFINE_IMP_SUBSPACE THEN
      ASM_REWRITE_TAC[AFFINE_TRANSLATION_EQ] THEN REWRITE_TAC[IN_IMAGE;
        VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN
      ASM_MESON_TAC[];
      REPEAT CONJ_TAC THENL
       [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
           SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);
        REWRITE_TAC[GSYM o_ASSOC] THEN REWRITE_TAC[IMAGE_o] THEN
        MATCH_MP_TAC IMAGE_SUBSET;
        REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]]];
    ALL_TAC] THEN
  ASM_SIMP_TAC[VECTOR_ARITH `a + --a + x:real^N = x`; GSYM IMAGE_o; o_DEF;
               IMAGE_ID; ETA_AX]);;

let INVARIANCE_OF_DIMENSION_AFFINE_SETS = prove
 (`!f:real^M->real^N u v s.
      affine u /\ affine v /\
      ~(s = {}) /\ open_in (subtopology euclidean u) s /\
      f continuous_on s /\ IMAGE f s SUBSET v /\
      (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
      ==> aff_dim u <= aff_dim v`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN
  ASM_REWRITE_TAC[IMAGE_CLAUSES; OPEN_IN_EMPTY; INJECTIVE_ON_ALT] THEN
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `?a:real^M b:real^N. a IN s /\ a IN u /\ b IN v`
  STRIP_ASSUME_TAC THENL
   [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
    ASM SET_TAC[];
    ALL_TAC] THEN
  MP_TAC(ISPECL
   [`(\x. --b + x) o (f:real^M->real^N) o (\x. a + x)`;
    `IMAGE (\x:real^M. --a + x) u`; `IMAGE (\x:real^N. --b + x) v`;
    `IMAGE (\x:real^M. --a + x) s`] INVARIANCE_OF_DIMENSION_SUBSPACES) THEN
  REWRITE_TAC[IMAGE_o; INJECTIVE_ON_ALT; OPEN_IN_TRANSLATION_EQ] THEN
  SIMP_TAC[IMP_CONJ; GSYM INT_OF_NUM_LE; GSYM AFF_DIM_DIM_SUBSPACE] THEN
  ASM_REWRITE_TAC[AFF_DIM_TRANSLATION_EQ; RIGHT_FORALL_IMP_THM] THEN
  SIMP_TAC[FORALL_IN_IMAGE; o_THM; GSYM IMAGE_o; IMP_IMP; GSYM CONJ_ASSOC] THEN
  DISCH_THEN MATCH_MP_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
   [CONJ_TAC THEN MATCH_MP_TAC AFFINE_IMP_SUBSPACE THEN
    ASM_REWRITE_TAC[AFFINE_TRANSLATION_EQ] THEN REWRITE_TAC[IN_IMAGE;
      VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN
    ASM_MESON_TAC[];
    ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN REPEAT CONJ_TAC THENL
     [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
         SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);
      REWRITE_TAC[GSYM o_ASSOC] THEN REWRITE_TAC[IMAGE_o] THEN
      MATCH_MP_TAC IMAGE_SUBSET;
      REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]]] THEN
  ASM_SIMP_TAC[VECTOR_ARITH `a + --a + x:real^N = x`; GSYM IMAGE_o; o_DEF;
               IMAGE_ID; ETA_AX]);;

let INVARIANCE_OF_DIMENSION = prove
 (`!f:real^M->real^N s.
        f continuous_on s /\ open s /\ ~(s = {}) /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
        ==> dimindex(:M) <= dimindex(:N)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM DIM_UNIV] THEN
  MATCH_MP_TAC INVARIANCE_OF_DIMENSION_SUBSPACES THEN
  MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `s:real^M->bool`] THEN
  ASM_REWRITE_TAC[SUBSPACE_UNIV; SUBSET_UNIV; SUBTOPOLOGY_UNIV;
                  GSYM OPEN_IN]);;

let CONTINUOUS_INJECTIVE_IMAGE_SUBSPACE_DIM_LE = prove
 (`!f:real^M->real^N s t.
        subspace s /\ subspace t /\
        f continuous_on s /\ IMAGE f s SUBSET t /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
        ==> dim(s) <= dim(t)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INVARIANCE_OF_DIMENSION_SUBSPACES THEN
  MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `s:real^M->bool`] THEN
  ASM_REWRITE_TAC[OPEN_IN_REFL] THEN ASM_SIMP_TAC[SUBSPACE_IMP_NONEMPTY]);;

let INVARIANCE_OF_DIMENSION_CONVEX_DOMAIN = prove
 (`!f:real^M->real^N s t.
        convex s /\ f continuous_on s /\ IMAGE f s SUBSET affine hull t /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
        ==> aff_dim(s) <= aff_dim(t)`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN
  ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_GE] THEN
  MP_TAC(ISPECL
   [`f:real^M->real^N`; `affine hull s:real^M->bool`;
    `affine hull t:real^N->bool`; `relative_interior s:real^M->bool`]
        INVARIANCE_OF_DIMENSION_AFFINE_SETS) THEN
  ASM_REWRITE_TAC[AFFINE_AFFINE_HULL; AFF_DIM_AFFINE_HULL;
                  OPEN_IN_RELATIVE_INTERIOR] THEN
  DISCH_THEN MATCH_MP_TAC THEN
  CONJ_TAC THENL [ASM_MESON_TAC[RELATIVE_INTERIOR_EQ_EMPTY]; ALL_TAC] THEN
  ASSUME_TAC(ISPEC `s:real^M->bool` RELATIVE_INTERIOR_SUBSET) THEN
  CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]);;

let HOMEOMORPHIC_CONVEX_SETS = prove
 (`!s:real^M->bool t:real^N->bool.
        convex s /\ convex t /\ s homeomorphic t ==> aff_dim s = aff_dim t`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM; GSYM INT_LE_ANTISYM; homeomorphism] THEN
  MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC INVARIANCE_OF_DIMENSION_CONVEX_DOMAIN THENL
   [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^N->real^M`] THEN
  ASM_REWRITE_TAC[HULL_SUBSET] THEN ASM SET_TAC[]);;

let HOMEOMORPHIC_CONVEX_COMPACT_SETS_EQ = prove
 (`!s:real^M->bool t:real^N->bool.
        convex s /\ compact s /\ convex t /\ compact t
        ==> (s homeomorphic t <=> aff_dim s = aff_dim t)`,
  MESON_TAC[HOMEOMORPHIC_CONVEX_SETS; HOMEOMORPHIC_CONVEX_COMPACT_SETS]);;

let INVARIANCE_OF_DOMAIN_GEN = prove
 (`!f:real^M->real^N s.
        dimindex(:N) <= dimindex(:M) /\ f continuous_on s /\ open s /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
        ==> open(IMAGE f s)`,
  REPEAT STRIP_TAC THEN MP_TAC(ISPECL
   [`f:real^M->real^N`; `(:real^M)`; `(:real^N)`; `s:real^M->bool`]
   INVARIANCE_OF_DOMAIN_SUBSPACES) THEN
  ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; SUBSPACE_UNIV;
                  DIM_UNIV; SUBSET_UNIV]);;

let INJECTIVE_INTO_1D_IMP_OPEN_MAP_UNIV = prove
 (`!f:real^N->real^1 s t.
        f continuous_on s /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
        open t /\ t SUBSET s
        ==> open (IMAGE f t)`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC INVARIANCE_OF_DOMAIN_GEN THEN
  ASM_REWRITE_TAC[DIMINDEX_1; DIMINDEX_GE_1] THEN CONJ_TAC THENL
   [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]);;

let CONTINUOUS_ON_INVERSE_OPEN = prove
 (`!f:real^M->real^N g s.
        dimindex(:N) <= dimindex(:M) /\
        f continuous_on s /\ open s /\
        (!x. x IN s ==> g(f x) = x)
        ==> g continuous_on IMAGE f s`,
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[CONTINUOUS_OPEN_IN_PREIMAGE_EQ] THEN
  X_GEN_TAC `t:real^M->bool` THEN DISCH_TAC THEN
  SUBGOAL_THEN
   `{x | x IN IMAGE f s /\ g x IN t} = IMAGE (f:real^M->real^N) (s INTER t)`
  SUBST1_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC OPEN_OPEN_IN_TRANS] THEN
  REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
  CONJ_TAC THEN MATCH_MP_TAC INVARIANCE_OF_DOMAIN_GEN THEN
  ASM_SIMP_TAC[OPEN_INTER; IN_INTER] THEN
  ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]);;

let CONTINUOUS_ON_INVERSE_INTO_1D = prove
 (`!f:real^N->real^1 g s t.
        f continuous_on s /\
        (path_connected s \/
         connected s /\ (locally compact s \/ locally connected s) \/
         compact s \/
         open s) /\
        IMAGE f s = t /\ (!x. x IN s ==> g(f x) = x)
        ==> g continuous_on t`,
  REPEAT STRIP_TAC THENL
   [REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_INVERSE_OPEN_MAP THEN
    MAP_EVERY EXISTS_TAC [`f:real^N->real^1`; `s:real^N->bool`] THEN
    ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
    FIRST_ASSUM(SUBST1_TAC o SYM) THEN
    MATCH_MP_TAC INJECTIVE_INTO_1D_IMP_OPEN_MAP THEN ASM SET_TAC[];
    MATCH_MP_TAC CONTINUOUS_INVERSE_INJECTIVE_PROPER_MAP THEN
    MAP_EVERY EXISTS_TAC [`f:real^N->real^1`; `s:real^N->bool`] THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONOTONE_INTO_1D_IMP_PROPER_MAP THEN
    ASM_REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `y:real^1` THEN
    SUBGOAL_THEN
     `{x | x IN s /\ (f:real^N->real^1) x = y} = {} \/
      ?a. {x | x IN s /\ (f:real^N->real^1) x = y} = {a}`
    STRIP_ASSUME_TAC THENL
     [ASM SET_TAC[];
      ASM_REWRITE_TAC[COMPACT_EMPTY; CONNECTED_EMPTY];
      ASM_REWRITE_TAC[COMPACT_SING; CONNECTED_SING]];
    MATCH_MP_TAC CONTINUOUS_ON_INVERSE_OPEN_MAP THEN
    MAP_EVERY EXISTS_TAC [`f:real^N->real^1`; `s:real^N->bool`] THEN
    ASM_REWRITE_TAC[] THEN X_GEN_TAC `w:real^N->bool` THEN DISCH_TAC THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
    REWRITE_TAC[open_in; SUBSET; FORALL_IN_IMAGE] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `x:real^N` THEN DISCH_TAC] THEN
    ABBREV_TAC `u = connected_component w (x:real^N)` THEN
    SUBGOAL_THEN
     `connected u /\ (x:real^N) IN u /\ u SUBSET s /\ u SUBSET w /\
      open_in (subtopology euclidean s) u`
    STRIP_ASSUME_TAC THENL
     [EXPAND_TAC "u" THEN REPEAT CONJ_TAC THENL
       [MESON_TAC[CONNECTED_CONNECTED_COMPONENT];
        ASM_MESON_TAC[IN; CONNECTED_COMPONENT_REFL];
        ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET; SUBSET_TRANS];
        ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET];
        ASM_MESON_TAC[LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT]];
      SUBGOAL_THEN
       `?e. &0 < e /\ !y. y IN t /\ dist(y,(f:real^N->real^1) x) < e
            ==> y IN IMAGE f u`
      ASSUME_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
      REPEAT(FIRST_X_ASSUM(K ALL_TAC o
        check (free_in `w:real^N->bool`) o concl))] THEN
    SUBGOAL_THEN
     `(?e. &0 < e /\
           !y. y IN t /\ drop(f x) <= drop y /\ drop y < drop(f x) + e
               ==> y IN IMAGE f (u:real^N->bool)) /\
      (?e. &0 < e /\
           !y. y IN t /\ drop(f x) - e < drop y /\ drop y <= drop(f x)
               ==> y IN IMAGE f (u:real^N->bool))`
    MP_TAC THENL
     [ALL_TAC;
      DISCH_THEN(CONJUNCTS_THEN2
       (X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))
       (X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))) THEN
      REWRITE_TAC[IMP_IMP; AND_FORALL_THM; TAUT
       `(p ==> r) /\ (q ==> r) <=> (p \/ q ==> r)`] THEN
      DISCH_TAC THEN EXISTS_TAC `min d e:real` THEN
      ASM_REWRITE_TAC[REAL_LT_MIN; DIST_1] THEN
      REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC] THEN
    MP_TAC(ISPECL [`f:real^N->real^1`; `s:real^N->bool`]
        MONOTONE_TOPOLOGICALLY_INTO_1D) THEN
    ANTS_TAC THENL
     [ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^1` THEN
      SUBGOAL_THEN
       `{x | x IN s /\ (f:real^N->real^1) x = y} = {} \/
        ?a. {x | x IN s /\ (f:real^N->real^1) x = y} = {a}`
      STRIP_ASSUME_TAC THENL
       [ASM SET_TAC[];
        ASM_REWRITE_TAC[COMPACT_EMPTY; CONNECTED_EMPTY];
        ASM_REWRITE_TAC[COMPACT_SING; CONNECTED_SING]];
      ALL_TAC] THEN
    DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THENL
     [DISCH_THEN(MP_TAC o SPEC
       `{y | y IN IMAGE (f:real^N->real^1) s /\ drop(f x) <= drop y}`);
      DISCH_THEN(MP_TAC o SPEC
       `{y | y IN IMAGE (f:real^N->real^1) s /\ drop y <= drop(f x)}`)] THEN
    (ANTS_TAC THENL
      [REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN
       REWRITE_TAC[GSYM CONVEX_CONNECTED_1] THEN MATCH_MP_TAC CONVEX_INTER THEN
       REWRITE_TAC[drop; CONVEX_HALFSPACE_COMPONENT_LE;
                   REWRITE_RULE[real_ge] CONVEX_HALFSPACE_COMPONENT_GE] THEN
       REWRITE_TAC[CONVEX_CONNECTED_1] THEN
       ASM_MESON_TAC[CONNECTED_CONTINUOUS_IMAGE];
       ALL_TAC]) THEN
    REWRITE_TAC[IN_ELIM_THM; SET_RULE
     `x IN s /\ f x IN IMAGE f s /\ P x <=> x IN s /\ P x`] THEN
    REWRITE_TAC[CONNECTED_CLOSED_IN; NOT_EXISTS_THM] THEN
    DISCH_THEN(MP_TAC o SPEC `{x:real^N}`) THEN
    REWRITE_TAC[CLOSED_IN_SING; IN_ELIM_THM; REAL_LE_REFL] THEN
    REWRITE_TAC[NOT_INSERT_EMPTY] THENL
     [DISCH_THEN(MP_TAC o SPEC
       `{w:real^N | w IN s DIFF u /\ drop(f x) <= drop(f w)}`);
      DISCH_THEN(MP_TAC o SPEC
       `{w:real^N | w IN s DIFF u /\ drop(f w) <= drop(f x)}`)] THEN
    DISCH_THEN(MP_TAC o MATCH_MP (TAUT
     `~(p /\ q /\ r /\ s /\ ~t) ==> p /\ q /\ s ==> t \/ ~r`)) THEN
    (ANTS_TAC THENL
      [CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
       CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
       REWRITE_TAC[SET_RULE
        `{x | x IN s DIFF u /\ P x} =
         {x | x IN s /\ P x} INTER (s DIFF u)`] THEN
       MATCH_MP_TAC CLOSED_IN_SUBTOPOLOGY_INTER_SUBSET THEN
       EXISTS_TAC `s:real^N->bool` THEN
       CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
       MATCH_MP_TAC CLOSED_IN_INTER THEN REWRITE_TAC[CLOSED_IN_REFL] THEN
       MATCH_MP_TAC CLOSED_IN_DIFF THEN ASM_REWRITE_TAC[CLOSED_IN_REFL];
       ALL_TAC]) THEN
    DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
     `{x | x IN s DIFF u /\ P x} = {} \/
      ~({x | x IN s /\ P x} SUBSET {a} UNION {x | x IN s DIFF u /\ P x})
      ==> u SUBSET s
          ==> (!x. x IN s /\ P x ==> x = a) \/
              ?x. x IN u /\ ~(x = a) /\ P x`)) THEN
    ASM_REWRITE_TAC[] THEN
    (DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC MP_TAC) THENL
      [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN ASM SET_TAC[];
       ALL_TAC]) THEN
    DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `dist((f:real^N->real^1) x,f y)` THEN
    ASM_REWRITE_TAC[GSYM DIST_NZ] THEN
    (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
    X_GEN_TAC `z:real^1` THEN STRIP_TAC THEN
    (SUBGOAL_THEN `is_interval(IMAGE (f:real^N->real^1) u)` MP_TAC THENL
      [REWRITE_TAC[IS_INTERVAL_CONNECTED_1] THEN
       MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
       REWRITE_TAC[IS_INTERVAL_1] THEN DISCH_THEN MATCH_MP_TAC])
    THENL
     [ALL_TAC;
      ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
      ONCE_REWRITE_TAC[SWAP_EXISTS_THM]] THEN
    REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
    ONCE_REWRITE_TAC[EXISTS_IN_IMAGE] THEN
    EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN
    EXISTS_TAC `(f:real^N->real^1) y` THEN
    ASM_SIMP_TAC[FUN_IN_IMAGE] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LE]) THEN
    REWRITE_TAC[DIST_1] THEN ASM_REAL_ARITH_TAC;
    ASM_MESON_TAC[CONTINUOUS_ON_INVERSE];
    FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
    MATCH_MP_TAC CONTINUOUS_ON_INVERSE_OPEN THEN
    ASM_REWRITE_TAC[DIMINDEX_1; DIMINDEX_GE_1]]);;

let INVARIANCE_OF_DOMAIN_HOMEOMORPHISM = prove
 (`!f:real^M->real^N s.
        dimindex(:N) <= dimindex(:M) /\ f continuous_on s /\ open s /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
        ==> ?g. homeomorphism (s,IMAGE f s) (f,g)`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN
  DISCH_TAC THEN ASM_REWRITE_TAC[homeomorphism] THEN
  ASM_SIMP_TAC[CONTINUOUS_ON_INVERSE_OPEN] THEN ASM SET_TAC[]);;

let INVARIANCE_OF_DOMAIN_HOMEOMORPHIC = prove
 (`!f:real^M->real^N s.
        dimindex(:N) <= dimindex(:M) /\ f continuous_on s /\ open s /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
        ==> s homeomorphic (IMAGE f s)`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(MP_TAC o MATCH_MP INVARIANCE_OF_DOMAIN_HOMEOMORPHISM) THEN
  REWRITE_TAC[homeomorphic] THEN MESON_TAC[]);;

let HOMEOMORPHIC_INTERVALS_EQ = prove
 (`(!a b:real^M c d:real^N.
        interval[a,b] homeomorphic interval[c,d] <=>
        aff_dim(interval[a,b]) = aff_dim(interval[c,d])) /\
   (!a b:real^M c d:real^N.
        interval[a,b] homeomorphic interval(c,d) <=>
        interval[a,b] = {} /\ interval(c,d) = {}) /\
   (!a b:real^M c d:real^N.
        interval(a,b) homeomorphic interval[c,d] <=>
        interval(a,b) = {} /\ interval[c,d] = {}) /\
   (!a b:real^M c d:real^N.
        interval(a,b) homeomorphic interval(c,d) <=>
        interval(a,b) = {} /\ interval(c,d) = {} \/
        ~(interval(a,b) = {}) /\ ~(interval(c,d) = {}) /\
        dimindex(:M) = dimindex(:N))`,
  SIMP_TAC[HOMEOMORPHIC_CONVEX_COMPACT_SETS_EQ; CONVEX_INTERVAL;
           COMPACT_INTERVAL] THEN
  REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN
  ASM_REWRITE_TAC[HOMEOMORPHIC_EMPTY] THENL
   [FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN
    REWRITE_TAC[COMPACT_INTERVAL_EQ] THEN ASM_MESON_TAC[HOMEOMORPHIC_EMPTY];
    FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN
    REWRITE_TAC[COMPACT_INTERVAL_EQ] THEN ASM_MESON_TAC[HOMEOMORPHIC_EMPTY];
    MATCH_MP_TAC(TAUT
     `(p <=> q) /\ (~p /\ ~q ==> r) ==> p /\ q \/ ~p /\ ~q /\ r`) THEN
    CONJ_TAC THENL [ASM_MESON_TAC[HOMEOMORPHIC_EMPTY]; STRIP_TAC] THEN
    REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN
    MATCH_MP_TAC INVARIANCE_OF_DIMENSION THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THENL
     [ALL_TAC; GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM]] THEN
    MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
    REWRITE_TAC[homeomorphism] THEN STRIP_TAC THENL
     [EXISTS_TAC `interval(a:real^M,b)`;
      EXISTS_TAC `interval(c:real^N,d)`] THEN
    ASM_REWRITE_TAC[OPEN_INTERVAL] THEN ASM SET_TAC[];
    TRANS_TAC HOMEOMORPHIC_TRANS
     `IMAGE ((\x. lambda i. x$i):real^M->real^N)
            (interval(a,b))` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC INVARIANCE_OF_DOMAIN_HOMEOMORPHIC THEN
      REPEAT CONJ_TAC THENL
       [ASM_MESON_TAC[LE_REFL];
        MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN
        SIMP_TAC[linear; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
                 LAMBDA_BETA; CART_EQ];
        REWRITE_TAC[OPEN_INTERVAL];
        SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN ASM_MESON_TAC[]];
      ALL_TAC] THEN
    SUBGOAL_THEN
     `IMAGE ((\x. lambda i. x$i):real^M->real^N)
            (interval(a,b)) =
            interval((lambda i. a$i),(lambda i. b$i))`
    SUBST1_TAC THENL
     [MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
      SIMP_TAC[IN_INTERVAL; LAMBDA_BETA] THEN
      CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
      X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
      EXISTS_TAC `(lambda i. (y:real^N)$i):real^M` THEN
      SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
      FIRST_ASSUM(SUBST1_TAC o SYM) THEN   SIMP_TAC[CART_EQ; LAMBDA_BETA];
      MATCH_MP_TAC HOMEOMORPHIC_OPEN_INTERVALS THEN
      GEN_REWRITE_TAC I [TAUT `(p <=> q) <=> (~p <=> ~q)`] THEN
      SIMP_TAC[INTERVAL_NE_EMPTY; LAMBDA_BETA] THEN
      REPEAT(FIRST_X_ASSUM(MP_TAC o
        GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY])) THEN
      ASM_MESON_TAC[]]]);;

let CONTINUOUS_IMAGE_SUBSET_INTERIOR = prove
 (`!f:real^M->real^N s.
        f continuous_on s /\ dimindex(:N) <= dimindex(:M) /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
        ==> IMAGE f (interior s) SUBSET interior(IMAGE f s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_MAXIMAL THEN
  SIMP_TAC[IMAGE_SUBSET; INTERIOR_SUBSET] THEN
  ASM_CASES_TAC `interior s:real^M->bool = {}` THENL
   [ASM_REWRITE_TAC[INTERIOR_EMPTY; OPEN_EMPTY; IMAGE_CLAUSES];
    MATCH_MP_TAC INVARIANCE_OF_DOMAIN_GEN] THEN
  ASM_REWRITE_TAC[OPEN_INTERIOR] THEN
  ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET; SUBSET]);;

let HOMEOMORPHIC_INTERIORS_SAME_DIMENSION = prove
 (`!s:real^M->bool t:real^N->bool.
        dimindex(:M) = dimindex(:N) /\ s homeomorphic t
        ==> (interior s) homeomorphic (interior t)`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
  REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN
  STRIP_TAC THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] INTERIOR_SUBSET] THEN
  REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN
  REPEAT CONJ_TAC THENL
   [SUBGOAL_THEN `t = IMAGE (f:real^M->real^N) s` SUBST1_TAC THENL
     [ASM SET_TAC[];
      MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_INTERIOR THEN
      ASM_MESON_TAC[LE_REFL]];
    SUBGOAL_THEN `s = IMAGE (g:real^N->real^M) t` SUBST1_TAC THENL
     [ASM SET_TAC[];
      MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_INTERIOR THEN
      ASM_MESON_TAC[LE_REFL]];
    ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET];
    ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET]]);;

let HOMEOMORPHIC_INTERIORS = prove
 (`!s:real^M->bool t:real^N->bool.
        s homeomorphic t /\ (interior s = {} <=> interior t = {})
        ==> (interior s) homeomorphic (interior t)`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `interior t:real^N->bool = {}` THEN
  ASM_SIMP_TAC[HOMEOMORPHIC_EMPTY] THEN STRIP_TAC THEN
  MATCH_MP_TAC HOMEOMORPHIC_INTERIORS_SAME_DIMENSION THEN
  ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM
   (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
  REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN
  MATCH_MP_TAC INVARIANCE_OF_DIMENSION THENL
   [MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `interior s:real^M->bool`];
    MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `interior t:real^N->bool`]] THEN
  ASM_REWRITE_TAC[OPEN_INTERIOR] THEN
  ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET; SUBSET]);;

let HOMEOMORPHIC_FRONTIERS_SAME_DIMENSION = prove
 (`!s:real^M->bool t:real^N->bool.
        dimindex(:M) = dimindex(:N) /\
        s homeomorphic t /\ closed s /\ closed t
        ==> (frontier s) homeomorphic (frontier t)`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
  REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN
  ASM_SIMP_TAC[REWRITE_RULE[SUBSET] FRONTIER_SUBSET_CLOSED] THEN
  STRIP_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
   [ALL_TAC; ASM_MESON_TAC[FRONTIER_SUBSET_CLOSED; CONTINUOUS_ON_SUBSET]] THEN
  ASM_SIMP_TAC[frontier; CLOSURE_CLOSED] THEN
  SUBGOAL_THEN
   `(!x:real^M. x IN interior s ==> f x IN interior t) /\
    (!y:real^N. y IN interior t ==> g y IN interior s)`
  MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN
  CONJ_TAC THENL
   [SUBGOAL_THEN `t = IMAGE (f:real^M->real^N) s` SUBST1_TAC THENL
     [ASM SET_TAC[];
      MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_INTERIOR THEN
      ASM_MESON_TAC[LE_REFL]];
    SUBGOAL_THEN `s = IMAGE (g:real^N->real^M) t` SUBST1_TAC THENL
     [ASM SET_TAC[];
      MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_INTERIOR THEN
      ASM_MESON_TAC[LE_REFL]]]);;

let HOMEOMORPHIC_FRONTIERS = prove
 (`!s:real^M->bool t:real^N->bool.
        s homeomorphic t /\ closed s /\ closed t /\
        (interior s = {} <=> interior t = {})
        ==> (frontier s) homeomorphic (frontier t)`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `interior t:real^N->bool = {}` THENL
   [ASM_SIMP_TAC[frontier; CLOSURE_CLOSED; DIFF_EMPTY]; STRIP_TAC] THEN
  MATCH_MP_TAC HOMEOMORPHIC_FRONTIERS_SAME_DIMENSION THEN
  ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM
   (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
  REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN
  MATCH_MP_TAC INVARIANCE_OF_DIMENSION THENL
   [MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `interior s:real^M->bool`];
    MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `interior t:real^N->bool`]] THEN
  ASM_REWRITE_TAC[OPEN_INTERIOR] THEN
  ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET; SUBSET]);;

let CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\ IMAGE f s SUBSET t /\ aff_dim t <= aff_dim s /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
        ==> IMAGE f (relative_interior s) SUBSET relative_interior(IMAGE f s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC RELATIVE_INTERIOR_MAXIMAL THEN
  SIMP_TAC[IMAGE_SUBSET; RELATIVE_INTERIOR_SUBSET] THEN
  MATCH_MP_TAC INVARIANCE_OF_DOMAIN_AFFINE_SETS THEN
  EXISTS_TAC `affine hull s:real^M->bool` THEN
  ASM_REWRITE_TAC[AFFINE_AFFINE_HULL; AFF_DIM_AFFINE_HULL] THEN
  REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR] THEN CONJ_TAC THENL
   [ASM_MESON_TAC[AFF_DIM_SUBSET; INT_LE_TRANS]; ALL_TAC] THEN
  ASSUME_TAC(ISPEC `s:real^M->bool` RELATIVE_INTERIOR_SUBSET) THEN
  REPEAT CONJ_TAC THENL
   [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC; ASM SET_TAC[]] THEN
  MATCH_MP_TAC SUBSET_TRANS THEN
  EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN
  SIMP_TAC[IMAGE_SUBSET; RELATIVE_INTERIOR_SUBSET; HULL_SUBSET]);;

let HOMEOMORPHIC_RELATIVE_INTERIORS_SAME_DIMENSION = prove
 (`!s:real^M->bool t:real^N->bool.
        aff_dim s = aff_dim t /\ s homeomorphic t
        ==> (relative_interior s) homeomorphic (relative_interior t)`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
  REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN
  STRIP_TAC THEN
  ASM_SIMP_TAC[REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET] THEN
  REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN
  REPEAT CONJ_TAC THENL
   [SUBGOAL_THEN `t = IMAGE (f:real^M->real^N) s` SUBST1_TAC THENL
     [ASM SET_TAC[];
      MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR THEN
      EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN
      ASM SET_TAC[]];
    SUBGOAL_THEN `s = IMAGE (g:real^N->real^M) t` SUBST1_TAC THENL
     [ASM SET_TAC[];
      MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR THEN
      EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN
      ASM SET_TAC[]];
    ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; RELATIVE_INTERIOR_SUBSET];
    ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; RELATIVE_INTERIOR_SUBSET]]);;

let HOMEOMORPHIC_RELATIVE_INTERIORS = prove
 (`!s:real^M->bool t:real^N->bool.
        s homeomorphic t /\
        (relative_interior s = {} <=> relative_interior t = {})
        ==> (relative_interior s) homeomorphic (relative_interior t)`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `relative_interior t:real^N->bool = {}` THEN
  ASM_SIMP_TAC[HOMEOMORPHIC_EMPTY] THEN STRIP_TAC THEN
  MATCH_MP_TAC HOMEOMORPHIC_RELATIVE_INTERIORS_SAME_DIMENSION THEN
  ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM
   (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
  ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN
  REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN CONJ_TAC THEN
  MATCH_MP_TAC INVARIANCE_OF_DIMENSION_AFFINE_SETS THENL
   [MAP_EVERY EXISTS_TAC
     [`f:real^M->real^N`; `relative_interior s:real^M->bool`];
    MAP_EVERY EXISTS_TAC
     [`g:real^N->real^M`; `relative_interior t:real^N->bool`]] THEN
  ASM_REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR; AFFINE_AFFINE_HULL] THEN
  (REPEAT CONJ_TAC THENL
    [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; RELATIVE_INTERIOR_SUBSET];
     ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; HULL_SUBSET; SET_RULE
      `(!x. x IN s ==> f x IN t) /\ s' SUBSET s /\ t SUBSET t'
       ==> IMAGE f s' SUBSET t'`];
     ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET]]));;

let HOMEOMORPHIC_RELATIVE_BOUNDARIES_SAME_DIMENSION = prove
 (`!s:real^M->bool t:real^N->bool.
        aff_dim s = aff_dim t /\ s homeomorphic t
        ==> (s DIFF relative_interior s) homeomorphic
            (t DIFF relative_interior t)`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
  REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN
  STRIP_TAC THEN ASM_SIMP_TAC[IN_DIFF] THEN
  ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
   [ALL_TAC; ASM_MESON_TAC[SUBSET_DIFF; CONTINUOUS_ON_SUBSET]] THEN
  SUBGOAL_THEN
   `(!x:real^M. x IN relative_interior s ==> f x IN relative_interior t) /\
    (!y:real^N. y IN relative_interior t ==> g y IN relative_interior s)`
  MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN
  CONJ_TAC THENL
   [SUBGOAL_THEN `t = IMAGE (f:real^M->real^N) s` SUBST1_TAC THENL
     [ASM SET_TAC[];
      MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR THEN
      EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN
      ASM SET_TAC[]];
    SUBGOAL_THEN `s = IMAGE (g:real^N->real^M) t` SUBST1_TAC THENL
     [ASM SET_TAC[];
      MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR THEN
      EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN
      ASM SET_TAC[]]]);;

let HOMEOMORPHIC_RELATIVE_BOUNDARIES = prove
 (`!s:real^M->bool t:real^N->bool.
        s homeomorphic t /\
        (relative_interior s = {} <=> relative_interior t = {})
        ==> (s DIFF relative_interior s) homeomorphic
            (t DIFF relative_interior t)`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `relative_interior t:real^N->bool = {}` THEN
  ASM_SIMP_TAC[DIFF_EMPTY] THEN STRIP_TAC THEN
  MATCH_MP_TAC HOMEOMORPHIC_RELATIVE_BOUNDARIES_SAME_DIMENSION THEN
  ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM
   (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
  ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN
  REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN CONJ_TAC THEN
  MATCH_MP_TAC INVARIANCE_OF_DIMENSION_AFFINE_SETS THENL
   [MAP_EVERY EXISTS_TAC
     [`f:real^M->real^N`; `relative_interior s:real^M->bool`];
    MAP_EVERY EXISTS_TAC
     [`g:real^N->real^M`; `relative_interior t:real^N->bool`]] THEN
  ASM_REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR; AFFINE_AFFINE_HULL] THEN
  (REPEAT CONJ_TAC THENL
    [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; RELATIVE_INTERIOR_SUBSET];
     ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; HULL_SUBSET; SET_RULE
      `(!x. x IN s ==> f x IN t) /\ s' SUBSET s /\ t SUBSET t'
       ==> IMAGE f s' SUBSET t'`];
     ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET]]));;

let UNIFORMLY_CONTINUOUS_HOMEOMORPHISM_UNIV_TRIVIAL = prove
 (`!f g s:real^N->bool.
        homeomorphism (s,(:real^N)) (f,g) /\ f uniformly_continuous_on s
        ==> s = (:real^N)`,
  REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphism; IN_UNIV] THEN
  ASM_CASES_TAC `s:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[NOT_IN_EMPTY] THENL [SET_TAC[]; STRIP_TAC] THEN
  MP_TAC(ISPEC `s:real^N->bool` CLOPEN) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(SUBST1_TAC o SYM) THEN CONJ_TAC THENL
   [REWRITE_TAC[GSYM COMPLETE_EQ_CLOSED; complete] THEN
    X_GEN_TAC `x:num->real^N` THEN STRIP_TAC THEN
    SUBGOAL_THEN `cauchy ((f:real^N->real^N) o x)` MP_TAC THENL
     [ASM_MESON_TAC[UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS]; ALL_TAC] THEN
    REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN
    DISCH_THEN(X_CHOOSE_TAC `l:real^N`) THEN
    EXISTS_TAC `(g:real^N->real^N) l` THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN
    EXISTS_TAC `(g:real^N->real^N) o (f:real^N->real^N) o (x:num->real^N)` THEN
    REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL
     [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM SET_TAC[];
      MATCH_MP_TAC LIM_CONTINUOUS_FUNCTION THEN ASM_SIMP_TAC[GSYM o_DEF] THEN
      ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV]];
    FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
    MATCH_MP_TAC INVARIANCE_OF_DOMAIN THEN
    ASM_REWRITE_TAC[OPEN_UNIV] THEN ASM SET_TAC[]]);;

let INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET_GEN = prove
 (`!f:real^M->real^N u s t.
        f continuous_on s /\ IMAGE f s SUBSET t /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
        bounded u /\ convex u /\ affine t /\ aff_dim t < aff_dim u /\
        open_in (subtopology euclidean (relative_frontier u)) s
        ==> open_in (subtopology euclidean t) (IMAGE f s)`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `relative_frontier u:real^M->bool = {}` THEN
  ASM_SIMP_TAC[OPEN_IN_SUBTOPOLOGY_EMPTY; IMAGE_CLAUSES; OPEN_IN_EMPTY] THEN
  STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
  SUBGOAL_THEN
   `?b c:real^M. b IN relative_frontier u /\ c IN relative_frontier u /\
                 ~(b = c)`
  STRIP_ASSUME_TAC THENL
   [MATCH_MP_TAC(SET_RULE
     `~(s = {} \/ ?x. s = {x}) ==> ?a b. a IN s /\ b IN s /\ ~(a = b)`) THEN
    ASM_MESON_TAC[RELATIVE_FRONTIER_NOT_SING];
    ALL_TAC] THEN
  MP_TAC(ISPECL [`(:real^M)`; `aff_dim(u:real^M->bool) - &1`]
        CHOOSE_AFFINE_SUBSET) THEN
  REWRITE_TAC[SUBSET_UNIV; AFFINE_UNIV] THEN ANTS_TAC THENL
   [MATCH_MP_TAC(INT_ARITH
     `&0:int <= t /\ t <= n ==> --a <= t - a /\ t - &1 <= n`) THEN
    REWRITE_TAC[AFF_DIM_LE_UNIV; AFF_DIM_UNIV; AFF_DIM_POS_LE] THEN
    ASM_MESON_TAC[RELATIVE_FRONTIER_EMPTY; NOT_IN_EMPTY];
    DISCH_THEN(X_CHOOSE_THEN `af:real^M->bool` STRIP_ASSUME_TAC)] THEN
  MP_TAC(ISPECL [`u:real^M->bool`; `af:real^M->bool`]
        HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN) THEN
  ASM_REWRITE_TAC[INT_ARITH `x - a + a:int = x`] THEN
  DISCH_THEN(fun th ->
    MP_TAC(SPEC `c:real^M` th) THEN MP_TAC(SPEC `b:real^M` th)) THEN
  ASM_REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`g:real^M->real^M`; `h:real^M->real^M`] THEN
  REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
  MAP_EVERY X_GEN_TAC [`j:real^M->real^M`; `k:real^M->real^M`] THEN
  STRIP_TAC THEN
  MP_TAC(ISPECL
   [`(f:real^M->real^N) o (k:real^M->real^M)`;
    `(af:real^M->bool)`;
    `t:real^N->bool`; `IMAGE (j:real^M->real^M) (s DELETE c)`]
   INVARIANCE_OF_DOMAIN_AFFINE_SETS) THEN
  MP_TAC(ISPECL
   [`(f:real^M->real^N) o (h:real^M->real^M)`;
    `(af:real^M->bool)`;
    `t:real^N->bool`; `IMAGE (g:real^M->real^M) (s DELETE b)`]
   INVARIANCE_OF_DOMAIN_AFFINE_SETS) THEN
  ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
  ASM_REWRITE_TAC[IMP_IMP; INT_ARITH `x:int <= y - &1 <=> x < y`] THEN
  MATCH_MP_TAC(TAUT
   `(p1 /\ p2) /\ (q1 /\ q2 ==> r) ==> (p1 ==> q1) /\ (p2 ==> q2) ==> r`) THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN
    ASM SET_TAC[];
    REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
    RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_DELETE]) THEN
    ASM_SIMP_TAC[o_THM; IN_DELETE; IMP_CONJ] THEN ASM_MESON_TAC[];
    MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN MAP_EVERY EXISTS_TAC
     [`h:real^M->real^M`; `relative_frontier u DELETE (b:real^M)`] THEN
    ASM_SIMP_TAC[homeomorphism; DOT_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
    ASM_REWRITE_TAC[IN_ELIM_THM; OPEN_IN_OPEN] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
    MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[];
    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN
    ASM SET_TAC[];
    REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
    RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_DELETE]) THEN
    ASM_SIMP_TAC[o_THM; IN_DELETE; IMP_CONJ] THEN ASM_MESON_TAC[];
    MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN MAP_EVERY EXISTS_TAC
     [`k:real^M->real^M`; `relative_frontier u DELETE (c:real^M)`] THEN
    ASM_SIMP_TAC[homeomorphism; DOT_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
    ASM_REWRITE_TAC[IN_ELIM_THM; OPEN_IN_OPEN] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
    MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[];
    DISCH_THEN(MP_TAC o MATCH_MP OPEN_IN_UNION) THEN
    MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
    MATCH_MP_TAC EQ_TRANS THEN
    EXISTS_TAC `IMAGE (f:real^M->real^N)
                      ((s DELETE b) UNION (s DELETE c))` THEN
    CONJ_TAC THENL
     [REWRITE_TAC[IMAGE_UNION] THEN BINOP_TAC; ASM SET_TAC[]] THEN
    REWRITE_TAC[IMAGE_o] THEN AP_TERM_TAC THEN ASM SET_TAC[]]);;

let INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET = prove
 (`!f:real^M->real^N a r s t.
        f continuous_on s /\ IMAGE f s SUBSET t /\
        (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
        ~(r = &0) /\ affine t /\ aff_dim t < &(dimindex(:M)) /\
        open_in (subtopology euclidean (sphere(a,r))) s
        ==> open_in (subtopology euclidean t) (IMAGE f s)`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `sphere(a:real^M,r) = {}` THEN
  ASM_SIMP_TAC[OPEN_IN_SUBTOPOLOGY_EMPTY; OPEN_IN_EMPTY; IMAGE_CLAUSES] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[SPHERE_EQ_EMPTY; REAL_NOT_LT]) THEN
  STRIP_TAC THEN
  MP_TAC(ISPECL [`f:real^M->real^N`; `cball(a:real^M,r)`;
                 `s:real^M->bool`; `t:real^N->bool`]
        INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET_GEN) THEN
  ASM_REWRITE_TAC[AFF_DIM_CBALL; RELATIVE_FRONTIER_CBALL;
                  BOUNDED_CBALL; CONVEX_CBALL] THEN
  COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);;

let NO_EMBEDDING_SPHERE_LOWDIM = prove
 (`!f:real^M->real^N a r.
        &0 < r /\
        f continuous_on sphere(a,r) /\
        (!x y. x IN sphere(a,r) /\ y IN sphere(a,r) /\ f x = f y ==> x = y)
        ==> dimindex(:M) <= dimindex(:N)`,
  REWRITE_TAC[GSYM NOT_LT] THEN REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC `IMAGE (f:real^M->real^N) (sphere(a:real^M,r))`
        COMPACT_OPEN) THEN
  ASM_SIMP_TAC[COMPACT_CONTINUOUS_IMAGE; IMAGE_EQ_EMPTY;
               COMPACT_SPHERE; SPHERE_EQ_EMPTY;
               REAL_ARITH `&0 < r ==> ~(r < &0)`] THEN
  ONCE_REWRITE_TAC[OPEN_IN] THEN
  ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
  MATCH_MP_TAC INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET THEN
  MAP_EVERY EXISTS_TAC [`a:real^M`; `r:real`] THEN
  ASM_REWRITE_TAC[AFFINE_UNIV; SUBSET_UNIV; AFF_DIM_UNIV;
                  OPEN_IN_REFL; INT_OF_NUM_LT] THEN
  ASM_REAL_ARITH_TAC);;

let EMPTY_INTERIOR_LOWDIM_GEN = prove
 (`!s:real^N->bool t:real^M->bool.
        dimindex(:M) < dimindex(:N) /\ s homeomorphic t ==> interior s = {}`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`(:real^M)`; `(:real^N)`] ISOMETRY_SUBSET_SUBSPACE) THEN
  ASM_SIMP_TAC[SUBSPACE_UNIV; DIM_UNIV; LT_IMP_LE; IN_UNIV; SUBSET_UNIV] THEN
  DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` STRIP_ASSUME_TAC) THEN
  MATCH_MP_TAC(MESON[HOMEOMORPHIC_EMPTY]
   `!t. interior(t:real^N->bool) homeomorphic interior(s:real^N->bool) /\
        interior t = {}
        ==> interior s = {}`) THEN
  EXISTS_TAC `IMAGE (h:real^M->real^N) t` THEN CONJ_TAC THENL
   [MATCH_MP_TAC HOMEOMORPHIC_INTERIORS_SAME_DIMENSION THEN REWRITE_TAC[] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_SYM]) THEN
    MATCH_MP_TAC EQ_IMP THEN CONV_TAC SYM_CONV THEN
    MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ THEN
    ASM_MESON_TAC[PRESERVES_NORM_INJECTIVE];
    MATCH_MP_TAC(SET_RULE `!t. s SUBSET t /\ t = {} ==> s = {}`) THEN
    EXISTS_TAC `interior(IMAGE (h:real^M->real^N) (:real^M))` THEN
    SIMP_TAC[SUBSET_INTERIOR; SET_RULE `IMAGE f s SUBSET IMAGE f UNIV`] THEN
    MATCH_MP_TAC EMPTY_INTERIOR_LOWDIM THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        LET_TRANS)) THEN
    REWRITE_TAC[GSYM DIM_UNIV] THEN
    MATCH_MP_TAC EQ_IMP_LE THEN MATCH_MP_TAC DIM_INJECTIVE_LINEAR_IMAGE THEN
    ASM_MESON_TAC[PRESERVES_NORM_INJECTIVE]]);;

let EMPTY_INTERIOR_LOWDIM_GEN_LE = prove
 (`!s:real^N->bool t:real^M->bool.
        dimindex(:M) <= dimindex(:N) /\
        interior t = {} /\
        s homeomorphic t
        ==> interior s = {}`,
  REWRITE_TAC[LE_LT] THEN REPEAT STRIP_TAC THENL
   [ASM_MESON_TAC[EMPTY_INTERIOR_LOWDIM_GEN];
    ASM_MESON_TAC[HOMEOMORPHIC_INTERIORS_SAME_DIMENSION;
                  HOMEOMORPHIC_EMPTY]]);;

let HOMEOMORPHIC_HYPERPLANES_EQ = prove
 (`!a:real^M b c:real^N d.
        ~(a = vec 0) /\ ~(c = vec 0)
        ==> ({x | a dot x = b} homeomorphic {x | c dot x = d} <=>
             dimindex(:M) = dimindex(:N))`,
  SIMP_TAC[HOMEOMORPHIC_AFFINE_SETS_EQ; AFFINE_HYPERPLANE] THEN
  SIMP_TAC[AFF_DIM_HYPERPLANE; INT_OF_NUM_EQ;
          INT_ARITH `x - &1:int = y - &1 <=> x = y`]);;

let HOMEOMORPHIC_UNIV_UNIV = prove
 (`(:real^M) homeomorphic (:real^N) <=> dimindex(:M) = dimindex(:N)`,
  SIMP_TAC[HOMEOMORPHIC_SUBSPACES_EQ; DIM_UNIV; SUBSPACE_UNIV]);;

let HOMEOMORPHIC_CBALLS_EQ = prove
 (`!a:real^M b:real^N r s.
        cball(a,r) homeomorphic cball(b,s) <=>
        r < &0 /\ s < &0 \/ r = &0 /\ s = &0 \/
        &0 < r /\ &0 < s /\ dimindex(:M) = dimindex(:N)`,
  let lemma =
    let d = `dimindex(:M) = dimindex(:N)`
    and t = `?a:real^M b:real^N. ~(cball(a,r) homeomorphic cball(b,s))` in
    DISCH d (DISCH t (GEOM_EQUAL_DIMENSION_RULE (ASSUME d) (ASSUME t))) in
  REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THENL
   [ASM_SIMP_TAC[CBALL_EMPTY; HOMEOMORPHIC_EMPTY; CBALL_EQ_EMPTY] THEN
    EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
    ALL_TAC] THEN
  ASM_CASES_TAC `r = &0` THEN ASM_REWRITE_TAC[REAL_LT_REFL] THENL
   [ASM_SIMP_TAC[CBALL_TRIVIAL; FINITE_SING; HOMEOMORPHIC_FINITE_STRONG] THEN
    REWRITE_TAC[FINITE_CBALL] THEN
    ASM_CASES_TAC `s < &0` THEN
    ASM_SIMP_TAC[CBALL_EMPTY; CARD_CLAUSES; FINITE_EMPTY;
                 NOT_IN_EMPTY; ARITH; REAL_LT_IMP_NE] THEN
    ASM_CASES_TAC `s = &0` THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
    ASM_SIMP_TAC[CBALL_TRIVIAL; CARD_CLAUSES; FINITE_EMPTY; NOT_IN_EMPTY;
                 REAL_LE_REFL; ARITH];
    ALL_TAC] THEN
  SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
  ASM_CASES_TAC `s <= &0` THEN
  ASM_SIMP_TAC[HOMEOMORPHIC_FINITE_STRONG; FINITE_CBALL] THENL
   [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
  SUBGOAL_THEN `&0 < s` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
  ASM_REWRITE_TAC[] THEN EQ_TAC THENL
   [REWRITE_TAC[homeomorphic; HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
    STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN
    MATCH_MP_TAC INVARIANCE_OF_DIMENSION THENL
     [MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `ball(a:real^M,r)`] THEN
      MP_TAC(ISPECL [`a:real^M`; `r:real`] BALL_SUBSET_CBALL);
      MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `ball(b:real^N,s)`] THEN
      MP_TAC(ISPECL [`b:real^N`; `s:real`] BALL_SUBSET_CBALL)] THEN
    ASM_REWRITE_TAC[BALL_EQ_EMPTY; OPEN_BALL; REAL_NOT_LE] THEN
    ASM_MESON_TAC[SUBSET; CONTINUOUS_ON_SUBSET];
    DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN
    GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN
    REWRITE_TAC[NOT_EXISTS_THM] THEN ASM_SIMP_TAC[HOMEOMORPHIC_CBALLS]]);;

let HOMEOMORPHIC_BALLS_EQ = prove
 (`!a:real^M b:real^N r s.
        ball(a,r) homeomorphic ball(b,s) <=>
        r <= &0 /\ s <= &0 \/
        &0 < r /\ &0 < s /\ dimindex(:M) = dimindex(:N)`,
  let lemma =
    let d = `dimindex(:M) = dimindex(:N)`
    and t = `?a:real^M b:real^N. ~(ball(a,r) homeomorphic ball(b,s))` in
    DISCH d (DISCH t (GEOM_EQUAL_DIMENSION_RULE (ASSUME d) (ASSUME t))) in
  REPEAT GEN_TAC THEN ASM_CASES_TAC `r <= &0` THENL
   [ASM_SIMP_TAC[BALL_EMPTY; HOMEOMORPHIC_EMPTY; BALL_EQ_EMPTY] THEN
    EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
    ALL_TAC] THEN
  ASM_CASES_TAC `s <= &0` THENL
   [ASM_SIMP_TAC[BALL_EMPTY; HOMEOMORPHIC_EMPTY; BALL_EQ_EMPTY] THEN
    ASM_REAL_ARITH_TAC;
    ALL_TAC] THEN
  ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN
  ASM_REWRITE_TAC[] THEN EQ_TAC THENL
   [REWRITE_TAC[homeomorphic; HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
    STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN
    MATCH_MP_TAC INVARIANCE_OF_DIMENSION THENL
     [MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `ball(a:real^M,r)`];
      MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `ball(b:real^N,s)`]] THEN
    ASM_REWRITE_TAC[BALL_EQ_EMPTY; OPEN_BALL; REAL_NOT_LE] THEN
    ASM SET_TAC[];
    DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN
    GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN
    REWRITE_TAC[NOT_EXISTS_THM] THEN ASM_SIMP_TAC[HOMEOMORPHIC_BALLS]]);;

(* ------------------------------------------------------------------------- *)
(* General forms of the Jordan curve theorem in setting of R^n.              *)
(* ------------------------------------------------------------------------- *)

let CARD_EQ_COMPONENTS_COMPLEMENTS = prove
 (`!s t:real^N->bool.
        closed s /\ closed t /\ s homeomorphic t
        ==> components((:real^N) DIFF s) =_c components((:real^N) DIFF t)`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `?f g. homeomorphic_maps (euclidean_space (dimindex (:N)),euclidean)
                            (f:(num->real)->real^N,g)`
  STRIP_ASSUME_TAC THENL
   [MESON_TAC[HOMEOMORPHIC_MAPS_EUCLIDEAN_SPACE_EUCLIDEAN]; ALL_TAC] THEN
  MP_TAC(ISPECL
   [`dimindex(:N)`;
    `IMAGE (g:real^N->num->real) s`;
    `IMAGE (g:real^N->num->real) t`]
   CARD_EQ_CONNECTED_COMPONENTS_EUCLIDEAN_COMPLEMENTS) THEN
  ANTS_TAC THENL
   [REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
     [CONJ_TAC THENL
       [UNDISCH_TAC `closed(s:real^N->bool)`;
        UNDISCH_TAC `closed(t:real^N->bool)`] THEN
      REWRITE_TAC[CLOSED_IN] THEN MATCH_MP_TAC EQ_IMP THEN
      CONV_TAC SYM_CONV THEN MATCH_MP_TAC HOMEOMORPHIC_MAP_CLOSEDNESS THEN
      REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN
      ASM_MESON_TAC[HOMEOMORPHIC_MAPS_MAP];
      TRANS_TAC HOMEOMORPHIC_SPACE_TRANS
       `subtopology euclidean (s:real^N->bool)` THEN
      CONJ_TAC THENL
       [ONCE_REWRITE_TAC[HOMEOMORPHIC_SPACE_SYM];
        TRANS_TAC HOMEOMORPHIC_SPACE_TRANS
         `subtopology euclidean (t:real^N->bool)` THEN
        ASM_REWRITE_TAC[HOMEOMORPHIC_SPACE_EUCLIDEAN]] THEN
      REWRITE_TAC[HOMEOMORPHIC_SPACE] THEN
      EXISTS_TAC `g:real^N->num->real` THEN
      MATCH_MP_TAC HOMEOMORPHIC_MAP_SUBTOPOLOGIES THEN
      RULE_ASSUM_TAC(REWRITE_RULE[HOMEOMORPHIC_MAPS_MAP]) THEN
      ASM_REWRITE_TAC[TOPSPACE_EUCLIDEAN; INTER_UNIV] THEN
      RULE_ASSUM_TAC(REWRITE_RULE
       [TOPSPACE_EUCLIDEAN; HOMEOMORPHIC_EQ_EVERYTHING_MAP]) THEN
      ASM SET_TAC[]];
      MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC CARD_EQ_CONG] THEN
  W(fun (asl,w) ->
    SUBGOAL_THEN(mk_forall(`s:real^N->bool`,lhand w))
     (fun th -> REWRITE_TAC[th])) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MAPS_MAP]) THEN
  POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`dimindex(:N)`,`n:num`) THEN
  X_GEN_TAC `n:num` THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN; IN_UNIV] THEN
  STRIP_TAC THEN X_GEN_TAC `s:real^N->bool` THEN
  FIRST_ASSUM(MP_TAC o SPECL
   [`(:real^N) DIFF s`;
    `topspace (euclidean_space n) DIFF IMAGE g (s:real^N->bool)`] o
   MATCH_MP (REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_MAP_SUBTOPOLOGIES)) THEN
  ANTS_TAC THENL
   [ALL_TAC;
    DISCH_THEN(SUBST1_TAC o
      MATCH_MP HOMEOMORPHIC_MAP_CONNECTED_COMPONENTS_OF) THEN
    REWRITE_TAC[EUCLIDEAN_CONNECTED_COMPONENTS_OF] THEN
    MATCH_MP_TAC CARD_EQ_IMAGE] THEN
  REPEAT(POP_ASSUM MP_TAC) THEN
  REWRITE_TAC[HOMEOMORPHIC_EQ_EVERYTHING_MAP; TOPSPACE_EUCLIDEAN] THEN
  SET_TAC[]);;

let JORDAN_CURVE_THEOREM_GEN = prove
 (`!s:real^N->bool.
        2 <= dimindex(:N) /\ s homeomorphic sphere(vec 0:real^N,&1)
        ==> ?ins out.
                 ~(ins = {}) /\ open ins /\ connected ins /\
                 ~(out = {}) /\ open out /\ connected out /\
                 bounded ins /\ ~bounded out /\
                 ins INTER out = {} /\
                 ins UNION out = (:real^N) DIFF s /\
                 frontier ins = s /\
                 frontier out = s`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `compact(s:real^N->bool)` ASSUME_TAC THENL
   [ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS; COMPACT_SPHERE]; ALL_TAC] THEN
  MP_TAC(ISPECL [`s:real^N->bool`; `sphere(vec 0:real^N,&1)`]
        CARD_EQ_COMPONENTS_COMPLEMENTS) THEN
  ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_SPHERE] THEN
  DISCH_THEN(MP_TAC o SPEC `2` o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        CARD_HAS_SIZE_CONG)) THEN
  DISCH_THEN(MP_TAC o snd o EQ_IMP_RULE) THEN ANTS_TAC THENL
   [REWRITE_TAC[HAS_SIZE_CONV `s HAS_SIZE 2`] THEN
    MAP_EVERY EXISTS_TAC
     [`ball(vec 0:real^N,&1)`; `(:real^N) DIFF cball(vec 0,&1)`] THEN
    CONJ_TAC THENL
     [DISCH_THEN(MP_TAC o AP_TERM `bounded:(real^N->bool)->bool`) THEN
      REWRITE_TAC[BOUNDED_BALL] THEN
      MATCH_MP_TAC COBOUNDED_IMP_UNBOUNDED THEN
      REWRITE_TAC[BOUNDED_CBALL; COMPL_COMPL];
      MATCH_MP_TAC  COMPONENTS_UNIQUE_2 THEN REWRITE_TAC[CONNECTED_BALL] THEN
      ASM_SIMP_TAC[CONNECTED_COMPLEMENT_BOUNDED_CONVEX;
                   BOUNDED_CBALL; CONVEX_CBALL] THEN
      REWRITE_TAC[EXTENSION; IN_UNION; IN_DIFF; IN_UNIV] THEN
      REWRITE_TAC[IN_CBALL_0; IN_BALL_0; IN_SPHERE_0] THEN
      CONJ_TAC THENL [REAL_ARITH_TAC; DISCH_TAC] THEN MP_TAC(ISPECL
       [`\x:real^N. lift(norm x)`; `(:real^N) DIFF sphere(vec 0,&1)`]
       CONNECTED_CONTINUOUS_IMAGE) THEN
      ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_NORM_COMPOSE; CONTINUOUS_ON_ID] THEN
      REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_1] THEN
      REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_IMAGE] THEN
      DISCH_THEN(MP_TAC o SPEC `vec 0:real^N`) THEN
      REWRITE_TAC[NORM_0; IN_DIFF; IN_SPHERE_0; IN_UNIV; IN_IMAGE] THEN
      CONV_TAC REAL_RAT_REDUCE_CONV THEN
      DISCH_THEN(MP_TAC o SPEC `&2 % basis 1:real^N`) THEN
      REWRITE_TAC[FORALL_LIFT; LIFT_DROP; NORM_MUL; IN_IMAGE] THEN
      SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
      CONV_TAC REAL_RAT_REDUCE_CONV THEN
      DISCH_THEN(MP_TAC o SPEC `&1:real`) THEN
      CONV_TAC REAL_RAT_REDUCE_CONV THEN MESON_TAC[LIFT_EQ]];
      DISCH_TAC] THEN
  SUBGOAL_THEN `~connected((:real^N) DIFF s)` ASSUME_TAC THENL
   [RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN
    ASM_SIMP_TAC[CONNECTED_EQ_CARD_COMPONENTS] THEN CONV_TAC NUM_REDUCE_CONV;
    ALL_TAC] THEN
  MP_TAC(ISPEC `(:real^N) DIFF s` COBOUNDED_HAS_BOUNDED_COMPONENT) THEN
  ASM_SIMP_TAC[COMPL_COMPL; COMPACT_IMP_BOUNDED] THEN
  MATCH_MP_TAC MONO_EXISTS THEN
  X_GEN_TAC `ins:real^N->bool` THEN STRIP_TAC THEN
  MP_TAC(ISPEC `(:real^N) DIFF s` COBOUNDED_UNBOUNDED_COMPONENTS) THEN
  ASM_SIMP_TAC[COMPL_COMPL; COMPACT_IMP_BOUNDED] THEN
  MATCH_MP_TAC MONO_EXISTS THEN
  X_GEN_TAC `out:real^N->bool` THEN STRIP_TAC THEN
  REWRITE_TAC[GSYM CONNECTED_EQ_CARD_COMPONENTS] THEN
  ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[TAUT
   `a /\ b /\ c /\ d /\ e /\ f /\ g <=>
    (a /\ d) /\ (b /\ e) /\ (c /\ f) /\ g`] THEN
  CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]; ALL_TAC] THEN
  CONJ_TAC THENL
   [ASM_MESON_TAC[OPEN_COMPONENTS; closed; COMPACT_IMP_CLOSED]; ALL_TAC] THEN
  CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN
  CONJ_TAC THENL [ASM_MESON_TAC[COMPONENTS_NONOVERLAP]; ALL_TAC] THEN
  CONJ_TAC THENL
   [GEN_REWRITE_TAC RAND_CONV [UNIONS_COMPONENTS] THEN
    ASM_REWRITE_TAC[GSYM UNIONS_2] THEN AP_TERM_TAC THEN
    FIRST_X_ASSUM(MP_TAC o CONV_RULE HAS_SIZE_CONV) THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `!t. closed t /\ t PSUBSET s ==> connected ((:real^N) DIFF t)`
  ASSUME_TAC THENL
   [ALL_TAC;
    CONJ_TAC THEN MATCH_MP_TAC FRONTIER_MINIMAL_SEPARATING_CLOSED THEN
    ASM_SIMP_TAC[COMPACT_IMP_CLOSED]] THEN
  SUBGOAL_THEN
   `!t. t PSUBSET sphere(vec 0,&1) ==> connected((:real^N) DIFF t)`
  (LABEL_TAC "*") THENL
   [REWRITE_TAC[PSUBSET_ALT; SUBSET; IN_SPHERE; GSYM REAL_LE_ANTISYM] THEN
    REPEAT STRIP_TAC THEN
    SUBGOAL_THEN
     `(:real^N) DIFF t =
      {x:real^N | dist(vec 0,x) <= &1 /\ ~(x IN t)} UNION
      {x:real^N | &1 <= dist(vec 0,x) /\ ~(x IN t)}`
    SUBST1_TAC THENL
     [SET_TAC[REAL_LE_TOTAL]; MATCH_MP_TAC CONNECTED_UNION] THEN
    REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
      EXISTS_TAC `ball(vec 0:real^N,&1)` THEN
      ASM_SIMP_TAC[CONNECTED_BALL; CLOSURE_BALL; SUBSET; IN_BALL; IN_CBALL;
                   REAL_LT_01; IN_ELIM_THM] THEN
      ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_NOT_LE];
      MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
      EXISTS_TAC `(:real^N) DIFF cball(vec 0,&1)` THEN
      REWRITE_TAC[CLOSURE_COMPLEMENT; SUBSET; IN_DIFF; IN_UNIV;
                  IN_BALL; IN_CBALL; IN_ELIM_THM; INTERIOR_CBALL] THEN
      CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_NOT_LE]] THEN
      MATCH_MP_TAC CONNECTED_OPEN_DIFF_CBALL THEN
      ASM_REWRITE_TAC[SUBSET_UNIV; CONNECTED_UNIV; OPEN_UNIV];
      ASM SET_TAC[]];
    X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
    FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN
    DISCH_TAC THEN FIRST_ASSUM(MP_TAC o
     SPECL [`t:real^N->bool`; `IMAGE (f:real^N->real^N) t`] o
     MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHISM_OF_SUBSETS)) THEN
    ANTS_TAC THENL
     [RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
      DISCH_THEN(ASSUME_TAC o MATCH_MP HOMEOMORPHISM_IMP_HOMEOMORPHIC)] THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (f:real^N->real^N) t`) THEN
    ANTS_TAC THENL
     [RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
      MATCH_MP_TAC EQ_IMP] THEN
    REWRITE_TAC[CONNECTED_EQ_CARD_COMPONENTS] THEN
    MATCH_MP_TAC(MESON[HAS_SIZE]
      `(!n. s HAS_SIZE n <=> t HAS_SIZE n)
       ==> (FINITE s /\ CARD s <= m <=> FINITE t /\ CARD t <= m)`) THEN
    GEN_TAC THEN MATCH_MP_TAC CARD_HAS_SIZE_CONG THEN
    MATCH_MP_TAC CARD_EQ_COMPONENTS_COMPLEMENTS THEN ASM_REWRITE_TAC[] THEN
    CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[HOMEOMORPHIC_SYM]] THEN
    MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
    SUBGOAL_THEN `compact(t:real^N->bool)` MP_TAC THENL
     [ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET; PSUBSET];
      MATCH_MP_TAC EQ_IMP] THEN
    MATCH_MP_TAC HOMEOMORPHIC_COMPACTNESS THEN ASM_REWRITE_TAC[]]);;

let JORDAN_INSIDE_OUTSIDE_GEN = prove
(`!s:real^N->bool.
        2 <= dimindex(:N) /\ s homeomorphic sphere(vec 0:real^N,&1)
        ==> ~(inside s = {}) /\
            open(inside s) /\
            connected(inside s) /\
            ~(outside s = {}) /\
            open(outside s) /\
            connected(outside s) /\
            bounded(inside s) /\
            ~bounded(outside s) /\
            inside s INTER outside s = {} /\
            inside s UNION outside s = (:real^N) DIFF s /\
            frontier(inside s) = s /\
            frontier(outside s) = s`,
  GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP JORDAN_CURVE_THEOREM_GEN) THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`ins:real^N->bool`; `out:real^N->bool`] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN `inside s :real^N->bool = ins /\
                outside s:real^N->bool = out `
   (fun th -> ASM_REWRITE_TAC[th]) THEN
  MATCH_MP_TAC INSIDE_OUTSIDE_UNIQUE THEN
  SUBGOAL_THEN `compact(s:real^N->bool)` ASSUME_TAC THENL
   [ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS; COMPACT_SPHERE]; ALL_TAC] THEN
  ASM_SIMP_TAC[CONNECTED_OPEN_SET; GSYM closed; COMPACT_IMP_CLOSED] THEN
  ASM_MESON_TAC[]);;

let JORDAN_BROUWER_FRONTIER = prove
 (`!s t a:real^N r.
     2 <= dimindex(:N) /\
     s homeomorphic sphere(a,r) /\ t IN components((:real^N) DIFF s)
     ==> frontier t = s`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THENL
   [ASM_SIMP_TAC[SPHERE_EMPTY; HOMEOMORPHIC_EMPTY; IMP_CONJ; DIFF_EMPTY] THEN
    SIMP_TAC[snd(EQ_IMP_RULE(SPEC_ALL COMPONENTS_EQ_SING));
             UNIV_NOT_EMPTY; CONNECTED_UNIV; IN_SING; FRONTIER_UNIV];
    ALL_TAC] THEN
  ASM_CASES_TAC `r = &0` THENL
   [ASM_SIMP_TAC[HOMEOMORPHIC_FINITE_STRONG; SPHERE_SING; FINITE_SING] THEN
    SIMP_TAC[CARD_CLAUSES; FINITE_EMPTY; GSYM HAS_SIZE; NOT_IN_EMPTY] THEN
    REWRITE_TAC[HAS_SIZE_CLAUSES; UNWIND_THM2; NOT_IN_EMPTY; IMP_CONJ] THEN
    SIMP_TAC[LEFT_IMP_EXISTS_THM; CONNECTED_PUNCTURED_UNIVERSE; IN_SING;
             snd(EQ_IMP_RULE(SPEC_ALL COMPONENTS_EQ_SING)); FRONTIER_SING;
             SET_RULE `UNIV DIFF s = {} <=> s = UNIV`; FRONTIER_COMPLEMENT;
             MESON[BOUNDED_SING; NOT_BOUNDED_UNIV] `~((:real^N) = {a})`];
    ALL_TAC] THEN
  SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; STRIP_TAC] THEN
  MP_TAC(ISPEC `s:real^N->bool` JORDAN_CURVE_THEOREM_GEN) THEN ANTS_TAC THENL
   [ASM_REWRITE_TAC[] THEN
    TRANS_TAC HOMEOMORPHIC_TRANS `sphere(a:real^N,r)` THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMEOMORPHIC_SPHERES THEN
    ASM_REWRITE_TAC[REAL_LT_01];
    REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
  MAP_EVERY X_GEN_TAC [`ins:real^N->bool`; `out:real^N->bool`] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN `components((:real^N) DIFF s) = {ins,out}` SUBST_ALL_TAC THENL
   [ALL_TAC; ASM SET_TAC[]] THEN
  MATCH_MP_TAC COMPONENTS_UNIQUE_2 THEN ASM_REWRITE_TAC[] THEN
  SUBGOAL_THEN `compact(s:real^N->bool)` ASSUME_TAC THENL
   [ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS; COMPACT_SPHERE]; ALL_TAC] THEN
  ASM_SIMP_TAC[CONNECTED_OPEN_SET; GSYM closed; COMPACT_IMP_CLOSED] THEN
  ASM_MESON_TAC[]);;

let JORDAN_BROUWER_NONSEPARATION = prove
 (`!s t a:real^N r.
        2 <= dimindex(:N) /\
        s homeomorphic sphere(a,r) /\ t PSUBSET s
        ==> connected((:real^N) DIFF t)`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC MINIMAL_SEPARATING_COMMON_COMPONENT_FRONTIER THEN
  EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
   [DISCH_THEN SUBST_ALL_TAC THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN
    REWRITE_TAC[COMPACT_SPHERE; NOT_COMPACT_UNIV];
    REPEAT STRIP_TAC THEN MATCH_MP_TAC JORDAN_BROUWER_FRONTIER THEN
    ASM_MESON_TAC[]]);;

let JORDAN_BROUWER_SEPARATION = prove
 (`!s a:real^N r.
        &0 < r /\ s homeomorphic sphere(a,r) ==> ~connected((:real^N) DIFF s)`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  SUBGOAL_THEN `compact(s:real^N->bool)` ASSUME_TAC THENL
   [ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS; COMPACT_SPHERE]; ALL_TAC] THEN
  SUBGOAL_THEN `1 <= dimindex(:N)` MP_TAC THENL
   [REWRITE_TAC[DIMINDEX_GE_1];
    REWRITE_TAC[ARITH_RULE `1 <= n <=> n = 1 \/ 2 <= n`]] THEN
  STRIP_TAC THENL
   [ASM_SIMP_TAC[BOUNDED_SEPARATION_1D; COMPACT_IMP_BOUNDED] THEN
    DISCH_THEN SUBST_ALL_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_EMPTY]) THEN
    REWRITE_TAC[SPHERE_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC;
    ASM_SIMP_TAC[CONNECTED_OPEN_SET; GSYM closed; COMPACT_IMP_CLOSED] THEN
    MP_TAC(ISPEC `s:real^N->bool` JORDAN_CURVE_THEOREM_GEN) THEN ANTS_TAC THENL
     [ASM_REWRITE_TAC[] THEN
      TRANS_TAC HOMEOMORPHIC_TRANS `sphere(a:real^N,r)` THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMEOMORPHIC_SPHERES THEN
      ASM_REWRITE_TAC[REAL_LT_01];
      MESON_TAC[]]]);;

let JORDAN_CURVE_THEOREM = prove
 (`!c:real^1->real^2.
        simple_path c /\ pathfinish c = pathstart c
        ==> ?ins out.
                 ~(ins = {}) /\ open ins /\ connected ins /\
                 ~(out = {}) /\ open out /\ connected out /\
                 bounded ins /\ ~bounded out /\
                 ins INTER out = {} /\
                 ins UNION out = (:real^2) DIFF path_image c /\
                 frontier ins = path_image c /\
                 frontier out = path_image c`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC JORDAN_CURVE_THEOREM_GEN THEN
  REWRITE_TAC[DIMINDEX_2; LE_REFL] THEN
  ASM_SIMP_TAC[HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE; REAL_LT_01]);;

let JORDAN_DISCONNECTED = prove
 (`!c. simple_path c /\ pathfinish c = pathstart c
       ==> ~connected((:real^2) DIFF path_image c)`,
  GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[connected] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP JORDAN_CURVE_THEOREM) THEN
  REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);;

let JORDAN_INSIDE_OUTSIDE = prove
 (`!c:real^1->real^2.
        simple_path c /\ pathfinish c = pathstart c
        ==> ~(inside(path_image c) = {}) /\
            open(inside(path_image c)) /\
            connected(inside(path_image c)) /\
            ~(outside(path_image c) = {}) /\
            open(outside(path_image c)) /\
            connected(outside(path_image c)) /\
            bounded(inside(path_image c)) /\
            ~bounded(outside(path_image c)) /\
            inside(path_image c) INTER outside(path_image c) = {} /\
            inside(path_image c) UNION outside(path_image c) =
            (:real^2) DIFF path_image c /\
            frontier(inside(path_image c)) = path_image c /\
            frontier(outside(path_image c)) = path_image c`,
  GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC JORDAN_INSIDE_OUTSIDE_GEN THEN
  REWRITE_TAC[DIMINDEX_2; LE_REFL] THEN
  ASM_SIMP_TAC[HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE; REAL_LT_01]);;

let JORDAN_COMPONENTS = prove
 (`!g. simple_path g /\ pathfinish g = pathstart g
       ==> components((:real^2) DIFF path_image g) =
           {inside(path_image g),outside(path_image g)}`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPONENTS_OPEN_UNIQUE THEN
  REWRITE_TAC[UNIONS_2; PAIRWISE_INSERT; NOT_IN_EMPTY; FORALL_IN_INSERT;
              IMP_CONJ; PAIRWISE_EMPTY] THEN
  MP_TAC(ISPEC `g:real^1->real^2` JORDAN_INSIDE_OUTSIDE) THEN
  ASM_REWRITE_TAC[] THEN
  MP_TAC(ISPEC `path_image g:real^2->bool` INSIDE_INTER_OUTSIDE) THEN
  REPLICATE_TAC 2 STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);;

let HOMEOMORPHIC_SEPARATION_SPHERE_CARD_EQ = prove
 (`!s t:real^N->bool a r.
      s SUBSET sphere(a,r) /\ t SUBSET sphere(a,r) /\
      closed s /\ closed t /\ s homeomorphic t
      ==> (components(sphere(a,r) DIFF s) =_c components(sphere(a,r) DIFF t))`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `compact(s:real^N->bool) /\ compact(t:real^N->bool)`
  STRIP_ASSUME_TAC THENL
   [ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET; BOUNDED_SPHERE];
    ALL_TAC] THEN
  ASM_CASES_TAC `FINITE(sphere(a:real^N,r))` THENL
   [FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_CARD_EQ) THEN
    SUBGOAL_THEN `FINITE(s:real^N->bool) /\ FINITE(t:real^N->bool)`
    STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN
    ASM_SIMP_TAC[COMPONENTS_FINITE; FINITE_DIFF; CARD_EQ_CARD; SIMPLE_IMAGE;
      FINITE_IMAGE; CARD_IMAGE_INJ; CARD_DIFF; SET_RULE `{a} = {b} <=> a = b`];
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [FINITE_SPHERE]) THEN
    REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LE] THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE
     `~(n = 1) ==> 1 <= n ==> 2 <= n`)) THEN
    REWRITE_TAC[DIMINDEX_GE_1] THEN DISCH_TAC] THEN
  SUBGOAL_THEN
   `s PSUBSET sphere(a:real^N,r) <=> t PSUBSET sphere(a:real^N,r)`
  ASSUME_TAC THENL
   [REPEAT(POP_ASSUM MP_TAC) THEN MAP_EVERY (fun t -> SPEC_TAC(t,t))
     [`t:real^N->bool`; `s:real^N->bool`] THEN
    REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(MESON[]
     `(!s t. R s t ==> R t s) /\ (!s t. R s t ==> P s ==> P t)
      ==> !s t. R s t ==> (P s <=> P t)`) THEN
    CONJ_TAC THENL [REWRITE_TAC[HOMEOMORPHIC_SYM; CONJ_ACI]; ALL_TAC] THEN
    REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[PSUBSET] THEN
    DISCH_THEN SUBST_ALL_TAC THEN
    MP_TAC(ISPECL
     [`sphere(a:real^N,r)`; `s:real^N->bool`; `a:real^N`; `r:real`]
     JORDAN_BROUWER_NONSEPARATION) THEN
    ASM_REWRITE_TAC[HOMEOMORPHIC_REFL] THEN
    MATCH_MP_TAC JORDAN_BROUWER_SEPARATION THEN ASM_MESON_TAC[];
    ALL_TAC] THEN
  FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
   `(s PSUBSET u <=> t PSUBSET u)
    ==> s SUBSET u /\ t SUBSET u
        ==> s = u /\ t = u \/ s PSUBSET u /\ t PSUBSET u`)) THEN
  ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
  ASM_REWRITE_TAC[DIFF_EQ_EMPTY; COMPONENTS_EMPTY; CARD_EQ_REFL] THEN
  SUBGOAL_THEN
  `?w z:real^N. w IN sphere(a,r) /\ z IN sphere(a,r) /\ ~(w IN s) /\ ~(z IN t)`
  STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  SUBGOAL_THEN
   `(sphere(a:real^N,r) DELETE w) homeomorphic (:real^(N,1)finite_diff)`
  MP_TAC THENL
   [MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_SPHERE_UNIV THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[DIMINDEX_FINITE_DIFF; DIMINDEX_1] THEN ASM_ARITH_TAC;
    REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM]] THEN
  MAP_EVERY X_GEN_TAC
   [`f:real^N->real^(N,1)finite_diff`; `g:real^(N,1)finite_diff->real^N`] THEN
  DISCH_TAC THEN
  SUBGOAL_THEN
   `(sphere(a:real^N,r) DELETE z) homeomorphic (:real^(N,1)finite_diff)`
  MP_TAC THENL
   [MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_SPHERE_UNIV THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[DIMINDEX_FINITE_DIFF; DIMINDEX_1] THEN ASM_ARITH_TAC;
    REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM]] THEN
  MAP_EVERY X_GEN_TAC
   [`h:real^N->real^(N,1)finite_diff`; `k:real^(N,1)finite_diff->real^N`] THEN
  DISCH_TAC THEN
  MP_TAC(ISPECL
   [`f:real^N->real^(N,1)finite_diff`;
    `g:real^(N,1)finite_diff->real^N`;
    `a:real^N`; `r:real`; `s:real^N->bool`; `w:real^N`]
        CARD_EQ_COMPONENTS_IN_COMPACTIFICATION) THEN
  ASM_SIMP_TAC[CLOSURE_CLOSED] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_EQ_TRANS) THEN
  MP_TAC(ISPECL
   [`h:real^N->real^(N,1)finite_diff`;
    `k:real^(N,1)finite_diff->real^N`;
    `a:real^N`; `r:real`; `t:real^N->bool`; `z:real^N`]
        CARD_EQ_COMPONENTS_IN_COMPACTIFICATION) THEN
  ASM_SIMP_TAC[CLOSURE_CLOSED] THEN
  GEN_REWRITE_TAC LAND_CONV [CARD_EQ_SYM] THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CARD_EQ_TRANS) THEN
  MATCH_MP_TAC CARD_ADD_CONG THEN REWRITE_TAC[CARD_EQ_REFL] THEN
  SUBGOAL_THEN
   `compact(IMAGE (f:real^N->real^(N,1)finite_diff) s) /\
    compact(IMAGE (h:real^N->real^(N,1)finite_diff) t)`
  STRIP_ASSUME_TAC THENL
   [CONJ_TAC THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
    ASM_REWRITE_TAC[] THEN
    REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o
      GEN_REWRITE_RULE I [homeomorphism])) THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
      CONTINUOUS_ON_SUBSET)) THEN
    ASM SET_TAC[];
    ALL_TAC] THEN
  ONCE_REWRITE_TAC[SET_RULE
   `{x | x IN s /\ P x} = s DIFF {x | x IN s /\ ~P x}`] THEN
  MATCH_MP_TAC CARD_DIFF_CONG THEN
  REWRITE_TAC[SUBSET_RESTRICT] THEN CONJ_TAC THENL
   [MATCH_MP_TAC CARD_EQ_COMPONENTS_COMPLEMENTS THEN
    ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN
    TRANS_TAC HOMEOMORPHIC_TRANS `s:real^N->bool` THEN CONJ_TAC THENL
     [ALL_TAC;
      TRANS_TAC HOMEOMORPHIC_TRANS `t:real^N->bool` THEN
      ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM]] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        HOMEOMORPHIC_SELF_IMAGE)) THEN
    ASM SET_TAC[];
    ALL_TAC] THEN
  W(MP_TAC o PART_MATCH (lhand o rand)
    HAS_SIZE_UNBOUNDED_COMPONENTS_COMPLEMENT o rand o lhand o snd) THEN
  W(MP_TAC o PART_MATCH (lhand o rand)
    HAS_SIZE_UNBOUNDED_COMPONENTS_COMPLEMENT o lhand o lhand o rand o snd) THEN
  ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN
  SIMP_TAC[CARD_EQ_CARD; HAS_SIZE] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP (MESON[HOMEOMORPHIC_EMPTY]
    `s homeomorphic t ==> (s = {} <=> t = {})`)) THEN
  SIMP_TAC[IMAGE_EQ_EMPTY; CARD_LT_FINITE_INFINITE]);;

let HOMEOMORPHIC_SEPARATION_SPHERE_HAS_SIZE_EQ = prove
 (`!s t:real^N->bool a r n.
      s SUBSET sphere(a,r) /\ t SUBSET sphere(a,r) /\ s homeomorphic t
      ==> (components(sphere(a,r) DIFF s) HAS_SIZE n <=>
           components(sphere(a,r) DIFF t) HAS_SIZE n)`,
  REPEAT STRIP_TAC THEN MP_TAC(ISPEC
    `subtopology euclidean (sphere(a:real^N,r))`
    KURATOWSKI_COMPONENT_NUMBER_INVARIANCE) THEN
  SIMP_TAC[METRIZABLE_IMP_HEREDITARILY_NORMAL_SPACE;
           METRIZABLE_SPACE_EUCLIDEAN; METRIZABLE_SPACE_SUBTOPOLOGY;
           HAUSDORFF_SPACE_SUBTOPOLOGY; HAUSDORFF_SPACE_EUCLIDEAN] THEN
  REWRITE_TAC[COMPACT_SPACE_EUCLIDEAN_SUBTOPOLOGY; COMPACT_SPHERE] THEN
  REWRITE_TAC[LOCALLY_CONNECTED_SPACE_SUBTOPOLOGY_EUCLIDEAN;
              LOCALLY_CONNECTED_SPHERE] THEN
  SIMP_TAC[CLOSED_IN_CLOSED_EQ; CLOSED_SPHERE] THEN
  REWRITE_TAC[HOMEOMORPHIC_SPACE_EUCLIDEAN; SUBTOPOLOGY_SUBTOPOLOGY;
    EUCLIDEAN_CONNECTED_COMPONENTS_OF; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
  REWRITE_TAC[SET_RULE `s INTER (s DIFF t) = s DIFF t`] THEN
  DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN ANTS_TAC THENL
   [REPEAT STRIP_TAC THEN MATCH_MP_TAC CARD_HAS_SIZE_CONG THEN
    MATCH_MP_TAC HOMEOMORPHIC_SEPARATION_SPHERE_CARD_EQ;
    ALL_TAC] THEN
  ASM_MESON_TAC[SET_RULE `s SUBSET u ==> u INTER s = s`]);;

let HOMEOMORPHIC_SEPARATION_SPHERE = prove
 (`!s t:real^N->bool a r.
      s SUBSET sphere(a,r) /\ t SUBSET sphere(a,r) /\ s homeomorphic t
      ==> (connected (sphere(a,r) DIFF s) <=> connected(sphere(a,r) DIFF t))`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[CONNECTED_EQ_CARD_COMPONENTS] THEN
  REWRITE_TAC[ARITH_RULE `c <= 1 <=> c = 0 \/ c = 1`; LEFT_OR_DISTRIB] THEN
  REWRITE_TAC[GSYM HAS_SIZE] THEN BINOP_TAC THEN
  MATCH_MP_TAC HOMEOMORPHIC_SEPARATION_SPHERE_HAS_SIZE_EQ THEN
  ASM_REWRITE_TAC[]);;

let HAS_SIZE_EQ_COMPONENTS_COMPLEMENTS = prove
 (`!s (t:real^N->bool) n.
        (closed s /\ closed t \/ bounded s /\ bounded t) /\
        s homeomorphic t
        ==> (components((:real^N) DIFF s) HAS_SIZE n <=>
             components((:real^N) DIFF t) HAS_SIZE n)`,
  REPEAT STRIP_TAC THENL
   [MATCH_MP_TAC CARD_HAS_SIZE_CONG THEN
    ASM_SIMP_TAC[CARD_EQ_COMPONENTS_COMPLEMENTS];
    ALL_TAC] THEN
  ONCE_REWRITE_TAC[SET_RULE
   `s = {c | c IN s /\ ~bounded c} UNION {c | c IN s /\ bounded c}`] THEN
  MP_TAC(ISPEC `t:real^N->bool` HAS_SIZE_UNBOUNDED_COMPONENTS_COMPLEMENT) THEN
  MP_TAC(ISPEC `s:real^N->bool` HAS_SIZE_UNBOUNDED_COMPONENTS_COMPLEMENT) THEN
  ASM_REWRITE_TAC[] THEN
  FIRST_ASSUM(SUBST1_TAC o MATCH_MP (MESON[HOMEOMORPHIC_EMPTY]
    `s homeomorphic t ==> (s = {} <=> t = {})`)) THEN
  ABBREV_TAC
   `m = if t:real^N->bool = {} \/ 2 <= dimindex (:N) then 1 else 2` THEN
  REWRITE_TAC[HAS_SIZE; IMP_IMP] THEN
  GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV)
   [TAUT `p /\ q <=> ~(p ==> ~q)`] THEN
  SIMP_TAC[FINITE_UNION; CARD_UNION; SET_RULE
   `{x | x IN s /\ ~P x} INTER {x | x IN s /\ P x} = {}`] THEN
  DISCH_THEN(K ALL_TAC) THEN FIRST_X_ASSUM(K ALL_TAC o SYM) THEN
  REWRITE_TAC[NOT_IMP] THEN MATCH_MP_TAC(MESON[EQ_ADD_LCANCEL]
   `(!n. FINITE s /\ CARD s = n <=> FINITE t /\ CARD t = n)
    ==> (FINITE s /\ m + CARD s = n <=> FINITE t /\ m + CARD t = n)`) THEN
  X_GEN_TAC `n:num` THEN
  ABBREV_TAC `z:real^(N,1)finite_sum = basis 1` THEN
  SUBGOAL_THEN `z IN sphere(vec 0:real^(N,1)finite_sum,&1)` ASSUME_TAC THENL
   [EXPAND_TAC "z" THEN REWRITE_TAC[IN_SPHERE_0] THEN
    SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `(sphere(vec 0:real^(N,1)finite_sum,&1) DELETE z) homeomorphic (:real^N)`
  MP_TAC THENL
   [MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_SPHERE_UNIV THEN
    ASM_REWRITE_TAC[REAL_LT_01; DIMINDEX_FINITE_SUM; DIMINDEX_1];
    REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM]] THEN
  MAP_EVERY X_GEN_TAC
   [`f:real^(N,1)finite_sum->real^N`; `g:real^N->real^(N,1)finite_sum`] THEN
  STRIP_TAC THEN
  MP_TAC(ISPECL
   [`IMAGE (g:real^N->real^(N,1)finite_sum) s`;
    `IMAGE (g:real^N->real^(N,1)finite_sum) t`;
    `vec 0:real^(N,1)finite_sum`; `&1:real`; `n + 1`]
   HOMEOMORPHIC_SEPARATION_SPHERE_HAS_SIZE_EQ) THEN
  SUBGOAL_THEN
   `IMAGE (g:real^N->real^(N,1)finite_sum) s SUBSET sphere(vec 0,&1) /\
    IMAGE (g:real^N->real^(N,1)finite_sum) t SUBSET sphere(vec 0,&1)`
  STRIP_ASSUME_TAC THENL
   [RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
    ASM_REWRITE_TAC[]] THEN
  ANTS_TAC THENL
   [TRANS_TAC HOMEOMORPHIC_TRANS `s:real^N->bool` THEN CONJ_TAC THENL
     [ALL_TAC;
      TRANS_TAC HOMEOMORPHIC_TRANS `t:real^N->bool` THEN
      ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM]] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        HOMEOMORPHIC_SELF_IMAGE) o GEN_REWRITE_RULE I [HOMEOMORPHISM_SYM]) THEN
    ASM SET_TAC[];
    ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
     CARD_EQ_COMPONENTS_IN_COMPACTIFICATION)) THEN
  DISCH_THEN(fun th ->
   MP_TAC(SPEC `IMAGE (g:real^N->real^(N,1)finite_sum) t` th) THEN
   MP_TAC(SPEC `IMAGE (g:real^N->real^(N,1)finite_sum) s` th)) THEN
  FIRST_ASSUM(MP_TAC o
    MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] BOUNDED_IMAGE_IN_COMPACTIFICATION) o
    ONCE_REWRITE_RULE[SET_RULE `s DELETE z = s DIFF {z}`] o
    GEN_REWRITE_RULE I [HOMEOMORPHISM_SYM]) THEN
  ASM_REWRITE_TAC[COMPACT_SPHERE; CLOSED_UNIV; SUBSET_UNIV] THEN
  REWRITE_TAC[SET_RULE `s INTER {z} = {} <=> ~(z IN s)`] THEN
  DISCH_THEN(ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN
  GEN_REWRITE_TAC I [IMP_IMP] THEN
  DISCH_THEN(CONJUNCTS_THEN(fun th ->
    REWRITE_TAC[MATCH_MP CARD_HAS_SIZE_CONG th])) THEN
  SUBGOAL_THEN
   `IMAGE f (IMAGE (g:real^N->real^(N,1)finite_sum) s) = s /\
    IMAGE f (IMAGE (g:real^N->real^(N,1)finite_sum) t) = t`
  (CONJUNCTS_THEN SUBST1_TAC) THENL
   [RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[];
    REWRITE_TAC[HAS_SIZE]] THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q <=> ~(p ==> ~q)`] THEN
  SIMP_TAC[CARD_ADD_C; FINITE_SING; CARD_ADD_FINITE_EQ] THEN
  REWRITE_TAC[CARD_SING; ARITH_RULE `1 + m = n + 1 <=> m = n`]);;

let HOMEOMORPHIC_SEPARATION = prove
 (`!s t. bounded s /\ bounded t /\ s homeomorphic t
         ==> (connected((:real^N) DIFF s) <=> connected((:real^N) DIFF t))`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[CONNECTED_EQ_CARD_COMPONENTS] THEN
  REWRITE_TAC[ARITH_RULE `c <= 1 <=> c = 0 \/ c = 1`; LEFT_OR_DISTRIB] THEN
  REWRITE_TAC[GSYM HAS_SIZE] THEN BINOP_TAC THEN
  MATCH_MP_TAC HAS_SIZE_EQ_COMPONENTS_COMPLEMENTS THEN
  ASM_REWRITE_TAC[]);;
