(* ========================================================================= *)
(* Additional topology theory.                                               *)
(*                                                                           *)
(*              (c) Copyright, John Harrison 1998-2013                       *)
(* ========================================================================= *)

needs "Multivariate/realanalysis.ml";;

(* ------------------------------------------------------------------------- *)
(* Injective map into R is also an open map w.r.t. the universe, and this    *)
(* is actually an implication in both directions for an interval. Compare    *)
(* the local form in INJECTIVE_INTO_1D_IMP_OPEN_MAP (not a bi-implication).  *)
(* ------------------------------------------------------------------------- *)

let INJECTIVE_EQ_1D_OPEN_MAP_UNIV = 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) <=>
              (!t. open t /\ t SUBSET s ==> open(IMAGE f t)))`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
   [ONCE_REWRITE_TAC[OPEN_SUBOPEN] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN
    X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
    DISCH_THEN(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[BALL_1] THEN
    DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `IMAGE (f:real^1->real^1)
                      (segment (x - lift d,x + lift d))` THEN
    MP_TAC(ISPECL
     [`f:real^1->real^1`; `x - lift d`; `x + lift d`]
     CONTINUOUS_INJECTIVE_IMAGE_OPEN_SEGMENT_1) THEN
    REWRITE_TAC[SEGMENT_1; DROP_ADD; DROP_SUB; LIFT_DROP] THEN
    ASM_CASES_TAC `drop x - d <= drop x + d` THENL
     [ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM SEGMENT_1];
      ASM_REAL_ARITH_TAC] THEN
    ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN
    REPEAT STRIP_TAC THENL
     [ASM_REWRITE_TAC[OPEN_SEGMENT_1];
      MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1] THEN
      REWRITE_TAC[DROP_ADD; DROP_SUB; LIFT_DROP] THEN ASM_REAL_ARITH_TAC;
      MATCH_MP_TAC IMAGE_SUBSET THEN
      ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET_TRANS]];
    MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
    MP_TAC(ISPECL [`f:real^1->real^1`; `x:real^1`; `y:real^1`]
        CONTINUOUS_IVT_LOCAL_EXTREMUM) THEN
    ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
     [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT_EQ; IS_INTERVAL_CONVEX_1;
                    CONTINUOUS_ON_SUBSET];
      DISCH_THEN(X_CHOOSE_TAC `z:real^1`) THEN
      FIRST_ASSUM(MP_TAC o SPEC `segment(x:real^1,y)`) THEN
      REWRITE_TAC[OPEN_SEGMENT_1; NOT_IMP] THEN CONJ_TAC THENL
       [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; IS_INTERVAL_CONVEX_1;
                      SUBSET_TRANS; SEGMENT_OPEN_SUBSET_CLOSED];
        FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC) THEN
        REWRITE_TAC[open_def; FORALL_IN_IMAGE] THEN
        DISCH_THEN(MP_TAC o SPEC `z:real^1`) THEN ASM_REWRITE_TAC[] THEN
        DISCH_THEN(X_CHOOSE_THEN `e:real`
         (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
        FIRST_X_ASSUM DISJ_CASES_TAC THENL
         [DISCH_THEN(MP_TAC o SPEC `(f:real^1->real^1) z + lift(e / &2)`);
          DISCH_THEN(MP_TAC o SPEC `(f:real^1->real^1) z - lift(e / &2)`)] THEN
        ASM_REWRITE_TAC[NORM_ARITH `dist(a + b:real^N,a) = norm b`;
                        NORM_ARITH `dist(a - b:real^N,a) = norm b`; NORM_LIFT;
                        REAL_ARITH `abs(e / &2) < e <=> &0 < e`] THEN
        REWRITE_TAC[IN_IMAGE] THEN
        DISCH_THEN(X_CHOOSE_THEN `w:real^1` (STRIP_ASSUME_TAC o GSYM)) THEN
        FIRST_X_ASSUM(MP_TAC o SPEC `w:real^1`) THEN
        ASM_SIMP_TAC[REWRITE_RULE[SUBSET] SEGMENT_OPEN_SUBSET_CLOSED] THEN
        REWRITE_TAC[DROP_ADD; DROP_SUB; LIFT_DROP] THEN
        ASM_REAL_ARITH_TAC]]]);;

(* ------------------------------------------------------------------------- *)
(* Map f:S^m->S^n for m < n is nullhomotopic.                                *)
(* ------------------------------------------------------------------------- *)

let INESSENTIAL_SPHEREMAP_LOWDIM_GEN = prove
 (`!f:real^M->real^N s t.
     convex s /\ bounded s /\ convex t /\ bounded t /\ aff_dim s < aff_dim t /\
     f continuous_on relative_frontier s /\
     IMAGE f (relative_frontier s) SUBSET (relative_frontier t)
     ==> ?c. homotopic_with (\z. T)
                (relative_frontier s,relative_frontier t) f (\x. c)`,
  let lemma1 = prove
   (`!f:real^N->real^N s t.
        subspace s /\ subspace t /\ dim s < dim t /\ s SUBSET t /\
        f differentiable_on sphere(vec 0,&1) INTER s
        ==> ~(IMAGE f (sphere(vec 0,&1) INTER s) = sphere(vec 0,&1) INTER t)`,
    REPEAT STRIP_TAC THEN
    ABBREV_TAC
     `(g:real^N->real^N) =
      \x. norm(x) % (f:real^N->real^N)(inv(norm x) % x)` THEN
    SUBGOAL_THEN
     `(g:real^N->real^N) differentiable_on s DELETE (vec 0)`
    ASSUME_TAC THENL
     [EXPAND_TAC "g" THEN MATCH_MP_TAC DIFFERENTIABLE_ON_MUL THEN
      SIMP_TAC[o_DEF; DIFFERENTIABLE_ON_NORM; IN_DELETE] THEN
      GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
      MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN CONJ_TAC THENL
       [MATCH_MP_TAC DIFFERENTIABLE_ON_MUL THEN
        REWRITE_TAC[DIFFERENTIABLE_ON_ID] THEN
        SUBGOAL_THEN
         `lift o (\x:real^N. inv(norm x)) =
          (lift o inv o drop) o (\x. lift(norm x))`
        SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN
        MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN
        SIMP_TAC[DIFFERENTIABLE_ON_NORM; IN_DELETE] THEN
        MATCH_MP_TAC DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON THEN
        SIMP_TAC[FORALL_IN_IMAGE; IN_DELETE; GSYM REAL_DIFFERENTIABLE_AT] THEN
        REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN
        MATCH_MP_TAC REAL_DIFFERENTIABLE_INV_ATREAL THEN
        ASM_REWRITE_TAC[REAL_DIFFERENTIABLE_ID; NORM_EQ_0];
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
            DIFFERENTIABLE_ON_SUBSET)) THEN
        ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; IN_INTER;
                     SUBSPACE_MUL; NORM_MUL; IN_DELETE] THEN
        SIMP_TAC[REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0]];
      ALL_TAC] THEN
    SUBGOAL_THEN
     `IMAGE (g:real^N->real^N) (s DELETE vec 0) = t DELETE (vec 0)`
    ASSUME_TAC THENL
     [UNDISCH_TAC `IMAGE (f:real^N->real^N) (sphere (vec 0,&1) INTER s) =
                   sphere (vec 0,&1) INTER t` THEN
      REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
      REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE;
                  IN_INTER; IN_SPHERE_0] THEN
      EXPAND_TAC "g" THEN REWRITE_TAC[IN_IMAGE; IN_INTER; IN_SPHERE_0] THEN
      SIMP_TAC[IN_DELETE; VECTOR_MUL_EQ_0; NORM_EQ_0] THEN
      MATCH_MP_TAC(TAUT
       `(p ==> r) /\ (p ==> q ==> s) ==> p /\ q ==> r /\ s`) THEN
      CONJ_TAC THENL [ALL_TAC; DISCH_TAC] THEN
      DISCH_THEN(fun th -> X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
        MP_TAC(SPEC `inv(norm x) % x:real^N` th)) THEN
      ASM_SIMP_TAC[SUBSPACE_MUL; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM;
                   REAL_MUL_LINV; NORM_EQ_0;
                   NORM_ARITH `norm x = &1 ==> ~(x:real^N = vec 0)`] THEN
      DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
      EXISTS_TAC `norm(x:real^N) % y:real^N` THEN
      ASM_SIMP_TAC[SUBSPACE_MUL; NORM_MUL; REAL_ABS_NORM; REAL_MUL_RID] THEN
      ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; NORM_EQ_0] THEN
      ASM_REWRITE_TAC[VECTOR_MUL_LID; VECTOR_MUL_EQ_0; NORM_EQ_0] THEN
      ASM_SIMP_TAC[NORM_ARITH `norm x = &1 ==> ~(x:real^N = vec 0)`] THEN
      UNDISCH_THEN `inv(norm x) % x = (f:real^N->real^N) y`
       (SUBST1_TAC o SYM) THEN
      ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; NORM_EQ_0] THEN
      REWRITE_TAC[VECTOR_MUL_LID];
      ALL_TAC] THEN
    MP_TAC(ISPECL [`t:real^N->bool`; `(:real^N)`]
          DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS) THEN
    ASM_REWRITE_TAC[SUBSPACE_UNIV; DIM_UNIV; IN_UNIV; SUBSET_UNIV] THEN
    ABBREV_TAC `t' = {y:real^N | !x. x IN t ==> orthogonal x y}` THEN
    DISCH_TAC THEN
    SUBGOAL_THEN `subspace(t':real^N->bool)` ASSUME_TAC THENL
     [EXPAND_TAC "t'" THEN REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTORS];
      ALL_TAC] THEN
    SUBGOAL_THEN
     `?fst snd. linear fst /\ linear snd /\
                (!z. fst(z) IN t /\ snd z IN t' /\ fst z + snd z = z) /\
                (!x y:real^N. x IN t /\ y IN t'
                              ==> fst(x + y) = x /\ snd(x + y) = y)`
    STRIP_ASSUME_TAC THENL
     [MP_TAC(ISPEC `t:real^N->bool` ORTHOGONAL_SUBSPACE_DECOMP_EXISTS) THEN
      REWRITE_TAC[SKOLEM_THM] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `fst:real^N->real^N` THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `snd:real^N->real^N` THEN
      DISCH_THEN(MP_TAC o GSYM) THEN
      ASM_SIMP_TAC[SPAN_OF_SUBSPACE; FORALL_AND_THM] THEN STRIP_TAC THEN
      MATCH_MP_TAC(TAUT `r /\ (r ==> p /\ q /\ s) ==> p /\ q /\ r /\ s`) THEN
      CONJ_TAC THENL
       [EXPAND_TAC "t'" THEN REWRITE_TAC[IN_ELIM_THM] THEN
        ASM_MESON_TAC[ORTHOGONAL_SYM];
        DISCH_TAC] THEN
      MATCH_MP_TAC(TAUT `r /\ (r ==> p /\ q) ==> p /\ q /\ r`) THEN
      CONJ_TAC THENL
       [REPEAT GEN_TAC THEN STRIP_TAC THEN
        MATCH_MP_TAC ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE THEN
        MAP_EVERY EXISTS_TAC [`t:real^N->bool`; `t':real^N->bool`] THEN
        ASM_SIMP_TAC[SPAN_OF_SUBSPACE] THEN ASM SET_TAC[];
        DISCH_TAC] THEN
      REWRITE_TAC[linear] THEN
      MATCH_MP_TAC(TAUT `(p /\ r) /\ (q /\ s) ==> (p /\ q) /\ (r /\ s)`) THEN
      REWRITE_TAC[AND_FORALL_THM] THEN CONJ_TAC THEN REPEAT GEN_TAC THEN
      MATCH_MP_TAC ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE THEN
      MAP_EVERY EXISTS_TAC [`t:real^N->bool`; `t':real^N->bool`] THEN
      ASM_SIMP_TAC[SPAN_OF_SUBSPACE; SUBSPACE_ADD; SUBSPACE_MUL] THEN
      (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
      ASM_REWRITE_TAC[GSYM VECTOR_ADD_LDISTRIB] THEN
      ONCE_REWRITE_TAC[VECTOR_ARITH
       `(x + y) + (x' + y'):real^N = (x + x') + (y + y')`] THEN
      ASM_REWRITE_TAC[];
      ALL_TAC] THEN
    MP_TAC(ISPECL
     [`\x:real^N. (g:real^N->real^N)(fst x) + snd x`;
      `{x + y:real^N | x IN (s DELETE vec 0) /\ y IN t'}`]
        NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE) THEN
    REWRITE_TAC[LE_REFL; NOT_IMP] THEN REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN
      MP_TAC(ISPECL [`s:real^N->bool`; `t':real^N->bool`] DIM_SUMS_INTER) THEN
      ASM_REWRITE_TAC[IN_DELETE] THEN
      FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE
       `t' + t = n ==> s < t /\ d' <= d /\ i = 0
           ==> d + i = s + t' ==> d' < n`)) THEN
      ASM_REWRITE_TAC[DIM_EQ_0] THEN CONJ_TAC THENL
       [MATCH_MP_TAC DIM_SUBSET THEN SET_TAC[]; EXPAND_TAC "t'"] THEN
      REWRITE_TAC[SUBSET; IN_INTER; IN_SING; IN_ELIM_THM] THEN
      ASM_MESON_TAC[SUBSET; ORTHOGONAL_REFL];
      MATCH_MP_TAC DIFFERENTIABLE_ON_ADD THEN
      ASM_SIMP_TAC[DIFFERENTIABLE_ON_LINEAR] THEN
      GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
      MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN
      ASM_SIMP_TAC[DIFFERENTIABLE_ON_LINEAR] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        DIFFERENTIABLE_ON_SUBSET)) THEN
      REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[IN_DELETE];
      SUBGOAL_THEN
       `~negligible {x + y | x IN IMAGE (g:real^N->real^N) (s DELETE vec 0) /\
                             y IN t'}`
      MP_TAC THENL
       [ASM_REWRITE_TAC[] THEN
        SUBGOAL_THEN `negligible(t':real^N->bool)` MP_TAC THENL
         [MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN ASM_ARITH_TAC;
          REWRITE_TAC[TAUT `p ==> ~q <=> ~(p /\ q)`]] THEN
        REWRITE_TAC[GSYM NEGLIGIBLE_UNION_EQ] THEN
        MP_TAC NOT_NEGLIGIBLE_UNIV THEN MATCH_MP_TAC EQ_IMP THEN
        AP_TERM_TAC THEN AP_TERM_TAC THEN
        REWRITE_TAC[EXTENSION; IN_UNION; IN_UNIV; IN_ELIM_THM; IN_DELETE] THEN
        X_GEN_TAC `z:real^N` THEN
        REWRITE_TAC[TAUT `p \/ q <=> ~p ==> q`] THEN DISCH_TAC THEN
        EXISTS_TAC `(fst:real^N->real^N) z` THEN
        EXISTS_TAC `(snd:real^N->real^N) z` THEN
        ASM_SIMP_TAC[] THEN ASM_MESON_TAC[VECTOR_ADD_LID];
        REWRITE_TAC[CONTRAPOS_THM] THEN
        MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN
        REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM;
                    FORALL_IN_IMAGE; IN_DELETE] THEN
        X_GEN_TAC `x:real^N` THEN REPEAT DISCH_TAC THEN
        X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
        REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `x + y:real^N` THEN
        RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[] THEN ASM
        SET_TAC[]]]) in
  let lemma2 = prove
   (`!f:real^N->real^N s t.
          subspace s /\ subspace t /\ dim s < dim t /\ s SUBSET t /\
          f continuous_on sphere(vec 0,&1) INTER s /\
          IMAGE f (sphere(vec 0,&1) INTER s) SUBSET sphere(vec 0,&1) INTER t
          ==> ?c. homotopic_with (\x. T)
                          (sphere(vec 0,&1) INTER s,sphere(vec 0,&1) INTER t)
                          f (\x. c)`,
    REPEAT STRIP_TAC THEN
    MP_TAC(ISPECL [`f:real^N->real^N`; `sphere(vec 0:real^N,&1) INTER s`;
                   `&1 / &2`; `t:real^N->bool`;]
          STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION_SUBSPACE) THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN
    ASM_SIMP_TAC[COMPACT_INTER_CLOSED; COMPACT_SPHERE; CLOSED_SUBSPACE] THEN
    ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE]] THEN
    DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC) THEN
    SUBGOAL_THEN
     `!x. x IN sphere(vec 0,&1) INTER s ==> ~((g:real^N->real^N) x = vec 0)`
    ASSUME_TAC THENL
     [X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
      REWRITE_TAC[FORALL_IN_IMAGE; IN_SPHERE_0] THEN
      RULE_ASSUM_TAC(REWRITE_RULE[IN_SPHERE_0]) THEN
      DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
      ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_INTER; IN_SPHERE_0] THEN
      CONV_TAC NORM_ARITH;
      ALL_TAC] THEN
    SUBGOAL_THEN `(g:real^N->real^N) differentiable_on
                  sphere(vec 0,&1) INTER s`
    ASSUME_TAC THENL
     [ASM_SIMP_TAC[DIFFERENTIABLE_ON_VECTOR_POLYNOMIAL_FUNCTION]; ALL_TAC] THEN
    ABBREV_TAC `(h:real^N->real^N) = \x. inv(norm(g x)) % g x` THEN
    SUBGOAL_THEN
     `!x. x IN sphere(vec 0,&1) INTER s
          ==> (h:real^N->real^N) x IN sphere(vec 0,&1) INTER t`
    ASSUME_TAC THENL
     [REPEAT STRIP_TAC THEN EXPAND_TAC "h" THEN
      ASM_SIMP_TAC[SUBSPACE_MUL; IN_INTER; IN_SPHERE_0; NORM_MUL] THEN
      REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NORM] THEN
      ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0; GSYM IN_SPHERE_0];
      ALL_TAC] THEN
    SUBGOAL_THEN
     `(h:real^N->real^N) differentiable_on sphere(vec 0,&1) INTER s`
    ASSUME_TAC THENL
     [EXPAND_TAC "h" THEN MATCH_MP_TAC DIFFERENTIABLE_ON_MUL THEN
      ASM_SIMP_TAC[DIFFERENTIABLE_ON_VECTOR_POLYNOMIAL_FUNCTION; o_DEF] THEN
      SUBGOAL_THEN
       `(\x. lift(inv(norm((g:real^N->real^N) x)))) =
        (lift o inv o drop) o (\x. lift(norm x)) o (g:real^N->real^N)`
      SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN
      MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN CONJ_TAC THENL
       [MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN
        ASM_SIMP_TAC[DIFFERENTIABLE_ON_VECTOR_POLYNOMIAL_FUNCTION] THEN
        MATCH_MP_TAC DIFFERENTIABLE_ON_NORM THEN
        ASM_REWRITE_TAC[SET_RULE
         `~(z IN IMAGE f s) <=> !x. x IN s ==> ~(f x = z)`];
        MATCH_MP_TAC DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON THEN
        REWRITE_TAC[GSYM REAL_DIFFERENTIABLE_AT] THEN
        REWRITE_TAC[FORALL_IN_IMAGE; IN_SPHERE_0] THEN
        X_GEN_TAC `x:real^N` THEN
        ASM_CASES_TAC `x:real^N = vec 0` THEN
        ASM_REWRITE_TAC[NORM_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN DISCH_TAC THEN
        REWRITE_TAC[GSYM REAL_DIFFERENTIABLE_AT; o_THM] THEN
        GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN
        MATCH_MP_TAC REAL_DIFFERENTIABLE_INV_ATREAL THEN
        ASM_SIMP_TAC[REAL_DIFFERENTIABLE_ID; NORM_EQ_0; IN_SPHERE_0]];
      ALL_TAC] THEN
    SUBGOAL_THEN
     `?c. homotopic_with (\z. T)
             (sphere(vec 0,&1) INTER s,sphere(vec 0,&1) INTER t)
             (h:real^N->real^N) (\x. c)`
    MP_TAC THENL
     [ALL_TAC;
      MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_TRANS) THEN
      SUBGOAL_THEN
       `homotopic_with (\z. T)
                       (sphere(vec 0:real^N,&1) INTER s,t DELETE (vec 0:real^N))
                       f g`
      MP_TAC THENL
       [MATCH_MP_TAC HOMOTOPIC_WITH_LINEAR THEN
        ASM_SIMP_TAC[CONTINUOUS_ON_VECTOR_POLYNOMIAL_FUNCTION] THEN
        X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[SET_RULE
          `s SUBSET t DELETE v <=> s SUBSET t /\ ~(v IN s)`] THEN
        CONJ_TAC THENL
         [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
          ASM_SIMP_TAC[SUBSPACE_IMP_CONVEX] THEN ASM SET_TAC[];
          DISCH_THEN(MP_TAC o MATCH_MP SEGMENT_BOUND) THEN
          SUBGOAL_THEN
           `(f:real^N->real^N) x IN sphere(vec 0,&1) /\
            norm(f x - g x) < &1/ &2`
          MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
          REWRITE_TAC[IN_SPHERE_0] THEN CONV_TAC NORM_ARITH];
        DISCH_THEN(MP_TAC o
          ISPECL [`\y:real^N. inv(norm y) % y`;
                  `sphere(vec 0:real^N,&1) INTER t`] o
          MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
          HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN
        ASM_REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL
         [CONJ_TAC THENL
           [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
            REWRITE_TAC[o_DEF; CONTINUOUS_ON_ID] THEN
            MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
            SIMP_TAC[IN_DELETE; NORM_EQ_0] THEN
            REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_NORM];
            REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE; IN_INTER] THEN
            ASM_SIMP_TAC[SUBSPACE_MUL; IN_SPHERE_0; NORM_MUL; REAL_ABS_MUL] THEN
            SIMP_TAC[REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0]];
          MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN
          RULE_ASSUM_TAC(REWRITE_RULE
           [SUBSET; IN_INTER; FORALL_IN_IMAGE; IN_SPHERE_0]) THEN
          ASM_SIMP_TAC[IN_SPHERE_0; IN_INTER;
                       REAL_INV_1; VECTOR_MUL_LID]]]] THEN
    SUBGOAL_THEN
     `?c. c IN (sphere(vec 0,&1) INTER t) DIFF
               (IMAGE (h:real^N->real^N) (sphere(vec 0,&1) INTER s))`
    MP_TAC THENL
     [MATCH_MP_TAC(SET_RULE
       `t SUBSET s /\ ~(t = s) ==> ?a. a IN s DIFF t`) THEN
      CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC lemma1] THEN
      ASM_REWRITE_TAC[];
      REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_INTER; IN_DIFF; IN_IMAGE] THEN
      REWRITE_TAC[SET_RULE
       `~(?x. P x /\ x IN s /\ x IN t) <=>
        (!x. x IN s INTER t ==> ~(P x))`] THEN
      X_GEN_TAC `c:real^N` THEN STRIP_TAC] THEN
    EXISTS_TAC `--c:real^N` THEN
    SUBGOAL_THEN
     `homotopic_with (\z. T)
                     (sphere(vec 0:real^N,&1) INTER s,t DELETE (vec 0:real^N))
                     h (\x. --c)`
    MP_TAC THENL
     [MATCH_MP_TAC HOMOTOPIC_WITH_LINEAR THEN
      ASM_SIMP_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_ON; CONTINUOUS_ON_CONST] THEN
      X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[SET_RULE
        `s SUBSET t DELETE v <=> s SUBSET t /\ ~(v IN s)`] THEN
      CONJ_TAC THENL
       [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
        ASM_SIMP_TAC[SUBSPACE_IMP_CONVEX; INSERT_SUBSET; SUBSPACE_NEG] THEN
        ASM SET_TAC[];
        DISCH_TAC THEN MP_TAC(ISPECL
         [`(h:real^N->real^N) x`; `vec 0:real^N`; `--c:real^N`]
         MIDPOINT_BETWEEN) THEN
        ASM_REWRITE_TAC[BETWEEN_IN_SEGMENT; DIST_0; NORM_NEG] THEN
        SUBGOAL_THEN `((h:real^N->real^N) x) IN sphere(vec 0,&1) /\
                      (c:real^N) IN sphere(vec 0,&1)`
        MP_TAC THENL [ASM SET_TAC[]; SIMP_TAC[IN_SPHERE_0]] THEN
        STRIP_TAC THEN REWRITE_TAC[midpoint; VECTOR_ARITH
         `vec 0:real^N = inv(&2) % (x + --y) <=> x = y`] THEN
        ASM SET_TAC[]];
      DISCH_THEN(MP_TAC o
        ISPECL [`\y:real^N. inv(norm y) % y`;
                `sphere(vec 0:real^N,&1) INTER t`] o
        MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
        HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN
      ASM_REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL
       [CONJ_TAC THENL
         [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
          REWRITE_TAC[o_DEF; CONTINUOUS_ON_ID] THEN
          MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
          SIMP_TAC[IN_DELETE; NORM_EQ_0] THEN
          REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_NORM];
          REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE; IN_INTER] THEN
          ASM_SIMP_TAC[SUBSPACE_MUL; IN_SPHERE_0; NORM_MUL; REAL_ABS_MUL] THEN
          SIMP_TAC[REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0]];
        MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN
        RULE_ASSUM_TAC(REWRITE_RULE
         [SUBSET; IN_INTER; FORALL_IN_IMAGE; IN_SPHERE_0]) THEN
        ASM_SIMP_TAC[IN_SPHERE_0; IN_INTER; REAL_INV_1; VECTOR_MUL_LID;
                     NORM_NEG]]]) in
  let lemma3 = prove
   (`!s:real^M->bool u:real^N->bool.
          bounded s /\ convex s /\ subspace u /\ aff_dim s <= &(dim u)
          ==> ?t. subspace t /\ t SUBSET u /\
                  (~(s = {}) ==> aff_dim t = aff_dim s) /\
                  (relative_frontier s) homeomorphic
                  (sphere(vec 0,&1) INTER t)`,
    REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL
     [STRIP_TAC THEN EXISTS_TAC `{vec 0:real^N}` THEN
      ASM_REWRITE_TAC[SUBSPACE_TRIVIAL; RELATIVE_FRONTIER_EMPTY] THEN
      ASM_SIMP_TAC[HOMEOMORPHIC_EMPTY;
                   SET_RULE `s INTER {a} = {} <=> ~(a IN s)`;
                   IN_SPHERE_0; NORM_0; SING_SUBSET; SUBSPACE_0] THEN
      CONV_TAC REAL_RAT_REDUCE_CONV;
      FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^M` MP_TAC o
          GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
      GEOM_ORIGIN_TAC `a:real^M` THEN
      SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; INT_OF_NUM_LE; GSYM DIM_UNIV] THEN
      REPEAT STRIP_TAC] THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP CHOOSE_SUBSPACE_OF_SUBSPACE) THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
    ASM_SIMP_TAC[SPAN_OF_SUBSPACE; AFF_DIM_DIM_SUBSPACE; INT_OF_NUM_EQ] THEN
    STRIP_TAC THEN
    TRANS_TAC HOMEOMORPHIC_TRANS
     `relative_frontier(ball(vec 0:real^N,&1) INTER t)` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS THEN
      ASM_SIMP_TAC[CONVEX_INTER; BOUNDED_INTER; BOUNDED_BALL;
                   SUBSPACE_IMP_CONVEX; CONVEX_BALL] THEN
      ONCE_REWRITE_TAC[INTER_COMM] THEN
      FIRST_ASSUM(ASSUME_TAC o MATCH_MP SUBSPACE_0) THEN
      SUBGOAL_THEN `~(t INTER ball(vec 0:real^N,&1) = {})` ASSUME_TAC THENL
       [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `vec 0:real^N` THEN
        ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_LT_01];
        ASM_SIMP_TAC[AFF_DIM_CONVEX_INTER_OPEN; OPEN_BALL;
                     SUBSPACE_IMP_CONVEX] THEN
        ASM_SIMP_TAC[AFF_DIM_DIM_0; HULL_INC]];
      MATCH_MP_TAC(MESON[HOMEOMORPHIC_REFL] `s = t ==> s homeomorphic t`) THEN
      SIMP_TAC[GSYM FRONTIER_BALL; REAL_LT_01] THEN
      MATCH_MP_TAC RELATIVE_FRONTIER_CONVEX_INTER_AFFINE THEN
      ASM_SIMP_TAC[CONVEX_BALL; SUBSPACE_IMP_AFFINE;
                   GSYM MEMBER_NOT_EMPTY] THEN
      EXISTS_TAC `vec 0:real^N` THEN
      ASM_SIMP_TAC[CENTRE_IN_BALL; INTERIOR_OPEN; OPEN_BALL;
                   SUBSPACE_0; IN_INTER; REAL_LT_01]]) in
    ONCE_REWRITE_TAC[MESON[] `(!a b c. P a b c) <=> (!b c a. P a b c)`] THEN
    REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
    REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
    REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN REPEAT GEN_TAC THEN
    ASM_CASES_TAC `s:real^M->bool = {}` THENL
     [ASM_SIMP_TAC[HOMOTOPIC_WITH; RELATIVE_FRONTIER_EMPTY; PCROSS_EMPTY;
                   NOT_IN_EMPTY; IMAGE_CLAUSES; CONTINUOUS_ON_EMPTY];
      ALL_TAC] THEN
    ASM_CASES_TAC `t:real^N->bool = {}` THEN
    ASM_SIMP_TAC[AFF_DIM_EMPTY; GSYM INT_NOT_LE; AFF_DIM_GE] THEN
    STRIP_TAC THEN
    MP_TAC(ISPECL [`t:real^N->bool`; `(:real^N)`] lemma3) THEN
    ASM_REWRITE_TAC[DIM_UNIV; SUBSPACE_UNIV; AFF_DIM_LE_UNIV] THEN
    DISCH_THEN(X_CHOOSE_THEN `t':real^N->bool` STRIP_ASSUME_TAC) THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT) THEN
    DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP
      HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY_NULL th]) THEN
    MP_TAC(ISPECL [`s:real^M->bool`; `t':real^N->bool`] lemma3) THEN
    ASM_SIMP_TAC[GSYM AFF_DIM_DIM_SUBSPACE] THEN
    ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN
    DISCH_THEN(X_CHOOSE_THEN `s':real^N->bool` STRIP_ASSUME_TAC) THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT) THEN
    DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP
      HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL th]) THEN
    REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma2 THEN
    ASM_SIMP_TAC[GSYM INT_OF_NUM_LT; GSYM AFF_DIM_DIM_SUBSPACE] THEN
    ASM_INT_ARITH_TAC);;

let INESSENTIAL_SPHEREMAP_LOWDIM = prove
 (`!f:real^M->real^N a r b s.
        dimindex(:M) < dimindex(:N) /\
        f continuous_on sphere(a,r) /\
        IMAGE f (sphere(a,r)) SUBSET (sphere(b,s))
        ==> ?c. homotopic_with (\z. T) (sphere(a,r),sphere(b,s)) f (\x. c)`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `s <= &0` THEN
  ASM_SIMP_TAC[NULLHOMOTOPIC_INTO_CONTRACTIBLE; CONTRACTIBLE_SPHERE] THEN
  ASM_CASES_TAC `r <= &0` THEN
  ASM_SIMP_TAC[NULLHOMOTOPIC_FROM_CONTRACTIBLE; CONTRACTIBLE_SPHERE] THEN
  ASM_SIMP_TAC[GSYM FRONTIER_CBALL; INTERIOR_CBALL; BALL_EQ_EMPTY;
               CONV_RULE(RAND_CONV SYM_CONV) (SPEC_ALL
               RELATIVE_FRONTIER_NONEMPTY_INTERIOR)] THEN
  STRIP_TAC THEN MATCH_MP_TAC INESSENTIAL_SPHEREMAP_LOWDIM_GEN THEN
  ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; AFF_DIM_CBALL] THEN
  ASM_REWRITE_TAC[GSYM REAL_NOT_LE; INT_OF_NUM_LT]);;

let HOMEOMORPHIC_SPHERES_EQ,HOMOTOPY_EQUIVALENT_SPHERES_EQ =
 (CONJ_PAIR o prove)
 (`(!a:real^M b:real^N r s.
        sphere(a,r) homeomorphic sphere(b,s) <=>
        r < &0 /\ s < &0 \/ r = &0 /\ s = &0 \/
        &0 < r /\ &0 < s /\ dimindex(:M) = dimindex(:N)) /\
   (!a:real^M b:real^N r s.
        sphere(a,r) homotopy_equivalent sphere(b,s) <=>
        r < &0 /\ s < &0 \/ r = &0 /\ s = &0 \/
        &0 < r /\ &0 < s /\ dimindex(:M) = dimindex(:N))`,
  let lemma = prove
   (`!a:real^M r b:real^N s.
          dimindex(:M) < dimindex(:N) /\ &0 < r /\ &0 < s
          ==> ~(sphere(a,r) homotopy_equivalent sphere(b,s))`,
    REPEAT STRIP_TAC THEN
    FIRST_ASSUM(MP_TAC o ISPEC `sphere(a:real^M,r)` o
        MATCH_MP HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY) THEN
    MATCH_MP_TAC(TAUT `~p /\ q ==> (p <=> q) ==> F`) THEN CONJ_TAC THENL
     [SUBGOAL_THEN `~(sphere(a:real^M,r) = {})` MP_TAC THENL
       [REWRITE_TAC[SPHERE_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC;
        REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM]] THEN
      X_GEN_TAC `c:real^M` THEN DISCH_TAC THEN
      DISCH_THEN(MP_TAC o SPECL[`\a:real^M. a`; `(\a. c):real^M->real^M`]) THEN
      SIMP_TAC[CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID;
               IMAGE_ID; SUBSET_REFL] THEN
      REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      SUBGOAL_THEN `~(contractible(sphere(a:real^M,r)))` MP_TAC THENL
       [REWRITE_TAC[CONTRACTIBLE_SPHERE] THEN ASM_REAL_ARITH_TAC;
        REWRITE_TAC[contractible] THEN MESON_TAC[]];
      MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^M->real^N`] THEN
      STRIP_TAC THEN
      MP_TAC(ISPEC `g:real^M->real^N` INESSENTIAL_SPHEREMAP_LOWDIM) THEN
      MP_TAC(ISPEC `f:real^M->real^N` INESSENTIAL_SPHEREMAP_LOWDIM) THEN
      ASM_REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN DISCH_THEN
       (MP_TAC o SPECL [`a:real^M`; `r:real`; `b:real^N`; `s:real`]) THEN
      ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ; RIGHT_IMP_FORALL_THM] THEN
      REPEAT GEN_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN
       (fun th -> CONJUNCTS_THEN (ASSUME_TAC o MATCH_MP
                         HOMOTOPIC_WITH_IMP_SUBSET) th THEN
                  MP_TAC th) THEN
      MATCH_MP_TAC(MESON[HOMOTOPIC_WITH_TRANS; HOMOTOPIC_WITH_SYM]
          `homotopic_with p (s,t) c d
            ==> homotopic_with p (s,t) f c /\
                homotopic_with p (s,t) g d
                ==> homotopic_with p (s,t) f g`) THEN
      REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN DISJ2_TAC THEN
      MP_TAC(ISPECL [`b:real^N`; `s:real`] PATH_CONNECTED_SPHERE) THEN
      ANTS_TAC THENL
       [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE
         `m < n ==> 1 <= m ==> 2 <= n`)) THEN REWRITE_TAC[DIMINDEX_GE_1];
        REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
        DISCH_THEN MATCH_MP_TAC THEN
        SUBGOAL_THEN `~(sphere(a:real^M,r) = {})` MP_TAC THENL
         [REWRITE_TAC[SPHERE_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC;
          ASM SET_TAC[]]]]) in
  REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
  MATCH_MP_TAC(TAUT
   `(r ==> p) /\ (q ==> r) /\ (p ==> q) ==> (r <=> q) /\ (p <=> q)`) THEN
  REWRITE_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT] THEN
  ASM_CASES_TAC `r < &0` THEN
  ASM_SIMP_TAC[SPHERE_EMPTY; SPHERE_EQ_EMPTY;
               HOMEOMORPHIC_EMPTY; HOMOTOPY_EQUIVALENT_EMPTY]
  THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
  ASM_CASES_TAC `s < &0` THEN
  ASM_SIMP_TAC[SPHERE_EMPTY; SPHERE_EQ_EMPTY;
               HOMEOMORPHIC_EMPTY; HOMOTOPY_EQUIVALENT_EMPTY]
  THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
  ASM_CASES_TAC `r = &0` THEN
  ASM_SIMP_TAC[SPHERE_SING; REAL_LT_REFL; HOMEOMORPHIC_SING;
               HOMOTOPY_EQUIVALENT_SING; CONTRACTIBLE_SPHERE;
               ONCE_REWRITE_RULE[HOMOTOPY_EQUIVALENT_SYM]
                   HOMOTOPY_EQUIVALENT_SING]
  THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
  ASM_CASES_TAC `s = &0` THEN
  ASM_SIMP_TAC[SPHERE_SING; REAL_LT_REFL; HOMEOMORPHIC_SING;
               HOMOTOPY_EQUIVALENT_SING; CONTRACTIBLE_SPHERE;
               ONCE_REWRITE_RULE[HOMOTOPY_EQUIVALENT_SYM]
                   HOMOTOPY_EQUIVALENT_SING]
  THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
  SUBGOAL_THEN `&0 < r /\ &0 < s` STRIP_ASSUME_TAC THENL
   [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN
  CONJ_TAC THENL
   [DISCH_THEN(fun th ->
      let t = `?a:real^M b:real^N. ~(sphere(a,r) homeomorphic sphere(b,s))` in
      MP_TAC(DISCH t (GEOM_EQUAL_DIMENSION_RULE th (ASSUME t)))) THEN
    ASM_SIMP_TAC[HOMEOMORPHIC_SPHERES] THEN MESON_TAC[];
    ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
    REWRITE_TAC[ARITH_RULE `~(m:num = n) <=> m < n \/ n < m`] THEN
    STRIP_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[HOMOTOPY_EQUIVALENT_SYM]] THEN
    ASM_SIMP_TAC[lemma]]);;

let SIMPLY_CONNECTED_SPHERE_GEN = prove
 (`!s. convex s /\ bounded s /\ &3 <= aff_dim s
       ==> simply_connected(relative_frontier s)`,
  REPEAT STRIP_TAC THEN
  ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_CIRCLEMAP;
               PATH_CONNECTED_SPHERE_GEN;
               INT_ARITH `&3:int <= x ==> ~(x = &1)`] THEN
  SUBGOAL_THEN `sphere(vec 0:real^2,&1) = relative_frontier(cball(vec 0,&1))`
  SUBST1_TAC THENL
   [REWRITE_TAC[RELATIVE_FRONTIER_CBALL; REAL_OF_NUM_EQ; ARITH]; ALL_TAC] THEN
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC INESSENTIAL_SPHEREMAP_LOWDIM_GEN THEN
  ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; AFF_DIM_CBALL] THEN
  REWRITE_TAC[DIMINDEX_2; REAL_LT_01] THEN ASM_INT_ARITH_TAC);;

let SIMPLY_CONNECTED_SPHERE = prove
 (`!a:real^N r. 3 <= dimindex(:N) ==> simply_connected(sphere(a,r))`,
  REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
   (REAL_ARITH `r < &0 \/ r = &0 \/ &0 < r`) THEN
  ASM_SIMP_TAC[SPHERE_EMPTY; SIMPLY_CONNECTED_EMPTY] THEN
  ASM_SIMP_TAC[SPHERE_SING; CONVEX_SING; CONVEX_IMP_SIMPLY_CONNECTED] THEN
  MP_TAC(ISPEC `cball(a:real^N,r)` SIMPLY_CONNECTED_SPHERE_GEN) THEN
  ASM_SIMP_TAC[AFF_DIM_CBALL; RELATIVE_FRONTIER_CBALL; CONVEX_CBALL;
               BOUNDED_CBALL; REAL_LT_IMP_NE; INT_OF_NUM_LE]);;

let SIMPLY_CONNECTED_PUNCTURED_CONVEX = prove
 (`!s a:real^N.
        convex s /\ &3 <= aff_dim s ==> simply_connected(s DELETE a)`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN relative_interior s` THENL
   [ALL_TAC;
    MATCH_MP_TAC CONTRACTIBLE_IMP_SIMPLY_CONNECTED THEN
    MATCH_MP_TAC CONTRACTIBLE_CONVEX_TWEAK_BOUNDARY_POINTS THEN
    EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
    MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN
    MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]] THEN
  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR_CBALL]) THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
   (X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC)) THEN
  MP_TAC(ISPECL
   [`cball(a:real^N,e) INTER affine hull s`; `s:real^N->bool`; `a:real^N`]
        HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_CONVEX) THEN
  ANTS_TAC THENL
   [ALL_TAC;
    MATCH_MP_TAC(MESON[HOMOTOPY_EQUIVALENT_SIMPLE_CONNECTEDNESS]
     `simply_connected s
      ==> s homotopy_equivalent t ==> simply_connected t`) THEN
    MATCH_MP_TAC SIMPLY_CONNECTED_SPHERE_GEN] THEN
  ASM_SIMP_TAC[CONVEX_INTER; AFFINE_AFFINE_HULL; AFFINE_IMP_CONVEX;
               CONVEX_CBALL; BOUNDED_INTER; BOUNDED_CBALL] THEN
  REPEAT CONJ_TAC THENL
   [W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_INTERIOR_CONVEX_INTER_AFFINE o
        rand o snd) THEN
    REWRITE_TAC[CONVEX_CBALL; AFFINE_AFFINE_HULL; INTERIOR_CBALL] THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM; IN_INTER] THEN
    DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_SIMP_TAC[CENTRE_IN_BALL] THEN
    ANTS_TAC THENL
     [ALL_TAC;
      DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC[CENTRE_IN_BALL; IN_INTER]] THEN
    ASM_MESON_TAC[SUBSET; HULL_SUBSET; RELATIVE_INTERIOR_SUBSET];
    REWRITE_TAC[relative_frontier] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
     (SET_RULE `s SUBSET u ==> c = s ==> c DIFF i SUBSET u`)) THEN
    REWRITE_TAC[CLOSURE_EQ] THEN MATCH_MP_TAC CLOSED_INTER THEN
    REWRITE_TAC[CLOSED_AFFINE_HULL; CLOSED_CBALL];
    ONCE_REWRITE_TAC[INTER_COMM] THEN
    W(MP_TAC o PART_MATCH (lhs o rand)

      AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR o rand o snd);
    ONCE_REWRITE_TAC[INTER_COMM] THEN
    W(MP_TAC o PART_MATCH (lhs o rand) AFF_DIM_CONVEX_INTER_NONEMPTY_INTERIOR o
        rand o snd)] THEN
  ASM_SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; GSYM MEMBER_NOT_EMPTY;
               LEFT_IMP_EXISTS_THM; IN_INTER] THEN
  DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN
  ASM_SIMP_TAC[INTERIOR_CBALL; CENTRE_IN_BALL; HULL_INC; HULL_SUBSET;
               AFF_DIM_AFFINE_HULL]);;

let SIMPLY_CONNECTED_PUNCTURED_UNIVERSE = prove
 (`!a. 3 <= dimindex(:N) ==> simply_connected((:real^N) DELETE a)`,
  GEN_TAC THEN DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `&1`] o
    MATCH_MP SIMPLY_CONNECTED_SPHERE) THEN
  MATCH_MP_TAC EQ_IMP THEN
  MATCH_MP_TAC HOMOTOPY_EQUIVALENT_SIMPLE_CONNECTEDNESS THEN
  MP_TAC(ISPECL [`cball(a:real^N,&1)`; `a:real^N`]
        HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_AFFINE_HULL) THEN
  REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; RELATIVE_INTERIOR_CBALL;
              RELATIVE_FRONTIER_CBALL] THEN
  CONV_TAC REAL_RAT_REDUCE_CONV THEN
  SIMP_TAC[CENTRE_IN_BALL; AFFINE_HULL_NONEMPTY_INTERIOR; INTERIOR_CBALL;
           BALL_EQ_EMPTY; REAL_OF_NUM_LE; ARITH; REAL_LT_01]);;

let SIMPLY_CONNECTED_CONVEX_DIFF_FINITE = prove
 (`!s t:real^N->bool.
        convex s /\ &3 <= aff_dim s /\ FINITE t
        ==> simply_connected(s DIFF t)`,
  let lemma = prove
   (`!P. (?u v. P u /\ P v /\ ~(u = v)) /\
         (!c. P c ==> ~(s INTER {x:real^N | x$k = c} = {}))
         ==> ?u v. u IN s INTER {x | P(x$k)} /\ v IN s INTER {x | P(x$k)} /\
                   ~(u = v)`,
    REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th ->
      MP_TAC(SPEC `u:real` th) THEN MP_TAC(SPEC `v:real` th)) THEN
    ASM SET_TAC[]) in
  ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN
  WF_INDUCT_TAC `CARD(t:real^N->bool)` THEN
  X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN
  ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN
  REPEAT_TCL DISJ_CASES_THEN STRIP_ASSUME_TAC (SET_RULE
   `s INTER t = {} \/ ?a:real^N. s INTER t = {a} \/
    ?a b. ~(a = b) /\ a IN s /\ a IN t /\ b IN s /\ b IN t`) THEN
  ASM_SIMP_TAC[CONVEX_IMP_SIMPLY_CONNECTED; SIMPLY_CONNECTED_PUNCTURED_CONVEX;
               DIFF_EMPTY; SET_RULE `s DIFF {a} = s DELETE a`] THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN
  REWRITE_TAC[NOT_IMP; LEFT_IMP_EXISTS_THM; NOT_FORALL_THM] THEN
  X_GEN_TAC `k:num` THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH
   `~(x = y) ==> x < y \/ y < x`)) THEN
  POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
  ONCE_REWRITE_TAC[REWRITE_RULE[IMP_CONJ_ALT] IMP_IMP] THEN
  MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`b:real^N`; `a:real^N`] THEN
  MATCH_MP_TAC(MESON[]
   `(!a b. R a b ==> R b a) /\ (!a b. P a b ==> R a b)
    ==> !a b. P a b \/ P b a ==> R a b`) THEN
  CONJ_TAC THENL [REWRITE_TAC[CONJ_ACI]; REPEAT STRIP_TAC] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP]) THEN
  SUBGOAL_THEN
   `!s t. s DIFF t =
          {x | x IN s /\ x$k < (b:real^N)$k} DIFF
          {x | x IN t /\ x$k < b$k} UNION
          {x:real^N | x IN s /\ (a:real^N)$k < x$k} DIFF
          {x | x IN t /\ a$k < x$k}`
   (fun th -> ONCE_REWRITE_TAC[th] THEN ASSUME_TAC(GSYM th))
  THENL
   [FIRST_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH
     `a < b ==> !x. a < x \/ x < b`)) THEN SET_TAC[];
    MATCH_MP_TAC SIMPLY_CONNECTED_UNION THEN ASM_REWRITE_TAC[]] THEN
  REPEAT CONJ_TAC THENL
   [REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} DIFF {x | x IN t /\ P x} =
                          (s DIFF t) INTER {x | P x}`] THEN
    MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN
    REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT];
    REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} DIFF {x | x IN t /\ P x} =
                          (s DIFF t) INTER {x | P x}`] THEN
    MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN
    REWRITE_TAC[GSYM real_gt; OPEN_HALFSPACE_COMPONENT_GT];
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    ASM_SIMP_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`;
      FINITE_INTER; CONVEX_INTER; CONVEX_HALFSPACE_COMPONENT_LT] THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC CARD_PSUBSET THEN ASM SET_TAC[REAL_LT_REFL];
      ALL_TAC] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH
     `&3:int <= x ==> y = x ==> &3 <= y`)) THEN
    MATCH_MP_TAC AFF_DIM_CONVEX_INTER_OPEN THEN
    ASM_REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT] THEN
    ASM SET_TAC[];
    FIRST_X_ASSUM MATCH_MP_TAC THEN
    ASM_SIMP_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`;
      FINITE_INTER; CONVEX_INTER;
      REWRITE_RULE[real_gt] CONVEX_HALFSPACE_COMPONENT_GT] THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC CARD_PSUBSET THEN ASM SET_TAC[REAL_LT_REFL];
      ALL_TAC] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH
     `&3:int <= x ==> y = x ==> &3 <= y`)) THEN
    MATCH_MP_TAC AFF_DIM_CONVEX_INTER_OPEN THEN
    ASM_REWRITE_TAC[REWRITE_RULE[real_gt] OPEN_HALFSPACE_COMPONENT_GT] THEN
    ASM SET_TAC[];
    ALL_TAC;
    ALL_TAC] THEN
  REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} DIFF {x | x IN t /\ P x} =
                        (s DIFF t) INTER {x | P x}`] THEN
  REWRITE_TAC[SET_RULE `(s INTER u) INTER (s INTER v) = s INTER (u INTER v)`;
              SET_RULE `(s DIFF t) INTER u = (s INTER u) DIFF t`] THEN
  REWRITE_TAC[SET_RULE `s INTER u DIFF s INTER t = s INTER u DIFF t`] THENL
   [MATCH_MP_TAC PATH_CONNECTED_CONVEX_DIFF_COUNTABLE THEN
    ASM_SIMP_TAC[FINITE_IMP_COUNTABLE; CONVEX_INTER; COLLINEAR_AFF_DIM;
                 CONVEX_HALFSPACE_COMPONENT_LT;
                 REWRITE_RULE[real_gt] CONVEX_HALFSPACE_COMPONENT_GT] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH
     `&3:int <= x ==> y = x ==> ~(y <= &1)`)) THEN
    MATCH_MP_TAC AFF_DIM_CONVEX_INTER_OPEN THEN
    ASM_SIMP_TAC[OPEN_INTER; OPEN_HALFSPACE_COMPONENT_LT;
                 REWRITE_RULE[real_gt] OPEN_HALFSPACE_COMPONENT_GT] THEN
    MATCH_MP_TAC(MESON[INFINITE; FINITE_EMPTY]
     `INFINITE s ==> ~(s = {})`);
    REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN
    MATCH_MP_TAC(MESON[FINITE_SUBSET; INFINITE]
     `INFINITE s /\ FINITE t ==> ~(s SUBSET t)`) THEN
    ASM_REWRITE_TAC[]] THEN
 (ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5)
   [CONNECTED_FINITE_IFF_SING; INFINITE; CONVEX_CONNECTED;
    CONVEX_INTER; CONVEX_HALFSPACE_COMPONENT_LT;
    REWRITE_RULE[real_gt] CONVEX_HALFSPACE_COMPONENT_GT] THEN
  MATCH_MP_TAC(SET_RULE
   `!u v. u IN s /\ v IN s /\ ~(u = v) ==> ~(s = {} \/ ?z. s = {z})`) THEN
  REWRITE_TAC[SET_RULE `{x | P x} INTER {x | Q x} = {x | Q x /\ P x}`] THEN
  MP_TAC lemma THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL
   [EXISTS_TAC `a$k + &1 / &3 * ((b:real^N)$k - (a:real^N)$k)` THEN
    EXISTS_TAC `a$k + &2 / &3 * ((b:real^N)$k - (a:real^N)$k)` THEN
    ASM_REAL_ARITH_TAC;
    X_GEN_TAC `c:real` THEN STRIP_TAC THEN
    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_ELIM_THM] THEN
    SUBGOAL_THEN `!x:real^N. x$k = basis k dot x` (fun t -> SIMP_TAC[t]) THENL
     [ASM_MESON_TAC[DOT_BASIS]; MATCH_MP_TAC CONNECTED_IVT_HYPERPLANE] THEN
    MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN
    ASM_SIMP_TAC[CONVEX_CONNECTED; DOT_BASIS; REAL_LT_IMP_LE]]));;

(* ------------------------------------------------------------------------- *)
(* Some technical lemmas about extending maps from cell complexes.           *)
(* ------------------------------------------------------------------------- *)

let EXTEND_MAP_CELL_COMPLEX_TO_SPHERE,
    EXTEND_MAP_CELL_COMPLEX_TO_SPHERE_COFINITE = (CONJ_PAIR o prove)
 (`(!f:real^M->real^N m s t.
        FINITE m /\ (!c. c IN m ==> polytope c /\ aff_dim c < aff_dim t) /\
        (!c1 c2. c1 IN m /\ c2 IN m
                 ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2) /\
        s SUBSET UNIONS m /\ closed s /\ convex t /\ bounded t /\
        f continuous_on s /\ IMAGE f s SUBSET relative_frontier t
        ==> ?g. g continuous_on UNIONS m /\
                IMAGE g (UNIONS m) SUBSET relative_frontier t /\
                !x. x IN s ==> g x = f x) /\
   (!f:real^M->real^N m s t.
        FINITE m /\ (!c. c IN m ==> polytope c /\ aff_dim c <= aff_dim t) /\
        (!c1 c2. c1 IN m /\ c2 IN m
                 ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2) /\
        s SUBSET UNIONS m /\ closed s /\ convex t /\ bounded t /\
        f continuous_on s /\ IMAGE f s SUBSET relative_frontier t
        ==> ?k g. FINITE k /\ DISJOINT k s /\
                  g continuous_on (UNIONS m DIFF k) /\
                  IMAGE g (UNIONS m DIFF k) SUBSET relative_frontier t /\
                  !x. x IN s ==> g x = f x)`,
  let wemma = prove
   (`!h:real^M->real^N k t f.
          (!s. s IN f ==> ?g. g continuous_on s /\
                              IMAGE g s SUBSET t /\
                              !x. x IN s INTER k ==> g x = h x) /\
          FINITE f /\ (!s. s IN f ==> closed s) /\
          (!s t. s IN f /\ t IN f /\ ~(s = t) ==> (s INTER t) SUBSET k)
          ==> ?g. g continuous_on (UNIONS f) /\
                  IMAGE g (UNIONS f) SUBSET t /\
                  !x. x IN (UNIONS f) INTER k ==> g x = h x`,
    REPLICATE_TAC 3 GEN_TAC THEN
    ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> q ==> p /\ r ==> s`] THEN
    MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
    REWRITE_TAC[UNIONS_0; IMAGE_CLAUSES; EMPTY_SUBSET; CONTINUOUS_ON_EMPTY;
                INTER_EMPTY; NOT_IN_EMPTY] THEN
    REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_INSERT] THEN
    REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; SUBSET_REFL] THEN
    MAP_EVERY X_GEN_TAC [`s:real^M->bool`; `u:(real^M->bool)->bool`] THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC
     (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN
    ASM_SIMP_TAC[UNIONS_INSERT] THEN
    DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
    ASM_CASES_TAC `(s:real^M->bool) UNION UNIONS u = UNIONS u` THENL
     [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN
    FIRST_X_ASSUM(X_CHOOSE_THEN `f:real^M->real^N` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `\x. if x IN s then (f:real^M->real^N) x else g x` THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    MATCH_MP_TAC CONTINUOUS_ON_CASES THEN ASM_SIMP_TAC[CLOSED_UNIONS] THEN
    ASM SET_TAC[]) in
  let lemma = prove
   (`!h:real^M->real^N k t f.
          (!s. s IN f ==> ?g. g continuous_on s /\
                              IMAGE g s SUBSET t /\
                              !x. x IN s INTER k ==> g x = h x) /\
          FINITE f /\ (!s. s IN f ==> closed s) /\
          (!s t. s IN f /\ t IN f /\ ~(s SUBSET t) /\ ~(t SUBSET s)
                 ==> (s INTER t) SUBSET k)
          ==> ?g. g continuous_on (UNIONS f) /\
                  IMAGE g (UNIONS f) SUBSET t /\
                  !x. x IN (UNIONS f) INTER k ==> g x = h x`,
    REPEAT STRIP_TAC THEN
    FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP UNIONS_MAXIMAL_SETS) THEN
    MATCH_MP_TAC wemma THEN
    ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM] THEN ASM SET_TAC[]) in
  let zemma = prove
   (`!f:real^M->real^N m n t.
          FINITE m /\ (!c. c IN m ==> polytope c) /\
          n SUBSET m /\ (!c. c IN m DIFF n ==> aff_dim c < aff_dim t) /\
          (!c1 c2. c1 IN m /\ c2 IN m
                   ==> (c1 INTER c2) face_of c1 /\ (c1 INTER c2) face_of c2) /\
          convex t /\ bounded t /\
          f continuous_on (UNIONS n) /\
          IMAGE f (UNIONS n) SUBSET relative_frontier t
          ==> ?g. g continuous_on (UNIONS m) /\
                  IMAGE g (UNIONS m) SUBSET relative_frontier t /\
                  (!x. x IN UNIONS n ==> g x = f x)`,
    REPEAT STRIP_TAC THEN
    ASM_CASES_TAC `m DIFF n:(real^M->bool)->bool = {}` THENL
     [SUBGOAL_THEN `(UNIONS m:real^M->bool) SUBSET UNIONS n` ASSUME_TAC THENL
       [ASM SET_TAC[]; EXISTS_TAC `f:real^M->real^N`] THEN
      REWRITE_TAC[] THEN CONJ_TAC THENL
       [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]];
      ALL_TAC] THEN
    SUBGOAL_THEN
     `!i. &i <= aff_dim t
          ==> ?g. g continuous_on
                  (UNIONS
                   (n UNION {d | ?c. c IN m /\ d face_of c /\
                                      aff_dim d < &i})) /\
                  IMAGE g (UNIONS
                   (n UNION {d | ?c. c IN m /\ d face_of c /\
                                      aff_dim d < &i}))
                  SUBSET relative_frontier t /\
                  (!x. x IN UNIONS n ==> g x = (f:real^M->real^N) x)`
    MP_TAC THENL
     [ALL_TAC;
      MP_TAC(ISPEC `aff_dim(t:real^N->bool)` INT_OF_NUM_EXISTS) THEN
      MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN
      CONJ_TAC THENL
       [ASM_MESON_TAC[AFF_DIM_GE; MEMBER_NOT_EMPTY;
                      INT_ARITH `--(&1):int <= s /\ s < t ==> &0 <= t`];
        ALL_TAC] THEN
      DISCH_THEN(X_CHOOSE_TAC `i:num`) THEN
      DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN
      SUBGOAL_THEN
       `UNIONS (n UNION {d | ?c. c IN m /\ d face_of c /\ aff_dim d < &i}) =
        UNIONS m:real^M->bool`
       (fun th -> REWRITE_TAC[th]) THEN
      FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
      MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
       [MATCH_MP_TAC UNIONS_MONO THEN REWRITE_TAC[IN_UNION] THEN
        REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN
        REWRITE_TAC[FORALL_AND_THM; FORALL_IN_GSPEC] THEN
        CONJ_TAC THENL [ASM_MESON_TAC[SUBSET]; GEN_TAC] THEN
        MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[FACE_OF_IMP_SUBSET];
        MATCH_MP_TAC SUBSET_UNIONS THEN REWRITE_TAC[SUBSET; IN_UNION] THEN
        X_GEN_TAC `d:real^M->bool` THEN DISCH_TAC THEN
        ASM_CASES_TAC `(d:real^M->bool) IN n` THEN
        ASM_SIMP_TAC[IN_ELIM_THM] THEN
        EXISTS_TAC `d:real^M->bool` THEN
        ASM_SIMP_TAC[FACE_OF_REFL; POLYTOPE_IMP_CONVEX] THEN
        ASM SET_TAC[]]] THEN
    MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
     [REWRITE_TAC[INT_ARITH `d < &0 <=> (--(&1) <= d ==> d:int = --(&1))`] THEN
      REWRITE_TAC[AFF_DIM_GE; AFF_DIM_EQ_MINUS1] THEN
      SUBGOAL_THEN
       `{d:real^M->bool| ?c. c IN m /\ d face_of c /\ d = {}} = {{}}`
       (fun th -> REWRITE_TAC[th])
      THENL
       [GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `d:real^M->bool` THEN
        REWRITE_TAC[IN_SING; IN_ELIM_THM] THEN
        ASM_CASES_TAC `d:real^M->bool = {}` THEN
        ASM_REWRITE_TAC[EMPTY_FACE_OF] THEN ASM SET_TAC[];
        REWRITE_TAC[UNIONS_UNION; UNIONS_1; UNION_EMPTY] THEN
        ASM_MESON_TAC[]];
      ALL_TAC] THEN
    X_GEN_TAC `p:num` THEN REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN
    REWRITE_TAC[INT_ARITH `p + &1 <= x <=> p:int < x`] THEN
    DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
    ASM_SIMP_TAC[INT_LT_IMP_LE] THEN
    DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` STRIP_ASSUME_TAC) THEN
    REWRITE_TAC[INT_ARITH `x:int < p + &1 <=> x <= p`] THEN
    SUBGOAL_THEN `~(t:real^N->bool = {})` ASSUME_TAC THENL
     [ASM_MESON_TAC[AFF_DIM_EMPTY; INT_ARITH `~(&p:int < --(&1))`];
      ALL_TAC] THEN
    SUBGOAL_THEN `~(relative_frontier t:real^N->bool = {})` ASSUME_TAC THENL
     [ASM_REWRITE_TAC[RELATIVE_FRONTIER_EQ_EMPTY] THEN DISCH_TAC THEN
      MP_TAC(ISPEC `t:real^N->bool` AFFINE_BOUNDED_EQ_LOWDIM) THEN
      ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC;
      ALL_TAC] THEN
    SUBGOAL_THEN
     `!d. d IN n UNION {d | ?c. c IN m /\ d face_of c /\ aff_dim d <= &p}
          ==> ?g. (g:real^M->real^N) continuous_on d /\
                  IMAGE g d SUBSET relative_frontier t /\
                  !x. x IN d INTER
                      UNIONS
                    (n UNION {d | ?c. c IN m /\ d face_of c /\ aff_dim d < &p})
                      ==> g x = h x`
    MP_TAC THENL
     [X_GEN_TAC `d:real^M->bool` THEN
      ASM_CASES_TAC `(d:real^M->bool) SUBSET UNIONS
                 (n UNION {d | ?c. c IN m /\ d face_of c /\ aff_dim d < &p})`
      THENL
       [DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `h:real^M->real^N` THEN
        REWRITE_TAC[] THEN CONJ_TAC THENL
         [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]];
        ALL_TAC] THEN
      ASM_CASES_TAC `?a:real^M. d = {a}` THENL
       [FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^M` SUBST_ALL_TAC) THEN
        DISCH_THEN(K ALL_TAC) THEN ASM_SIMP_TAC[CONTINUOUS_ON_SING; SET_RULE
         `~({a} SUBSET s) ==> ~(x IN {a} INTER s)`] THEN
        REWRITE_TAC[SUBSET; FORALL_IN_IMAGE;
                    FORALL_IN_INSERT; NOT_IN_EMPTY] THEN
        MATCH_MP_TAC(MESON[] `(?c. P(\x. c)) ==> (?f. P f)`) THEN
        ASM SET_TAC[];
        ALL_TAC] THEN
      SUBGOAL_THEN `~(d:real^M->bool = {})` ASSUME_TAC THENL
       [ASM SET_TAC[]; ALL_TAC] THEN
      FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE
       `~(s SUBSET UNIONS f) ==> ~(s IN f)`)) THEN
      REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP
       (SET_RULE `~(d IN s UNION t) /\ d IN s UNION u
                  ==> ~(d IN s) /\ d IN u DIFF t`)) THEN
      DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
      DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
       `d IN
        {d | ?c. c IN m /\ d face_of c /\ aff_dim d <= &p} DIFF
        {d | ?c. c IN m /\ d face_of c /\ aff_dim d < &p}
        ==> ?c. c IN m /\ d face_of c /\
                (aff_dim d <= &p /\ ~(aff_dim d < &p))`)) THEN
      REWRITE_TAC[INT_ARITH `d:int <= p /\ ~(d < p) <=> d = p`] THEN
      DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN
      MP_TAC(ISPECL [`h:real^M->real^N`; `relative_frontier d:real^M->bool`;
        `t:real^N->bool`] NULLHOMOTOPIC_INTO_RELATIVE_FRONTIER_EXTENSION) THEN
      ASM_REWRITE_TAC[CLOSED_RELATIVE_FRONTIER;
                      RELATIVE_FRONTIER_EQ_EMPTY] THEN
      SUBGOAL_THEN
       `relative_frontier d SUBSET
        UNIONS {e:real^M->bool | e face_of c /\ aff_dim e < &p}`
      ASSUME_TAC THENL
       [W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_FRONTIER_OF_POLYHEDRON o
          lhand o snd) THEN
        ANTS_TAC THENL
         [ASM_MESON_TAC[POLYTOPE_IMP_POLYHEDRON; FACE_OF_POLYTOPE_POLYTOPE];
          DISCH_THEN SUBST1_TAC] THEN
        MATCH_MP_TAC SUBSET_UNIONS THEN
        ASM_SIMP_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM; facet_of] THEN
        X_GEN_TAC `f:real^M->bool` THEN REPEAT STRIP_TAC THENL
         [ASM_MESON_TAC[FACE_OF_TRANS]; INT_ARITH_TAC];
        ALL_TAC] THEN
      ANTS_TAC THENL
       [REPEAT CONJ_TAC THENL
         [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
            CONTINUOUS_ON_SUBSET)) THEN
          ASM SET_TAC[];
          ASM_MESON_TAC[AFFINE_BOUNDED_EQ_TRIVIAL; FACE_OF_POLYTOPE_POLYTOPE;
                        POLYTOPE_IMP_BOUNDED];
          ASM SET_TAC[]];
        ALL_TAC] THEN
      MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN
      CONJ_TAC THENL
       [MATCH_MP_TAC INESSENTIAL_SPHEREMAP_LOWDIM_GEN THEN
        ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
         [ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE; POLYTOPE_IMP_CONVEX];
          ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE; POLYTOPE_IMP_BOUNDED];
          FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
            CONTINUOUS_ON_SUBSET)) THEN
          ASM SET_TAC[];
          ASM SET_TAC[]];
        MATCH_MP_TAC MONO_EXISTS] THEN
      X_GEN_TAC `g:real^M->real^N` THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL
       [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV];
        ASM SET_TAC[];
        ALL_TAC] THEN
      REWRITE_TAC[INTER_UNIONS] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
       (SET_RULE `(!x. x IN s ==> P x) ==> t SUBSET s
                  ==> !x. x IN t ==> P x`)) THEN
      REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN
      X_GEN_TAC `e:real^M->bool` THEN DISCH_TAC THEN
      MATCH_MP_TAC FACE_OF_SUBSET_RELATIVE_FRONTIER THEN CONJ_TAC THENL
       [MATCH_MP_TAC(MESON[]
         `(d INTER e) face_of d /\ (d INTER e) face_of e
          ==> (d INTER e) face_of d`) THEN
        MATCH_MP_TAC FACE_OF_INTER_SUBFACE THEN
        EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
        FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNION]) THEN
        REWRITE_TAC[IN_ELIM_THM] THEN
        STRIP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
        ASM_MESON_TAC[FACE_OF_REFL; SUBSET; POLYTOPE_IMP_CONVEX];
        REWRITE_TAC[SET_RULE `d INTER e = d <=> d SUBSET e`] THEN
        DISCH_TAC THEN
        FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNION]) THEN
        REWRITE_TAC[IN_ELIM_THM] THEN
        DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN
        ASM_MESON_TAC[AFF_DIM_SUBSET; INT_NOT_LE]];
      ALL_TAC] THEN
    DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] lemma)) THEN
    ANTS_TAC THENL
     [ALL_TAC;
      MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN ASM SET_TAC[]] THEN
    CONJ_TAC THENL
     [REWRITE_TAC[FINITE_UNION] THEN
      CONJ_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN
      MATCH_MP_TAC FINITE_SUBSET THEN
      EXISTS_TAC `UNIONS {{d:real^M->bool | d face_of c} | c IN m}` THEN
      CONJ_TAC THENL
       [REWRITE_TAC[FINITE_UNIONS; FORALL_IN_GSPEC] THEN
        ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN
        ASM_MESON_TAC[FINITE_POLYTOPE_FACES];
        REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]];
      ALL_TAC] THEN
    CONJ_TAC THENL
     [REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN
      ASM_MESON_TAC[FACE_OF_IMP_CLOSED; POLYTOPE_IMP_CLOSED;
                    POLYTOPE_IMP_CONVEX; SUBSET];
      ALL_TAC] THEN
    MAP_EVERY X_GEN_TAC [`d:real^M->bool`; `e:real^M->bool`] THEN
    REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN
    DISCH_THEN(CONJUNCTS_THEN2 (DISJ_CASES_THEN2 ASSUME_TAC
     (X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC)) MP_TAC)
    THENL [ASM SET_TAC[]; ALL_TAC] THEN
    DISCH_THEN(CONJUNCTS_THEN2 (DISJ_CASES_THEN2 ASSUME_TAC
     (X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC)) MP_TAC)
    THENL [ASM SET_TAC[]; STRIP_TAC] THEN
    REWRITE_TAC[UNIONS_UNION] THEN
    MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s SUBSET t UNION u`) THEN
    MATCH_MP_TAC(SET_RULE `x IN s ==> x SUBSET UNIONS s`) THEN
    REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `c:real^M->bool` THEN
    ASM_REWRITE_TAC[] THEN
    SUBGOAL_THEN `d INTER e face_of (d:real^M->bool) /\
                  d INTER e face_of e`
    STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[FACE_OF_INTER_SUBFACE]; ALL_TAC] THEN
    CONJ_TAC THENL [ASM_MESON_TAC[FACE_OF_TRANS]; ALL_TAC] THEN
    TRANS_TAC INT_LTE_TRANS `aff_dim(d:real^M->bool)` THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN
    ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
     [ASM_MESON_TAC[POLYTOPE_IMP_CONVEX; FACE_OF_IMP_CONVEX];
      ASM SET_TAC[]]) in
  let memma = prove
   (`!h:real^M->real^N k t u f.
          (!s. s IN f ==> ?a g. ~(a IN u) /\ g continuous_on (s DELETE a) /\
                               IMAGE g (s DELETE a) SUBSET t /\
                               !x. x IN s INTER k ==> g x = h x) /\
          FINITE f /\ (!s. s IN f ==> closed s) /\
          (!s t. s IN f /\ t IN f /\ ~(s = t) ==> (s INTER t) SUBSET k)
          ==> ?c g. FINITE c /\ DISJOINT c u /\ CARD c <= CARD f /\
                    g continuous_on (UNIONS f DIFF c) /\
                    IMAGE g (UNIONS f DIFF c) SUBSET t /\
                    !x. x IN (UNIONS f DIFF c) INTER k ==> g x = h x`,
    REPLICATE_TAC 4 GEN_TAC THEN
    ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> q ==> p /\ r ==> s`] THEN
    MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
    REWRITE_TAC[UNIONS_0; IMAGE_CLAUSES; EMPTY_SUBSET; CONTINUOUS_ON_EMPTY;
                INTER_EMPTY; NOT_IN_EMPTY; EMPTY_DIFF] THEN
    CONJ_TAC THENL
     [MESON_TAC[DISJOINT_EMPTY; FINITE_EMPTY; CARD_CLAUSES; LE_REFL];
      ALL_TAC] THEN
    REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_INSERT] THEN
    REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; SUBSET_REFL] THEN
    MAP_EVERY X_GEN_TAC [`s:real^M->bool`; `u:(real^M->bool)->bool`] THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC
     (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN
    ASM_SIMP_TAC[UNIONS_INSERT] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`c:real^M->bool`; `g:real^M->real^N`] THEN
    STRIP_TAC THEN ASM_SIMP_TAC[CARD_CLAUSES] THEN
    ASM_CASES_TAC `(s:real^M->bool) UNION UNIONS u = UNIONS u` THENL
     [ASM_SIMP_TAC[] THEN ASM_MESON_TAC[ARITH_RULE `x <= y ==> x <= SUC y`];
      ALL_TAC] THEN
    FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^M`
     (X_CHOOSE_THEN `f:real^M->real^N` STRIP_ASSUME_TAC)) THEN
    EXISTS_TAC `(a:real^M) INSERT c` THEN
    ASM_SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; RIGHT_EXISTS_AND_THM] THEN
    REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ASM_ARITH_TAC; ALL_TAC] THEN
    EXISTS_TAC `\x. if x IN s then (f:real^M->real^N) x else g x` THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
    EXISTS_TAC `(s DIFF ((a:real^M) INSERT c)) UNION
                (UNIONS u DIFF ((a:real^M) INSERT c))` THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN REPEAT CONJ_TAC THENL
     [REWRITE_TAC[CLOSED_IN_CLOSED] THEN
      EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[];
      REWRITE_TAC[CLOSED_IN_CLOSED] THEN
      EXISTS_TAC `UNIONS u:real^M->bool` THEN ASM_SIMP_TAC[CLOSED_UNIONS];
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
            CONTINUOUS_ON_SUBSET));
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
            CONTINUOUS_ON_SUBSET));
      ALL_TAC] THEN
    ASM SET_TAC[]) in
  let temma = prove
   (`!h:real^M->real^N k t u f.
          (!s. s IN f ==> ?a g. ~(a IN u) /\ g continuous_on (s DELETE a) /\
                                IMAGE g (s DELETE a) SUBSET t /\
                                !x. x IN s INTER k ==> g x = h x) /\
          FINITE f /\ (!s. s IN f ==> closed s) /\
          (!s t. s IN f /\ t IN f /\  ~(s SUBSET t) /\ ~(t SUBSET s)
                 ==> (s INTER t) SUBSET k)
          ==> ?c g. FINITE c /\ DISJOINT c u /\ CARD c <= CARD f /\
                    g continuous_on (UNIONS f DIFF c) /\
                    IMAGE g (UNIONS f DIFF c) SUBSET t /\
                    !x. x IN (UNIONS f DIFF c) INTER k ==> g x = h x`,
    REPEAT STRIP_TAC THEN
    MP_TAC(ISPECL [`h:real^M->real^N`; `k:real^M->bool`; `t:real^N->bool`;
                   `u:real^M->bool`;
                   `{t:real^M->bool | t IN f /\
                                      (!u. u IN f ==> ~(t PSUBSET u))}`]
          memma) THEN
    ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM; UNIONS_MAXIMAL_SETS] 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
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          LE_TRANS)) THEN
    MATCH_MP_TAC CARD_SUBSET THEN
    ASM_SIMP_TAC[] THEN SET_TAC[]) in
  let bemma = prove
   (`!f:real^M->real^N m n t.
        FINITE m /\ (!c. c IN m ==> polytope c) /\
        n SUBSET m /\ (!c. c IN m DIFF n ==> aff_dim c <= aff_dim t) /\
        (!c1 c2. c1 IN m /\ c2 IN m
                 ==> (c1 INTER c2) face_of c1 /\ (c1 INTER c2) face_of c2) /\
        convex t /\ bounded t /\
        f continuous_on (UNIONS n) /\
        IMAGE f (UNIONS n) SUBSET relative_frontier t
        ==> ?k g. FINITE k /\ DISJOINT k (UNIONS n) /\ CARD k <= CARD m /\
                  g continuous_on (UNIONS m DIFF k) /\
                  IMAGE g (UNIONS m DIFF k) SUBSET relative_frontier t /\
                  (!x. x IN UNIONS n ==> g x = f x)`,
    REPEAT STRIP_TAC THEN
    MP_TAC(ISPECL [`f:real^M->real^N`;
         `n UNION {d:real^M->bool | ?c. c IN m DIFF n /\ d face_of c /\
                                        aff_dim d < aff_dim(t:real^N->bool)}`;
         `n:(real^M->bool)->bool`; `t:real^N->bool`] zemma) THEN
    ASM_REWRITE_TAC[SUBSET_UNION; SET_RULE
     `(n UNION m) DIFF n = m DIFF n`] THEN
    SIMP_TAC[IN_DIFF; IN_ELIM_THM; LEFT_IMP_EXISTS_THM;
             LEFT_AND_EXISTS_THM] THEN
    ANTS_TAC THENL
     [REPEAT CONJ_TAC THENL
       [ASM_REWRITE_TAC[FINITE_UNION] THEN
        CONJ_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN
        MATCH_MP_TAC FINITE_SUBSET THEN
        EXISTS_TAC `UNIONS {{d:real^M->bool | d face_of c} | c IN m}` THEN
        CONJ_TAC THENL
         [REWRITE_TAC[FINITE_UNIONS; FORALL_IN_GSPEC] THEN
          ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN
          ASM_MESON_TAC[FINITE_POLYTOPE_FACES];
          REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]];
        REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN
        ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE; SUBSET];
        REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN
        ASM_MESON_TAC[FACE_OF_INTER_SUBFACE; SUBSET; FACE_OF_REFL;
                      POLYTOPE_IMP_CONVEX; FACE_OF_IMP_CONVEX]];
      ALL_TAC] THEN
    DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` STRIP_ASSUME_TAC) THEN
    SUBGOAL_THEN
     `!d. d IN m
          ==> ?a g. ~(a IN UNIONS n) /\
                    (g:real^M->real^N) continuous_on (d DELETE a) /\
                    IMAGE g (d DELETE a) SUBSET relative_frontier t /\
                    !x. x IN d INTER
                         UNIONS
                          (n UNION {d | ?c. (c IN m /\ ~(c IN n)) /\
                                            d face_of c /\
                                            aff_dim d < aff_dim t})
                        ==> g x = h x`
    MP_TAC THENL
     [X_GEN_TAC `d:real^M->bool` THEN DISCH_TAC THEN
      ASM_CASES_TAC `(d:real^M->bool) SUBSET
                     UNIONS(n UNION {d | ?c. (c IN m /\ ~(c IN n)) /\
                                             d face_of c /\
                                     aff_dim d < aff_dim(t:real^N->bool)})`
      THENL
       [SUBGOAL_THEN `~(UNIONS n = (:real^M))` MP_TAC THENL
         [MATCH_MP_TAC(MESON[NOT_BOUNDED_UNIV]
           `bounded s ==> ~(s = UNIV)`) THEN
          MATCH_MP_TAC BOUNDED_UNIONS THEN
          ASM_MESON_TAC[POLYTOPE_IMP_BOUNDED; SUBSET; FINITE_SUBSET];
          GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [EXTENSION]] THEN
        REWRITE_TAC[IN_UNIV; NOT_FORALL_THM] THEN
        MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^M` THEN
        STRIP_TAC THEN EXISTS_TAC `h:real^M->real^N` THEN
        ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
         [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET;
                        SET_RULE `s SUBSET t ==> s DELETE a SUBSET t`];
          ASM SET_TAC[]];
        ALL_TAC] THEN
      ASM_CASES_TAC `(d:real^M->bool) IN n` THENL [ASM SET_TAC[]; ALL_TAC] THEN
      DISJ_CASES_THEN MP_TAC (SPEC
       `relative_interior(d:real^M->bool) = {}` EXCLUDED_MIDDLE)
      THENL
       [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY; POLYTOPE_IMP_CONVEX] THEN
        ASM SET_TAC[];
        REWRITE_TAC[GSYM MEMBER_NOT_EMPTY]] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^M` THEN STRIP_TAC THEN
      SUBGOAL_THEN
       `relative_frontier d SUBSET
        UNIONS {e:real^M->bool | e face_of d /\
                                 aff_dim e < aff_dim(t:real^N->bool)}`
      ASSUME_TAC THENL
       [W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_FRONTIER_OF_POLYHEDRON o
          lhand o snd) THEN
        ANTS_TAC THENL
         [ASM_MESON_TAC[POLYTOPE_IMP_POLYHEDRON; FACE_OF_POLYTOPE_POLYTOPE];
          DISCH_THEN SUBST1_TAC] THEN
        MATCH_MP_TAC SUBSET_UNIONS THEN
        ASM_SIMP_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM; facet_of] THEN
        ASM_SIMP_TAC[INT_ARITH `d - &1:int < t <=> d <= t`; IN_DIFF];
        ALL_TAC] THEN
      MP_TAC(ISPECL [`d:real^M->bool`; `a:real^M`]
          RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL) THEN
      ASM_SIMP_TAC[POLYTOPE_IMP_CONVEX; POLYTOPE_IMP_BOUNDED] THEN
      REWRITE_TAC[retract_of; LEFT_IMP_EXISTS_THM; retraction] THEN
      X_GEN_TAC `r:real^M->real^M` THEN STRIP_TAC THEN
      EXISTS_TAC `(h:real^M->real^N) o (r:real^M->real^M)` THEN
      REPEAT CONJ_TAC THENL
       [REWRITE_TAC[IN_UNIONS] THEN
        DISCH_THEN(X_CHOOSE_THEN `e:real^M->bool` STRIP_ASSUME_TAC) THEN
        SUBGOAL_THEN
         `e INTER d face_of e /\ e INTER d face_of (d:real^M->bool)`
        MP_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
        DISCH_THEN(MP_TAC o MATCH_MP
          (REWRITE_RULE[IMP_CONJ] FACE_OF_SUBSET_RELATIVE_FRONTIER) o
          CONJUNCT2) THEN
        REWRITE_TAC[NOT_IMP; relative_frontier] THEN
        MP_TAC(ISPEC `d:real^M->bool` RELATIVE_INTERIOR_SUBSET) 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)) THEN
        SIMP_TAC[HULL_SUBSET; SET_RULE
                  `s SUBSET t ==> s DELETE a SUBSET t DELETE a`];
        REWRITE_TAC[IMAGE_o] THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
         `IMAGE h t SUBSET u ==> s SUBSET t ==> IMAGE h s SUBSET u`));
        SIMP_TAC[INTER_UNIONS; o_THM] THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
         (SET_RULE `(!x. x IN s ==> r x = x) ==> t SUBSET s
                    ==> !x. x IN t ==> h(r x) = h x`)) THEN
        REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN
        X_GEN_TAC `e:real^M->bool` THEN DISCH_TAC THEN
        MATCH_MP_TAC FACE_OF_SUBSET_RELATIVE_FRONTIER THEN
        CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
        MATCH_MP_TAC(MESON[]
         `(d INTER e) face_of d /\ (d INTER e) face_of e
          ==> (d INTER e) face_of d`) THEN
        FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNION]) THEN
        REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THENL
         [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
        MATCH_MP_TAC FACE_OF_INTER_SUBFACE THEN
        MAP_EVERY EXISTS_TAC [`d:real^M->bool`; `c:real^M->bool`] THEN
        ASM_SIMP_TAC[FACE_OF_REFL; POLYTOPE_IMP_CONVEX]] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
       `IMAGE r (h DELETE a) SUBSET t ==> d SUBSET h /\ t SUBSET u
        ==> IMAGE r (d DELETE a) SUBSET u`)) THEN
      REWRITE_TAC[HULL_SUBSET] THEN ASM SET_TAC[];
      ALL_TAC] THEN
    DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] temma)) THEN
    ANTS_TAC THENL
     [ALL_TAC;
      REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
      STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]] THEN
    ASM_SIMP_TAC[POLYTOPE_IMP_CLOSED] THEN
    MAP_EVERY X_GEN_TAC [`d:real^M->bool`; `e:real^M->bool`] THEN
    STRIP_TAC THEN REWRITE_TAC[UNIONS_UNION] THEN
    ASM_CASES_TAC `(d:real^M->bool) IN n` THENL [ASM SET_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC(SET_RULE `x IN s ==> x SUBSET t UNION UNIONS s`) THEN
    REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `d:real^M->bool` THEN
    ASM_REWRITE_TAC[] THEN
    ASM_CASES_TAC `d INTER e:real^M->bool = d` THENL
      [ASM SET_TAC[]; ALL_TAC] THEN
    ASM_SIMP_TAC[] THEN TRANS_TAC INT_LTE_TRANS `aff_dim(d:real^M->bool)` THEN
    ASM_SIMP_TAC[IN_DIFF] THEN MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN
    ASM_MESON_TAC[POLYTOPE_IMP_CONVEX]) in
  CONJ_TAC THENL
   [REPEAT STRIP_TAC THEN
    SUBGOAL_THEN `compact(s:real^M->bool)` ASSUME_TAC THENL
     [ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN
      ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_UNIONS; POLYTOPE_IMP_BOUNDED];
      ALL_TAC] THEN
    MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`;
                   `relative_frontier t:real^N->bool`]
          NEIGHBOURHOOD_EXTENSION_INTO_ANR) THEN
    ASM_SIMP_TAC[LEFT_FORALL_IMP_THM; ANR_RELATIVE_FRONTIER_CONVEX] THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `g:real^M->real^N`] THEN
    STRIP_TAC THEN
    MP_TAC(ISPECL [`s:real^M->bool`; `(:real^M) DIFF v`]
          SEPARATE_COMPACT_CLOSED) THEN
    ASM_SIMP_TAC[GSYM OPEN_CLOSED; IN_DIFF; IN_UNIV] THEN
    ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    ONCE_REWRITE_TAC[TAUT `p /\ ~q ==> r <=> p /\ ~r ==> q`] THEN
    REWRITE_TAC[REAL_NOT_LE; LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `d:real` THEN STRIP_TAC THEN
    MP_TAC(ISPECL [`m:(real^M->bool)->bool`; `aff_dim(t:real^N->bool) - &1`;
                   `d:real`] CELL_COMPLEX_SUBDIVISION_EXISTS) THEN
    ASM_SIMP_TAC[INT_ARITH `x:int <= t - &1 <=> x < t`] THEN
    DISCH_THEN(X_CHOOSE_THEN `n:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPECL
     [`g:real^M->real^N`; `n:(real^M->bool)->bool`;
      `{c:real^M->bool | c IN n /\ c SUBSET v}`; `t:real^N->bool`]
     zemma) THEN
    ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
     [ASM_SIMP_TAC[SUBSET_RESTRICT; IN_DIFF] 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[]];
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^M->real^N` THEN
      STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN
      DISCH_TAC THEN TRANS_TAC EQ_TRANS `(g:real^M->real^N) x` THEN
      CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
      SUBGOAL_THEN `(x:real^M) IN UNIONS n` MP_TAC THENL
       [ASM SET_TAC[]; ALL_TAC] THEN
      REWRITE_TAC[IN_UNIONS] THEN MATCH_MP_TAC MONO_EXISTS THEN
      X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
      ASM_REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[SUBSET] THEN
      X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      EXISTS_TAC `x:real^M` THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC REAL_LET_TRANS THEN
      EXISTS_TAC `diameter(c:real^M->bool)` THEN
      ASM_SIMP_TAC[dist] THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN
      ASM_SIMP_TAC[POLYTOPE_IMP_BOUNDED]];
    REPEAT STRIP_TAC THEN
    SUBGOAL_THEN `compact(s:real^M->bool)` ASSUME_TAC THENL
     [ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN
      ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_UNIONS; POLYTOPE_IMP_BOUNDED];
      ALL_TAC] THEN
    MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`;
                   `relative_frontier t:real^N->bool`]
          NEIGHBOURHOOD_EXTENSION_INTO_ANR) THEN
    ASM_SIMP_TAC[LEFT_FORALL_IMP_THM; ANR_RELATIVE_FRONTIER_CONVEX] THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `g:real^M->real^N`] THEN
    STRIP_TAC THEN
    MP_TAC(ISPECL [`s:real^M->bool`; `(:real^M) DIFF v`]
          SEPARATE_COMPACT_CLOSED) THEN
    ASM_SIMP_TAC[GSYM OPEN_CLOSED; IN_DIFF; IN_UNIV] THEN
    ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    ONCE_REWRITE_TAC[TAUT `p /\ ~q ==> r <=> p /\ ~r ==> q`] THEN
    REWRITE_TAC[REAL_NOT_LE; LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `d:real` THEN STRIP_TAC THEN
    MP_TAC(ISPECL [`m:(real^M->bool)->bool`; `aff_dim(t:real^N->bool)`;
                   `d:real`] CELL_COMPLEX_SUBDIVISION_EXISTS) THEN
    ASM_SIMP_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `n:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPECL
     [`g:real^M->real^N`; `n:(real^M->bool)->bool`;
      `{c:real^M->bool | c IN n /\ c SUBSET v}`; `t:real^N->bool`]
     bemma) THEN
    ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
     [ASM_SIMP_TAC[SUBSET_RESTRICT; IN_DIFF] 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[]];
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^M->real^N` THEN
      STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
       [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
         `DISJOINT k u ==> s SUBSET u ==> DISJOINT k s`)) THEN
        REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC;
        X_GEN_TAC `x:real^M` THEN
        DISCH_TAC THEN TRANS_TAC EQ_TRANS `(g:real^M->real^N) x` THEN
        CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]] THEN
      (SUBGOAL_THEN `(x:real^M) IN UNIONS n` MP_TAC THENL
        [ASM SET_TAC[]; ALL_TAC] THEN
       REWRITE_TAC[IN_UNIONS] THEN MATCH_MP_TAC MONO_EXISTS THEN
       X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
       ASM_REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[SUBSET] THEN
       X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
       EXISTS_TAC `x:real^M` THEN ASM_REWRITE_TAC[] THEN
       MATCH_MP_TAC REAL_LET_TRANS THEN
        EXISTS_TAC `diameter(c:real^M->bool)` THEN
       ASM_SIMP_TAC[dist] THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN
       ASM_SIMP_TAC[POLYTOPE_IMP_BOUNDED])]]);;

(* ------------------------------------------------------------------------- *)
(* Special cases and corollaries involving spheres.                          *)
(* ------------------------------------------------------------------------- *)

let EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_SIMPLE = prove
 (`!f:real^M->real^N s t u.
        compact s /\ convex u /\ bounded u /\ aff_dim t <= aff_dim u /\
        s SUBSET t /\ f continuous_on s /\ IMAGE f s SUBSET relative_frontier u
        ==> ?k g. FINITE k /\ k SUBSET t /\ DISJOINT k s /\
                  g continuous_on (t DIFF k) /\
                  IMAGE g (t DIFF k) SUBSET relative_frontier u /\
                  !x. x IN s ==> g x = f x`,
  let lemma = prove
   (`!f:A->B->bool P k.
        INFINITE {x | P x} /\ FINITE k /\
        (!x y. P x /\ P y /\ ~(x = y) ==> DISJOINT (f x) (f y))
        ==> ?x. P x /\ DISJOINT k (f x)`,
    REWRITE_TAC[INFINITE] THEN REPEAT STRIP_TAC THEN
    REWRITE_TAC[SET_RULE `(?x. P x /\ DISJOINT k (f x)) <=>
                          ~(!x. ?y. P x ==> y IN k /\ y IN f x)`] THEN
    REWRITE_TAC[SKOLEM_THM] THEN
    DISCH_THEN(X_CHOOSE_TAC `g:A->B`) THEN
    MP_TAC(ISPECL [`g:A->B`; `{x:A | P x}`] FINITE_IMAGE_INJ_EQ) THEN
    ASM_REWRITE_TAC[IN_ELIM_THM; NOT_IMP] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
      (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN
    ASM SET_TAC[]) in
  SUBGOAL_THEN
   `!f:real^M->real^N s t u.
        compact s /\ convex u /\ bounded u /\ aff_dim t <= aff_dim u /\
        s SUBSET t /\ f continuous_on s /\ IMAGE f s SUBSET relative_frontier u
        ==> ?k g. FINITE k /\ DISJOINT k s /\
                  g continuous_on (t DIFF k) /\
                  IMAGE g (t DIFF k) SUBSET relative_frontier u /\
                  !x. x IN s ==> g x = f x`
  MP_TAC THENL
   [ALL_TAC;
    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 ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN
    DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `k INTER t:real^M->bool` THEN
    ASM_SIMP_TAC[FINITE_INTER; INTER_SUBSET] THEN
    REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC; ASM SET_TAC[]] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
            CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]] THEN
  SUBGOAL_THEN
   `!f:real^M->real^N s t u.
        compact s /\ s SUBSET t /\ affine t /\
        convex u /\ bounded u /\ aff_dim t <= aff_dim u /\
        f continuous_on s /\ IMAGE f s SUBSET relative_frontier u
        ==> ?k g. FINITE k /\ DISJOINT k s /\
                  g continuous_on (t DIFF k) /\
                  IMAGE g (t DIFF k) SUBSET relative_frontier u /\
                  !x. x IN s ==> g x = f x`
  ASSUME_TAC THENL
   [ALL_TAC;
    REPEAT STRIP_TAC THEN
    SUBGOAL_THEN
     `?k g. FINITE k /\ DISJOINT k s /\
            g continuous_on (affine hull t DIFF k) /\
            IMAGE g (affine hull t DIFF k) SUBSET relative_frontier u /\
            !x. x IN s ==> g x = (f:real^M->real^N) x`
    MP_TAC THENL
     [FIRST_X_ASSUM MATCH_MP_TAC THEN
      ASM_SIMP_TAC[AFF_DIM_AFFINE_HULL; AFFINE_AFFINE_HULL] THEN
      TRANS_TAC SUBSET_TRANS `t:real^M->bool` THEN
      ASM_REWRITE_TAC[HULL_SUBSET];
      REPEAT(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));
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
            SUBSET_TRANS)) THEN
        MATCH_MP_TAC IMAGE_SUBSET] THEN
      MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF k SUBSET t DIFF k`) THEN
      REWRITE_TAC[HULL_SUBSET]]] THEN
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL
   [ASM_CASES_TAC `relative_frontier(u:real^N->bool) = {}` THENL
     [RULE_ASSUM_TAC(REWRITE_RULE[RELATIVE_FRONTIER_EQ_EMPTY]) THEN
      UNDISCH_TAC `bounded(u:real^N->bool)` THEN
      ASM_SIMP_TAC[AFFINE_BOUNDED_EQ_LOWDIM] THEN DISCH_TAC THEN
      SUBGOAL_THEN `aff_dim(t:real^M->bool) <= &0` MP_TAC THENL
       [ASM_INT_ARITH_TAC; ALL_TAC] THEN
      SIMP_TAC[AFF_DIM_GE; INT_ARITH
       `--(&1):int <= x ==> (x <= &0 <=> x = --(&1) \/ x = &0)`] THEN
      REWRITE_TAC[AFF_DIM_EQ_MINUS1; AFF_DIM_EQ_0] THEN
      DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC (X_CHOOSE_TAC `a:real^M`)) THEN
      EXISTS_TAC `{a:real^M}` THEN
      ASM_REWRITE_TAC[DISJOINT_EMPTY; FINITE_SING; NOT_IN_EMPTY;
                      EMPTY_DIFF; DIFF_EQ_EMPTY; IMAGE_CLAUSES;
                      CONTINUOUS_ON_EMPTY; EMPTY_SUBSET];
      EXISTS_TAC `{}:real^M->bool` THEN
      FIRST_X_ASSUM(X_CHOOSE_TAC `y:real^N` o
        GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
      ASM_SIMP_TAC[FINITE_EMPTY; DISJOINT_EMPTY; NOT_IN_EMPTY; DIFF_EMPTY] THEN
      EXISTS_TAC `(\x. y):real^M->real^N` THEN
      REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]];
    ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN
  DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC) THEN
  REWRITE_TAC[INSERT_SUBSET] THEN
  DISCH_THEN(X_CHOOSE_THEN `b:real^M` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL
   [`f:real^M->real^N`;
    `{interval[--(b + vec 1):real^M,b + vec 1] INTER t}`;
    `s:real^M->bool`; `u:real^N->bool`]
   EXTEND_MAP_CELL_COMPLEX_TO_SPHERE_COFINITE) THEN
  SUBGOAL_THEN
   `interval[--b,b] SUBSET interval[--(b + vec 1):real^M,b + vec 1]`
  ASSUME_TAC THENL
   [REWRITE_TAC[SUBSET_INTERVAL; VECTOR_ADD_COMPONENT; VECTOR_NEG_COMPONENT;
                VEC_COMPONENT] THEN
    REAL_ARITH_TAC;
    ALL_TAC] THEN
  ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FINITE_SING] THEN
  REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; IMP_IMP] THEN
  REWRITE_TAC[INTER_IDEMPOT; UNIONS_1; FACE_OF_REFL_EQ; SUBSET_INTER] THEN
  ANTS_TAC THENL
   [ASM_SIMP_TAC[HULL_SUBSET; COMPACT_IMP_CLOSED] THEN REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC POLYTOPE_INTER_POLYHEDRON THEN
      ASM_SIMP_TAC[POLYTOPE_INTERVAL; AFFINE_IMP_POLYHEDRON];
      TRANS_TAC INT_LE_TRANS `aff_dim(t:real^M->bool)` THEN
      ASM_SIMP_TAC[AFF_DIM_SUBSET; INTER_SUBSET];
      ASM_SIMP_TAC[CONVEX_INTER; CONVEX_INTERVAL; AFFINE_IMP_CONVEX];
      ASM SET_TAC[]];
    REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
  MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `g:real^M->real^N`] THEN
  STRIP_TAC THEN EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
  SUBGOAL_THEN
   `?d:real. (&1 / &2 <= d /\ d <= &1) /\
             DISJOINT k (frontier(interval[--(b + lambda i. d):real^M,
                                             (b + lambda i. d)]))`
  STRIP_ASSUME_TAC THENL
   [MATCH_MP_TAC lemma THEN
    ASM_SIMP_TAC[INFINITE; FINITE_REAL_INTERVAL; REAL_NOT_LE] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN
    MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[] THEN
    CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
    MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN REPEAT STRIP_TAC THEN
    REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE
     `c SUBSET i' ==> DISJOINT (c DIFF i) (c' DIFF i')`) THEN
    REWRITE_TAC[INTERIOR_INTERVAL; CLOSURE_INTERVAL] THEN
    SIMP_TAC[SUBSET_INTERVAL; VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT;
             LAMBDA_BETA] THEN
    ASM_REAL_ARITH_TAC;
    ALL_TAC] THEN
  ABBREV_TAC `c:real^M = b + lambda i. d` THEN SUBGOAL_THEN
   `interval[--b:real^M,b] SUBSET interval(--c,c) /\
    interval[--b:real^M,b] SUBSET interval[--c,c] /\
    interval[--c,c] SUBSET interval[--(b + vec 1):real^M,b + vec 1]`
  STRIP_ASSUME_TAC THENL
   [REWRITE_TAC[SUBSET_INTERVAL] THEN EXPAND_TAC "c" THEN REPEAT CONJ_TAC THEN
    SIMP_TAC[VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN
    MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
    REWRITE_TAC[VEC_COMPONENT] THEN ASM_REAL_ARITH_TAC;
    ALL_TAC] THEN
  EXISTS_TAC
   `(g:real^M->real^N) o
    closest_point (interval[--c,c] INTER t)` THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_CLOSEST_POINT THEN
      ASM_SIMP_TAC[CONVEX_INTER; CLOSED_INTER; CLOSED_INTERVAL; CLOSED_AFFINE;
        AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; CONVEX_INTERVAL] THEN
      ASM SET_TAC[];
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET))];
    REWRITE_TAC[IMAGE_o] THEN
    FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        SUBSET_TRANS)) THEN
    MATCH_MP_TAC IMAGE_SUBSET;
    X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[o_THM] THEN
    TRANS_TAC EQ_TRANS `(g:real^M->real^N) x` THEN
    CONJ_TAC THENL [AP_TERM_TAC; ASM SET_TAC[]] THEN
    MATCH_MP_TAC CLOSEST_POINT_SELF THEN
    ASM_SIMP_TAC[IN_INTER; HULL_INC] THEN ASM SET_TAC[]] THEN
  (REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF] THEN
   X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN CONJ_TAC THENL
    [MATCH_MP_TAC(SET_RULE
      `closest_point s x IN s /\ s SUBSET u ==> closest_point s x IN u`) THEN
     CONJ_TAC THENL [MATCH_MP_TAC CLOSEST_POINT_IN_SET; ASM SET_TAC[]] THEN
     ASM_SIMP_TAC[CLOSED_INTER; CLOSED_INTERVAL; CLOSED_AFFINE] THEN
     ASM SET_TAC[];
     ALL_TAC] THEN
   ASM_CASES_TAC `x IN interval[--c:real^M,c]` THEN
   ASM_SIMP_TAC[CLOSEST_POINT_SELF; IN_INTER] THEN
   MATCH_MP_TAC(SET_RULE
    `closest_point s x IN relative_frontier s /\
     DISJOINT k (relative_frontier s)
     ==> ~(closest_point s x IN k)`) THEN
   CONJ_TAC THENL
    [MATCH_MP_TAC CLOSEST_POINT_IN_RELATIVE_FRONTIER THEN
     ASM_SIMP_TAC[CLOSED_INTER; CLOSED_AFFINE; CLOSED_INTERVAL] THEN
     CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_DIFF]] THEN CONJ_TAC THENL
      [ALL_TAC; ASM_MESON_TAC[SUBSET; RELATIVE_INTERIOR_SUBSET; IN_INTER]] THEN
     ONCE_REWRITE_TAC[INTER_COMM] THEN
     W(MP_TAC o PART_MATCH (lhs o rand)
       AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR o rand o snd) THEN
     ASM_SIMP_TAC[HULL_HULL; AFFINE_AFFINE_HULL; AFFINE_IMP_CONVEX] THEN
     ASM_SIMP_TAC[HULL_P] THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
     REWRITE_TAC[INTERIOR_INTERVAL] THEN ASM SET_TAC[];
     W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_FRONTIER_CONVEX_INTER_AFFINE o
       rand o snd) THEN
     ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
     REWRITE_TAC[CONVEX_INTERVAL; AFFINE_AFFINE_HULL; INTERIOR_INTERVAL] THEN
     ASM SET_TAC[]]));;

let EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_GEN = prove
 (`!f:real^M->real^N s t u p.
        compact s /\ convex u /\ bounded u /\
        affine t /\ aff_dim t <= aff_dim u /\ s SUBSET t /\
        f continuous_on s /\ IMAGE f s SUBSET relative_frontier u /\
        (!c. c IN components(t DIFF s) /\ bounded c ==> ~(c INTER p = {}))
        ==> ?k g. FINITE k /\ k SUBSET p /\ k SUBSET t /\ DISJOINT k s /\
                  g continuous_on (t DIFF k) /\
                  IMAGE g (t DIFF k) SUBSET relative_frontier u /\
                  !x. x IN s ==> g x = f x`,
  let lemma0 = prove
   (`!u t s v. closed_in (subtopology euclidean u) v /\ t SUBSET u /\
               s = v INTER t
               ==> closed_in (subtopology euclidean t) s`,
    REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED; LEFT_AND_EXISTS_THM] THEN
    MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]) in
  let lemma1 = prove
   (`!f:A->B->bool P k.
        INFINITE {x | P x} /\ FINITE k /\
        (!x y. P x /\ P y /\ ~(x = y) ==> DISJOINT (f x) (f y))
        ==> ?x. P x /\ DISJOINT k (f x)`,
    REWRITE_TAC[INFINITE] THEN REPEAT STRIP_TAC THEN
    REWRITE_TAC[SET_RULE `(?x. P x /\ DISJOINT k (f x)) <=>
                          ~(!x. ?y. P x ==> y IN k /\ y IN f x)`] THEN
    REWRITE_TAC[SKOLEM_THM] THEN
    DISCH_THEN(X_CHOOSE_TAC `g:A->B`) THEN
    MP_TAC(ISPECL [`g:A->B`; `{x:A | P x}`] FINITE_IMAGE_INJ_EQ) THEN
    ASM_REWRITE_TAC[IN_ELIM_THM; NOT_IMP] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
      (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN
    ASM SET_TAC[]) in
  let lemma2 = prove
   (`!f:real^M->real^N s t k p u.
          FINITE k /\ affine u /\
          f continuous_on ((u:real^M->bool) DIFF k) /\
          IMAGE f ((u:real^M->bool) DIFF k) SUBSET t /\
          (!c. c IN components((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})
               ==> ~(c INTER p = {})) /\
          closed_in (subtopology euclidean u) s /\ DISJOINT k s /\ k SUBSET u
          ==> ?g. g continuous_on ((u:real^M->bool) DIFF p) /\
                  IMAGE g ((u:real^M->bool) DIFF p) SUBSET t /\
                  !x. x IN s ==> g x = f x`,
    REPEAT GEN_TAC THEN ASM_CASES_TAC `k:real^M->bool = {}` THENL
     [ASM_REWRITE_TAC[DIFF_EMPTY] THEN REPEAT STRIP_TAC THEN
      EXISTS_TAC `f:real^M->real^N` THEN REWRITE_TAC[] THEN CONJ_TAC THENL
       [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_DIFF]; ASM SET_TAC[]];
      STRIP_TAC] THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
    SUBGOAL_THEN `~(((u:real^M->bool) DIFF s) INTER k = {})` MP_TAC THENL
     [ASM SET_TAC[]; ALL_TAC] THEN
    GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV o LAND_CONV)
     [UNIONS_COMPONENTS] THEN
    REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN
    REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `co:real^M->bool` THEN STRIP_TAC THEN
    SUBGOAL_THEN `locally connected (u:real^M->bool)` ASSUME_TAC THENL
     [ASM_SIMP_TAC[AFFINE_IMP_CONVEX; CONVEX_IMP_LOCALLY_CONNECTED];
      ALL_TAC] THEN
    SUBGOAL_THEN
     `!c. c IN components ((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})
          ==> ?a g. a IN c /\ a IN p /\
                    g continuous_on (s UNION (c DELETE a)) /\
                    IMAGE g (s UNION (c DELETE a)) SUBSET t /\
                    !x. x IN s ==> g x = (f:real^M->real^N) x`
    MP_TAC THENL
     [X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
      FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN
      ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^M` THEN
      STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
      SUBGOAL_THEN `open_in (subtopology euclidean u) (c:real^M->bool)`
      MP_TAC THENL
       [MATCH_MP_TAC OPEN_IN_TRANS THEN
        EXISTS_TAC `u DIFF s:real^M->bool` THEN
        ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN
        MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN
        ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
        EXISTS_TAC `u:real^M->bool` THEN
        ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL];
        DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th)] THEN
      REWRITE_TAC[OPEN_IN_CONTAINS_CBALL] THEN
      DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `a:real^M`)) THEN
      ASM_REWRITE_TAC[] THEN
      DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
      SUBGOAL_THEN `ball(a:real^M,d) INTER u SUBSET c` ASSUME_TAC THENL
       [ASM_MESON_TAC[BALL_SUBSET_CBALL; SUBSET_TRANS;
                      SET_RULE `b SUBSET c ==> b INTER u SUBSET c INTER u`];
        ALL_TAC] THEN
      MP_TAC(ISPECL
      [`ball(a:real^M,d) INTER u`; `c:real^M->bool`;
        `s UNION c:real^M->bool`; `c INTER k:real^M->bool`]
          HOMEOMORPHISM_GROUPING_POINTS_EXISTS_GEN) THEN
      ASM_REWRITE_TAC[INTER_SUBSET; SUBSET_UNION; UNION_SUBSET] THEN
      ANTS_TAC THENL
       [REPEAT CONJ_TAC THENL
         [MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN
          EXISTS_TAC `u:real^M->bool` THEN
          ASM_SIMP_TAC[HULL_MINIMAL; HULL_SUBSET];
          MP_TAC(ISPECL [`c:real^M->bool`; `u:real^M->bool`]
             AFFINE_HULL_OPEN_IN) THEN
          ASM_SIMP_TAC[HULL_P] THEN ASM SET_TAC[];
          REWRITE_TAC[HULL_SUBSET];
          ASM_MESON_TAC[IN_COMPONENTS_CONNECTED];
          ASM_MESON_TAC[FINITE_SUBSET; INTER_SUBSET];
          MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN
          EXISTS_TAC `u:real^M->bool` THEN
          ASM_REWRITE_TAC[] THEN
          ASM_MESON_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; INTER_COMM];
          REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
          EXISTS_TAC `a:real^M` THEN REWRITE_TAC[CENTRE_IN_BALL] THEN
          ASM SET_TAC[]];
        REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM]] THEN
      MAP_EVERY X_GEN_TAC [`h:real^M->real^M`; `k:real^M->real^M`] THEN
      REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN
      MP_TAC(ISPECL [`cball(a:real^M,d) INTER u`; `a:real^M`]
          RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL) THEN
      MP_TAC(ISPECL [`cball(a:real^M,d)`; `u:real^M->bool`]
          RELATIVE_INTERIOR_CONVEX_INTER_AFFINE) THEN
      MP_TAC(ISPECL [`cball(a:real^M,d)`; `u:real^M->bool`]
          RELATIVE_FRONTIER_CONVEX_INTER_AFFINE) THEN
      MP_TAC(ISPECL [`u:real^M->bool`; `cball(a:real^M,d)`]
          (ONCE_REWRITE_RULE[INTER_COMM]
             AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR)) THEN
      ASM_SIMP_TAC[CONVEX_CBALL; FRONTIER_CBALL; INTERIOR_CBALL] THEN
      SUBGOAL_THEN `a IN ball(a:real^M,d) INTER u` ASSUME_TAC THENL
       [ASM_REWRITE_TAC[CENTRE_IN_BALL; IN_INTER] THEN ASM SET_TAC[];
        ALL_TAC] THEN
      REPLICATE_TAC 3
       (ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC]) THEN
      ASM_SIMP_TAC[CONVEX_INTER; CONVEX_CBALL; AFFINE_IMP_CONVEX] THEN
      ANTS_TAC THENL
       [ASM_MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET; BOUNDED_CBALL];
        ALL_TAC] THEN
      ASM_REWRITE_TAC[retract_of; retraction] THEN
      DISCH_THEN(X_CHOOSE_THEN `r:real^M->real^M` STRIP_ASSUME_TAC) THEN
      EXISTS_TAC
       `(f:real^M->real^N) o (k:real^M->real^M) o
        (\x. if x IN ball(a,d) then r x else x)` THEN
      REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
       [ALL_TAC;
        X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[o_THM] THEN
        COND_CASES_TAC THENL
         [ASM SET_TAC[]; AP_TERM_TAC THEN ASM SET_TAC[]]] THEN
      ABBREV_TAC `j = \x:real^M. if x IN ball(a,d) then r x else x` THEN
      SUBGOAL_THEN
       `(j:real^M->real^M) continuous_on ((u:real^M->bool) DELETE a)`
      ASSUME_TAC THENL
       [EXPAND_TAC "j" THEN
        SUBGOAL_THEN
         `u DELETE (a:real^M) =
          (cball(a,d) DELETE a) INTER u UNION
          ((u:real^M->bool) DIFF ball(a,d))`
         (fun th -> SUBST1_TAC th THEN
                    MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
                    SUBST1_TAC(SYM th))
        THENL
         [MP_TAC(ISPECL [`a:real^M`; `d:real`] BALL_SUBSET_CBALL) THEN
          ASM SET_TAC[];
          ALL_TAC] THEN
        REWRITE_TAC[IN_DIFF; IN_INTER; IN_DELETE; CONTINUOUS_ON_ID] THEN
        REPEAT CONJ_TAC THENL
         [ALL_TAC; ALL_TAC;
          FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
            CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[];
          REWRITE_TAC[GSYM BALL_UNION_SPHERE] THEN ASM SET_TAC[]] THEN
        REWRITE_TAC[CLOSED_IN_CLOSED] THENL
         [EXISTS_TAC `cball(a:real^M,d)` THEN REWRITE_TAC[CLOSED_CBALL];
          EXISTS_TAC `(:real^M) DIFF ball(a,d)` THEN
          REWRITE_TAC[GSYM OPEN_CLOSED; OPEN_BALL]] THEN
        MP_TAC(ISPECL [`a:real^M`; `d:real`] BALL_SUBSET_CBALL) THEN
        MP_TAC(ISPECL [`a:real^M`; `d:real`] CENTRE_IN_BALL) THEN
        ASM SET_TAC[];
        ALL_TAC] THEN
      SUBGOAL_THEN
       `IMAGE (j:real^M->real^M) (s UNION c DELETE a) SUBSET
        (s UNION c DIFF ball(a,d))`
      ASSUME_TAC THENL
       [EXPAND_TAC "j" THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
        X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
        COND_CASES_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
        SUBGOAL_THEN `(r:real^M->real^M) x IN sphere(a,d)` MP_TAC THENL
         [MP_TAC(ISPECL [`a:real^M`; `d:real`] CENTRE_IN_BALL) THEN
          ASM SET_TAC[];
          REWRITE_TAC[GSYM CBALL_DIFF_BALL] THEN ASM SET_TAC[]];
        ALL_TAC] THEN
      CONJ_TAC THENL
       [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))
        THENL [ASM SET_TAC[]; ASM SET_TAC[]; ALL_TAC];
        ONCE_REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
         (SET_RULE `IMAGE f u SUBSET t
                    ==> s SUBSET u ==> IMAGE f s SUBSET t`))] THEN
      REWRITE_TAC[IMAGE_o] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
        `s SUBSET u ==> IMAGE f u SUBSET t ==> IMAGE f s SUBSET t`)) THEN
      REWRITE_TAC[SUBSET; IN_UNIV; IN_DIFF; FORALL_IN_IMAGE] THEN
      ASM SET_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
     [`a:(real^M->bool)->real^M`; `h:(real^M->bool)->real^M->real^N`] THEN
    DISCH_TAC THEN MP_TAC(ISPECL
     [`h:(real^M->bool)->real^M->real^N`;
      `\c:real^M->bool. s UNION (c DELETE (a c))`;
      `s UNION UNIONS
       { c DELETE (a c) |
         c IN components ((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})}`;
      `{c | c IN components ((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})}`]
     PASTING_LEMMA_EXISTS_CLOSED) THEN
    SUBGOAL_THEN
     `FINITE {c | c IN components((u:real^M->bool) DIFF s) /\
                  ~(c INTER k = {})}`
    ASSUME_TAC THENL
     [MP_TAC(ISPECL
       [`\c:real^M->bool. c INTER k`;
        `{c | c IN components ((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})}`]
       FINITE_IMAGE_INJ_EQ) THEN
      REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL
       [MESON_TAC[COMPONENTS_EQ;
                  SET_RULE
                    `s INTER k = t INTER k /\ ~(s INTER k = {})
                     ==> ~(s INTER t = {})`];
        DISCH_THEN(SUBST1_TAC o SYM) THEN
        REWRITE_TAC[GSYM SIMPLE_IMAGE; IN_ELIM_THM]] THEN
      MP_TAC(ISPEC
       `{c INTER k |c| c IN components((u:real^M->bool) DIFF s) /\
                       ~(c INTER k = {})}`
        FINITE_UNIONS) THEN
      MATCH_MP_TAC(TAUT `p ==> (p <=> q /\ r) ==> q`) THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        FINITE_SUBSET)) THEN
      REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[];
      ALL_TAC] THEN
    ASM_REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL
     [REPEAT CONJ_TAC THENL
       [REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[];
        X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN ASM_SIMP_TAC[] THEN
        MATCH_MP_TAC lemma0 THEN
        MAP_EVERY EXISTS_TAC [`u:real^M->bool`; `s UNION c:real^M->bool`] THEN
        REPEAT CONJ_TAC THENL
         [MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENT THEN
          ASM_REWRITE_TAC[];
          ASM_REWRITE_TAC[UNION_SUBSET; UNIONS_SUBSET; FORALL_IN_GSPEC] THEN
          MESON_TAC[IN_COMPONENTS_SUBSET;
                    SET_RULE `c SUBSET u DIFF s ==> c DELETE a SUBSET u`];
          ASM_SIMP_TAC[CLOSED_UNION_COMPLEMENT_COMPONENT; UNIONS_GSPEC] THEN
          MATCH_MP_TAC(SET_RULE
           `~(a IN t) /\ c DELETE a SUBSET t
            ==> s UNION c DELETE a = (s UNION c) INTER (s UNION t)`) THEN
          CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
          REWRITE_TAC[IN_ELIM_THM; IN_DELETE] THEN
          DISCH_THEN(X_CHOOSE_THEN `c':real^M->bool` STRIP_ASSUME_TAC) THEN
          MP_TAC(ISPECL [`(u:real^M->bool) DIFF s`;
                          `c:real^M->bool`; `c':real^M->bool`]
            COMPONENTS_EQ) THEN
          ASM_CASES_TAC `c':real^M->bool = c` THENL
           [ASM_MESON_TAC[]; ALL_TAC] THEN
          ASM SET_TAC[]];
        MAP_EVERY X_GEN_TAC
         [`c1:real^M->bool`; `c2:real^M->bool`; `x:real^M`] THEN
        STRIP_TAC THEN ASM_CASES_TAC `c2:real^M->bool = c1` THEN
        ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE
          `x IN u INTER (s UNION c1 DELETE a) INTER (s UNION c2 DELETE b)
           ==> (c1 INTER c2 = {}) ==> x IN s`)) THEN
        ANTS_TAC THENL [ASM_MESON_TAC[COMPONENTS_EQ]; ASM_SIMP_TAC[]]];
      DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC)] THEN
    MP_TAC
     (ISPECL [`\x. x IN s UNION
                        UNIONS {c | c IN components((u:real^M->bool) DIFF s) /\
                                    c INTER k = {}}`;
              `f:real^M->real^N`;
              `g:real^M->real^N`;
              `s UNION
               UNIONS {c | c IN components((u:real^M->bool) DIFF s) /\
                           c INTER k = {}}`;
              `s UNION
               UNIONS { c DELETE (a c) |
                        c IN components((u:real^M->bool) DIFF s) /\
                        ~(c INTER k = {})}`]
          CONTINUOUS_ON_CASES_LOCAL) THEN
    ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
     [REPEAT CONJ_TAC THENL
       [MATCH_MP_TAC lemma0 THEN EXISTS_TAC `u:real^M->bool` THEN
        EXISTS_TAC `u DIFF
                    UNIONS {c DELETE a c |
                            c IN components ((u:real^M->bool) DIFF s) /\
                            ~(c INTER k = {})}` THEN
        REPEAT CONJ_TAC THENL
          [MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN
           MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN
           X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN
           MATCH_MP_TAC OPEN_IN_DELETE THEN MATCH_MP_TAC OPEN_IN_TRANS THEN
           EXISTS_TAC `u DIFF s:real^M->bool` THEN
           ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN
           MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN
           ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
           EXISTS_TAC `u:real^M->bool` THEN
           ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL];
           ASM_REWRITE_TAC[UNION_SUBSET] THEN
           REWRITE_TAC[UNIONS_SUBSET; IN_ELIM_THM] THEN
           MESON_TAC[IN_COMPONENTS_SUBSET;
                     SET_RULE `c SUBSET u DIFF s ==> c DELETE a SUBSET u /\
                                                     c SUBSET u`];
           REWRITE_TAC[SET_RULE
            `(s UNION t) UNION (s UNION u) = (s UNION t) UNION u`] THEN
           MATCH_MP_TAC(SET_RULE
            `s SUBSET u /\ t INTER s = {}
             ==> s = (u DIFF t) INTER (s UNION t)`) THEN
           CONJ_TAC THENL
            [ASM_REWRITE_TAC[UNION_SUBSET] THEN
             REWRITE_TAC[UNIONS_SUBSET; IN_ELIM_THM] THEN
             MESON_TAC[IN_COMPONENTS_SUBSET;
                       SET_RULE `c SUBSET u DIFF s ==> c DELETE a SUBSET u /\
                                                       c SUBSET u`];
             ALL_TAC] THEN
           REWRITE_TAC[EMPTY_UNION; SET_RULE
            `c INTER (s UNION t) = (s INTER c) UNION (c INTER t)`] THEN
           CONJ_TAC THENL
            [MATCH_MP_TAC(SET_RULE
              `t SUBSET UNIV DIFF s ==> s INTER t = {}`) THEN
             REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN GEN_TAC THEN
             DISCH_THEN(CONJUNCTS_THEN2
               (MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)
               MP_TAC) THEN ASM SET_TAC[];
             REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN
             X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
             X_GEN_TAC `c':real^M->bool` THEN STRIP_TAC THEN
             MP_TAC(ISPECL [`(u:real^M->bool) DIFF s`;
                            `c:real^M->bool`; `c':real^M->bool`]
               COMPONENTS_EQ) THEN
             ASM_CASES_TAC `c':real^M->bool = c` THENL
              [ASM_MESON_TAC[]; ASM SET_TAC[]]]];
        MATCH_MP_TAC lemma0 THEN EXISTS_TAC `u:real^M->bool` THEN
        EXISTS_TAC
         `UNIONS {s UNION c |c| c IN components ((u:real^M->bool) DIFF s) /\
                                ~(c INTER k = {})}` THEN
        REPEAT CONJ_TAC THENL
         [MATCH_MP_TAC CLOSED_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN
          ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
          ASM_SIMP_TAC[FINITE_IMAGE] THEN REPEAT STRIP_TAC THEN
          MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENT THEN
          ASM_REWRITE_TAC[];
          ASM_REWRITE_TAC[UNION_SUBSET] THEN
          REWRITE_TAC[UNIONS_SUBSET; IN_ELIM_THM] THEN
          MESON_TAC[IN_COMPONENTS_SUBSET;
                    SET_RULE `c SUBSET u DIFF s ==> c DELETE a SUBSET u /\
                                                    c SUBSET u`];
          MATCH_MP_TAC(SET_RULE
           `t SUBSET u /\ u INTER s SUBSET t ==> t = u INTER (s UNION t)`) THEN
          CONJ_TAC THENL
           [REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]; ALL_TAC] THEN
          MATCH_MP_TAC(SET_RULE
           `u INTER t SUBSET s ==> u INTER (s UNION t) SUBSET s UNION v`) THEN
          MATCH_MP_TAC(SET_RULE
          `((UNIV DIFF s) INTER t) INTER u SUBSET s
           ==> t INTER u SUBSET s`) THEN
          GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o TOP_DEPTH_CONV)
           [INTER_UNIONS] THEN
          REWRITE_TAC[SET_RULE
           `{g x | x IN {f y | P y}} = {g(f y) | P y}`] THEN
          REWRITE_TAC[SET_RULE
           `(UNIV DIFF s) INTER (s UNION c) = c DIFF s`] THEN
          REWRITE_TAC[SET_RULE
           `t INTER u SUBSET s <=> t INTER ((UNIV DIFF s) INTER u) = {}`] THEN
          ONCE_REWRITE_TAC[INTER_UNIONS] THEN
          REWRITE_TAC[EMPTY_UNIONS; FORALL_IN_GSPEC; INTER_UNIONS] THEN
          X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
          X_GEN_TAC `c':real^M->bool` THEN STRIP_TAC THEN
          MP_TAC(ISPECL [`(u:real^M->bool) DIFF s`;
               `c:real^M->bool`; `c':real^M->bool`]
            COMPONENTS_EQ) THEN
          ASM_CASES_TAC `c':real^M->bool = c` THENL
           [ASM_MESON_TAC[]; ASM SET_TAC[]]];
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET)) THEN
        REWRITE_TAC[UNION_SUBSET] THEN
        CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
        REWRITE_TAC[UNIONS_SUBSET; IN_ELIM_THM] THEN
        GEN_TAC THEN
        DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)
          MP_TAC) THEN ASM SET_TAC[];
        REWRITE_TAC[TAUT `p /\ ~p <=> F`] THEN X_GEN_TAC `x:real^M` THEN
        REWRITE_TAC[IN_UNION] THEN
        ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THENL
         [ASM SET_TAC[]; ALL_TAC] THEN
        REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_DELETE] THEN
        DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `c:real^M->bool`)
          (X_CHOOSE_TAC `c':real^M->bool`)) THEN
        MP_TAC(ISPECL [`(u:real^M->bool) DIFF s`;
                        `c:real^M->bool`; `c':real^M->bool`]
            COMPONENTS_EQ) THEN
        ASM_CASES_TAC `c':real^M->bool = c` THENL
         [ASM_MESON_TAC[]; ASM SET_TAC[]]];
      MATCH_MP_TAC(MESON[CONTINUOUS_ON_SUBSET]
       `t SUBSET s /\ P f
        ==> f continuous_on s ==> ?g. g continuous_on t /\ P g`) THEN
      REWRITE_TAC[] THEN CONJ_TAC THENL
       [REWRITE_TAC[SET_RULE
         `(s UNION t) UNION (s UNION u) = s UNION (t UNION u)`] THEN
        MATCH_MP_TAC(SET_RULE
         `(u DIFF s) DIFF p SUBSET t
          ==> u DIFF p SUBSET s UNION t`) THEN
        GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [UNIONS_COMPONENTS] THEN
        REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[];
        SIMP_TAC[IN_UNION]] THEN
      REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF; IN_UNION; IN_UNIV] THEN
      X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
      ASM_CASES_TAC `(x:real^M) IN s` THENL [ASM SET_TAC[]; ALL_TAC] THEN
      ASM_REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN COND_CASES_TAC THENL
       [ASM SET_TAC[]; ALL_TAC] THEN
      SUBGOAL_THEN
        `x IN ((u:real^M->bool) DIFF s)` MP_TAC THENL
          [ASM SET_TAC[]; ALL_TAC] THEN
      GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [UNIONS_COMPONENTS] THEN
      REWRITE_TAC[IN_UNIONS] THEN
      DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN
      DISCH_THEN(MP_TAC o SPEC `c:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN
      DISCH_TAC THEN
      FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `c:real^M->bool`]) THEN
      ASM_REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]]) in
  let lemma3 = prove
   (`!f:real^M->real^N s t u p.
          compact s /\ convex u /\ bounded u /\
          affine t /\ aff_dim t <= aff_dim u /\ s SUBSET t /\
          f continuous_on s /\ IMAGE f s SUBSET relative_frontier u /\
          (!c. c IN components(t DIFF s) ==> ~(c INTER p = {}))
          ==> ?k g. FINITE k /\ k SUBSET p /\ k SUBSET t /\ DISJOINT k s /\
                    g continuous_on (t DIFF k) /\
                    IMAGE g (t DIFF k) SUBSET relative_frontier u /\
                    !x. x IN s ==> g x = f x`,
    REPEAT STRIP_TAC THEN
    MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`;
                   `t:real^M->bool`; `u:real^N->bool`]
          EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_SIMPLE) THEN
    ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `g:real^M->real^N`] THEN
    STRIP_TAC THEN
    SUBGOAL_THEN
     `!x. ?y. x IN k
              ==> ?c. c IN components (t DIFF s:real^M->bool) /\
                      x IN c /\ y IN c /\ y IN p`
    MP_TAC THENL
     [X_GEN_TAC `x:real^M` THEN REWRITE_TAC[RIGHT_EXISTS_IMP_THM] THEN
      DISCH_TAC THEN
      SUBGOAL_THEN `(x:real^M) IN (t DIFF s)` MP_TAC THENL
       [ASM SET_TAC[]; ALL_TAC] THEN
      GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [UNIONS_COMPONENTS] THEN
      ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
      REWRITE_TAC[IN_UNIONS; RIGHT_EXISTS_AND_THM] THEN
      MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[];
      REWRITE_TAC[SKOLEM_THM] THEN
      DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^M` (LABEL_TAC "*"))] THEN
    EXISTS_TAC `IMAGE (h:real^M->real^M) k` THEN
    MP_TAC(ISPECL
     [`g:real^M->real^N`; `s:real^M->bool`;
      `relative_frontier u:real^N->bool`; `k:real^M->bool`;
      `IMAGE (h:real^M->real^M) k`; `t:real^M->bool`] lemma2) THEN
    ASM_SIMP_TAC[AFFINE_AFFINE_HULL; FINITE_IMAGE] THEN ANTS_TAC THENL
     [CONJ_TAC THENL
       [X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
        FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
        ONCE_REWRITE_TAC[INTER_COMM] THEN
        REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; EXISTS_IN_IMAGE; IN_INTER] THEN
        MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^M` THEN
        STRIP_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `x:real^M`) THEN
        ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
        X_GEN_TAC `c':real^M->bool` THEN STRIP_TAC THEN
        MP_TAC(ISPECL [`(t:real^M->bool) DIFF s`;
                       `c:real^M->bool`; `c':real^M->bool`]
          COMPONENTS_EQ) THEN
        ASM_CASES_TAC `c':real^M->bool = c` THENL [ALL_TAC; ASM SET_TAC[]] THEN
        ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
        MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN
        EXISTS_TAC `(:real^M)` THEN
        ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN
        ASM_SIMP_TAC[COMPACT_IMP_CLOSED; SUBSET_UNIV]];
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^M->real^N` THEN
      STRIP_TAC THEN ASM_SIMP_TAC[] THEN
      REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s ==> ~(x IN t)`] THEN
      ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
      ASM_MESON_TAC[IN_COMPONENTS_SUBSET; SUBSET; IN_DIFF]]) in
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL
   [ASM_CASES_TAC `relative_frontier(u:real^N->bool) = {}` THENL
     [RULE_ASSUM_TAC(REWRITE_RULE[RELATIVE_FRONTIER_EQ_EMPTY]) THEN
      UNDISCH_TAC `bounded(u:real^N->bool)` THEN
      ASM_SIMP_TAC[AFFINE_BOUNDED_EQ_LOWDIM] THEN DISCH_TAC THEN
      SUBGOAL_THEN `aff_dim(t:real^M->bool) <= &0` MP_TAC THENL
       [ASM_INT_ARITH_TAC; ALL_TAC] THEN
      SIMP_TAC[AFF_DIM_GE; INT_ARITH
       `--(&1):int <= x ==> (x <= &0 <=> x = --(&1) \/ x = &0)`] THEN
      REWRITE_TAC[AFF_DIM_EQ_MINUS1; AFF_DIM_EQ_0] THEN
      DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC (X_CHOOSE_TAC `a:real^M`)) THENL
       [EXISTS_TAC `{}:real^M->bool` THEN
        ASM_REWRITE_TAC[EMPTY_DIFF; FINITE_EMPTY; CONTINUOUS_ON_EMPTY;
                        IMAGE_CLAUSES; NOT_IN_EMPTY] THEN
        SET_TAC[];
        FIRST_X_ASSUM(MP_TAC o SPEC `{a:real^M}`) THEN
        ASM_REWRITE_TAC[DIFF_EMPTY; IN_COMPONENTS_SELF] THEN
        REWRITE_TAC[CONNECTED_SING; NOT_INSERT_EMPTY; BOUNDED_SING] THEN
        DISCH_TAC THEN EXISTS_TAC `{a:real^M}` THEN
        ASM_REWRITE_TAC[DIFF_EQ_EMPTY; CONTINUOUS_ON_EMPTY; NOT_IN_EMPTY;
                        FINITE_SING; IMAGE_CLAUSES; EMPTY_SUBSET] THEN
        ASM SET_TAC[]];
      EXISTS_TAC `{}:real^M->bool` THEN
      FIRST_X_ASSUM(X_CHOOSE_TAC `y:real^N` o
        GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
      ASM_SIMP_TAC[FINITE_EMPTY; DISJOINT_EMPTY; NOT_IN_EMPTY; DIFF_EMPTY] THEN
      EXISTS_TAC `(\x. y):real^M->real^N` THEN
      REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]];
    ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN
  DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC) THEN
  REWRITE_TAC[INSERT_SUBSET] THEN
  DISCH_THEN(X_CHOOSE_THEN `b:real^M` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL
   [`f:real^M->real^N`; `s:real^M->bool`;
    `t:real^M->bool`; `u:real^N->bool`;
    `p UNION (UNIONS {c | c IN components (t DIFF s) /\ ~bounded c} DIFF
              interval[--(b + vec 1):real^M,b + vec 1])`]
        lemma3) THEN
  ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
   [X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
    ASM_CASES_TAC `bounded(c:real^M->bool)` THENL
     [FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN
      ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
      ALL_TAC] THEN
    SUBGOAL_THEN
     `~(c SUBSET interval[--(b + vec 1):real^M,b + vec 1])`
    MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_INTERVAL];
    ALL_TAC] THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `g:real^M->real^N`] THEN
  STRIP_TAC THEN
  EXISTS_TAC `k INTER interval[--(b + vec 1):real^M,b + vec 1]` THEN
  ASM_SIMP_TAC[FINITE_INTER; RIGHT_EXISTS_AND_THM] THEN
  REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
  SUBGOAL_THEN
   `interval[--b,b] SUBSET interval[--(b + vec 1):real^M,b + vec 1]`
  ASSUME_TAC THENL
   [REWRITE_TAC[SUBSET_INTERVAL; VECTOR_ADD_COMPONENT; VECTOR_NEG_COMPONENT;
                VEC_COMPONENT] THEN
    REAL_ARITH_TAC;
    ALL_TAC] THEN
  SUBGOAL_THEN
   `?d:real. (&1 / &2 <= d /\ d <= &1) /\
             DISJOINT k (frontier(interval[--(b + lambda i. d):real^M,
                                             (b + lambda i. d)]))`
  STRIP_ASSUME_TAC THENL
   [MATCH_MP_TAC lemma1 THEN
    ASM_SIMP_TAC[INFINITE; FINITE_REAL_INTERVAL; REAL_NOT_LE] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN
    MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[] THEN
    CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
    MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN REPEAT STRIP_TAC THEN
    REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE
     `c SUBSET i' ==> DISJOINT (c DIFF i) (c' DIFF i')`) THEN
    REWRITE_TAC[INTERIOR_INTERVAL; CLOSURE_INTERVAL] THEN
    SIMP_TAC[SUBSET_INTERVAL; VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT;
             LAMBDA_BETA] THEN
    ASM_REAL_ARITH_TAC;
    ALL_TAC] THEN
  ABBREV_TAC `c:real^M = b + lambda i. d` THEN SUBGOAL_THEN
   `interval[--b:real^M,b] SUBSET interval(--c,c) /\
    interval[--b:real^M,b] SUBSET interval[--c,c] /\
    interval[--c,c] SUBSET interval[--(b + vec 1):real^M,b + vec 1]`
  STRIP_ASSUME_TAC THENL
   [REWRITE_TAC[SUBSET_INTERVAL] THEN EXPAND_TAC "c" THEN REPEAT CONJ_TAC THEN
    SIMP_TAC[VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN
    MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
    REWRITE_TAC[VEC_COMPONENT] THEN ASM_REAL_ARITH_TAC;
    ALL_TAC] THEN
  EXISTS_TAC
   `(g:real^M->real^N) o
    closest_point (interval[--c,c] INTER t)` THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_CLOSEST_POINT THEN
      ASM_SIMP_TAC[CONVEX_INTER; CLOSED_INTER; CLOSED_INTERVAL; CLOSED_AFFINE;
        AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; CONVEX_INTERVAL] THEN
      ASM SET_TAC[];
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
          CONTINUOUS_ON_SUBSET))];
    REWRITE_TAC[IMAGE_o] THEN
    FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        SUBSET_TRANS)) THEN
    MATCH_MP_TAC IMAGE_SUBSET;
    X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[o_THM] THEN
    TRANS_TAC EQ_TRANS `(g:real^M->real^N) x` THEN
    CONJ_TAC THENL [AP_TERM_TAC; ASM SET_TAC[]] THEN
    MATCH_MP_TAC CLOSEST_POINT_SELF THEN
    ASM_SIMP_TAC[IN_INTER; HULL_INC] THEN ASM SET_TAC[]] THEN
  (REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF] THEN
   X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN CONJ_TAC THENL
    [MATCH_MP_TAC(SET_RULE
      `closest_point s x IN s /\ s SUBSET u ==> closest_point s x IN u`) THEN
     CONJ_TAC THENL [MATCH_MP_TAC CLOSEST_POINT_IN_SET; ASM SET_TAC[]] THEN
     ASM_SIMP_TAC[CLOSED_INTER; CLOSED_INTERVAL; CLOSED_AFFINE] THEN
     ASM SET_TAC[];
     ALL_TAC] THEN
   ASM_CASES_TAC `x IN interval[--c:real^M,c]` THEN
   ASM_SIMP_TAC[CLOSEST_POINT_SELF; IN_INTER] THENL
    [ASM SET_TAC[]; ALL_TAC] THEN
   MATCH_MP_TAC(SET_RULE
    `closest_point s x IN relative_frontier s /\
     DISJOINT k (relative_frontier s)
     ==> ~(closest_point s x IN k)`) THEN
   CONJ_TAC THENL
    [MATCH_MP_TAC CLOSEST_POINT_IN_RELATIVE_FRONTIER THEN
     ASM_SIMP_TAC[CLOSED_INTER; CLOSED_AFFINE; CLOSED_INTERVAL] THEN
     CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_DIFF]] THEN CONJ_TAC THENL
      [ALL_TAC; ASM_MESON_TAC[SUBSET; RELATIVE_INTERIOR_SUBSET; IN_INTER]] THEN
     ONCE_REWRITE_TAC[INTER_COMM] THEN
     W(MP_TAC o PART_MATCH (lhs o rand)
       AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR o rand o snd) THEN
     ASM_SIMP_TAC[HULL_HULL; AFFINE_AFFINE_HULL; AFFINE_IMP_CONVEX] THEN
     ASM_SIMP_TAC[HULL_P] THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
     REWRITE_TAC[INTERIOR_INTERVAL] THEN ASM SET_TAC[];
     W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_FRONTIER_CONVEX_INTER_AFFINE o
       rand o snd) THEN
     ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
     REWRITE_TAC[CONVEX_INTERVAL; AFFINE_AFFINE_HULL; INTERIOR_INTERVAL] THEN
     ASM SET_TAC[]]));;

let EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE = prove
 (`!f:real^M->real^N s t a r p.
        compact s /\ affine t /\ aff_dim t <= &(dimindex(:N)) /\ s SUBSET t /\
        &0 <= r /\ f continuous_on s /\ IMAGE f s SUBSET sphere(a,r) /\
        (!c. c IN components(t DIFF s) /\ bounded c ==> ~(c INTER p = {}))
        ==> ?k g. FINITE k /\ k SUBSET p /\ k SUBSET t /\ DISJOINT k s /\
                  g continuous_on (t DIFF k) /\
                  IMAGE g (t DIFF k) SUBSET sphere(a,r) /\
                  !x. x IN s ==> g x = f x`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `r = &0` THENL
   [ASM_SIMP_TAC[SPHERE_SING] THEN STRIP_TAC THEN
    EXISTS_TAC `{}:real^M->bool` THEN
    EXISTS_TAC `(\x. a):real^M->real^N` THEN
    REWRITE_TAC[CONTINUOUS_ON_CONST; FINITE_EMPTY] THEN ASM SET_TAC[];
    MP_TAC(ISPECL [`a:real^N`; `r:real`] RELATIVE_FRONTIER_CBALL) THEN
    ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
    STRIP_TAC THEN MATCH_MP_TAC EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_GEN THEN
    ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; AFF_DIM_CBALL] THEN
    COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]);;

let EXTEND_MAP_UNIV_TO_SPHERE_COFINITE = prove
 (`!f:real^M->real^N s a r p.
     dimindex(:M) <= dimindex(:N) /\ &0 <= r /\
     compact s /\ f continuous_on s /\ IMAGE f s SUBSET sphere(a,r) /\
     (!c. c IN components((:real^M) DIFF s) /\ bounded c
          ==> ~(c INTER p = {}))
     ==> ?k g. FINITE k /\ k SUBSET p /\ DISJOINT k s /\
               g continuous_on ((:real^M) DIFF k) /\
               IMAGE g ((:real^M) DIFF k) SUBSET sphere(a,r) /\
               !x. x IN s ==> g x = f x`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `(:real^M)`;
                 `a:real^N`; `r:real`; `p:real^M->bool`]
        EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE) THEN
  ASM_REWRITE_TAC[AFFINE_UNIV; SUBSET_UNIV; AFF_DIM_UNIV; INT_OF_NUM_LE]);;

let EXTEND_MAP_UNIV_TO_SPHERE_NO_BOUNDED_COMPONENT = prove
 (`!f:real^M->real^N s a r.
     dimindex(:M) <= dimindex(:N) /\ &0 <= r /\
     compact s /\ f continuous_on s /\ IMAGE f s SUBSET sphere(a,r) /\
     (!c. c IN components((:real^M) DIFF s) ==> ~bounded c)
     ==> ?g. g continuous_on (:real^M) /\
             IMAGE g (:real^M) SUBSET sphere(a,r) /\
             !x. x IN s ==> g x = f x`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`;  `a:real^N`; `r:real`;
                 `{}:real^M->bool`] EXTEND_MAP_UNIV_TO_SPHERE_COFINITE) THEN
  ASM_SIMP_TAC[IMP_CONJ; SUBSET_EMPTY; RIGHT_EXISTS_AND_THM] THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
  REWRITE_TAC[UNWIND_THM2; FINITE_EMPTY; DISJOINT_EMPTY; DIFF_EMPTY] THEN
  MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]);;

let EXTEND_MAP_SPHERE_TO_SPHERE_GEN = prove
 (`!f:real^M->real^N c s t.
        closed c /\ c SUBSET relative_frontier s /\ convex s /\ bounded s /\
        convex t /\ bounded t /\ aff_dim s <= aff_dim t /\
        f continuous_on c /\ IMAGE f c SUBSET relative_frontier t
         ==> ?g. g continuous_on (relative_frontier s) /\
                 IMAGE g (relative_frontier s) SUBSET relative_frontier t /\
                 !x. x IN c ==> g x = f x`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `?p:real^M->bool. polytope p /\ aff_dim p = aff_dim(s:real^M->bool)`
  STRIP_ASSUME_TAC THENL
   [MATCH_MP_TAC CHOOSE_POLYTOPE THEN
    ASM_REWRITE_TAC[AFF_DIM_GE; AFF_DIM_LE_UNIV];
    ALL_TAC] THEN
  MP_TAC(ISPECL [`s:real^M->bool`; `p:real^M->bool`]
        HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS) THEN
  ASM_SIMP_TAC[POLYTOPE_IMP_CONVEX; POLYTOPE_IMP_BOUNDED; homeomorphic] THEN
  REWRITE_TAC[HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`h: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)`;
    `{f:real^M->bool | f face_of p /\ ~(f = p)}`;
    `IMAGE (h:real^M->real^M) c`;
    `t:real^N->bool`] EXTEND_MAP_CELL_COMPLEX_TO_SPHERE) THEN
  ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN
  ASM_SIMP_TAC[GSYM RELATIVE_FRONTIER_OF_POLYHEDRON_ALT;
               POLYTOPE_IMP_POLYHEDRON] THEN
  REWRITE_TAC[IN_ELIM_THM; GSYM IMAGE_o; o_THM] THEN ANTS_TAC THENL
   [REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC FINITE_SUBSET THEN
      EXISTS_TAC `{f:real^M->bool | f face_of p}` THEN
      ASM_SIMP_TAC[FINITE_POLYTOPE_FACES] THEN SET_TAC[];
      ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE;
                    FACE_OF_AFF_DIM_LT; POLYTOPE_IMP_CONVEX; INT_LTE_TRANS];
      ASM_MESON_TAC[FACE_OF_INTER; FACE_OF_SUBSET;
                    INTER_SUBSET; FACE_OF_INTER; FACE_OF_IMP_SUBSET];
      ASM SET_TAC[];
      MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
      MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
      CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN
      ASM_REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN
      FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        BOUNDED_SUBSET)) THEN
      ASM_SIMP_TAC[BOUNDED_RELATIVE_FRONTIER];
      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[]];
    DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `(g:real^M->real^N) o (h:real^M->real^M)` THEN
    REWRITE_TAC[IMAGE_o; o_THM] THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_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[]]);;

let EXTEND_MAP_SPHERE_TO_SPHERE = prove
 (`!f:real^M->real^N c a r b s.
        dimindex(:M) <= dimindex(:N) /\ closed c /\ c SUBSET sphere(a,r) /\
        f continuous_on c /\ IMAGE f c SUBSET sphere(b,s) /\
        (&0 <= r /\ c = {} ==> &0 <= s)
        ==> ?g. g continuous_on sphere(a,r) /\
                IMAGE g (sphere(a,r)) SUBSET sphere(b,s) /\
                !x. x IN c ==> g x = f x`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THEN
  ASM_SIMP_TAC[SPHERE_EMPTY; NOT_IN_EMPTY; CONTINUOUS_ON_EMPTY;
               IMAGE_CLAUSES; EMPTY_SUBSET]
  THENL [MESON_TAC[]; ASM_REWRITE_TAC[GSYM REAL_NOT_LT]] THEN
  ASM_CASES_TAC `sphere(b:real^N,s) = {}` THENL
   [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SPHERE_EQ_EMPTY]) THEN
    ASM SET_TAC[];
    FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SPHERE_EQ_EMPTY])] THEN
  REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN
  ASM_CASES_TAC `r = &0` THEN
  ASM_SIMP_TAC[SPHERE_SING; CONTINUOUS_ON_SING; REAL_LE_REFL] THENL
   [ASM_CASES_TAC `c:real^M->bool = {}` THENL
     [DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC(MESON[]
       `(?c. P(\x. c)) ==> ?f. P f`) THEN ASM SET_TAC[];
      DISCH_TAC THEN EXISTS_TAC `f:real^M->real^N` THEN ASM SET_TAC[]];
    ALL_TAC] THEN
  ASM_CASES_TAC `s = &0` THENL
   [ASM_SIMP_TAC[SPHERE_SING] THEN STRIP_TAC THEN
    EXISTS_TAC `(\x. b):real^M->real^N` THEN
    REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  STRIP_TAC THEN
  MP_TAC(ISPECL [`f:real^M->real^N`; `c:real^M->bool`;
                 `cball(a:real^M,r)`; `cball(b:real^N,s)`]
        EXTEND_MAP_SPHERE_TO_SPHERE_GEN) THEN
  ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; AFF_DIM_CBALL;
                  RELATIVE_FRONTIER_CBALL] THEN
  DISCH_THEN MATCH_MP_TAC THEN
  REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[INT_OF_NUM_LE]) THEN
  ASM_REAL_ARITH_TAC);;

let EXTEND_MAP_SPHERE_TO_SPHERE_COFINITE_GEN = prove
 (`!f:real^M->real^N s t u p.
        convex t /\ bounded t /\ convex u /\ bounded u /\
        aff_dim t <= aff_dim u + &1 /\
        closed s /\ s SUBSET relative_frontier t /\
        f continuous_on s /\ IMAGE f s SUBSET relative_frontier u /\
        (!c. c IN components(relative_frontier t DIFF s) ==> ~(c INTER p = {}))
        ==> ?k g. FINITE k /\ k SUBSET p /\
                  k SUBSET relative_frontier t /\ DISJOINT k s /\
                  g continuous_on (relative_frontier t DIFF k) /\
                  IMAGE g (relative_frontier t DIFF k) SUBSET
                  relative_frontier u /\
                  !x. x IN s ==> g x = f x`,
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `s = (relative_frontier t:real^M->bool)` THENL
   [ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
    MAP_EVERY EXISTS_TAC [`{}:real^M->bool`; `f:real^M->real^N`] THEN
    ASM_REWRITE_TAC[FINITE_EMPTY; DIFF_EMPTY] THEN SET_TAC[];
    POP_ASSUM MP_TAC] THEN
  ASM_CASES_TAC `relative_frontier t:real^M->bool = {}` THENL
   [ASM SET_TAC[]; REPEAT STRIP_TAC] THEN
  SUBGOAL_THEN
   `?c q:real^M. c IN components (relative_frontier t DIFF s) /\
                 q IN c /\ q IN relative_frontier t /\ ~(q IN s) /\ q IN p`
  STRIP_ASSUME_TAC THENL
   [MP_TAC(ISPEC `(relative_frontier t:real^M->bool) DIFF s`
      UNIONS_COMPONENTS) THEN
    DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
     `s = u ==> ~(s = {}) ==> ~(u = {})`)) THEN
    ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[EMPTY_UNIONS]] THEN
    REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN
    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^M->bool` THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN
    ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
    MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN
    ASM_REWRITE_TAC[GSYM IN_DIFF] THEN
    ASM_MESON_TAC[SUBSET; IN_COMPONENTS_SUBSET];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `?af. affine af /\ aff_dim(t:real^M->bool) = aff_dim(af:real^M->bool) + &1`
  STRIP_ASSUME_TAC THENL
   [MP_TAC(ISPECL [`(:real^M)`; `aff_dim(t: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];
      MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN INT_ARITH_TAC];
    ALL_TAC] THEN
  MP_TAC(ISPECL [`t:real^M->bool`; `af:real^M->bool`; `q:real^M`]
        HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN) THEN
  ASM_REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`h: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)`;
    `IMAGE (h:real^M->real^M) s`;
    `(af:real^M->bool)`;
    `u:real^N->bool`;
    `IMAGE (h:real^M->real^M) (p INTER relative_frontier t DELETE q)`]
   EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_GEN) THEN
  ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
   [REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE 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_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET;
                      COMPACT_RELATIVE_FRONTIER_BOUNDED]];
      ASM_INT_ARITH_TAC;
      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)) THEN
      ASM SET_TAC[];
      REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
      X_GEN_TAC `l:real^M->bool` THEN STRIP_TAC THEN
      SUBGOAL_THEN `~(l:real^M->bool = {})` ASSUME_TAC THENL
       [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]; ALL_TAC] THEN
      SUBGOAL_THEN `?x:real^M. x IN l` STRIP_ASSUME_TAC THENL
       [ASM SET_TAC[]; ALL_TAC] THEN
      SUBGOAL_THEN `l SUBSET af DIFF IMAGE (h:real^M->real^M) s`
      ASSUME_TAC THENL
       [ASM_MESON_TAC[IN_COMPONENTS_SUBSET]; ALL_TAC] THEN
      SUBGOAL_THEN `connected(l:real^M->bool)` ASSUME_TAC THENL
       [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN
      SUBGOAL_THEN
       `?r. r IN components (relative_frontier t DIFF s) /\
            IMAGE (k:real^M->real^M) l SUBSET r`
      STRIP_ASSUME_TAC THENL
       [REWRITE_TAC[IN_COMPONENTS; LEFT_AND_EXISTS_THM] THEN
        EXISTS_TAC `connected_component (relative_frontier t DIFF s)
                                        ((k:real^M->real^M) x)` THEN
        EXISTS_TAC `(k:real^M->real^M) x` THEN REWRITE_TAC[] THEN
        CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
        MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
        ASM_SIMP_TAC[FUN_IN_IMAGE] THEN
        CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
        MATCH_MP_TAC CONNECTED_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[];
        ALL_TAC] THEN
      FIRST_X_ASSUM(MP_TAC o SPEC `r:real^M->bool`) THEN
      ASM_REWRITE_TAC[] THEN
      GEN_REWRITE_TAC LAND_CONV [GSYM MEMBER_NOT_EMPTY] THEN
      REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_INTER] THEN
      X_GEN_TAC `z:real^M` THEN STRIP_TAC THEN
      SUBGOAL_THEN `r SUBSET ((relative_frontier t:real^M->bool) DIFF s)`
      ASSUME_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_SUBSET]; ALL_TAC] THEN
      SUBGOAL_THEN `connected(r:real^M->bool)` ASSUME_TAC THENL
       [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN
      ASM_CASES_TAC `(q:real^M) IN r` THENL
       [ALL_TAC;
        REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
        EXISTS_TAC `(h:real^M->real^M) z` THEN REWRITE_TAC[IN_INTER] THEN
        CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
        MATCH_MP_TAC(SET_RULE `!s. x IN s /\ s SUBSET t ==> x IN t`) THEN
        EXISTS_TAC `IMAGE (h:real^M->real^M) r` THEN
        ASM_SIMP_TAC[FUN_IN_IMAGE] THEN MATCH_MP_TAC COMPONENTS_MAXIMAL THEN
        EXISTS_TAC `af DIFF IMAGE (h:real^M->real^M) s` THEN
        ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
         [MATCH_MP_TAC CONNECTED_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[];
          REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF; IN_ELIM_THM] THEN
          X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN
          CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
          REWRITE_TAC[SET_RULE
           `~(h y IN IMAGE h s) <=> !y'. y' IN s ==> ~(h y = h y')`] THEN
          X_GEN_TAC `y':real^M` THEN DISCH_TAC THEN
          DISCH_THEN(MP_TAC o AP_TERM `k:real^M->real^M`) THEN
          MATCH_MP_TAC(MESON[]
           `k(h y) = y /\ k(h y') = y' /\ ~(y = y')
            ==> k(h y) = k(h y') ==> F`) THEN
          ASM SET_TAC[];
          ASM SET_TAC[]]] THEN
      SUBGOAL_THEN
       `?n. open_in (subtopology euclidean (relative_frontier t)) n /\
            (q:real^M) IN n /\ n INTER IMAGE (k:real^M->real^M) l = {}`
      STRIP_ASSUME_TAC THENL
       [EXISTS_TAC `relative_frontier t DIFF
                    IMAGE (k:real^M->real^M) (closure l)` THEN
        SUBGOAL_THEN `closure l SUBSET (af:real^M->bool)` ASSUME_TAC THENL
         [MATCH_MP_TAC CLOSURE_MINIMAL THEN
          ASM_SIMP_TAC[CLOSED_AFFINE] THEN ASM SET_TAC[];
          ALL_TAC] THEN
        REPEAT CONJ_TAC THENL
         [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[COMPACT_CLOSURE] THEN
          FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
            CONTINUOUS_ON_SUBSET)) THEN
          ASM SET_TAC[];
          ASM SET_TAC[];
          MP_TAC(ISPEC `l:real^M->bool` CLOSURE_SUBSET) THEN SET_TAC[]];
        ALL_TAC] THEN
      FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
      SUBGOAL_THEN
       `?w. connected w /\ w SUBSET r DELETE q /\
            (k:real^M->real^M) x IN w /\ ~((n DELETE q) INTER w = {})`
      STRIP_ASSUME_TAC THENL
       [ALL_TAC;
        MATCH_MP_TAC(TAUT `F ==> p`) THEN
        SUBGOAL_THEN `IMAGE (h:real^M->real^M) w SUBSET l` MP_TAC THENL
         [ALL_TAC; ASM SET_TAC[]] THEN
        MATCH_MP_TAC COMPONENTS_MAXIMAL THEN
        EXISTS_TAC `af DIFF IMAGE (h:real^M->real^M) s` THEN
        ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
         [MATCH_MP_TAC CONNECTED_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[];
          REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF; IN_ELIM_THM] THEN
          X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN
          CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
          REWRITE_TAC[SET_RULE
           `~(h y IN IMAGE h s) <=> !y'. y' IN s ==> ~(h y = h y')`] THEN
          X_GEN_TAC `y':real^M` THEN DISCH_TAC THEN
          DISCH_THEN(MP_TAC o AP_TERM `k:real^M->real^M`) THEN
          MATCH_MP_TAC(MESON[]
           `k(h y) = y /\ k(h y') = y' /\ ~(y = y')
            ==> k(h y) = k(h y') ==> F`) THEN
          ASM SET_TAC[];
          ASM SET_TAC[]]] THEN
      SUBGOAL_THEN `path_connected(r:real^M->bool)` MP_TAC THENL
       [W(MP_TAC o PART_MATCH (lhand o rand) PATH_CONNECTED_EQ_CONNECTED_LPC o
          snd) THEN
        ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
        MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
        EXISTS_TAC `(relative_frontier t:real^M->bool)` THEN
        ASM_SIMP_TAC[LOCALLY_PATH_CONNECTED_SPHERE_GEN] THEN
        MATCH_MP_TAC OPEN_IN_TRANS THEN
        EXISTS_TAC `(relative_frontier t:real^M->bool) DIFF s` 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 `(relative_frontier t:real^M->bool)` THEN
          ASM_SIMP_TAC[LOCALLY_CONNECTED_SPHERE_GEN];
          ALL_TAC] THEN
        MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
        MATCH_MP_TAC CLOSED_SUBSET THEN ASM_REWRITE_TAC[];
        ALL_TAC] THEN
      REWRITE_TAC[PATH_CONNECTED_ARCWISE] THEN
      DISCH_THEN(MP_TAC o SPECL [`(k:real^M->real^M) x`; `q:real^M`]) THEN
      ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
      DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC) THEN
      FIRST_X_ASSUM(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC o
        GEN_REWRITE_RULE I [arc]) THEN
      DISCH_TAC THEN
      SUBGOAL_THEN
       `open_in (subtopology euclidean (interval[vec 0,vec 1]))
                {x | x IN interval[vec 0,vec 1] /\
                     (g:real^1->real^M) x IN n}`
      MP_TAC THENL
       [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
        EXISTS_TAC `(relative_frontier t:real^M->bool)` THEN
        ASM_REWRITE_TAC[GSYM path; GSYM path_image] THEN
        ASM SET_TAC[];
        ALL_TAC] THEN
      REWRITE_TAC[OPEN_IN_CONTAINS_CBALL] THEN
      REWRITE_TAC[IN_ELIM_THM; SUBSET_RESTRICT] THEN
      DISCH_THEN(MP_TAC o SPEC `vec 1:real^1`) THEN
      REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
      ANTS_TAC THENL [ASM_MESON_TAC[pathfinish]; ALL_TAC] THEN
      DISCH_THEN(X_CHOOSE_THEN `r:real`
        (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
      ABBREV_TAC `t' = lift(&1 - min (&1 / &2) r)` THEN
      SUBGOAL_THEN `t' IN interval[vec 0:real^1,vec 1]` ASSUME_TAC THENL
       [EXPAND_TAC "t'" THEN SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
        ASM_REAL_ARITH_TAC;
        ALL_TAC] THEN
      GEN_REWRITE_TAC LAND_CONV [SUBSET] THEN
      DISCH_THEN(MP_TAC o SPEC `t':real^1`) THEN
      ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM; IN_CBALL; DIST_REAL;
                      DROP_VEC; GSYM drop] THEN
      ANTS_TAC THENL
       [EXPAND_TAC "t'" THEN REWRITE_TAC[LIFT_DROP] THEN ASM_REAL_ARITH_TAC;
        DISCH_TAC] THEN
      EXISTS_TAC `IMAGE (g:real^1->real^M) (interval[vec 0,t'])` THEN
      REPEAT 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_REWRITE_TAC[GSYM path; SUBSET_INTERVAL_1] THEN
        ASM_REWRITE_TAC[REAL_LE_REFL; GSYM IN_INTERVAL_1];
        REWRITE_TAC[SET_RULE
         `s SUBSET t DELETE q <=> s SUBSET t /\ !x. x IN s ==> ~(x = q)`] THEN
        CONJ_TAC THENL
         [TRANS_TAC SUBSET_TRANS
            `IMAGE (g:real^1->real^M) (interval[vec 0,vec 1])` THEN
          CONJ_TAC THENL
           [MATCH_MP_TAC IMAGE_SUBSET THEN
            ASM_REWRITE_TAC[REAL_LE_REFL; GSYM IN_INTERVAL_1;
                            SUBSET_INTERVAL_1];
            ASM_REWRITE_TAC[GSYM path_image]];
          REWRITE_TAC[FORALL_IN_IMAGE] THEN
          X_GEN_TAC `t'':real^1` THEN DISCH_TAC THEN
          FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV)
           [SYM th]) THEN
          REWRITE_TAC[pathfinish] THEN DISCH_TAC THEN
          FIRST_X_ASSUM(MP_TAC o SPECL [`t'':real^1`; `vec 1:real^1`]) THEN
          ASM_REWRITE_TAC[GSYM DROP_EQ] THEN
          UNDISCH_TAC `t'' IN interval[vec 0:real^1,t']` THEN
          EXPAND_TAC "t'" THEN
          REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
          ASM_REAL_ARITH_TAC];
        REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 0:real^1` THEN
        CONJ_TAC THENL [ASM_MESON_TAC[pathstart]; ALL_TAC] THEN
        EXPAND_TAC "t'" THEN
        REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
        ASM_REAL_ARITH_TAC;
        REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
        ONCE_REWRITE_TAC[INTER_COMM] THEN
        REWRITE_TAC[EXISTS_IN_IMAGE; IN_INTER] THEN
        EXISTS_TAC `t':real^1` THEN CONJ_TAC THENL
         [EXPAND_TAC "t'" THEN
          REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
          ASM_REAL_ARITH_TAC;
          ASM_REWRITE_TAC[IN_DELETE] THEN
          FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV)
           [SYM th]) THEN
          REWRITE_TAC[pathfinish] THEN DISCH_TAC THEN
          FIRST_X_ASSUM(MP_TAC o SPECL [`t':real^1`; `vec 1:real^1`]) THEN
          ASM_REWRITE_TAC[GSYM DROP_EQ] THEN
          EXPAND_TAC "t'" THEN
          REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
          ASM_REAL_ARITH_TAC]]];
    ALL_TAC] THEN
  ASM_SIMP_TAC[DOT_BASIS; LE_REFL; DIMINDEX_GE_1; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`tk:real^M->bool`; `g:real^M->real^N`] THEN
  REWRITE_TAC[o_THM] THEN
  STRIP_TAC THEN EXISTS_TAC `q INSERT IMAGE (k:real^M->real^M) tk` THEN
  EXISTS_TAC `(g:real^M->real^N) o (h:real^M->real^M)` THEN
  ASM_SIMP_TAC[FINITE_INSERT; FINITE_IMAGE; o_THM] THEN REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC(SET_RULE
     `a IN t /\ s SUBSET t DELETE a ==> a INSERT s SUBSET t`) THEN
    ASM_REWRITE_TAC[] THEN
    TRANS_TAC SUBSET_TRANS
      `p INTER (relative_frontier t:real^M->bool) DELETE q` THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
     (SET_RULE `t SUBSET IMAGE h s ==> IMAGE k (IMAGE h s) SUBSET s
            ==> IMAGE k t SUBSET s`)) THEN
    REWRITE_TAC[GSYM IMAGE_o] THEN
    MATCH_MP_TAC(SET_RULE
     `(!x. x IN s ==> f x = x) ==> IMAGE f s SUBSET s`) THEN
    REWRITE_TAC[o_THM] THEN ASM SET_TAC[];
    ASM SET_TAC[];
    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)) THEN
    ASM SET_TAC[];
    REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
    ASM SET_TAC[]]);;

let EXTEND_MAP_SPHERE_TO_SPHERE_COFINITE = prove
 (`!f:real^M->real^N s a d b e p.
        dimindex(:M) <= dimindex(:N) + 1 /\
        (&0 < d /\ s = {} ==> &0 <= e) /\
        closed s /\ s SUBSET sphere(a,d) /\
        f continuous_on s /\ IMAGE f s SUBSET sphere(b,e) /\
        (!c. c IN components(sphere(a,d) DIFF s) ==> ~(c INTER p = {}))
        ==> ?k g. FINITE k /\ k SUBSET p /\
                  k SUBSET sphere(a,d) /\ DISJOINT k s /\
                  g continuous_on (sphere(a,d) DIFF k) /\
                  IMAGE g (sphere(a,d) DIFF k) SUBSET sphere(b,e) /\
                  !x. x IN s ==> g x = f x`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `s = sphere(a:real^M,d)` THENL
   [ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
    MAP_EVERY EXISTS_TAC [`{}:real^M->bool`; `f:real^M->real^N`] THEN
    ASM_REWRITE_TAC[FINITE_EMPTY; DIFF_EMPTY] THEN SET_TAC[];
    POP_ASSUM MP_TAC] THEN
  ASM_CASES_TAC `d < &0` THENL
   [ASM_SIMP_TAC[SPHERE_EMPTY] THEN SET_TAC[]; ALL_TAC] THEN
  ASM_CASES_TAC `d = &0` THENL
   [ASM_SIMP_TAC[SPHERE_SING] THEN
    ASM_CASES_TAC `s:real^M->bool = {}` THENL
     [ASM_REWRITE_TAC[]; ASM SET_TAC[]] THEN
    REPEAT STRIP_TAC THEN
    EXISTS_TAC `{a:real^M}` THEN
    REWRITE_TAC[FINITE_SING; CONTINUOUS_ON_EMPTY; DIFF_EQ_EMPTY] THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `{a:real^M}`) THEN
    REWRITE_TAC[DIFF_EMPTY; IN_COMPONENTS_SELF; CONNECTED_SING] THEN
    REWRITE_TAC[IMAGE_CLAUSES] THEN SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN `&0 < d` ASSUME_TAC THENL
   [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
  ASM_CASES_TAC `e = &0` THENL
   [ASM_SIMP_TAC[SPHERE_SING] THEN REPEAT STRIP_TAC THEN
    EXISTS_TAC `{}:real^M->bool` THEN
    EXISTS_TAC `(\x. b):real^M->real^N` THEN
    REWRITE_TAC[CONTINUOUS_ON_CONST; FINITE_EMPTY] THEN ASM SET_TAC[];
    REPEAT STRIP_TAC] THEN
  SUBGOAL_THEN `&0 <= e` ASSUME_TAC THENL
   [ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_SIMP_TAC[] THEN
    MP_TAC(SYM(ISPECL [`b:real^N`; `e:real`] SPHERE_EQ_EMPTY)) THEN
    SIMP_TAC[GSYM REAL_NOT_LT] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL
   [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
  MP_TAC(ISPECL
   [`f:real^M->real^N`; `s:real^M->bool`; `cball(a:real^M,d)`;
    `cball(b:real^N,e)`; `p:real^M->bool`]
   EXTEND_MAP_SPHERE_TO_SPHERE_COFINITE_GEN) THEN
  ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL] THEN
  REWRITE_TAC[AFF_DIM_CBALL] THEN
  MP_TAC(ISPECL [`a:real^M`; `d:real`] RELATIVE_FRONTIER_CBALL) THEN
  MP_TAC(ISPECL [`b:real^N`; `e:real`] RELATIVE_FRONTIER_CBALL) THEN
  ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN SUBST1_TAC) THEN
  ASM_REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_LE]);;

(* ------------------------------------------------------------------------- *)
(* Borsuk-style characterization of separation.                              *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_ON_BORSUK_MAP = prove
 (`!s a:real^N.
        ~(a IN s) ==> (\x. inv(norm (x - a)) % (x - a)) continuous_on s`,
  REPEAT STRIP_TAC THEN
  MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF] THEN CONJ_TAC THENL
    [MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV); ALL_TAC] THEN
  SIMP_TAC[CONTINUOUS_ON_LIFT_NORM_COMPOSE; CONTINUOUS_ON_SUB;
           CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN
  REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_MESON_TAC[]);;

let BORSUK_MAP_INTO_SPHERE = prove
 (`!s a:real^N.
        IMAGE (\x. inv(norm (x - a)) % (x - a)) s SUBSET sphere(vec 0,&1) <=>
        ~(a IN s)`,
  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0] THEN
  REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN
  REWRITE_TAC[REAL_FIELD `inv x * x = &1 <=> ~(x = &0)`] THEN
  REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN MESON_TAC[]);;

let BORSUK_MAPS_HOMOTOPIC_IN_PATH_COMPONENT = prove
 (`!s a b. path_component ((:real^N) DIFF s) a b
           ==> homotopic_with (\x. T) (s,sphere(vec 0,&1))
                   (\x. inv(norm(x - a)) % (x - a))
                   (\x. inv(norm(x - b)) % (x - b))`,
  REPEAT GEN_TAC THEN REWRITE_TAC[path_component; LEFT_IMP_EXISTS_THM] THEN
  REWRITE_TAC[path; path_image; pathstart; pathfinish; SUBSET;
              FORALL_IN_IMAGE; IN_UNIV; IN_DIFF] THEN
  X_GEN_TAC `g:real^1->real^N` THEN STRIP_TAC THEN
  SIMP_TAC[HOMOTOPIC_WITH] THEN
  EXISTS_TAC `\z. inv(norm(sndcart z - g(fstcart z))) %
                  (sndcart z - (g:real^1->real^N)(fstcart z))` THEN
  ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_SPHERE_0;
               SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL
     [MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
      ASM_SIMP_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART;
                   NORM_EQ_0; VECTOR_SUB_EQ] THEN CONJ_TAC
      THENL [MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE; ASM_MESON_TAC[]];
      ALL_TAC] THEN
    MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
    SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
    GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
    MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
    REWRITE_TAC[IMAGE_FSTCART_PCROSS] THEN ASM_MESON_TAC[CONTINUOUS_ON_EMPTY];
    REPEAT STRIP_TAC THEN
    REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN
    MATCH_MP_TAC REAL_MUL_LINV THEN
    ASM_REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_MESON_TAC[]]);;

let NON_EXTENSIBLE_BORSUK_MAP = prove
 (`!s c a:real^N.
        compact s /\ c IN components((:real^N) DIFF s) /\ bounded c /\ a IN c
        ==> ~(?g. g continuous_on (s UNION c) /\
                  IMAGE g (s UNION c) SUBSET sphere (vec 0,&1) /\
                  (!x. x IN s ==> g x = inv(norm(x - a)) % (x - a)))`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
  REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN
  ASM_REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
  SUBGOAL_THEN `c = connected_component ((:real^N) DIFF s) a` SUBST_ALL_TAC
  THENL [ASM_MESON_TAC[IN_COMPONENTS; CONNECTED_COMPONENT_EQ]; ALL_TAC] THEN
  MP_TAC(ISPECL
   [`s UNION connected_component ((:real^N) DIFF s) a`; `a: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
  FIRST_ASSUM(MP_TAC o SPEC `a:real^N` o MATCH_MP NO_RETRACTION_CBALL) THEN
  REWRITE_TAC[retract_of; retraction] THEN
  EXISTS_TAC `\x. if x IN connected_component ((:real^N) DIFF s) a
                  then a + r % g(x)
                  else a + r % inv(norm(x - a)) % (x - a)` THEN
  REWRITE_TAC[SPHERE_SUBSET_CBALL] THEN REPEAT CONJ_TAC THENL
   [SUBGOAL_THEN `cball(a:real^N,r) =
                  (s UNION connected_component ((:real^N) DIFF s) a) UNION
                  (cball(a,r) DIFF connected_component ((:real^N) DIFF s) a)`
    SUBST1_TAC THENL
     [MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN ASM
      SET_TAC[];
      ALL_TAC] THEN
    MATCH_MP_TAC CONTINUOUS_ON_CASES THEN REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC CLOSED_UNION_COMPLEMENT_COMPONENT THEN
      ASM_SIMP_TAC[IN_COMPONENTS; COMPACT_IMP_CLOSED; IN_UNIV; IN_DIFF] THEN
      ASM_MESON_TAC[];
      MATCH_MP_TAC CLOSED_DIFF THEN
      ASM_SIMP_TAC[CLOSED_CBALL; OPEN_CONNECTED_COMPONENT; GSYM closed;
                   COMPACT_IMP_CLOSED];
      MATCH_MP_TAC CONTINUOUS_ON_ADD THEN SIMP_TAC[CONTINUOUS_ON_CONST] THEN
      MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN ASM_SIMP_TAC[CONTINUOUS_ON_CONST];
      MATCH_MP_TAC CONTINUOUS_ON_ADD THEN SIMP_TAC[CONTINUOUS_ON_CONST] THEN
      MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
      MATCH_MP_TAC CONTINUOUS_ON_BORSUK_MAP THEN
      ASM_SIMP_TAC[CENTRE_IN_CBALL; IN_DIFF; REAL_LT_IMP_LE] THEN
      REWRITE_TAC[IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
      ASM_REWRITE_TAC[IN_DIFF; IN_UNIV];
      REPEAT STRIP_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
      FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]];

      REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
      REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
      ASM_REWRITE_TAC[IN_SPHERE; NORM_ARITH `dist(a:real^N,a + x) = norm x`;
                      NORM_MUL] THEN
      ASM_SIMP_TAC[REAL_ABS_INV; REAL_ABS_NORM; VECTOR_SUB_EQ;
        REAL_FIELD `&0 < r ==> abs r = r /\ (r * x = r <=> x = &1)`;
        REAL_FIELD `inv x * x = &1 <=> ~(x = &0)`; NORM_EQ_0]
      THENL
       [ONCE_REWRITE_TAC[GSYM IN_SPHERE_0] THEN ASM SET_TAC[];
        UNDISCH_TAC `~(x IN connected_component ((:real^N) DIFF s) a)` THEN
        SIMP_TAC[CONTRAPOS_THM; IN] THEN
        ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ; IN_DIFF; IN_UNIV]];
      SIMP_TAC[IN_SPHERE; ONCE_REWRITE_RULE[NORM_SUB] dist] THEN
      ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN
      REWRITE_TAC[VECTOR_ARITH `a + &1 % (x - a):real^N = x`] THEN
      REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
       `s UNION t SUBSET u ==> !x. x IN t /\ ~(x IN u) ==> wev`)) THEN
      EXISTS_TAC `x:real^N` THEN
      ASM_REWRITE_TAC[ONCE_REWRITE_RULE[NORM_SUB] dist; IN_BALL;
                      REAL_LT_REFL]]);;

let BORSUK_MAP_ESSENTIAL_BOUNDED_COMPONENT = prove
 (`!s a. compact s /\ ~(a IN s)
         ==> (bounded(connected_component ((:real^N) DIFF s) a) <=>
              ~(?c. homotopic_with (\x. T) (s,sphere(vec 0:real^N,&1))
                                   (\x. inv(norm(x - a)) % (x - a)) (\x. c)))`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL
   [ASM_SIMP_TAC[DIFF_EMPTY; CONNECTED_COMPONENT_UNIV; NOT_BOUNDED_UNIV] THEN
    SIMP_TAC[HOMOTOPIC_WITH; NOT_IN_EMPTY; PCROSS_EMPTY; IMAGE_CLAUSES;
             CONTINUOUS_ON_EMPTY; EMPTY_SUBSET];
    ALL_TAC] THEN
  EQ_TAC THENL
   [ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN
    REPEAT DISCH_TAC THEN
    MP_TAC(ISPECL
     [`\x:real^N. inv(norm(x - a)) % (x - a)`; `s:real^N->bool`;
      `vec 0:real^N`; `&1`]
     NULLHOMOTOPIC_INTO_SPHERE_EXTENSION) THEN
    ASM_SIMP_TAC[COMPACT_IMP_CLOSED; NOT_IMP; CONTINUOUS_ON_BORSUK_MAP;
                 BORSUK_MAP_INTO_SPHERE] THEN
    MP_TAC(ISPECL [`s:real^N->bool`;
        `connected_component ((:real^N) DIFF s) a`;
        `a:real^N`] NON_EXTENSIBLE_BORSUK_MAP) THEN
    ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
     [GEN_REWRITE_TAC RAND_CONV [IN] THEN
      REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
      ASM_REWRITE_TAC[IN_COMPONENTS; IN_DIFF; IN_UNIV] THEN ASM_MESON_TAC[];
      REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
      GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
       [MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; SET_TAC[]]];
    ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN
    DISCH_TAC THEN
    FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL o
      MATCH_MP COMPACT_IMP_BOUNDED) THEN
    DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
    SUBGOAL_THEN
     `?b. b IN connected_component ((:real^N) DIFF s) a /\
          ~(b IN ball(vec 0,r))`
    MP_TAC THENL
     [REWRITE_TAC[SET_RULE `(?b. b IN s /\ ~(b IN t)) <=> ~(s SUBSET t)`] THEN
      ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL];
      DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC)] THEN
    SUBGOAL_THEN
     `?c. homotopic_with (\x. T) (ball(vec 0:real^N,r),sphere (vec 0,&1))
                         (\x. inv (norm (x - b)) % (x - b)) (\x. c)`
    MP_TAC THENL
     [MATCH_MP_TAC NULLHOMOTOPIC_FROM_CONTRACTIBLE THEN
      ASM_SIMP_TAC[CONTINUOUS_ON_BORSUK_MAP; BORSUK_MAP_INTO_SPHERE;
                   CONVEX_IMP_CONTRACTIBLE; CONVEX_BALL];
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN STRIP_TAC] THEN
    MATCH_MP_TAC HOMOTOPIC_WITH_TRANS THEN
    EXISTS_TAC `\x:real^N. inv(norm (x - b)) % (x - b)` THEN CONJ_TAC THENL
     [MATCH_MP_TAC BORSUK_MAPS_HOMOTOPIC_IN_PATH_COMPONENT THEN
      ASM_SIMP_TAC[OPEN_PATH_CONNECTED_COMPONENT; GSYM closed;
                   COMPACT_IMP_CLOSED] THEN  ASM_MESON_TAC[IN];
      ASM_MESON_TAC[HOMOTOPIC_WITH_SUBSET_LEFT]]]);;

let HOMOTOPIC_BORSUK_MAPS_IN_BOUNDED_COMPONENT = prove
 (`!s a b.
        compact s /\ ~(a IN s) /\ ~(b IN s) /\
        bounded (connected_component ((:real^N) DIFF s) a) /\
        homotopic_with (\x. T) (s,sphere(vec 0,&1))
                               (\x. inv(norm(x - a)) % (x - a))
                               (\x. inv(norm(x - b)) % (x - b))
        ==> connected_component ((:real^N) DIFF s) a b`,
  REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [GSYM IN] THEN
  MP_TAC(ISPECL
   [`s:real^N->bool`; `connected_component ((:real^N) DIFF s) a`;
    `a:real^N`] NON_EXTENSIBLE_BORSUK_MAP) THEN
  ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
   [GEN_REWRITE_TAC RAND_CONV [IN] THEN
    REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
    ASM_REWRITE_TAC[IN_COMPONENTS; IN_DIFF; IN_UNIV] THEN ASM_MESON_TAC[];
    ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM]] THEN
  DISCH_TAC THEN REWRITE_TAC[] THEN
  MATCH_MP_TAC BORSUK_HOMOTOPY_EXTENSION THEN
  EXISTS_TAC `\x:real^N. inv(norm(x - b)) % (x - b)` THEN
  ASM_SIMP_TAC[COMPACT_IMP_CLOSED; ANR_SPHERE;
               CLOSED_SUBSET; SUBSET_UNION] THEN
  ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN
  ASM_SIMP_TAC[CONTINUOUS_ON_BORSUK_MAP; IN_UNION; BORSUK_MAP_INTO_SPHERE] THEN
  REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
  MATCH_MP_TAC CLOSED_UNION_COMPLEMENT_COMPONENT THEN
  ASM_SIMP_TAC[COMPACT_IMP_CLOSED; IN_COMPONENTS; IN_DIFF; IN_UNIV] THEN
  ASM_MESON_TAC[]);;

let BORSUK_MAPS_HOMOTOPIC_IN_CONNECTED_COMPONENT_EQ = prove
 (`!s a b. 2 <= dimindex(:N) /\ compact s /\ ~(a IN s) /\ ~(b IN s)
           ==> (homotopic_with (\x. T) (s,sphere(vec 0,&1))
                   (\x. inv(norm(x - a)) % (x - a))
                   (\x. inv(norm(x - b)) % (x - b)) <=>
                connected_component ((:real^N) DIFF s) a b)`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [DISCH_TAC;
    ASM_SIMP_TAC[GSYM OPEN_PATH_CONNECTED_COMPONENT; GSYM closed;
                 COMPACT_IMP_CLOSED] THEN
    REWRITE_TAC[BORSUK_MAPS_HOMOTOPIC_IN_PATH_COMPONENT]] THEN
  ASM_CASES_TAC `bounded(connected_component ((:real^N) DIFF s) a)` THENL
   [MATCH_MP_TAC HOMOTOPIC_BORSUK_MAPS_IN_BOUNDED_COMPONENT THEN
    ASM_REWRITE_TAC[];
    ALL_TAC] THEN
  ASM_CASES_TAC `bounded(connected_component ((:real^N) DIFF s) b)` THENL
   [ONCE_REWRITE_TAC[CONNECTED_COMPONENT_SYM_EQ] THEN
    MATCH_MP_TAC HOMOTOPIC_BORSUK_MAPS_IN_BOUNDED_COMPONENT THEN
    ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN
    ASM_REWRITE_TAC[];
    ALL_TAC] THEN
  MP_TAC(ISPECL [`(:real^N) DIFF s`; `a:real^N`; `b:real^N`]
        COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT) THEN
  ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EQ; IN_DIFF; IN_UNIV;
                  SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN
  ASM_SIMP_TAC[COMPACT_IMP_BOUNDED]);;

let BORSUK_SEPARATION_THEOREM_GEN = prove
 (`!s:real^N->bool.
    compact s
    ==> ((!c. c IN components((:real^N) DIFF s) ==> ~bounded c) <=>
         (!f. f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0:real^N,&1)
              ==> ?c. homotopic_with (\x. T) (s,sphere(vec 0,&1)) f (\x. c)))`,
  REPEAT STRIP_TAC THEN EQ_TAC THENL
   [ALL_TAC;
    ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
    REWRITE_TAC[NOT_FORALL_THM; components; EXISTS_IN_GSPEC; NOT_IMP;
                IN_UNIV; IN_DIFF] THEN
    DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `\x:real^N. inv(norm(x - a)) % (x - a)` THEN
    ASM_SIMP_TAC[GSYM BORSUK_MAP_ESSENTIAL_BOUNDED_COMPONENT;
                 CONTINUOUS_ON_BORSUK_MAP; BORSUK_MAP_INTO_SPHERE]] THEN
  DISCH_TAC THEN X_GEN_TAC `f:real^N->real^N` THEN STRIP_TAC THEN
  MP_TAC(ISPECL
   [`f:real^N->real^N`; `s:real^N->bool`; `vec 0:real^N`; `&1:real`]
        EXTEND_MAP_UNIV_TO_SPHERE_NO_BOUNDED_COMPONENT) THEN
  ASM_REWRITE_TAC[LE_REFL; REAL_POS] THEN
  DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL
   [`g:real^N->real^N`; `(:real^N)`; `sphere(vec 0:real^N,&1)`]
        NULLHOMOTOPIC_FROM_CONTRACTIBLE) THEN
  ASM_REWRITE_TAC[CONTRACTIBLE_UNIV] THEN
  MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
  DISCH_THEN(MP_TAC o SPEC `s:real^N->bool` o MATCH_MP
   (REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_SUBSET_LEFT)) THEN
  REWRITE_TAC[SUBSET_UNIV] THEN
  MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT]
        HOMOTOPIC_WITH_EQ) THEN
  ASM_SIMP_TAC[]);;

let BORSUK_SEPARATION_THEOREM = prove
 (`!s:real^N->bool.
      2 <= dimindex(:N) /\ compact s
      ==> (connected((:real^N) DIFF s) <=>
           !f. f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0:real^N,&1)
               ==> ?c. homotopic_with (\x. T) (s,sphere(vec 0,&1)) f (\x. c))`,
  SIMP_TAC[GSYM BORSUK_SEPARATION_THEOREM_GEN] THEN
  X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN EQ_TAC THENL
   [DISCH_TAC THEN
    MP_TAC(ISPEC `(:real^N) DIFF s` COMPONENTS_EQ_SING) THEN
    MP_TAC(ISPEC `(:real^N) DIFF s` COBOUNDED_IMP_UNBOUNDED) THEN
    ASM_CASES_TAC `(:real^N) DIFF s = {}` THEN
    ASM_SIMP_TAC[COMPACT_IMP_BOUNDED; SET_RULE `UNIV DIFF (UNIV DIFF s) = s`;
                 BOUNDED_EMPTY; FORALL_IN_INSERT; NOT_IN_EMPTY];

    REWRITE_TAC[components; FORALL_IN_GSPEC; IN_DIFF; IN_UNIV] THEN
    DISCH_TAC THEN REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENT_EQ] THEN
    REWRITE_TAC[IN_DIFF; IN_UNIV] THEN REPEAT STRIP_TAC THEN
    MATCH_MP_TAC COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT THEN
    ASM_SIMP_TAC[COMPACT_IMP_BOUNDED;
                 SET_RULE `UNIV DIFF (UNIV DIFF s) = s`]]);;

let HOMOTOPY_EQUIVALENT_SEPARATION = prove
 (`!s t. compact s /\ compact t /\ s homotopy_equivalent t
         ==> (connected((:real^N) DIFF s) <=> connected((:real^N) DIFF t))`,
  let special = prove
   (`!s:real^1->bool.
          bounded s /\ connected((:real^1) DIFF s) ==> s = {}`,
    REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1] THEN REPEAT STRIP_TAC THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_OPEN_INTERVAL) THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM; EXTENSION; NOT_IN_EMPTY] THEN
    MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IS_INTERVAL_1]) THEN
    DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `b:real^1`]) THEN
    REWRITE_TAC[IN_UNIV; IN_DIFF; SUBSET; IN_INTERVAL_1] THEN
    MESON_TAC[REAL_LT_REFL; REAL_LT_IMP_LE]) in
  REPEAT STRIP_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
    REWRITE_TAC[GSYM DIMINDEX_1]] THEN
  STRIP_TAC THENL
   [ASSUME_TAC(GEOM_EQUAL_DIMENSION_RULE(ASSUME `dimindex(:N) = dimindex(:1)`)
       special) THEN
    EQ_TAC THEN DISCH_TAC THENL
     [FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`);
      FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`)] THEN
    ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN DISCH_TAC THEN
    UNDISCH_TAC `(s:real^N->bool) homotopy_equivalent (t:real^N->bool)` THEN
    ASM_REWRITE_TAC[HOMOTOPY_EQUIVALENT_EMPTY] THEN DISCH_TAC THEN
    ASM_REWRITE_TAC[CONNECTED_UNIV; DIFF_EMPTY];
    REPEAT STRIP_TAC THEN ASM_SIMP_TAC[BORSUK_SEPARATION_THEOREM] THEN
    MATCH_MP_TAC HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL THEN
    ASM_REWRITE_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
  MP_TAC(ISPECL [`s:real^N->bool`; `sphere(a:real^N,r)`]
        HOMOTOPY_EQUIVALENT_SEPARATION) THEN
  ANTS_TAC THENL
   [ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS; COMPACT_SPHERE;
                  HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT];
    DISCH_THEN SUBST1_TAC] THEN
  DISCH_TAC THEN MP_TAC(ISPECL
   [`(:real^N) DIFF sphere(a,r)`;
    `ball(a:real^N,r)`] CONNECTED_INTER_FRONTIER) THEN
  ASM_SIMP_TAC[FRONTIER_BALL; NOT_IMP] THEN REPEAT CONJ_TAC THENL
   [REWRITE_TAC[GSYM CBALL_DIFF_BALL] THEN MATCH_MP_TAC(SET_RULE
     `~(b = {})
      ==> ~((UNIV DIFF (c DIFF b)) INTER b = {})`) THEN
    ASM_SIMP_TAC[BALL_EQ_EMPTY; REAL_NOT_LE];
    MATCH_MP_TAC(SET_RULE
     `~(s UNION t = UNIV) ==> ~(UNIV DIFF t DIFF s = {})`) THEN
    REWRITE_TAC[BALL_UNION_SPHERE] THEN
    MESON_TAC[BOUNDED_CBALL; NOT_BOUNDED_UNIV];
    SET_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`,
  let lemma = prove
   (`!s a r. 2 <= dimindex(:N) /\ &0 < r /\ s PSUBSET sphere(a,r)
             ==> connected((:real^N) DIFF s)`,
    REWRITE_TAC[PSUBSET_ALT; SUBSET; IN_SPHERE; GSYM REAL_LE_ANTISYM] THEN
    REPEAT STRIP_TAC THEN
    SUBGOAL_THEN
     `(:real^N) DIFF s =
      {x:real^N | dist(a,x) <= r /\ ~(x IN s)} UNION
      {x:real^N | r <= dist(a,x) /\ ~(x IN s)}`
    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(a:real^N,r)` THEN
      ASM_SIMP_TAC[CONNECTED_BALL; CLOSURE_BALL; SUBSET; IN_BALL; IN_CBALL;
                   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(a,r)` 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[]]) in
  MAP_EVERY X_GEN_TAC
   [`s:real^N->bool`; `c:real^N->bool`; `a:real^N`; `r:real`] 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; ALL_TAC] THEN
  REPEAT STRIP_TAC THEN MATCH_MP_TAC FRONTIER_MINIMAL_SEPARATING_CLOSED THEN
  ASM_REWRITE_TAC[] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN
  SIMP_TAC[COMPACT_SPHERE; COMPACT_IMP_CLOSED] THEN DISCH_TAC THEN
  CONJ_TAC THENL [ASM_MESON_TAC[JORDAN_BROUWER_SEPARATION]; ALL_TAC] THEN
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
  REWRITE_TAC[HOMEOMORPHISM; 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 [`t:real^N->bool`; `IMAGE (f:real^N->real^N) t`]
        HOMOTOPY_EQUIVALENT_SEPARATION) THEN
  ANTS_TAC THENL
   [MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
     [ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET; PSUBSET];
      DISCH_TAC THEN
      SUBGOAL_THEN `t homeomorphic (IMAGE (f:real^N->real^N) t)` MP_TAC THENL
       [REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC
         [`f:real^N->real^N`; `g:real^N->real^N`] THEN
        ASM_REWRITE_TAC[HOMEOMORPHISM] THEN REPEAT CONJ_TAC THEN
        TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
          (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))) THEN ASM SET_TAC[];
        ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS;
                      HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT]]];
      DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC lemma THEN
      MAP_EVERY EXISTS_TAC [`a:real^N`; `r:real`] THEN ASM SET_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
  SUBGOAL_THEN
   `!c. c IN components((:real^N) DIFF s)
        ==> connected(c UNION (s DIFF t))`
  ASSUME_TAC THENL
   [REPEAT STRIP_TAC THEN
    MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
    EXISTS_TAC `c:real^N->bool` THEN
    CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN
    CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[UNION_SUBSET; CLOSURE_SUBSET]] THEN
    SUBGOAL_THEN `s:real^N->bool = frontier c` SUBST1_TAC THENL
     [ASM_MESON_TAC[JORDAN_BROUWER_FRONTIER]; ALL_TAC] THEN
    REWRITE_TAC[frontier] THEN SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN
    `~(components((:real^N) DIFF s) = {})`
  ASSUME_TAC THENL
   [REWRITE_TAC[COMPONENTS_EQ_EMPTY; SET_RULE
     `UNIV DIFF s = {} <=> s = UNIV`] THEN
    ASM_MESON_TAC[NOT_BOUNDED_UNIV; COMPACT_EQ_BOUNDED_CLOSED;
                  HOMEOMORPHIC_COMPACTNESS; COMPACT_SPHERE];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `(:real^N) DIFF t =
    UNIONS {c UNION (s DIFF t) | c | c IN components((:real^N) DIFF s)}`
  SUBST1_TAC THENL
   [MP_TAC(ISPEC `(:real^N) DIFF s` UNIONS_COMPONENTS) THEN
    REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[];
    MATCH_MP_TAC CONNECTED_UNIONS THEN
    ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN
    REWRITE_TAC[INTERS_GSPEC] THEN ASM SET_TAC[]]);;

let JORDAN_BROUWER_ACCESSIBILITY = prove
 (`!s c a:real^N r v x.
        2 <= dimindex(:N) /\
        s homeomorphic sphere(a,r) /\
        c IN components((:real^N) DIFF s) /\ x IN c /\
        open_in (subtopology euclidean s) v /\ ~(v = {})
        ==> ?g. arc g /\
                IMAGE g (interval[vec 0,vec 1] DELETE (vec 1)) SUBSET c /\
                pathstart g = x /\
                pathfinish g IN v`,
  REPEAT STRIP_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN
  REWRITE_TAC[COMPACT_SPHERE] THEN
  REWRITE_TAC[closed; COMPACT_EQ_BOUNDED_CLOSED] THEN STRIP_TAC THEN
  MATCH_MP_TAC DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED THEN
  ASM_REWRITE_TAC[] THEN
  ASM_MESON_TAC[JORDAN_BROUWER_FRONTIER; OPEN_COMPONENTS;
                IN_COMPONENTS_CONNECTED]);;

(* ------------------------------------------------------------------------- *)
(* Invariance of domain and corollaries.                                     *)
(* ------------------------------------------------------------------------- *)

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)`,
  let lemma = prove
   (`!f:real^N->real^N a r.
          f continuous_on cball(a,r) /\ &0 < r /\
          (!x y. x IN cball(a,r) /\ y IN cball(a,r) /\ f x = f y ==> x = y)
          ==> open(IMAGE f (ball(a,r)))`,
    REPEAT STRIP_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL
     [MP_TAC(ISPECL [`(:real^N)`; `(:real^1)`] ISOMETRIES_SUBSPACES) THEN
      ASM_SIMP_TAC[SUBSPACE_UNIV; DIM_UNIV; DIMINDEX_1;
                   LEFT_IMP_EXISTS_THM] THEN
      MAP_EVERY X_GEN_TAC [`h:real^N->real^1`; `k:real^1->real^N`] THEN
      REWRITE_TAC[IN_UNIV] THEN STRIP_TAC THEN
      MP_TAC(ISPECL [`(h:real^N->real^1) o f o (k:real^1->real^N)`;
                     `IMAGE (h:real^N->real^1) (cball(a,r))`]
          INJECTIVE_EQ_1D_OPEN_MAP_UNIV) THEN
      MATCH_MP_TAC(TAUT
       `p /\ q /\ r /\ (s ==> t)
        ==> (p /\ q ==> (r <=> s)) ==> t`) THEN
      REPEAT CONJ_TAC THENL
       [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN
        ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; GSYM IMAGE_o] THEN
        ASM_REWRITE_TAC[o_DEF; IMAGE_ID];
        REWRITE_TAC[IS_INTERVAL_CONNECTED_1] THEN
        MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
        ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; CONNECTED_CBALL];
        ASM_SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM;
                     FORALL_IN_IMAGE; o_DEF] THEN
        ASM SET_TAC[];
        DISCH_THEN(MP_TAC o SPEC `IMAGE (h:real^N->real^1) (ball(a,r))`) THEN
        ASM_SIMP_TAC[IMAGE_SUBSET; BALL_SUBSET_CBALL; GSYM IMAGE_o] THEN
        ANTS_TAC THENL
         [MP_TAC(ISPECL [`a:real^N`; `r:real`] OPEN_BALL); ALL_TAC] THEN
        MATCH_MP_TAC EQ_IMP THENL
         [CONV_TAC SYM_CONV;
          REWRITE_TAC[GSYM o_ASSOC] THEN ONCE_REWRITE_TAC[IMAGE_o] THEN
          ASM_REWRITE_TAC[o_DEF; ETA_AX]] THEN
        MATCH_MP_TAC OPEN_BIJECTIVE_LINEAR_IMAGE_EQ THEN
        ASM_MESON_TAC[]];
       FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE
        `~(n = 1) ==> 1 <= n ==> 2 <= n`)) THEN
       REWRITE_TAC[DIMINDEX_GE_1] THEN DISCH_TAC] THEN
    REPEAT STRIP_TAC THEN
    MP_TAC(ISPECL [`IMAGE (f:real^N->real^N) (sphere(a,r))`;
                   `a:real^N`; `r:real`]
          JORDAN_BROUWER_SEPARATION) THEN
    ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
     [ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
      MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN EXISTS_TAC `f:real^N->real^N` THEN
      ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET; SPHERE_SUBSET_CBALL;
                    COMPACT_SPHERE];
      DISCH_TAC] THEN
    MP_TAC(ISPEC `(:real^N) DIFF IMAGE f (sphere(a:real^N,r))`
      COBOUNDED_HAS_BOUNDED_COMPONENT) THEN
    ASM_REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN
    ANTS_TAC THENL
     [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET; SPHERE_SUBSET_CBALL;
        COMPACT_SPHERE; COMPACT_CONTINUOUS_IMAGE; COMPACT_IMP_BOUNDED];
      DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC)] THEN
    SUBGOAL_THEN
     `IMAGE (f:real^N->real^N) (ball(a,r)) = c`
    SUBST1_TAC THENL
     [ALL_TAC;
      FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
          OPEN_COMPONENTS)) THEN
      REWRITE_TAC[GSYM closed] THEN
      ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET; SPHERE_SUBSET_CBALL;
        COMPACT_SPHERE; COMPACT_CONTINUOUS_IMAGE; COMPACT_IMP_CLOSED]] THEN
    MATCH_MP_TAC(SET_RULE
     `~(c = {}) /\ (~(c INTER t = {}) ==> t SUBSET c) /\ c SUBSET t
      ==> t = c`) THEN
    REPEAT STRIP_TAC THENL
     [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY];
      FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
          COMPONENTS_MAXIMAL)) THEN
      ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
       [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
        REWRITE_TAC[CONNECTED_BALL] THEN
        ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; BALL_SUBSET_CBALL];
        REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN
        MP_TAC(ISPECL [`a:real^N`; `r:real`] SPHERE_SUBSET_CBALL) THEN
        ASM SET_TAC[]];
      FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
      FIRST_ASSUM(MP_TAC o SPEC `(:real^N) DIFF IMAGE f (cball(a:real^N,r))` o
        MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COMPONENTS_MAXIMAL)) THEN
      SIMP_TAC[SET_RULE `UNIV DIFF t SUBSET UNIV DIFF s <=> s SUBSET t`;
               IMAGE_SUBSET; SPHERE_SUBSET_CBALL] THEN
      MATCH_MP_TAC(TAUT `p /\ ~r /\ (~q ==> s) ==> (p /\ q ==> r) ==> s`) THEN
      REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
       [MATCH_MP_TAC(INST_TYPE [`:N`,`:M`]
          CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT) THEN
        EXISTS_TAC `cball(a:real^N,r)` THEN
        ASM_REWRITE_TAC[CONVEX_CBALL; COMPACT_CBALL] THEN
        ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
        MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN
        EXISTS_TAC `f:real^N->real^N` THEN ASM_REWRITE_TAC[COMPACT_CBALL];
        DISCH_THEN(MP_TAC o
          MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET)) THEN
        ASM_REWRITE_TAC[] THEN MATCH_MP_TAC COBOUNDED_IMP_UNBOUNDED THEN
        REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN
        ASM_MESON_TAC[COMPACT_IMP_BOUNDED; COMPACT_CONTINUOUS_IMAGE;
                      COMPACT_CBALL];
        REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN ASM SET_TAC[]]]) in
  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[OPEN_SUBOPEN] THEN
  REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `a:real^N` THEN DISCH_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[LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `r:real` THEN STRIP_TAC THEN
  EXISTS_TAC `IMAGE (f:real^N->real^N) (ball(a,r))` THEN
  REPEAT CONJ_TAC THENL
   [MATCH_MP_TAC lemma THEN ASM_MESON_TAC[SUBSET; CONTINUOUS_ON_SUBSET];
    ASM_SIMP_TAC[FUN_IN_IMAGE; CENTRE_IN_BALL];
    MATCH_MP_TAC IMAGE_SUBSET THEN
    ASM_MESON_TAC[BALL_SUBSET_CBALL; SUBSET_TRANS]]);;

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)`,
  let lemma0 = prove
   (`!f:real^M->real^M s u.
          subspace s /\ dim s = dimindex(:N) /\
          f continuous_on u /\ IMAGE f u SUBSET s /\
          (!x y. x IN u /\ y IN u /\ f x = f y ==> x = y) /\
          open_in (subtopology euclidean s) u
          ==> open_in (subtopology euclidean s) (IMAGE f u)`,
    REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(:real^N)`; `s:real^M->bool`]
      HOMEOMORPHIC_SUBSPACES) THEN
    ASM_REWRITE_TAC[DIM_UNIV; SUBSPACE_UNIV] THEN
    REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN
    MAP_EVERY X_GEN_TAC [`h:real^N->real^M`; `k:real^M->real^N`] THEN
    STRIP_TAC THEN MP_TAC(ISPECL
     [`(k:real^M->real^N) o f o (h:real^N->real^M)`;
      `IMAGE (k:real^M->real^N) u`] INVARIANCE_OF_DOMAIN) THEN
    REWRITE_TAC[GSYM IMAGE_o; o_THM] THEN
    SUBGOAL_THEN
     `!t. open t <=>
          open_in (subtopology euclidean (IMAGE (k:real^M->real^N) s)) t`
     (fun th -> REWRITE_TAC[th])
    THENL [ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN]; ALL_TAC] THEN
    ANTS_TAC THENL
     [REPEAT CONJ_TAC THENL
       [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
        FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
        REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
        MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
        MAP_EVERY EXISTS_TAC [`h:real^N->real^M`; `s:real^M->bool`] THEN
        ASM_REWRITE_TAC[homeomorphism];
        REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
        FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
        ASM_SIMP_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN
        FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]];
      ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
      SUBGOAL_THEN
       `IMAGE f u =
        IMAGE (h:real^N->real^M) (IMAGE ((k o f o h) o (k:real^M->real^N)) u)`
      SUBST1_TAC THENL
       [REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC(SET_RULE
         `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN
        REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
        ASM_SIMP_TAC[SUBSET; o_THM] THEN ASM SET_TAC[];
        MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
        MAP_EVERY EXISTS_TAC [`k:real^M->real^N`; `(:real^N)`] THEN
        ASM_REWRITE_TAC[homeomorphism]]]) in
  let lemma1 = prove
   (`!f:real^N->real^N s u.
          subspace s /\ f continuous_on u /\ IMAGE f u SUBSET s /\
          (!x y. x IN u /\ y IN u /\ f x = f y ==> x = y) /\
          open_in (subtopology euclidean s) u
          ==> open_in (subtopology euclidean s) (IMAGE f u)`,
    REWRITE_TAC[INJECTIVE_ON_ALT] THEN REPEAT STRIP_TAC THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
    ABBREV_TAC `s' = {y:real^N | !x. x IN s ==> orthogonal x y}` THEN
    SUBGOAL_THEN `subspace(s':real^N->bool)` ASSUME_TAC THENL
      [EXPAND_TAC "s'" THEN REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTORS];
       FIRST_ASSUM(ASSUME_TAC o MATCH_MP SUBSPACE_IMP_NONEMPTY)] THEN
    ABBREV_TAC `g:real^(N,N)finite_sum->real^(N,N)finite_sum =
                  \z. pastecart (f(fstcart z)) (sndcart z)` THEN
    SUBGOAL_THEN
     `g continuous_on ((u:real^N->bool) PCROSS s') /\
      IMAGE g (u PCROSS s') SUBSET (s:real^N->bool) PCROSS (s':real^N->bool) /\
      (!w z. w IN u PCROSS s' /\ z IN u PCROSS s' ==> (g w = g z <=> w = z))`
    STRIP_ASSUME_TAC THENL
     [EXPAND_TAC "g" THEN REPEAT CONJ_TAC THENL
       [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
        SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
        GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
        MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
        SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART;
                 IMAGE_FSTCART_PCROSS] THEN
        COND_CASES_TAC THEN ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY];
        REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
        SIMP_TAC[PASTECART_IN_PCROSS; SNDCART_PASTECART;
                 FSTCART_PASTECART] THEN
        ASM SET_TAC[];
        EXPAND_TAC "g" THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
        REWRITE_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART;
                    SNDCART_PASTECART] THEN
        ASM_SIMP_TAC[PASTECART_INJ]];
      ALL_TAC] THEN
    SUBGOAL_THEN
     `open_in (subtopology euclidean (s PCROSS s'))
              (IMAGE (g:real^(N,N)finite_sum->real^(N,N)finite_sum)
                     (u PCROSS s'))`
    MP_TAC THENL
     [MATCH_MP_TAC lemma0 THEN
      ASM_SIMP_TAC[SUBSPACE_PCROSS; OPEN_IN_PCROSS_EQ; OPEN_IN_REFL] THEN
      CONJ_TAC THENL [ASM_SIMP_TAC[DIM_PCROSS]; ASM_MESON_TAC[]] THEN
      MP_TAC(ISPECL [`s:real^N->bool`; `(:real^N)`]
        DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS) THEN
      ASM_REWRITE_TAC[SUBSET_UNIV; SUBSPACE_UNIV; IN_UNIV; DIM_UNIV] THEN
      ARITH_TAC;
      SUBGOAL_THEN
       `IMAGE (g:real^(N,N)finite_sum->real^(N,N)finite_sum) (u PCROSS s') =
        IMAGE f u PCROSS s'`
      SUBST1_TAC THENL
       [EXPAND_TAC "g" THEN
        REWRITE_TAC[EXTENSION; EXISTS_PASTECART; PASTECART_IN_PCROSS;
                    IN_IMAGE; FORALL_PASTECART; PASTECART_IN_PCROSS;
                    FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_INJ] THEN
        ASM SET_TAC[];
        ASM_SIMP_TAC[OPEN_IN_PCROSS_EQ; IMAGE_EQ_EMPTY] THEN
        STRIP_TAC THEN ASM_SIMP_TAC[IMAGE_CLAUSES; OPEN_IN_EMPTY]]]) in
  REWRITE_TAC[INJECTIVE_ON_ALT] THEN REPEAT STRIP_TAC THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
  MP_TAC(ISPECL [`u:real^M->bool`; `dim(v:real^N->bool)`]
    CHOOSE_SUBSPACE_OF_SUBSPACE) THEN ASM_SIMP_TAC[SPAN_OF_SUBSPACE] THEN
  DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN
  MP_TAC(ISPECL [`v:real^N->bool`; `v:real^M->bool`]
        HOMEOMORPHIC_SUBSPACES) THEN
  ASM_REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`h:real^N->real^M`; `k:real^M->real^N`] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN
   `IMAGE (f:real^M->real^N) s =
    IMAGE (k:real^M->real^N) (IMAGE ((h:real^N->real^M) o f) s)`
  SUBST1_TAC THENL
   [REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC(SET_RULE
     `(!x. x IN u ==> f x = g x) ==> IMAGE f u = IMAGE g u`) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN
    ASM_SIMP_TAC[SUBSET; o_THM] THEN ASM SET_TAC[];
    MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
    MAP_EVERY EXISTS_TAC [`h:real^N->real^M`; `v:real^M->bool`] THEN
    ASM_REWRITE_TAC[homeomorphism] THEN
    MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `u:real^M->bool` THEN
    ASM_REWRITE_TAC[IMAGE_o] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC lemma1 THEN
    ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_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 SET_TAC[]]);;

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 \/ 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[];
    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 REAL_CONTINUOUS_ON_INVERSE = prove
 (`!f g s. f real_continuous_on s /\
           (is_realinterval s \/ real_compact s \/ real_open s) /\
           (!x. x IN s ==> g(f x) = x)
           ==> g real_continuous_on (IMAGE f s)`,
  REPEAT GEN_TAC THEN
  REWRITE_TAC[REAL_CONTINUOUS_ON; real_compact; REAL_OPEN;
              IS_REALINTERVAL_IS_INTERVAL] THEN
  DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_INVERSE_INTO_1D THEN
  MAP_EVERY EXISTS_TAC [`lift o f o drop`; `IMAGE lift s`] THEN
  ASM_REWRITE_TAC[GSYM IS_INTERVAL_PATH_CONNECTED_1] THEN
  ASM_SIMP_TAC[FORALL_IN_IMAGE; o_DEF; LIFT_DROP; GSYM IMAGE_o]);;

let REAL_CONTINUOUS_ON_INVERSE_ALT = prove
 (`!f g s t. f real_continuous_on s /\
             (is_realinterval s \/ real_compact s \/ real_open s) /\
             IMAGE f s = t /\ (!x. x IN s ==> g(f x) = x)
           ==> g real_continuous_on t`,
  MESON_TAC[REAL_CONTINUOUS_ON_INVERSE]);;

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);;

(* ------------------------------------------------------------------------- *)
(* Dimension-based conditions for various homeomorphisms.                    *)
(* ------------------------------------------------------------------------- *)

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
   [ALL_TAC; ASM_MESON_TAC[HOMEOMORPHIC_SUBSPACES]] THEN
  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 CONTINUOUS_INJECTIVE_IMAGE_SUBSPACE_DIM_LE THEN
  ASM_MESON_TAC[]);;

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 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]]);;

let SIMPLY_CONNECTED_SPHERE_EQ = prove
 (`!a:real^N r.
        simply_connected(sphere(a,r)) <=> 3 <= dimindex(:N) \/ r <= &0`,
  let hslemma = prove
   (`!a:real^M r b:real^N s.
        dimindex(:M) = dimindex(:N)
        ==> &0 < r /\ &0 < s  ==> (sphere(a,r) homeomorphic sphere(b,s))`,
    REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th ->
      let t = `?a:real^M b:real^N. ~(sphere(a,r) homeomorphic sphere(b,s))` in
      MP_TAC(DISCH t (GEOM_EQUAL_DIMENSION_RULE th (ASSUME t)))) THEN
    ASM_SIMP_TAC[HOMEOMORPHIC_SPHERES] THEN MESON_TAC[]) in
  REPEAT GEN_TAC THEN
  ASM_CASES_TAC `r < &0` THEN
  ASM_SIMP_TAC[SPHERE_EMPTY; REAL_LT_IMP_LE; SIMPLY_CONNECTED_EMPTY] THEN
  ASM_CASES_TAC `r = &0` THEN
  ASM_SIMP_TAC[SPHERE_SING; REAL_LE_REFL; CONVEX_IMP_SIMPLY_CONNECTED;
               CONVEX_SING] THEN
  ASM_REWRITE_TAC[REAL_LE_LT] THEN
  EQ_TAC THEN REWRITE_TAC[SIMPLY_CONNECTED_SPHERE] THEN
  ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
  REWRITE_TAC[ARITH_RULE `~(3 <= n) <=> (1 <= n ==> n = 1 \/ n = 2)`] THEN
  REWRITE_TAC[DIMINDEX_GE_1] THEN STRIP_TAC THENL
   [DISCH_THEN(MP_TAC o MATCH_MP SIMPLY_CONNECTED_IMP_CONNECTED) THEN
    ASM_REWRITE_TAC[CONNECTED_SPHERE_EQ; ARITH] THEN ASM_REAL_ARITH_TAC;
    RULE_ASSUM_TAC(REWRITE_RULE[GSYM DIMINDEX_2]) THEN
    FIRST_ASSUM(MP_TAC o ISPECL [`a:real^N`; `r:real`; `vec 0:real^2`;
          `&1:real`] o MATCH_MP hslemma) THEN
    ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
    DISCH_THEN(SUBST1_TAC o MATCH_MP HOMEOMORPHIC_SIMPLY_CONNECTED_EQ) THEN
    REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_CIRCLEMAP] THEN
    REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\x:real^2. x`) THEN
    REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID; SUBSET_REFL] THEN
    REWRITE_TAC[GSYM contractible; CONTRACTIBLE_SPHERE] THEN
    CONV_TAC REAL_RAT_REDUCE_CONV]);;

let SIMPLY_CONNECTED_PUNCTURED_UNIVERSE_EQ = prove
 (`!a. simply_connected((:real^N) DELETE a) <=> 3 <= dimindex(:N)`,
  GEN_TAC THEN TRANS_TAC EQ_TRANS `simply_connected(sphere(a:real^N,&1))` THEN
  CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SIMPLY_CONNECTED_SPHERE_EQ]] THEN
  CONV_TAC REAL_RAT_REDUCE_CONV THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
  MATCH_MP_TAC HOMOTOPY_EQUIVALENT_SIMPLE_CONNECTEDNESS THEN
  MP_TAC(ISPECL [`cball(a:real^N,&1)`; `a:real^N`]
        HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_AFFINE_HULL) THEN
  REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; RELATIVE_INTERIOR_CBALL;
              RELATIVE_FRONTIER_CBALL] THEN
  CONV_TAC REAL_RAT_REDUCE_CONV THEN
  SIMP_TAC[CENTRE_IN_BALL; AFFINE_HULL_NONEMPTY_INTERIOR; INTERIOR_CBALL;
           BALL_EQ_EMPTY; REAL_OF_NUM_LE; ARITH; REAL_LT_01]);;

let NOT_SIMPLY_CONNECTED_CIRCLE = prove
 (`!a:real^2 r. &0 < r ==> ~simply_connected(sphere(a,r))`,
  REWRITE_TAC[SIMPLY_CONNECTED_SPHERE_EQ; DIMINDEX_2; ARITH] THEN
  REAL_ARITH_TAC);;

(* ------------------------------------------------------------------------- *)
(* The power, squaring and exponential functions as covering maps.           *)
(* ------------------------------------------------------------------------- *)

let COVERING_SPACE_POW_PUNCTURED_PLANE = prove
 (`!n. 0 < n
       ==> covering_space ((:complex) DIFF {Cx(&0)},(\z. z pow n))
                          ((:complex) DIFF {Cx (&0)})`,
  let lemma = prove
   (`!n. 0 < n
         ==> ?e. &0 < e /\
                 !w z. norm(w - z) < e * norm(z)
                       ==> (w pow n = z pow n <=> w = z)`,
    REPEAT STRIP_TAC THEN
    FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE
     `0 < n ==> n = 1 \/ 2 <= n`)) THEN
    ASM_SIMP_TAC[COMPLEX_POW_1] THENL [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN
    EXISTS_TAC `&2 * sin(pi / &n)` THEN CONJ_TAC THENL
     [REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`] THEN
      MATCH_MP_TAC SIN_POS_PI THEN
      ASM_SIMP_TAC[REAL_LT_DIV; PI_POS; REAL_OF_NUM_LT] THEN
      REWRITE_TAC[REAL_ARITH `x / y < x <=> &0 < x * (&1 - inv y)`] THEN
      MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[PI_POS; REAL_SUB_LT] THEN
      MATCH_MP_TAC REAL_INV_LT_1 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN
      ASM_ARITH_TAC;
      ALL_TAC] THEN
    REPEAT GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THENL
     [ASM_REWRITE_TAC[COMPLEX_NORM_0; COMPLEX_SUB_RZERO] THEN
      CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[] THEN
      SIMP_TAC[NORM_ARITH `norm(w) < x * &0 <=> F`];
      ALL_TAC] THEN
    ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; COMPLEX_NORM_NZ] THEN
    ASM_SIMP_TAC[COMPLEX_POW_EQ_0; COMPLEX_FIELD
     `~(z = Cx(&0)) ==> (w = z <=> w / z = Cx(&1))`] THEN
    REWRITE_TAC[GSYM COMPLEX_NORM_DIV; GSYM COMPLEX_POW_DIV] THEN
    ASM_SIMP_TAC[COMPLEX_FIELD
     `~(z = Cx(&0)) ==> (w - z) / z = w / z - Cx(&1)`] THEN
    ASM_CASES_TAC `w / z = Cx(&0)` THENL
     [ASM_REWRITE_TAC[COMPLEX_SUB_LZERO; NORM_NEG; COMPLEX_NORM_CX] THEN
      ASM_SIMP_TAC[COMPLEX_POW_ZERO; LE_1];
      UNDISCH_TAC `~(w / z = Cx(&0))` THEN
      UNDISCH_THEN `~(z = Cx(&0))` (K ALL_TAC) THEN
      REPEAT(POP_ASSUM MP_TAC) THEN
      SPEC_TAC(`w / z:complex`,`z:complex`) THEN REPEAT STRIP_TAC] THEN
    EQ_TAC THEN SIMP_TAC[COMPLEX_POW_ONE] THEN DISCH_TAC THEN
    UNDISCH_TAC `norm(z - Cx(&1)) < &2 * sin (pi / &n)` THEN
    ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LT] THEN
    DISCH_TAC THEN MP_TAC(SPEC `n:num` COMPLEX_ROOTS_UNITY) THEN
    ASM_SIMP_TAC[LE_1; EXTENSION; IN_ELIM_THM] THEN
    DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(X_CHOOSE_THEN `j:num` MP_TAC) THEN
    REWRITE_TAC[COMPLEX_RING `t * p * ii * q = ii * (t * p * q)`] THEN
    REWRITE_TAC[GSYM CX_MUL] THEN ASM_CASES_TAC `j = 0` THENL
     [ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_MUL_RZERO; CEXP_0;
                      COMPLEX_MUL_RZERO];
      STRIP_TAC THEN ASM_REWRITE_TAC[DIST_CEXP_II_1]] THEN
    MATCH_MP_TAC(REAL_ARITH `x <= y ==> &2 * x <= &2 * abs y`) THEN
    REWRITE_TAC[REAL_ARITH `(&2 * x) / &2 = x`] THEN
    ASM_CASES_TAC `&j / &n <= &1 / &2` THENL
     [ALL_TAC;
      SUBGOAL_THEN `sin(pi * &j / &n) = sin(pi * &(n - j) / &n)`
      SUBST1_TAC THENL
       [ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; LT_IMP_LE; REAL_OF_NUM_LT;
           REAL_FIELD `&0 < n ==> pi * (n - j) / n = pi - pi * j / n`] THEN
        REWRITE_TAC[SIN_SUB; COS_PI; SIN_PI] THEN REAL_ARITH_TAC;
        ALL_TAC]] THEN
    MATCH_MP_TAC SIN_MONO_LE THEN
    REWRITE_TAC[REAL_ARITH `--(pi / &2) = pi * --(&1 / &2)`; real_div] THEN
    SIMP_TAC[REAL_LE_LMUL_EQ; PI_POS] THEN
    ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; REAL_MUL_LINV; REAL_LT_IMP_NZ;
                 REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; REAL_OF_NUM_LT; LE_1;
                 ARITH_RULE `j < n ==> 1 <= n - j`; REAL_OF_NUM_LE;
                 REAL_ARITH `&0 <= x ==> --(&1 / &2) <= x`;
                 REAL_POS; REAL_LE_INV_EQ] THEN
    ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; LT_IMP_LE] THEN
    REWRITE_TAC[REAL_ARITH `n - j <= inv(&2) * n <=> inv(&2) * n <= j`] THEN
    ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_LE_RDIV_EQ;
                 REAL_OF_NUM_LT] THEN
    ASM_REAL_ARITH_TAC) in
  REPEAT STRIP_TAC THEN
  SIMP_TAC[covering_space; CONTINUOUS_ON_COMPLEX_POW; CONTINUOUS_ON_ID] THEN
  SIMP_TAC[OPEN_IN_OPEN_EQ; OPEN_DIFF; OPEN_UNIV; CLOSED_SING] THEN
  MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
   [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DIFF; IN_UNIV; IN_SING] THEN
    ASM_MESON_TAC[COMPLEX_POW_EQ_0; EXISTS_COMPLEX_ROOT; LE_1];
    DISCH_THEN(fun th -> GEN_REWRITE_TAC
        (BINDER_CONV o LAND_CONV o RAND_CONV) [GSYM th])] THEN
  REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; IN_DIFF; IN_SING] THEN
  SIMP_TAC[SUBSET_UNIV; SET_RULE `s SUBSET UNIV DIFF {a} <=> ~(a IN s)`] THEN
  X_GEN_TAC `z:complex` THEN DISCH_TAC THEN
  MP_TAC(SPEC `n:num` lemma) THEN ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
  ABBREV_TAC `d = (min (&1 / &2) (e / &4)) * norm(z:complex)` THEN
  SUBGOAL_THEN `&0 < d` ASSUME_TAC THENL
   [EXPAND_TAC "d" THEN MATCH_MP_TAC REAL_LT_MUL THEN
    ASM_REWRITE_TAC[COMPLEX_NORM_NZ] THEN ASM_REAL_ARITH_TAC;
    ALL_TAC] THEN
  SUBGOAL_THEN
   `!w x y. w pow n = z pow n /\ x IN ball(w,d) /\ y IN ball(w,d)
            ==> (x pow n = y pow n <=> x = y)`
  ASSUME_TAC THENL
   [REWRITE_TAC[IN_BALL] THEN REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
    SUBGOAL_THEN `norm(z pow n) = norm(w pow n)` MP_TAC THENL
     [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]] THEN
    DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
     (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN
    ASM_SIMP_TAC[LE_1; NORM_POS_LE] THEN
    ASM_CASES_TAC `w = Cx(&0)` THENL
     [ASM_MESON_TAC[COMPLEX_NORM_ZERO]; DISCH_THEN SUBST_ALL_TAC] THEN
    MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&2 * d` THEN CONJ_TAC THENL
     [MAP_EVERY UNDISCH_TAC
       [`dist(w:complex,x) < d`; `dist(w:complex,y) < d`] THEN
      CONV_TAC NORM_ARITH;
      ALL_TAC] THEN
    EXPAND_TAC "d" THEN MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC `&2 * e / &4 * norm(w:complex)` THEN CONJ_TAC THENL
     [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN
      MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN
      REAL_ARITH_TAC;
      ALL_TAC] THEN
    ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_ARITH
     `&2 * e / &4 * x <= e * y <=> e * x <= e * &2 * y`] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH
     `dist(z,y) < d ==> d <= &1 / &2 * norm(z)
                        ==> norm(z) <= &2 * norm y`)) THEN
    EXPAND_TAC "d" THEN MATCH_MP_TAC REAL_LE_RMUL THEN
    REWRITE_TAC[NORM_POS_LE] THEN REAL_ARITH_TAC;
    ALL_TAC] THEN
  EXISTS_TAC `IMAGE (\w. w pow n) (ball(z,d))` THEN REPEAT CONJ_TAC THENL
   [REWRITE_TAC[IN_IMAGE] THEN ASM_MESON_TAC[CENTRE_IN_BALL];
    MATCH_MP_TAC INVARIANCE_OF_DOMAIN THEN
    SIMP_TAC[OPEN_BALL; CONTINUOUS_ON_COMPLEX_POW; CONTINUOUS_ON_ID] THEN
    ASM_MESON_TAC[];
    REWRITE_TAC[SET_RULE
     `~(z IN IMAGE f s) <=> (!x. x IN s ==> ~(f x = z))`] THEN
    X_GEN_TAC `w:complex` THEN
    ASM_SIMP_TAC[IN_BALL; COMPLEX_POW_EQ_0; LE_1] THEN
    ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
    SIMP_TAC[GSYM COMPLEX_VEC_0; DIST_0] THEN DISCH_TAC THEN
    EXPAND_TAC "d" THEN
    REWRITE_TAC[REAL_ARITH `~(z < e * z) <=> &0 <= z * (&1 - e)`] THEN
    MATCH_MP_TAC REAL_LE_MUL THEN CONV_TAC NORM_ARITH;
    ALL_TAC] THEN
  SUBGOAL_THEN
   `!z'. z' pow n = z pow n
         ==> IMAGE (\w. w pow n) (ball(z',d)) =
             IMAGE (\w. w pow n) (ball(z,d))`
  ASSUME_TAC THENL
   [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_BALL] THEN
    X_GEN_TAC `w:complex` THEN DISCH_TAC THEN
    ASM_CASES_TAC `w = Cx(&0)` THENL
     [ASM_MESON_TAC[COMPLEX_POW_EQ_0; LE_1]; ALL_TAC] THEN
    X_GEN_TAC `x:complex` THEN  EQ_TAC THEN
    DISCH_THEN(X_CHOOSE_THEN `y:complex` STRIP_ASSUME_TAC) THENL
     [EXISTS_TAC `z / w * y:complex`;
      EXISTS_TAC `w / z * y:complex`] THEN
    ASM_SIMP_TAC[COMPLEX_POW_MUL; COMPLEX_POW_DIV; COMPLEX_DIV_REFL;
                 COMPLEX_POW_EQ_0; LE_1; COMPLEX_MUL_LID; dist] THEN
    ASM_SIMP_TAC[COMPLEX_FIELD
     `~(w = Cx(&0)) ==> z - z / w * y = z / w * (w - y)`] THEN
    REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV] THEN
    (SUBGOAL_THEN `norm(z pow n) = norm(w pow n)` MP_TAC THENL
     [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]]) THEN
    DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
     (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN
    ASM_SIMP_TAC[LE_1; NORM_POS_LE; REAL_DIV_REFL; COMPLEX_NORM_ZERO] THEN
    ASM_REWRITE_TAC[REAL_MUL_LID; GSYM dist];
    ALL_TAC] THEN
  EXISTS_TAC `{ ball(z',d) | z' pow n = z pow n}` THEN
  REWRITE_TAC[FORALL_IN_GSPEC] THEN REPEAT CONJ_TAC THENL
   [REWRITE_TAC[UNIONS_GSPEC; EXTENSION; IN_ELIM_THM] THEN
    X_GEN_TAC `x:complex` THEN EQ_TAC THENL
     [DISCH_THEN(X_CHOOSE_THEN `w:complex` STRIP_ASSUME_TAC) THEN
      CONJ_TAC THENL
       [DISCH_TAC THEN UNDISCH_TAC `x IN ball(w:complex,d)` THEN
        ASM_REWRITE_TAC[IN_BALL; GSYM COMPLEX_VEC_0; DIST_0] THEN
        SUBGOAL_THEN `norm(w pow n) = norm(z pow n)` MP_TAC THENL
         [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]] THEN
        DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
         (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN
        ASM_SIMP_TAC[LE_1; NORM_POS_LE; REAL_NOT_LT] THEN DISCH_TAC THEN
        EXPAND_TAC "d" THEN REWRITE_TAC[REAL_ARITH
         `e * z <= z <=> &0 <= z * (&1 - e)`] THEN
        MATCH_MP_TAC REAL_LE_MUL THEN CONV_TAC NORM_ARITH;
        SUBGOAL_THEN `IMAGE (\w. w pow n) (ball(z,d)) =
                  IMAGE (\w. w pow n) (ball(w,d))`
        SUBST1_TAC THENL [ASM_MESON_TAC[]; ASM SET_TAC[]]];
      STRIP_TAC THEN
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_IMAGE]) THEN
      REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:complex` THEN
      REWRITE_TAC[IN_BALL] THEN STRIP_TAC THEN
      ASM_CASES_TAC `y = Cx(&0)` THENL
       [ASM_MESON_TAC[COMPLEX_POW_EQ_0; LE_1]; ALL_TAC] THEN
      EXISTS_TAC `x / y * z:complex` THEN
      REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV] THEN
      ASM_SIMP_TAC[COMPLEX_POW_MUL; COMPLEX_POW_DIV; COMPLEX_DIV_REFL;
                   COMPLEX_POW_EQ_0; LE_1; COMPLEX_MUL_LID; dist] THEN
      ASM_SIMP_TAC[COMPLEX_FIELD
       `~(y = Cx(&0)) ==> x / y * z - x = x / y * (z - y)`] THEN
      REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV] THEN
      SUBGOAL_THEN `norm(y pow n) = norm(x pow n)` MP_TAC THENL
       [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]] THEN
      REWRITE_TAC[COMPLEX_POW_MUL; COMPLEX_POW_DIV] THEN
      DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
       (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN
      ASM_SIMP_TAC[LE_1; NORM_POS_LE; REAL_DIV_REFL; COMPLEX_NORM_ZERO] THEN
      ASM_REWRITE_TAC[REAL_MUL_LID; GSYM dist]];
    X_GEN_TAC `w:complex` THEN DISCH_TAC THEN
    REWRITE_TAC[OPEN_BALL; IN_BALL; REAL_NOT_LT; dist; COMPLEX_SUB_RZERO] THEN
    SUBGOAL_THEN `norm(w pow n) = norm(z pow n)` MP_TAC THENL
     [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]] THEN
    DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
     (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN
    ASM_SIMP_TAC[LE_1; NORM_POS_LE] THEN DISCH_THEN SUBST1_TAC THEN
    EXPAND_TAC "d" THEN
    REWRITE_TAC[REAL_ARITH `e * z <= z <=> &0 <= z * (&1 - e)`] THEN
    MATCH_MP_TAC REAL_LE_MUL THEN CONV_TAC NORM_ARITH;
    REWRITE_TAC[pairwise; IMP_CONJ; FORALL_IN_GSPEC; RIGHT_FORALL_IMP_THM] THEN
    X_GEN_TAC `u:complex` THEN DISCH_TAC THEN
    X_GEN_TAC `v:complex` THEN DISCH_TAC THEN
    ASM_CASES_TAC `v:complex = u` THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(K ALL_TAC) THEN
    REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s /\ x IN t ==> F`] THEN
    X_GEN_TAC `x:complex` THEN REWRITE_TAC[IN_BALL] THEN
    DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH
     `dist(u,x) < d /\ dist(v,x) < d ==> dist(u,v) < &2 * d`)) THEN
    REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
    EXISTS_TAC `e * norm(z:complex)` THEN CONJ_TAC THENL
     [EXPAND_TAC "d" THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN
      MATCH_MP_TAC REAL_LE_RMUL THEN
      REWRITE_TAC[NORM_POS_LE] THEN ASM_REAL_ARITH_TAC;
      ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN REWRITE_TAC[dist]] THEN
    SUBGOAL_THEN `norm(z pow n) = norm(v pow n)` MP_TAC THENL
     [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]] THEN
    DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
     (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN
    ASM_SIMP_TAC[LE_1; NORM_POS_LE] THEN ASM_MESON_TAC[];
    X_GEN_TAC `w:complex` THEN DISCH_TAC THEN
    SUBGOAL_THEN `IMAGE (\w. w pow n) (ball(z,d)) =
                  IMAGE (\w. w pow n) (ball(w,d))`
    SUBST1_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
    MATCH_MP_TAC INVARIANCE_OF_DOMAIN_HOMEOMORPHISM THEN
    SIMP_TAC[LE_REFL; OPEN_BALL; CONTINUOUS_ON_COMPLEX_POW;
             CONTINUOUS_ON_ID] THEN
    ASM_MESON_TAC[]]);;

let COVERING_SPACE_SQUARE_PUNCTURED_PLANE = prove
 (`covering_space ((:complex) DIFF {Cx(&0)},(\z. z pow 2))
                  ((:complex) DIFF {Cx (&0)})`,
  SIMP_TAC[COVERING_SPACE_POW_PUNCTURED_PLANE; ARITH]);;

let COVERING_SPACE_CEXP_PUNCTURED_PLANE = prove
 (`covering_space((:complex),cexp) ((:complex) DIFF {Cx(&0)})`,
  SIMP_TAC[covering_space; IN_UNIV; CONTINUOUS_ON_CEXP; IN_DIFF; IN_SING] THEN
  CONJ_TAC THENL [SET_TAC[CEXP_CLOG; CEXP_NZ]; ALL_TAC] THEN
  SIMP_TAC[OPEN_IN_OPEN_EQ; OPEN_DIFF; OPEN_UNIV; CLOSED_SING] THEN
  SIMP_TAC[SUBSET_UNIV; SET_RULE `s SUBSET UNIV DIFF {a} <=> ~(a IN s)`] THEN
  X_GEN_TAC `z:complex` THEN DISCH_TAC THEN
  EXISTS_TAC `IMAGE cexp (ball(clog z,&1))` THEN
  REWRITE_TAC[SET_RULE `~(z IN IMAGE f s) <=> !x. x IN s ==> ~(f x = z)`] THEN
  REWRITE_TAC[CEXP_NZ] THEN CONJ_TAC THENL
   [REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `clog z` THEN
    ASM_SIMP_TAC[CEXP_CLOG; CENTRE_IN_BALL; REAL_LT_01];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `!x y. x IN cball(clog z,&1) /\ y IN cball(clog z,&1) /\ cexp x = cexp y
          ==> x = y`
  ASSUME_TAC THENL
   [REWRITE_TAC[IN_CBALL] THEN REPEAT STRIP_TAC THEN
    MATCH_MP_TAC COMPLEX_EQ_CEXP THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `norm(x - y:complex)` THEN
    REWRITE_TAC[GSYM IM_SUB; COMPLEX_NORM_GE_RE_IM] THEN
    MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&2` THEN CONJ_TAC THENL
     [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC NORM_ARITH;
      MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC];
    ALL_TAC] THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC INVARIANCE_OF_DOMAIN THEN
    REWRITE_TAC[OPEN_BALL; CONTINUOUS_ON_CEXP] THEN
    ASM_MESON_TAC[SUBSET; BALL_SUBSET_CBALL];
    ALL_TAC] THEN
  MP_TAC(ISPECL [`cball(clog z,&1)`; `cexp`;
                 `IMAGE cexp (cball(clog z,&1))`] HOMEOMORPHISM_COMPACT) THEN
  ASM_REWRITE_TAC[COMPACT_CBALL; CONTINUOUS_ON_CEXP] THEN
  REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE] THEN
  X_GEN_TAC `l:complex->complex` THEN STRIP_TAC THEN
  EXISTS_TAC `{ IMAGE (\x. x + Cx (&2 * n * pi) * ii)
                      (ball(clog z,&1))
                | integer n}` THEN
  SIMP_TAC[FORALL_IN_GSPEC; OPEN_BALL;
           ONCE_REWRITE_RULE[VECTOR_ADD_SYM] OPEN_TRANSLATION] THEN
  REPEAT CONJ_TAC THENL
   [REWRITE_TAC[UNIONS_GSPEC; IN_IMAGE; CEXP_EQ] THEN SET_TAC[];
    REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
    REWRITE_TAC[FORALL_IN_GSPEC] THEN
    X_GEN_TAC `m:real` THEN DISCH_TAC THEN
    X_GEN_TAC `n:real` THEN DISCH_TAC THEN
    ASM_CASES_TAC `m:real = n` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
    REWRITE_TAC[IN_BALL; dist; SET_RULE
     `DISJOINT (IMAGE f s) (IMAGE g s) <=>
      !x y. x IN s /\ y IN s ==> ~(f x = g y)`] THEN
    REPEAT GEN_TAC THEN MATCH_MP_TAC(NORM_ARITH
     `&2 <= norm(m - n)
      ==> norm(c - x) < &1 /\ norm(c - y) < &1 ==> ~(x + m = y + n)`) THEN
    REWRITE_TAC[GSYM COMPLEX_SUB_RDISTRIB; COMPLEX_NORM_MUL] THEN
    REWRITE_TAC[COMPLEX_NORM_II; GSYM CX_SUB; COMPLEX_NORM_CX] THEN
    REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN
    REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM; REAL_ABS_PI; REAL_MUL_RID] THEN
    MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 * &1 * pi` THEN
    CONJ_TAC THENL [MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; ALL_TAC] THEN
    MATCH_MP_TAC REAL_LE_LMUL THEN
    SIMP_TAC[REAL_LE_RMUL_EQ; PI_POS; REAL_POS] THEN
    MATCH_MP_TAC REAL_ABS_INTEGER_LEMMA THEN
    ASM_SIMP_TAC[REAL_SUB_0; INTEGER_CLOSED];
    X_GEN_TAC `n:real` THEN DISCH_TAC THEN
    EXISTS_TAC `(\x. x + Cx(&2 * n * pi) * ii) o (l:complex->complex)` THEN
    ASM_REWRITE_TAC[CONTINUOUS_ON_CEXP; o_THM; IMAGE_o; FORALL_IN_IMAGE] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[INJECTIVE_ON_ALT]) THEN
    ASM_SIMP_TAC[CEXP_ADD; CEXP_INTEGER_2PI; COMPLEX_MUL_RID;
                 REWRITE_RULE[SUBSET] BALL_SUBSET_CBALL] THEN
    REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC(SET_RULE
       `(!x. e(f x) = e x) ==> IMAGE e (IMAGE f s) = IMAGE e s`) THEN
      ASM_SIMP_TAC[CEXP_ADD; CEXP_INTEGER_2PI; COMPLEX_MUL_RID];
      MATCH_MP_TAC(SET_RULE
       `(!x. x IN s ==> l(e x) = x)
        ==> IMAGE t (IMAGE l (IMAGE e s)) = IMAGE t s`) THEN
      ASM_SIMP_TAC[REWRITE_RULE[SUBSET] BALL_SUBSET_CBALL];
      MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
      SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID;
               CONTINUOUS_ON_CONST] THEN
      ASM_MESON_TAC[BALL_SUBSET_CBALL; IMAGE_SUBSET;
                    CONTINUOUS_ON_SUBSET]]]);;

(* ------------------------------------------------------------------------- *)
(* Hence the Borsukian results about mappings into circle.                   *)
(* ------------------------------------------------------------------------- *)

let INESSENTIAL_EQ_CONTINUOUS_LOGARITHM = prove
 (`!f:real^N->complex s.
      (?a. homotopic_with (\h. T) (s,(:complex) DIFF {Cx(&0)}) f (\t. a)) <=>
      (?g. g continuous_on s /\ (!x. x IN s ==> f x = cexp(g x)))`,
  REPEAT GEN_TAC THEN EQ_TAC THENL
   [DISCH_THEN(CHOOSE_THEN
     (MP_TAC o CONJ COVERING_SPACE_CEXP_PUNCTURED_PLANE)) THEN
    DISCH_THEN(MP_TAC o MATCH_MP COVERING_SPACE_LIFT_INESSENTIAL_FUNCTION) THEN
    REWRITE_TAC[SUBSET_UNIV] THEN MESON_TAC[];
    DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN
    SUBGOAL_THEN
     `?a. homotopic_with (\h. T) (s,(:complex) DIFF {Cx(&0)})
              (cexp o g) (\x:real^N. a)`
    MP_TAC THENL
     [MATCH_MP_TAC NULLHOMOTOPIC_THROUGH_CONTRACTIBLE THEN
      EXISTS_TAC `(:complex)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN
      ASM_SIMP_TAC[STARLIKE_IMP_CONTRACTIBLE; STARLIKE_UNIV] THEN
      REWRITE_TAC[CONTINUOUS_ON_CEXP; SUBSET; FORALL_IN_IMAGE] THEN
      REWRITE_TAC[IN_UNIV; IN_DIFF; IN_SING; CEXP_NZ];
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:complex` THEN
      MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN
      ASM_SIMP_TAC[o_THM]]]);;

let INESSENTIAL_IMP_CONTINUOUS_LOGARITHM_CIRCLE = prove
 (`!f:real^N->complex s.
        (?a. homotopic_with (\h. T) (s,sphere(vec 0,&1)) f (\t. a))
        ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = cexp(g x)`,
  REPEAT GEN_TAC THEN
  SIMP_TAC[sphere; GSYM INESSENTIAL_EQ_CONTINUOUS_LOGARITHM] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:complex` THEN
  REWRITE_TAC[homotopic_with] THEN MATCH_MP_TAC MONO_EXISTS THEN
  REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
    (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN
  SIMP_TAC[SUBSET; DIST_0; FORALL_IN_GSPEC; IN_UNIV; IN_DIFF; IN_SING] THEN
  ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
  SIMP_TAC[COMPLEX_NORM_CX] THEN REAL_ARITH_TAC);;

let INESSENTIAL_EQ_CONTINUOUS_LOGARITHM_CIRCLE = prove
 (`!f:real^N->complex s.
        (?a. homotopic_with (\h. T) (s,sphere(vec 0,&1)) f (\t. a)) <=>
        (?g. (Cx o g) continuous_on s /\
             !x. x IN s ==> f x = cexp(ii * Cx(g x)))`,
  REPEAT GEN_TAC THEN EQ_TAC THENL
   [DISCH_TAC THEN FIRST_ASSUM(MP_TAC o
      MATCH_MP INESSENTIAL_IMP_CONTINUOUS_LOGARITHM_CIRCLE) THEN
    DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `Im o (g:real^N->complex)` THEN CONJ_TAC THENL
     [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
      ASM_REWRITE_TAC[CONTINUOUS_ON_CX_IM];
      FIRST_X_ASSUM(CHOOSE_THEN (MP_TAC o CONJUNCT1 o
        MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET)) THEN
      ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; NORM_CEXP] THEN
      REWRITE_TAC[EULER; o_THM; RE_MUL_II; IM_MUL_II] THEN
      SIMP_TAC[RE_CX; IM_CX; REAL_NEG_0; REAL_EXP_0]];
    DISCH_THEN(X_CHOOSE_THEN `g:real^N->real` STRIP_ASSUME_TAC) THEN
    SUBGOAL_THEN
     `?a. homotopic_with (\h. T) (s,sphere(vec 0,&1))
              ((cexp o (\z. ii * z)) o (Cx o g)) (\x:real^N. a)`
    MP_TAC THENL
     [MATCH_MP_TAC NULLHOMOTOPIC_THROUGH_CONTRACTIBLE THEN
      EXISTS_TAC `{z | Im z = &0}` THEN ASM_REWRITE_TAC[] THEN
      ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; CONTINUOUS_ON_CEXP; CONJ_ASSOC;
                   CONTINUOUS_ON_COMPLEX_LMUL; CONTINUOUS_ON_ID] THEN
      CONJ_TAC THENL
       [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_SPHERE_0;
                    o_THM; IM_CX] THEN
        SIMP_TAC[NORM_CEXP; RE_MUL_II; REAL_EXP_0; REAL_NEG_0];
        MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN
        MATCH_MP_TAC CONVEX_IMP_STARLIKE THEN CONJ_TAC THENL
         [REWRITE_TAC[IM_DEF; CONVEX_STANDARD_HYPERPLANE];
          REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN
          MESON_TAC[IM_CX]]];
      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:complex` THEN
      MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN
      ASM_SIMP_TAC[o_THM]]]);;

let HOMOTOPIC_CIRCLEMAPS_DIV,HOMOTOPIC_CIRCLEMAPS_DIV_1 = (CONJ_PAIR o prove)
 (`(!f g:real^N->real^2 s.
    homotopic_with (\x. T) (s,sphere(vec 0,&1)) f g <=>
    f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0,&1) /\
    g continuous_on s /\ IMAGE g s SUBSET sphere(vec 0,&1) /\
    ?c. homotopic_with (\x. T) (s,sphere(vec 0,&1)) (\x. f x / g x) (\x. c)) /\
   (!f g:real^N->real^2 s.
    homotopic_with (\x. T) (s,sphere(vec 0,&1)) f g <=>
    f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0,&1) /\
    g continuous_on s /\ IMAGE g s SUBSET sphere(vec 0,&1) /\
    homotopic_with (\x. T) (s,sphere(vec 0,&1)) (\x. f x / g x) (\x. Cx(&1)))`,
  let lemma = prove
   (`!f g h:real^N->real^2 s.
          homotopic_with (\x. T) (s,sphere(vec 0,&1)) f g
          ==> h continuous_on s /\ (!x. x IN s ==> h(x) IN sphere(vec 0,&1))
               ==> homotopic_with (\x. T) (s,sphere(vec 0,&1))
                                          (\x. f x * h x) (\x. g x * h x)`,
    REWRITE_TAC[IN_SPHERE_0] THEN REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN
    ASM_SIMP_TAC[HOMOTOPIC_WITH; LEFT_IMP_EXISTS_THM] THEN
    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; FORALL_IN_PCROSS] THEN
    X_GEN_TAC `k:real^((1,N)finite_sum)->real^2` THEN STRIP_TAC THEN
    EXISTS_TAC `\z. (k:real^(1,N)finite_sum->real^2) z * h(sndcart z)` THEN
    ASM_SIMP_TAC[COMPLEX_NORM_MUL; SNDCART_PASTECART; REAL_MUL_LID] THEN
    ASM_REWRITE_TAC[SNDCART_PASTECART] THEN
    MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN
    ASM_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; IMAGE_SNDCART_PCROSS] THEN
    ASM_REWRITE_TAC[UNIT_INTERVAL_NONEMPTY]) in
  REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC
   (TAUT `(q <=> r) /\ (p <=> r) ==> (p <=> q) /\ (p <=> r)`) THEN
  CONJ_TAC THENL
   [REPEAT(MATCH_MP_TAC(TAUT `(p ==> (q <=> r)) ==> (p /\ q <=> p /\ r)`) THEN
           DISCH_TAC) THEN
    EQ_TAC THENL
     [ALL_TAC; DISCH_TAC THEN EXISTS_TAC `Cx(&1)` THEN ASM_MESON_TAC[]] THEN
    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:complex` THEN
    DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET th) THEN
        MP_TAC th) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN
    REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN
    ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN
    MP_TAC(ISPECL [`vec 0:real^2`; `&1`] PATH_CONNECTED_SPHERE) THEN
    REWRITE_TAC[DIMINDEX_2; LE_REFL; PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
    DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL
     [ASM SET_TAC[]; REWRITE_TAC[IN_SPHERE_0; COMPLEX_NORM_CX; REAL_ABS_NUM]];
    EQ_TAC THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP lemma) THENL
     [FIRST_ASSUM(STRIP_ASSUME_TAC o
         MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN
      FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
      DISCH_THEN(MP_TAC o SPEC `\x. inv((g:real^N->complex) x)`);
      DISCH_THEN(MP_TAC o SPEC `g:real^N->complex`)] THEN
    RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0]) THEN
    ASM_SIMP_TAC[IN_SPHERE_0; COMPLEX_NORM_INV; REAL_INV_1] THEN
    ASM_SIMP_TAC[GSYM COMPLEX_NORM_ZERO; REAL_OF_NUM_EQ; ARITH_EQ;
                 CONTINUOUS_ON_COMPLEX_INV] THEN
    ASM_REWRITE_TAC[SUBSET; IN_SPHERE_0; FORALL_IN_IMAGE] THEN
    MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT]
     HOMOTOPIC_WITH_EQ) THEN
    ASM_SIMP_TAC[COMPLEX_DIV_RMUL; COMPLEX_MUL_LID; COMPLEX_MUL_RINV;
                 GSYM complex_div; COMPLEX_DIV_REFL;
                 GSYM COMPLEX_NORM_ZERO; REAL_OF_NUM_EQ; ARITH_EQ]]);;

(* ------------------------------------------------------------------------- *)
(* In particular, complex logs exist on various "well-behaved" sets.         *)
(* ------------------------------------------------------------------------- *)

let CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE = prove
 (`!f:real^N->complex s.
        f continuous_on s /\ contractible s /\
        (!x. x IN s ==> ~(f x = Cx(&0)))
        ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = cexp(g x)`,
  REPEAT STRIP_TAC THEN
  REWRITE_TAC[GSYM INESSENTIAL_EQ_CONTINUOUS_LOGARITHM] THEN
  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NULLHOMOTOPIC_FROM_CONTRACTIBLE THEN
  ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);;

let CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED = prove
 (`!f:real^N->complex s.
        f continuous_on s /\ simply_connected s /\ locally path_connected s /\
        (!x. x IN s ==> ~(f x = Cx(&0)))
        ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = cexp(g x)`,
  REPEAT STRIP_TAC THEN MP_TAC
  (ISPECL [`f:real^N->complex`; `s:real^N->bool`]
    (MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT)
        COVERING_SPACE_CEXP_PUNCTURED_PLANE)) THEN
  ASM_REWRITE_TAC[IN_UNIV] THEN ASM SET_TAC[]);;

let CONTINUOUS_LOGARITHM_ON_CBALL = prove
 (`!f:real^N->complex a r.
        f continuous_on cball(a,r) /\
        (!z. z IN cball(a,r) ==> ~(f z = Cx(&0)))
        ==> ?h. h continuous_on cball(a,r) /\
                !z. z IN cball(a,r) ==> f z = cexp(h z)`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `cball(a:real^N,r) = {}` THEN
  ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY; NOT_IN_EMPTY] THEN
  MATCH_MP_TAC CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE THEN
  ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN
  MATCH_MP_TAC CONVEX_IMP_STARLIKE THEN
  ASM_REWRITE_TAC[CONVEX_CBALL]);;

let CONTINUOUS_LOGARITHM_ON_BALL = prove
 (`!f:real^N->complex a r.
        f continuous_on ball(a,r) /\
        (!x. x IN ball(a,r) ==> ~(f x = Cx(&0)))
        ==> ?h. h continuous_on ball(a,r) /\
                !x. x IN ball(a,r) ==> f x = cexp(h x)`,
  REPEAT STRIP_TAC THEN
  ASM_CASES_TAC `ball(a:real^N,r) = {}` THEN
  ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY; NOT_IN_EMPTY] THEN
  MATCH_MP_TAC CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE THEN
  ASM_REWRITE_TAC[] THEN
  MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN
  MATCH_MP_TAC CONVEX_IMP_STARLIKE THEN
  ASM_REWRITE_TAC[CONVEX_BALL]);;

let CONTINUOUS_SQRT_ON_CONTRACTIBLE = prove
 (`!f:real^N->complex s.
        f continuous_on s /\ contractible s /\
        (!x. x IN s ==> ~(f x = Cx(&0)))
        ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = (g x) pow 2`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE) THEN
  DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `\z:real^N. cexp(g z / Cx(&2))` THEN
  ASM_SIMP_TAC[GSYM CEXP_N; COMPLEX_RING `Cx(&2) * z / Cx(&2) = z`] THEN
  GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
  MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
  REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN
  MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN
  ASM_SIMP_TAC[CONTINUOUS_ON_CONST] THEN
  CONV_TAC COMPLEX_RING);;

let CONTINUOUS_SQRT_ON_SIMPLY_CONNECTED = prove
 (`!f:real^N->complex s.
        f continuous_on s /\ simply_connected s /\ locally path_connected s /\
        (!x. x IN s ==> ~(f x = Cx(&0)))
        ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = (g x) pow 2`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED) THEN
  DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `\z:real^N. cexp(g z / Cx(&2))` THEN
  ASM_SIMP_TAC[GSYM CEXP_N; COMPLEX_RING `Cx(&2) * z / Cx(&2) = z`] THEN
  GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
  MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
  REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN
  MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN
  ASM_SIMP_TAC[CONTINUOUS_ON_CONST] THEN
  CONV_TAC COMPLEX_RING);;

(* ------------------------------------------------------------------------- *)
(* Analogously, holomorphic logarithms and square roots.                     *)
(* ------------------------------------------------------------------------- *)

let CONTRACTIBLE_IMP_HOLOMORPHIC_LOG,SIMPLY_CONNECTED_IMP_HOLOMORPHIC_LOG =
 (CONJ_PAIR o prove)
 (`(!s:complex->bool.
      contractible s
      ==> !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0)))
              ==> ?g. g holomorphic_on s /\ !z. z IN s ==> f z = cexp(g z)) /\
   (!s:complex->bool.
      simply_connected s /\ locally path_connected s
      ==> !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0)))
              ==> ?g. g holomorphic_on s /\ !z. z IN s ==> f z = cexp(g z))`,
  REPEAT STRIP_TAC THENL
   [MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`]
        CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE);
    MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`]
        CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED)] THEN
  ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN
 (MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  UNDISCH_TAC `f holomorphic_on s` THEN
  REWRITE_TAC[holomorphic_on] THEN MATCH_MP_TAC MONO_FORALL THEN
  X_GEN_TAC `z:complex` THEN ASM_CASES_TAC `(z:complex) IN s` THEN
  ASM_REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN] THEN
  DISCH_THEN(X_CHOOSE_THEN `f':complex` MP_TAC) THEN
  DISCH_THEN(MP_TAC o
   ISPECL [`\x. (cexp(g x) - cexp(g z)) / (x - z)`; `&1`] o
   MATCH_MP (REWRITE_RULE [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`]
    LIM_TRANSFORM_WITHIN)) THEN
  ASM_SIMP_TAC[REAL_LT_01] THEN
  DISCH_THEN(MP_TAC o
    SPECL [`\x:complex. if g x = g z then cexp(g z)
                        else (cexp(g x) - cexp(g z)) / (g x - g z)`;
           `cexp(g(z:complex))`] o
    MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_COMPLEX_DIV)) THEN
  REWRITE_TAC[CEXP_NZ] THEN ANTS_TAC THENL
   [SUBGOAL_THEN
     `(\x. if g x = g z then cexp(g z)
           else (cexp(g x) - cexp(g(z:complex))) / (g x - g z)) =
      (\y. if y = g z then cexp(g z) else (cexp y - cexp(g z)) / (y - g z)) o g`
    SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN
    MATCH_MP_TAC LIM_COMPOSE_AT THEN
    EXISTS_TAC `(g:complex->complex) z` THEN REPEAT CONJ_TAC THENL
     [ASM_MESON_TAC[CONTINUOUS_ON];
      REWRITE_TAC[EVENTUALLY_TRUE];
      ONCE_REWRITE_TAC[LIM_AT_ZERO] THEN
      SIMP_TAC[COMPLEX_VEC_0; COMPLEX_ADD_SUB; COMPLEX_EQ_ADD_LCANCEL_0] THEN
      MP_TAC(SPEC `cexp(g(z:complex))` (MATCH_MP LIM_COMPLEX_LMUL
       LIM_CEXP_MINUS_1)) THEN REWRITE_TAC[COMPLEX_MUL_RID] THEN
      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN
      SIMP_TAC[EVENTUALLY_AT; GSYM DIST_NZ; CEXP_ADD] THEN
      EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN
      SIMPLE_COMPLEX_ARITH_TAC];
    DISCH_THEN(fun th ->
        EXISTS_TAC `f' / cexp(g(z:complex))` THEN MP_TAC th) THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ]
        LIM_TRANSFORM_EVENTUALLY) THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
     [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN
    DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[CONTINUOUS_WITHIN; tendsto] THEN
    DISCH_THEN(MP_TAC o SPEC `&2 * pi`) THEN
    REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
    X_GEN_TAC `w:complex` THEN REWRITE_TAC[dist] THEN DISCH_TAC THEN
    COND_CASES_TAC THENL
     [ASM_REWRITE_TAC[COMPLEX_SUB_REFL; complex_div; COMPLEX_MUL_LZERO];
      ASM_CASES_TAC `w:complex = z` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
      SUBGOAL_THEN `~(cexp(g(w:complex)) = cexp(g z))` MP_TAC THENL
       [UNDISCH_TAC `~((g:complex->complex) w = g z)` THEN
        REWRITE_TAC[CONTRAPOS_THM] THEN
        MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] COMPLEX_EQ_CEXP) THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
         REAL_LET_TRANS)) THEN
        REWRITE_TAC[GSYM IM_SUB; COMPLEX_NORM_GE_RE_IM];
        REPEAT(FIRST_X_ASSUM(MP_TAC o check(is_neg o concl))) THEN
        CONV_TAC COMPLEX_FIELD]]]));;

let CONTRACTIBLE_IMP_HOLOMORPHIC_SQRT,SIMPLY_CONNECTED_IMP_HOLOMORPHIC_SQRT =
 (CONJ_PAIR o prove)
 (`(!s:complex->bool.
      contractible s
      ==> !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0)))
              ==> ?g. g holomorphic_on s /\  !z. z IN s ==> f z = g z pow 2) /\
   (!s:complex->bool.
      simply_connected s /\ locally path_connected s
      ==> !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0)))
              ==> ?g. g holomorphic_on s /\  !z. z IN s ==> f z = g z pow 2)`,
  CONJ_TAC THEN GEN_TAC THENL
   [DISCH_THEN(ASSUME_TAC o MATCH_MP CONTRACTIBLE_IMP_HOLOMORPHIC_LOG);
    DISCH_THEN(ASSUME_TAC o
      MATCH_MP SIMPLY_CONNECTED_IMP_HOLOMORPHIC_LOG)] THEN
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o SPEC `f:complex->complex`) THEN ASM_SIMP_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN
  EXISTS_TAC `\z:complex. cexp(g z / Cx(&2))` THEN
  ASM_SIMP_TAC[GSYM CEXP_N; COMPLEX_RING `Cx(&2) * z / Cx(&2) = z`] THEN
  GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
  MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN
  REWRITE_TAC[HOLOMORPHIC_ON_CEXP] THEN
  MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN
  ASM_SIMP_TAC[HOLOMORPHIC_ON_CONST] THEN
  CONV_TAC COMPLEX_RING);;

(* ------------------------------------------------------------------------- *)
(* Related theorems about holomorphic inverse cosines.                       *)
(* ------------------------------------------------------------------------- *)

let CONTRACTIBLE_IMP_HOLOMORPHIC_ACS = prove
 (`!f s. f holomorphic_on s /\ contractible s /\
         (!z. z IN s ==> ~(f z = Cx(&1)) /\ ~(f z = --Cx(&1)))
         ==> ?g. g holomorphic_on s /\ !z. z IN s ==> f z = ccos(g z)`,
   REPEAT STRIP_TAC THEN
   FIRST_ASSUM(MP_TAC o SPEC `\z:complex. Cx(&1) - f(z) pow 2` o
     MATCH_MP CONTRACTIBLE_IMP_HOLOMORPHIC_SQRT) THEN
   ASM_SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_POW;
                COMPLEX_RING `~(Cx(&1) - z pow 2 = Cx(&0)) <=>
                              ~(z = Cx(&1)) /\ ~(z = --Cx(&1))`] THEN
   REWRITE_TAC[COMPLEX_RING
    `Cx(&1) - w pow 2 = z pow 2 <=>
     (w + ii * z) * (w - ii * z) = Cx(&1)`] THEN
   DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN
   FIRST_ASSUM(MP_TAC o SPEC `\z:complex. f(z) + ii * g(z)` o
       MATCH_MP CONTRACTIBLE_IMP_HOLOMORPHIC_LOG) THEN
   ASM_SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_CONST;
     COMPLEX_RING `(a + b) * (a - b) = Cx(&1) ==> ~(a + b = Cx(&0))`] THEN
   DISCH_THEN(X_CHOOSE_THEN `h:complex->complex` STRIP_ASSUME_TAC) THEN
   EXISTS_TAC `\z:complex. --ii * h(z)` THEN
   ASM_SIMP_TAC[HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_CONST; ccos] THEN
   X_GEN_TAC `z:complex` THEN
   DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`)) THEN
   ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
   FIRST_X_ASSUM(MP_TAC o MATCH_MP (COMPLEX_FIELD
    `a * b = Cx(&1) ==> b = inv a`)) THEN
   ASM_SIMP_TAC[GSYM CEXP_NEG] THEN
   FIRST_X_ASSUM(ASSUME_TAC o SYM) THEN DISCH_THEN(ASSUME_TAC o SYM) THEN
   ASM_REWRITE_TAC[COMPLEX_RING `ii * --ii * z = z`;
                   COMPLEX_RING `--ii * --ii * z = --z`] THEN
   CONV_TAC COMPLEX_RING);;

let CONTRACTIBLE_IMP_HOLOMORPHIC_ACS_BOUNDED = prove
 (`!f s a.
        f holomorphic_on s /\ contractible s /\ a IN s /\
        (!z. z IN s ==> ~(f z = Cx(&1)) /\ ~(f z = --Cx(&1)))
        ==> ?g. g holomorphic_on s /\ norm(g a) <= pi + norm(f a) /\
                !z. z IN s ==> f z = ccos(g z)`,
  let lemma = prove
    (`!w. ?v. ccos(v) = w /\ norm(v) <= pi + norm(w)`,
     GEN_TAC THEN EXISTS_TAC `cacs w` THEN ABBREV_TAC `v = cacs w` THEN
     MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
      [ASM_MESON_TAC[CCOS_CACS]; DISCH_THEN(SUBST1_TAC o SYM)] THEN
     SIMP_TAC[NORM_LE_SQUARE; PI_POS_LE; NORM_POS_LE; REAL_LE_ADD] THEN
     MATCH_MP_TAC(REAL_ARITH
      `&0 <= b * c /\ a <= b pow 2 + c pow 2 ==> a <= (b + c) pow 2`) THEN
     SIMP_TAC[REAL_LE_MUL; PI_POS_LE; NORM_POS_LE] THEN
     REWRITE_TAC[COMPLEX_SQNORM; GSYM NORM_POW_2; NORM_CCOS_POW_2] THEN
     MATCH_MP_TAC REAL_LE_ADD2 THEN REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN
     EXPAND_TAC "v" THEN REWRITE_TAC[REAL_ABS_PI; RE_CACS_BOUND] THEN
     MATCH_MP_TAC(REAL_ARITH
      `&0 <= c /\ x <= (d / &2) pow 2 ==> x <= c + d pow 2 / &4`) THEN
     REWRITE_TAC[REAL_LE_POW_2; GSYM REAL_LE_SQUARE_ABS; REAL_LE_ABS_SINH]) in
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`]
        CONTRACTIBLE_IMP_HOLOMORPHIC_ACS) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN
  MP_TAC(SPEC `(f:complex->complex) a` lemma) THEN
  DISCH_THEN(X_CHOOSE_THEN `b:complex` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN `ccos b = ccos(g(a:complex))` MP_TAC THENL
   [ASM_MESON_TAC[]; REWRITE_TAC[CCOS_EQ]] THEN
  DISCH_THEN(X_CHOOSE_THEN `n:real` (STRIP_ASSUME_TAC o GSYM)) THENL
   [EXISTS_TAC `\z:complex. g z + Cx(&2 * n * pi)`;
    EXISTS_TAC `\z:complex. --(g z) + Cx(&2 * n * pi)`] THEN
  ASM_SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_NEG;
               HOLOMORPHIC_ON_CONST] THEN
  CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[CCOS_EQ] THEN
  ASM_MESON_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Extension property for inessential maps. This almost follows from         *)
(* INESSENTIAL_NEIGHBOURHOOD_EXTENSION except that here we don't need to     *)
(* assume that t is closed in s.                                             *)
(* ------------------------------------------------------------------------- *)

let INESSENTIAL_NEIGHBOURHOOD_EXTENSION_LOGARITHM = prove
 (`!f:real^N->complex s t.
        f continuous_on s /\ t SUBSET s /\
        (?g. g continuous_on t /\ !x. x IN t ==> f x = cexp(g x))
        ==> ?u. t SUBSET u /\ open_in (subtopology euclidean s) u /\
                (?g. g continuous_on u /\ !x. x IN u ==> f x = cexp(g x))`,
  REPEAT GEN_TAC THEN
  REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  DISCH_THEN(X_CHOOSE_THEN `h:real^N->complex` (STRIP_ASSUME_TAC o GSYM)) THEN
  SUBGOAL_THEN
   `!x. x IN t
        ==> ?d. &0 < d /\
                (!y. y IN s /\ dist(x,y) < d
                     ==> norm(f y / f x - Cx(&1)) < &1 / &7) /\
                (!z:real^N. z IN t /\ dist(x,z) < &2 * d
                            ==> norm(h z - h x) < &1 / &5)`
  MP_TAC THENL
   [REPEAT STRIP_TAC THEN
    UNDISCH_TAC `(h:real^N->complex) continuous_on t` THEN
    GEN_REWRITE_TAC LAND_CONV [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
    DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
    ASM_REWRITE_TAC[continuous_within] THEN
    DISCH_THEN(MP_TAC o SPEC `&1 / &5`) THEN
    CONV_TAC REAL_RAT_REDUCE_CONV THEN
    GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [dist] THEN
    DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
    SUBGOAL_THEN `~((f:real^N->complex) x = Cx(&0))` ASSUME_TAC THENL
     [ASM_MESON_TAC[CEXP_NZ]; ALL_TAC] THEN
    SUBGOAL_THEN
     `(\y:real^N. f y / f x) continuous (at x within s)`
    MP_TAC THENL
     [REWRITE_TAC[complex_div] THEN MATCH_MP_TAC CONTINUOUS_COMPLEX_MUL THEN
      REWRITE_TAC[CONTINUOUS_CONST] THEN
      ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; SUBSET];
      REWRITE_TAC[continuous_within] THEN
      DISCH_THEN(MP_TAC o SPEC `&1 / &7`) THEN
      CONV_TAC REAL_RAT_REDUCE_CONV THEN
      ASM_SIMP_TAC[COMPLEX_DIV_REFL; dist] THEN
      DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC)] THEN
    EXISTS_TAC `min d (e / &2)` THEN
    ASM_REWRITE_TAC[REAL_LT_MIN; REAL_HALF] THEN CONJ_TAC THENL
     [ASM_MESON_TAC[NORM_SUB];
      REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
      ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_REWRITE_TAC[] THEN
      ASM_REAL_ARITH_TAC];
    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 `d:real^N->real` THEN DISCH_THEN(LABEL_TAC "*")] THEN
  ABBREV_TAC `u = \x. s INTER ball(x:real^N,d x)` THEN
  ABBREV_TAC `g = \x y. h(x:real^N) + clog(f y / f x)` THEN
  SUBGOAL_THEN
   `(!x:real^N. x IN t ==> x IN u x) /\
    (!x. x IN t ==> open_in (subtopology euclidean s) (u x))`
  STRIP_ASSUME_TAC THENL
   [EXPAND_TAC "u" THEN
    ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL; OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
    ASM SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN `!x:real^N y:real^N. x IN t /\ y IN u x ==> cexp(g x y) = f y`
  ASSUME_TAC THENL
   [REPEAT STRIP_TAC THEN
    EXPAND_TAC "g" THEN REWRITE_TAC[CEXP_ADD] THEN ASM_SIMP_TAC[] THEN
    REMOVE_THEN "*" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(MP_TAC o SPEC `y:real^N` o el 1 o CONJUNCTS) THEN
    MP_TAC(ASSUME `y IN (u:real^N->real^N->bool) x`) THEN
    EXPAND_TAC "u" THEN REWRITE_TAC[IN_INTER; IN_BALL] THEN
    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
    DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH
     `norm(x - y) < &1 / &7 ==> norm(y) = &1 ==> ~(x = vec 0)`)) THEN
    SIMP_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM; CEXP_CLOG; COMPLEX_VEC_0] THEN
    SIMP_TAC[COMPLEX_DIV_LMUL; COMPLEX_DIV_EQ_0; DE_MORGAN_THM];
    ALL_TAC] THEN
  MP_TAC(ISPECL
   [`g:real^N->real^N->complex`;
    `u:real^N->real^N->bool`;
    `UNIONS {(u:real^N->real^N->bool) x | x IN t}`;
    `t:real^N->bool`]
    PASTING_LEMMA_EXISTS) THEN
  REWRITE_TAC[SUBSET_REFL] THEN ANTS_TAC THENL
   [CONJ_TAC THENL
     [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN CONJ_TAC THENL
       [MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN
        ASM_SIMP_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
        REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN
        ASM_MESON_TAC[OPEN_IN_IMP_SUBSET];
        EXPAND_TAC "g" THEN REWRITE_TAC[] THEN
        MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
        REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
        GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
        MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
         [REWRITE_TAC[complex_div] THEN
          MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_RMUL THEN
          ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET];
          MATCH_MP_TAC CONTINUOUS_ON_CLOG THEN
          REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; IN_INTER] THEN
          X_GEN_TAC `y:real^N` THEN REPEAT STRIP_TAC THEN
          ONCE_REWRITE_TAC[COMPLEX_RING `z = (z - Cx(&1)) + Cx(&1)`] THEN
          REWRITE_TAC[RE_ADD; RE_CX] THEN MATCH_MP_TAC(REAL_ARITH
           `abs x < &1 ==> &0 < x + &1`) THEN
          MATCH_MP_TAC(MESON[COMPLEX_NORM_GE_RE_IM; REAL_LET_TRANS]
           `norm z < &1 ==> abs(Re z) < &1`) THEN
          MATCH_MP_TAC(REAL_ARITH `x < &1 / &7 ==> x < &1`) THEN
          REMOVE_THEN "*" (MP_TAC o SPEC `x:real^N`) THEN ASM_SIMP_TAC[] THEN
          DISCH_THEN(MP_TAC o SPEC `y:real^N` o el 1 o CONJUNCTS) THEN
          MP_TAC(ASSUME `y IN (u:real^N->real^N->bool) x`) THEN
          EXPAND_TAC "u" THEN REWRITE_TAC[IN_INTER; IN_BALL] THEN
          STRIP_TAC THEN ASM_REWRITE_TAC[]]];
      MAP_EVERY X_GEN_TAC  [`a:real^N`; `b:real^N`; `x:real^N`] THEN
      REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN
      MATCH_MP_TAC COMPLEX_EQ_CEXP THEN
      CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
      EXPAND_TAC "g" THEN REWRITE_TAC[IM_ADD] THEN
      MATCH_MP_TAC(REAL_ARITH
       `&5 < a /\ abs(ha - hb) < &1 / &5 /\ abs(fa) < &2 /\ abs(fb) < &2
        ==> abs((ha + fa) - (hb + fb)) < a`) THEN
      CONJ_TAC THENL [MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; ALL_TAC] THEN
      CONJ_TAC THENL
       [REWRITE_TAC[GSYM IM_SUB] THEN
        MATCH_MP_TAC(MESON[COMPLEX_NORM_GE_RE_IM; REAL_LET_TRANS]
         `norm z < a ==> abs(Im z) < a`) THEN
        MP_TAC(ASSUME `x IN (u:real^N->real^N->bool) b`) THEN
        MP_TAC(ASSUME `x IN (u:real^N->real^N->bool) a`) THEN
        EXPAND_TAC "u" THEN REWRITE_TAC[IMP_IMP; IN_INTER; IN_BALL] THEN
        DISCH_THEN(MP_TAC o MATCH_MP (TAUT
         `(p /\ q) /\ (p /\ r) ==> q /\ r`)) THEN
        DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH
         `dist(a,x) < d /\ dist(b,x) < e
          ==> dist(a,b) < &2 * d \/ dist(a,b) < &2 * e`)) THEN
        STRIP_TAC THENL
         [REMOVE_THEN "*" (MP_TAC o SPEC `a:real^N`);
          REMOVE_THEN "*" (MP_TAC o SPEC `b:real^N`)] THEN
        ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN
        ASM_MESON_TAC[NORM_SUB; DIST_SYM];
        CONJ_TAC THEN TRANS_TAC REAL_LT_TRANS `pi / &2` THEN
        (CONJ_TAC THENL
          [ALL_TAC; MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC]) THEN
        MATCH_MP_TAC RE_CLOG_POS_LT_IMP THEN
        ONCE_REWRITE_TAC[COMPLEX_RING `z = (z - Cx(&1)) + Cx(&1)`] THEN
        REWRITE_TAC[RE_ADD; RE_CX] THEN MATCH_MP_TAC(REAL_ARITH
         `abs x < &1 ==> &0 < x + &1`) THEN
        MATCH_MP_TAC(MESON[COMPLEX_NORM_GE_RE_IM; REAL_LET_TRANS]
         `norm z < &1 ==> abs(Re z) < &1`) THEN
        MATCH_MP_TAC(REAL_ARITH `x < &1 / &7 ==> x < &1`) THENL
         [REMOVE_THEN "*" (MP_TAC o SPEC `a:real^N`);
          REMOVE_THEN "*" (MP_TAC o SPEC `b:real^N`)] THEN
        ASM_REWRITE_TAC[] THEN
        DISCH_THEN(MP_TAC o SPEC `x:real^N` o el 1 o CONJUNCTS) THEN
        DISCH_THEN MATCH_MP_TAC THENL
         [MP_TAC(ASSUME `x IN (u:real^N->real^N->bool) a`);
          MP_TAC(ASSUME `x IN (u:real^N->real^N->bool) b`)] THEN
        EXPAND_TAC "u" THEN REWRITE_TAC[IN_INTER; IN_BALL] THEN
        STRIP_TAC THEN ASM_REWRITE_TAC[]]];
    DISCH_THEN(X_CHOOSE_THEN `h':real^N->complex` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `UNIONS {(u:real^N->real^N->bool) x | x IN t}` THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    ASM_SIMP_TAC[OPEN_IN_UNIONS; FORALL_IN_GSPEC] THEN
    EXISTS_TAC `h':real^N->complex` THEN ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[FORALL_IN_UNIONS; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
    REWRITE_TAC[FORALL_IN_GSPEC] THEN
    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 [`y:real^N`; `x:real^N`]) THEN
    ASM_REWRITE_TAC[] THEN
    ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN
    ASM_MESON_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* The "borsukian" property of sets. This doesn't seem to have a standard    *)
(* name. Kuratowski uses "contractible with respect to [S^1]" while          *)
(* Whyburn uses "property b". It's closely related to unicoherence.          *)
(* ------------------------------------------------------------------------- *)

let borsukian = new_definition
 `borsukian(s:real^N->bool) <=>
        !f. f continuous_on s /\ IMAGE f s SUBSET ((:real^2) DIFF {Cx(&0)})
            ==> ?a. homotopic_with (\h. T) (s,(:real^2) DIFF {Cx(&0)})
                                   f (\x. a)`;;

let BORSUKIAN_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) /\
        borsukian s
        ==> borsukian t`,
  REPEAT GEN_TAC THEN REWRITE_TAC[borsukian] THEN STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o check (is_forall o concl)) THEN
  PURE_ONCE_REWRITE_TAC[TAUT `p /\ q <=> p /\ q /\ T`] THEN
  MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
    COHOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN) THEN
  REWRITE_TAC[] THEN ASM_MESON_TAC[]);;

let RETRACT_OF_BORSUKIAN = prove
 (`!s t:real^N->bool. borsukian t /\ s retract_of t ==> borsukian s`,
  REPEAT GEN_TAC THEN
  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
  MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC]
        BORSUKIAN_RETRACTION_GEN)) THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^N->real^N` THEN
  REWRITE_TAC[RETRACTION] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  EXISTS_TAC `\x:real^N. x` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID]);;

let HOMEOMORPHIC_BORSUKIAN = prove
 (`!s:real^M->bool t:real^N->bool.
        s homeomorphic t /\ borsukian s ==> borsukian t`,
  REWRITE_TAC[homeomorphic; homeomorphism] THEN
  MESON_TAC[BORSUKIAN_RETRACTION_GEN; SUBSET_REFL]);;

let HOMEOMORPHIC_BORSUKIAN_EQ = prove
 (`!s:real^M->bool t:real^N->bool.
     s homeomorphic t ==> (borsukian s <=> borsukian t)`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_BORSUKIAN) THEN
  ASM_MESON_TAC[HOMEOMORPHIC_SYM]);;

let BORSUKIAN_TRANSLATION = prove
 (`!a:real^N s. borsukian (IMAGE (\x. a + x) s) <=> borsukian s`,
  REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_BORSUKIAN_EQ THEN
  REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);;

add_translation_invariants [BORSUKIAN_TRANSLATION];;

let BORSUKIAN_INJECTIVE_LINEAR_IMAGE = prove
 (`!f:real^M->real^N s.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (borsukian(IMAGE f s) <=> borsukian s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_BORSUKIAN_EQ THEN
  ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF;
                HOMEOMORPHIC_REFL]);;

add_linear_invariants [BORSUKIAN_INJECTIVE_LINEAR_IMAGE];;

let HOMOTOPY_EQUIVALENT_BORSUKIANNESS = prove
 (`!s:real^M->bool t:real^N->bool.
        s homotopy_equivalent t
        ==> (borsukian s <=> borsukian t)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[borsukian] THEN
  MATCH_MP_TAC HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL THEN
  ASM_REWRITE_TAC[]);;

let BORSUKIAN_ALT = prove
 (`!s:real^N->bool.
        borsukian s <=>
        !f g:real^N->real^2.
           f continuous_on s /\ IMAGE f s SUBSET ((:real^2) DIFF {Cx(&0)}) /\
           g continuous_on s /\ IMAGE g s SUBSET ((:real^2) DIFF {Cx(&0)})
           ==> homotopic_with (\h. T) (s,(:real^2) DIFF {Cx (&0)}) f g`,
  REWRITE_TAC[borsukian; HOMOTOPIC_TRIVIALITY] THEN
  SIMP_TAC[PATH_CONNECTED_PUNCTURED_UNIVERSE; DIMINDEX_2; LE_REFL]);;

let BORSUKIAN_CONTINUOUS_LOGARITHM = prove
 (`!s:real^N->bool.
        borsukian s <=>
        !f. f continuous_on s /\ IMAGE f s SUBSET ((:real^2) DIFF {Cx(&0)})
            ==> ?g. g continuous_on s /\ (!x. x IN s ==> f(x) = cexp(g x))`,
  REWRITE_TAC[borsukian; INESSENTIAL_EQ_CONTINUOUS_LOGARITHM]);;

let BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE = prove
 (`!s:real^N->bool.
        borsukian s <=>
           !f. f continuous_on s /\ IMAGE f s SUBSET sphere(Cx(&0),&1)
               ==> ?g. g continuous_on s /\ (!x. x IN s ==> f(x) = cexp(g x))`,
  GEN_TAC THEN REWRITE_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM] THEN
  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_SPHERE_0; SET_RULE
   `IMAGE f s SUBSET UNIV DIFF {a} <=> !z. z IN s ==> ~(f z = a)`] THEN
  EQ_TAC THEN DISCH_TAC THEN
  X_GEN_TAC `f:real^N->complex` THEN STRIP_TAC THENL
   [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
    X_GEN_TAC `x:real^N` THEN REPEAT STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
    ASM_REWRITE_TAC[COMPLEX_NORM_0] THEN REAL_ARITH_TAC;
    FIRST_X_ASSUM(MP_TAC o SPEC `\x:real^N. f(x) / Cx(norm(f x))`) THEN
    ASM_SIMP_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NORM;
                 REAL_DIV_REFL; NORM_EQ_0; COMPLEX_NORM_ZERO] THEN
    ANTS_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN
      ASM_REWRITE_TAC[CX_INJ; COMPLEX_NORM_ZERO; CONTINUOUS_ON_CX_LIFT] THEN
      ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_NORM_COMPOSE];
      ASM_SIMP_TAC[CX_INJ; COMPLEX_NORM_ZERO; COMPLEX_FIELD
       `~(z = Cx(&0)) ==> (w / z = u <=> w = z * u)`] THEN
      DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN
      EXISTS_TAC
       `\x. clog(Cx(norm(f x:complex))) + (g:real^N->complex)(x)` THEN
      ASM_SIMP_TAC[CEXP_ADD; CEXP_CLOG; CX_INJ; COMPLEX_NORM_ZERO] THEN
      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
      ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
      MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
      ASM_SIMP_TAC[CONTINUOUS_ON_CX_LIFT; CONTINUOUS_ON_LIFT_NORM_COMPOSE] THEN
      MATCH_MP_TAC CONTINUOUS_ON_CLOG THEN
      ASM_SIMP_TAC[IMP_CONJ; FORALL_IN_IMAGE; RE_CX; COMPLEX_NORM_NZ]]]);;

let BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE_CX = prove
 (`!s:real^N->bool.
        borsukian s <=>
            !f. f continuous_on s /\ IMAGE f s SUBSET sphere(Cx(&0),&1)
            ==> ?g. (Cx o g) continuous_on s /\
                    (!x. x IN s ==> f x = cexp(ii * Cx(g x)))`,
  GEN_TAC THEN REWRITE_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE] THEN
  REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_SPHERE_0] THEN EQ_TAC THEN
  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `f:real^N->complex` THEN
  DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL
   [X_GEN_TAC `g:real^N->complex` THEN STRIP_TAC THEN
    EXISTS_TAC `Im o (g:real^N->complex)` THEN
    ASM_SIMP_TAC[CONTINUOUS_ON_CX_IM; CONTINUOUS_ON_COMPOSE; o_ASSOC] THEN
    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`)) THEN ASM_REWRITE_TAC[] THEN
    ASM_CASES_TAC `(f:real^N->complex) x = cexp(g x)` THEN
    ASM_REWRITE_TAC[NORM_CEXP; o_DEF; REAL_EXP_EQ_1] THEN
    DISCH_TAC THEN AP_TERM_TAC THEN
    ASM_REWRITE_TAC[COMPLEX_EQ; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX] THEN
    REWRITE_TAC[REAL_NEG_0];
    X_GEN_TAC `g:real^N->real` THEN STRIP_TAC THEN
    EXISTS_TAC `\x:real^N. ii * Cx(g x)` THEN
    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN
    ASM_REWRITE_TAC[GSYM o_DEF]]);;

let BORSUKIAN_CIRCLE = prove
 (`!s:real^N->bool.
        borsukian s <=>
            !f. f continuous_on s /\ IMAGE f s SUBSET sphere(Cx(&0),&1)
                ==> ?a. homotopic_with (\h. T) (s,sphere(Cx(&0),&1))
                                               f (\x. a)`,
  REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN
  REWRITE_TAC[INESSENTIAL_EQ_CONTINUOUS_LOGARITHM_CIRCLE] THEN
  REWRITE_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE_CX] THEN
  REWRITE_TAC[COMPLEX_VEC_0]);;

let BORSUKIAN_CIRCLE_ALT = prove
 (`!s:real^N->bool.
        borsukian s <=>
        !f g:real^N->real^2.
           f continuous_on s /\ IMAGE f s SUBSET sphere(Cx(&0),&1) /\
           g continuous_on s /\ IMAGE g s SUBSET sphere(Cx(&0),&1)
           ==> homotopic_with (\h. T) (s,sphere(Cx(&0),&1)) f g`,
  REWRITE_TAC[BORSUKIAN_CIRCLE; HOMOTOPIC_TRIVIALITY] THEN
  SIMP_TAC[PATH_CONNECTED_SPHERE; DIMINDEX_2; LE_REFL]);;

let CONTRACTIBLE_IMP_BORSUKIAN = prove
 (`!s:real^N->bool. contractible s ==> borsukian s`,
  SIMP_TAC[borsukian; CONTRACTIBLE_IMP_PATH_CONNECTED] THEN
  MESON_TAC[NULLHOMOTOPIC_FROM_CONTRACTIBLE]);;

let SIMPLY_CONNECTED_IMP_BORSUKIAN = prove
 (`!s:real^N->bool.
        simply_connected s /\ locally path_connected s ==> borsukian s`,
  SIMP_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM] THEN REPEAT STRIP_TAC THEN
  MATCH_MP_TAC CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED THEN
  ASM SET_TAC[]);;

let STARLIKE_IMP_BORSUKIAN = prove
 (`!s:real^N->bool. starlike s ==> borsukian s`,
  SIMP_TAC[CONTRACTIBLE_IMP_BORSUKIAN; STARLIKE_IMP_CONTRACTIBLE]);;

let BORSUKIAN_EMPTY = prove
 (`borsukian({}:real^N->bool)`,
  SIMP_TAC[CONTRACTIBLE_IMP_BORSUKIAN; CONTRACTIBLE_EMPTY]);;

let BORSUKIAN_UNIV = prove
 (`borsukian(:real^N)`,
  SIMP_TAC[CONTRACTIBLE_IMP_BORSUKIAN; CONTRACTIBLE_UNIV]);;

let CONVEX_IMP_BORSUKIAN = prove
 (`!s:real^N->bool. convex s ==> borsukian s`,
  MESON_TAC[STARLIKE_IMP_BORSUKIAN; CONVEX_IMP_STARLIKE; BORSUKIAN_EMPTY]);;

let BORSUKIAN_SPHERE = prove
 (`!a:real^N r. 3 <= dimindex(:N) ==> borsukian (sphere(a,r))`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC SIMPLY_CONNECTED_IMP_BORSUKIAN THEN
  ASM_SIMP_TAC[SIMPLY_CONNECTED_SPHERE] THEN
  REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN
  ASM_SIMP_TAC[LOCALLY_PATH_CONNECTED_SPHERE; SIMPLY_CONNECTED_SPHERE]);;

let BORSUKIAN_OPEN_UNION = prove
 (`!s t:real^N->bool.
        open_in (subtopology euclidean (s UNION t)) s /\
        open_in (subtopology euclidean (s UNION t)) t /\
        borsukian s /\ borsukian t /\ connected(s INTER t)
        ==> borsukian(s UNION t)`,
  REPEAT GEN_TAC THEN SIMP_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM] THEN
  STRIP_TAC THEN X_GEN_TAC `f:real^N->complex` THEN STRIP_TAC THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `f:real^N->complex`)) THEN
  ANTS_TAC THENL
   [CONJ_TAC THENL
     [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; ASM SET_TAC[]];
    DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC)] THEN
  ANTS_TAC THENL
   [CONJ_TAC THENL
     [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; ASM SET_TAC[]];
    DISCH_THEN(X_CHOOSE_THEN `h:real^N->complex` STRIP_ASSUME_TAC)] THEN
  ASM_CASES_TAC `s INTER t:real^N->bool = {}` THENL
   [EXISTS_TAC `(\x. if x IN s then g x else h x):real^N->complex` THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL_OPEN THEN
    ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  MP_TAC(ISPECL
   [`(\x. g x - h x):real^N->complex`; `s INTER t:real^N->bool`]
   CONTINUOUS_DISCRETE_RANGE_CONSTANT) THEN
  ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
   [CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
      ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET];
      X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN
      EXISTS_TAC `&2 * pi` THEN
      REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN
      X_GEN_TAC `y:real^N` THEN
      DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
      ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN
      ONCE_REWRITE_TAC[COMPLEX_RING
       `a - b:complex = c - d <=> a - c = b - d`] THEN
      DISCH_TAC THEN MATCH_MP_TAC COMPLEX_EQ_CEXP THEN
      REWRITE_TAC[CEXP_SUB] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
       REAL_LET_TRANS)) THEN
      GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [COMPLEX_RING
       `(a - b) - (c - d):complex = (a - c) - (b - d)`] THEN
      REWRITE_TAC[GSYM IM_SUB; COMPLEX_NORM_GE_RE_IM]];

    REWRITE_TAC[IN_INTER; COMPLEX_EQ_SUB_RADD] THEN
    DISCH_THEN(X_CHOOSE_TAC `a:complex`) THEN
    EXISTS_TAC `(\x. if x IN s then g x else a + h x):real^N->complex` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL_OPEN THEN
      ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST] THEN
      ASM SET_TAC[];
      GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[] THEN
      COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
       [ASM_MESON_TAC[]; REWRITE_TAC[CEXP_ADD]] THEN
      SUBGOAL_THEN `?y:real^N. y IN s /\ y IN t` STRIP_ASSUME_TAC THENL
       [ASM SET_TAC[]; ALL_TAC] THEN
      SUBGOAL_THEN `cexp(a + h(y:real^N)) = cexp(h y)` MP_TAC THENL
       [ASM_MESON_TAC[]; REWRITE_TAC[CEXP_ADD]] THEN
      SIMP_TAC[COMPLEX_RING `a * z = z <=> a = Cx(&1) \/ z = Cx(&0)`;
               CEXP_NZ; COMPLEX_MUL_LID] THEN
      ASM SET_TAC[]]]);;

let BORSUKIAN_CLOSED_UNION = prove
 (`!s t:real^N->bool.
        closed_in (subtopology euclidean (s UNION t)) s /\
        closed_in (subtopology euclidean (s UNION t)) t /\
        borsukian s /\ borsukian t /\ connected(s INTER t)
        ==> borsukian(s UNION t)`,
  REPEAT GEN_TAC THEN SIMP_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM] THEN
  STRIP_TAC THEN X_GEN_TAC `f:real^N->complex` THEN STRIP_TAC THEN
  REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `f:real^N->complex`)) THEN
  ANTS_TAC THENL
   [CONJ_TAC THENL
     [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; ASM SET_TAC[]];
    DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC)] THEN
  ANTS_TAC THENL
   [CONJ_TAC THENL
     [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; ASM SET_TAC[]];
    DISCH_THEN(X_CHOOSE_THEN `h:real^N->complex` STRIP_ASSUME_TAC)] THEN
  ASM_CASES_TAC `s INTER t:real^N->bool = {}` THENL
   [EXISTS_TAC `(\x. if x IN s then g x else h x):real^N->complex` THEN
    CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
    MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
    ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  MP_TAC(ISPECL
   [`(\x. g x - h x):real^N->complex`; `s INTER t:real^N->bool`]
   CONTINUOUS_DISCRETE_RANGE_CONSTANT) THEN
  ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
   [CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
      ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET];
      X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN
      EXISTS_TAC `&2 * pi` THEN
      REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN
      X_GEN_TAC `y:real^N` THEN
      DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
      ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN
      ONCE_REWRITE_TAC[COMPLEX_RING
       `a - b:complex = c - d <=> a - c = b - d`] THEN
      DISCH_TAC THEN MATCH_MP_TAC COMPLEX_EQ_CEXP THEN
      REWRITE_TAC[CEXP_SUB] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
       REAL_LET_TRANS)) THEN
      GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [COMPLEX_RING
       `(a - b) - (c - d):complex = (a - c) - (b - d)`] THEN
      REWRITE_TAC[GSYM IM_SUB; COMPLEX_NORM_GE_RE_IM]];

    REWRITE_TAC[IN_INTER; COMPLEX_EQ_SUB_RADD] THEN
    DISCH_THEN(X_CHOOSE_TAC `a:complex`) THEN
    EXISTS_TAC `(\x. if x IN s then g x else a + h x):real^N->complex` THEN
    CONJ_TAC THENL
     [MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
      ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST] THEN
      ASM SET_TAC[];
      GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[] THEN
      COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
       [ASM_MESON_TAC[]; REWRITE_TAC[CEXP_ADD]] THEN
      SUBGOAL_THEN `?y:real^N. y IN s /\ y IN t` STRIP_ASSUME_TAC THENL
       [ASM SET_TAC[]; ALL_TAC] THEN
      SUBGOAL_THEN `cexp(a + h(y:real^N)) = cexp(h y)` MP_TAC THENL
       [ASM_MESON_TAC[]; REWRITE_TAC[CEXP_ADD]] THEN
      SIMP_TAC[COMPLEX_RING `a * z = z <=> a = Cx(&1) \/ z = Cx(&0)`;
               CEXP_NZ; COMPLEX_MUL_LID] THEN
      ASM SET_TAC[]]]);;

let BORSUKIAN_SEPARATION_COMPACT = prove
 (`!s:real^2->bool.
        compact s ==> (borsukian s <=> connected((:real^2) DIFF s))`,
  SIMP_TAC[BORSUKIAN_CIRCLE; BORSUK_SEPARATION_THEOREM; DIMINDEX_2; LE_REFL;
           COMPLEX_VEC_0]);;

let BORSUKIAN_COMPONENTWISE_EQ = prove
 (`!s:real^N->bool.
        locally connected s \/ compact s
        ==> (borsukian s <=> !c. c IN components s ==> borsukian c)`,
  GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[BORSUKIAN_ALT] THEN
  MATCH_MP_TAC COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS THEN
  ASM_SIMP_TAC[OPEN_IMP_ANR; OPEN_DIFF; OPEN_UNIV; CLOSED_SING]);;

let BORSUKIAN_COMPONENTWISE = prove
 (`!s:real^N->bool.
        (locally connected s \/ compact s) /\
        (!c. c IN components s ==> borsukian c)
        ==> borsukian s`,
  MESON_TAC[BORSUKIAN_COMPONENTWISE_EQ]);;

let BORSUKIAN_MONOTONE_IMAGE_COMPACT = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\ IMAGE f s = t /\ compact s /\
        (!y. y IN t ==> connected {x | x IN s /\ f x = y}) /\
        borsukian s
        ==> borsukian t`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM] THEN
  X_GEN_TAC `g:real^N->complex` THEN STRIP_TAC THEN FIRST_X_ASSUM
   (MP_TAC o GEN_REWRITE_RULE I [BORSUKIAN_CONTINUOUS_LOGARITHM]) THEN
  DISCH_THEN(MP_TAC o SPEC `(g:real^N->complex) o (f:real^M->real^N)`) THEN
  ASM_SIMP_TAC[IMAGE_o; CONTINUOUS_ON_COMPOSE; o_THM] THEN
  DISCH_THEN(X_CHOOSE_THEN `h:real^M->complex` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN
   `!y. ?x. y IN t ==> x IN s /\ (f:real^M->real^N) x = y`
  MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `f':real^N->real^M` THEN STRIP_TAC THEN
  EXISTS_TAC `(h:real^M->complex) o (f':real^N->real^M)` THEN
  REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  MATCH_MP_TAC CONTINUOUS_FROM_CLOSED_GRAPH THEN
  EXISTS_TAC `IMAGE (h:real^M->complex) s` THEN
  ASM_SIMP_TAC[COMPACT_CONTINUOUS_IMAGE; IMAGE_o] THEN
  CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[o_THM]] THEN
  SUBGOAL_THEN
   `{pastecart x ((h:real^M->complex) ((f':real^N->real^M) x)) | x IN t} =
    {p | ?x. x IN s /\ pastecart x p IN
                       {z | z IN s PCROSS UNIV /\
                            (sndcart z - pastecart (f(fstcart z))
                                                   (h(fstcart z))) IN {vec 0}}}`
  SUBST1_TAC THENL
   [ALL_TAC;
    MATCH_MP_TAC CLOSED_COMPACT_PROJECTION THEN ASM_REWRITE_TAC[] THEN
    MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
    ASM_SIMP_TAC[CLOSED_UNIV; CLOSED_PCROSS; COMPACT_IMP_CLOSED] THEN
    REWRITE_TAC[CLOSED_SING] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
    SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
    MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN REWRITE_TAC[GSYM o_DEF] THEN
    CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
    SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; IMAGE_FSTCART_PCROSS] THEN
    ASM_REWRITE_TAC[UNIV_NOT_EMPTY]] THEN
  REWRITE_TAC[IN_ELIM_THM; PASTECART_IN_PCROSS; FSTCART_PASTECART;
              SNDCART_PASTECART; IN_UNIV; IN_SING; VECTOR_SUB_EQ] THEN
  REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM] THEN
  REWRITE_TAC[CONJ_ASSOC; PASTECART_INJ] THEN
  MAP_EVERY X_GEN_TAC [`y:real^N`; `z:complex`] THEN
  ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ r <=> q /\ p /\ r`] THEN
  REWRITE_TAC[UNWIND_THM1] THEN EQ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  DISCH_THEN(X_CHOOSE_THEN `w:real^M` STRIP_ASSUME_TAC) THEN
  CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  SUBGOAL_THEN
   `?a. !x. x IN {x | x IN s /\ (f:real^M->real^N) x = y}
            ==> h x - h(f' y):complex = a`
  MP_TAC THENL
   [ALL_TAC;
    REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
    X_GEN_TAC `a:complex` THEN
    DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
    DISCH_THEN(MP_TAC o SPEC `(f':real^N->real^M) y`) THEN
    ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[VECTOR_SUB_REFL]] THEN
    DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
    RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_SUB_EQ]) THEN ASM SET_TAC[]] THEN
  MATCH_MP_TAC CONTINUOUS_DISCRETE_RANGE_CONSTANT THEN
  REWRITE_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL
   [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[];
    MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
      CONTINUOUS_ON_SUBSET)) THEN SET_TAC[];
    ALL_TAC] THEN
  X_GEN_TAC `v:real^M` THEN STRIP_TAC THEN
  EXISTS_TAC `&2 * pi` THEN
  REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN
  X_GEN_TAC `u:real^M` THEN
  REWRITE_TAC[COMPLEX_RING `a - x:complex = b - x <=> a = b`] THEN
  DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
  ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN
  REWRITE_TAC[COMPLEX_RING `(a - x) - (b - x):complex = a - b`] THEN
  DISCH_TAC THEN MATCH_MP_TAC COMPLEX_EQ_CEXP THEN
  CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[GSYM IM_SUB] THEN
  ASM_MESON_TAC[REAL_LET_TRANS; COMPLEX_NORM_GE_RE_IM]);;

(* ------------------------------------------------------------------------- *)
(* Unicoherence (closed).                                                    *)
(* ------------------------------------------------------------------------- *)

let unicoherent = new_definition
 `unicoherent(u:real^N->bool) <=>
  !s t. connected s /\ connected t /\ s UNION t = u /\
        closed_in (subtopology euclidean u) s /\
        closed_in (subtopology euclidean u) t
        ==> connected (s INTER t)`;;

let HOMEOMORPHIC_UNICOHERENT = prove
 (`!s:real^M->bool t:real^N->bool.
        s homeomorphic t /\ unicoherent s ==> unicoherent t`,
  REPEAT STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
  REWRITE_TAC[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[unicoherent] THEN
  MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN
   `u INTER v = IMAGE (f:real^M->real^N)
                (IMAGE (g:real^N->real^M) u INTER IMAGE g v)`
  SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN CONJ_TAC THENL
   [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
      CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[];
    ALL_TAC] THEN
  FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [unicoherent]) THEN
  ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> r /\ (p /\ q) /\ s`] THEN
  CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  CONJ_TAC THENL
   [CONJ_TAC THEN MATCH_MP_TAC CONNECTED_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[];
    CONJ_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_CLOSED_MAP THEN
    MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `t:real^N->bool`] THEN
    ASM_REWRITE_TAC[homeomorphism]]);;

let HOMEOMORPHIC_UNICOHERENT_EQ = prove
 (`!s:real^M->bool t:real^N->bool.
     s homeomorphic t ==> (unicoherent s <=> unicoherent t)`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_UNICOHERENT) THEN
  ASM_MESON_TAC[HOMEOMORPHIC_SYM]);;

let UNICOHERENT_TRANSLATION = prove
 (`!a:real^N s. unicoherent (IMAGE (\x. a + x) s) <=> unicoherent s`,
  REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_UNICOHERENT_EQ THEN
  REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);;

add_translation_invariants [UNICOHERENT_TRANSLATION];;

let UNICOHERENT_INJECTIVE_LINEAR_IMAGE = prove
 (`!f:real^M->real^N s.
        linear f /\ (!x y. f x = f y ==> x = y)
        ==> (unicoherent(IMAGE f s) <=> unicoherent s)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_UNICOHERENT_EQ THEN
  ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF;
                HOMEOMORPHIC_REFL]);;

add_linear_invariants [UNICOHERENT_INJECTIVE_LINEAR_IMAGE];;

let BORSUKIAN_IMP_UNICOHERENT = prove
 (`!u:real^N->bool. borsukian u ==> unicoherent u`,
  GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[unicoherent] THEN
  SUBGOAL_THEN
   `!f. f continuous_on u /\ IMAGE f u SUBSET sphere(vec 0,&1)
             ==> ?a. homotopic_with (\h. T)
                     (u,(:complex) DIFF {Cx (&0)}) (f:real^N->complex) (\t. a)`
  MP_TAC THENL
   [FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I
     [BORSUKIAN_CIRCLE]) THEN
    X_GEN_TAC `f:real^N->complex` THEN STRIP_TAC THEN
    FIRST_X_ASSUM(MP_TAC o SPEC `f:real^N->complex`) THEN
    ASM_REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN
    MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_SUBSET_RIGHT) THEN
    REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF {a} <=> ~(a IN s)`] THEN
    REWRITE_TAC[IN_SPHERE; DIST_REFL] THEN REAL_ARITH_TAC;
    POP_ASSUM(K ALL_TAC)] THEN
  REWRITE_TAC[sphere; DIST_0; INESSENTIAL_EQ_CONTINUOUS_LOGARITHM] THEN
  REPEAT STRIP_TAC THEN SIMP_TAC[CONNECTED_CLOSED_IN_EQ; NOT_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `w:real^N->bool`] THEN STRIP_TAC THEN
  SUBGOAL_THEN
   `closed_in (subtopology euclidean u) (v:real^N->bool) /\
    closed_in (subtopology euclidean u) (w:real^N->bool)`
  STRIP_ASSUME_TAC THENL
   [ASM_MESON_TAC[CLOSED_IN_INTER; CLOSED_IN_TRANS]; ALL_TAC] THEN
  MP_TAC(ISPECL
   [`v:real^N->bool`; `w:real^N->bool`; `u:real^N->bool`;
    `vec 0:real^1`; `vec 1:real^1`] URYSOHN_LOCAL) THEN
  ASM_REWRITE_TAC[] THEN
  DISCH_THEN(X_CHOOSE_THEN `q:real^N->real^1` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN
   `?g:real^N->real^2.
        g continuous_on u /\ IMAGE g u SUBSET {x | norm x = &1} /\
        (!x. x IN s ==> g(x) = cexp(Cx pi * ii * Cx(drop(q x)))) /\
        (!x. x IN t ==> g(x) = inv(cexp(Cx pi * ii * Cx(drop(q x)))))`
  (DESTRUCT_TAC "@g. cont circle s t") THENL
   [EXISTS_TAC
     `\x. if (x:real^N) IN s then cexp(Cx pi * ii * Cx(drop(q x)))
          else inv(cexp(Cx pi * ii * Cx(drop(q x))))` THEN
    SUBGOAL_THEN
     `!x:real^N.
        x IN s INTER t
        ==> cexp(Cx pi * ii * Cx(drop(q x))) =
            inv(cexp(Cx pi * ii * Cx(drop (q x))))`
    ASSUME_TAC THENL
     [SUBST1_TAC(SYM(ASSUME `v UNION w:real^N->bool = s INTER t`)) THEN
      REWRITE_TAC[IN_UNION] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN
      REWRITE_TAC[DROP_VEC; COMPLEX_MUL_RZERO; CEXP_0; COMPLEX_INV_1] THEN
      REWRITE_TAC[COMPLEX_MUL_RID; EULER] THEN
      REWRITE_TAC[RE_MUL_CX; IM_MUL_CX; RE_MUL_II; IM_MUL_II] THEN
      REWRITE_TAC[RE_II; IM_II; REAL_MUL_RZERO; REAL_MUL_RID] THEN
      REWRITE_TAC[REAL_EXP_0; COMPLEX_MUL_LID; COS_PI; SIN_PI] THEN
      REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN
      CONV_TAC COMPLEX_RING;
      ALL_TAC] THEN
    SIMP_TAC[] THEN REPEAT CONJ_TAC THENL
     [EXPAND_TAC "u" THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
      ASM_REWRITE_TAC[SET_RULE
       `P /\ ~P \/ x IN t /\ x IN s <=> x IN s INTER t`] THEN
      CONJ_TAC THENL
       [ALL_TAC;
        MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_INV THEN REWRITE_TAC[CEXP_NZ]] THEN
      GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
      MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
      REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN
      REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN
      MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN
      REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
      MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN
      ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION];
      REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
      REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
      REWRITE_TAC[COMPLEX_NORM_INV; NORM_CEXP] THEN
      REWRITE_TAC[RE_MUL_CX; RE_MUL_II; IM_CX] THEN
      REWRITE_TAC[REAL_MUL_RZERO; REAL_NEG_0; REAL_EXP_0; REAL_INV_1];
      GEN_TAC THEN DISCH_TAC THEN COND_CASES_TAC THEN
      ASM_REWRITE_TAC[] THEN ASM SET_TAC[]];
     FIRST_X_ASSUM(MP_TAC o SPEC `g:real^N->complex`) THEN
     ASM_REWRITE_TAC[] THEN
     DISCH_THEN(X_CHOOSE_THEN `h:real^N->complex` STRIP_ASSUME_TAC)] THEN
  SUBGOAL_THEN
   `(?n. integer n /\
         !x:real^N. x IN s
                    ==> h(x) - Cx pi * ii * Cx (drop (q x)) =
                        Cx(&2 * n * pi) * ii) /\
    (?n. integer n /\
         !x:real^N. x IN t
                    ==> h(x) + Cx pi * ii * Cx (drop (q x)) =
                        Cx(&2 * n * pi) * ii)`
  (CONJUNCTS_THEN2
    (X_CHOOSE_THEN `m:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))
    (X_CHOOSE_THEN `n:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)))
  THENL
   [CONJ_TAC THEN MATCH_MP_TAC(MESON[]
     `(?x. x IN s) /\
      (!x. x IN s ==> ?n. P n /\ f x = k n) /\
      (?a. !x. x IN s ==> f x = a)
      ==> (?n. P n /\ !x. x IN s ==> f x = k n)`) THEN
    (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
    MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN
   (CONJ_TAC THENL
     [REWRITE_TAC[COMPLEX_RING `a + b:complex = c <=> a = --b + c`;
                  COMPLEX_RING `a - b:complex = c <=> a = b + c`] THEN
      REWRITE_TAC[GSYM CEXP_EQ; CEXP_NEG] THEN ASM SET_TAC[];
      ALL_TAC] THEN
    DISCH_THEN(LABEL_TAC "*") THEN
    MATCH_MP_TAC CONTINUOUS_DISCRETE_RANGE_CONSTANT THEN
    ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
     [(MATCH_MP_TAC CONTINUOUS_ON_ADD ORELSE
       MATCH_MP_TAC CONTINUOUS_ON_SUB) THEN
      CONJ_TAC THENL
       [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; ALL_TAC] THEN
      REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN
      MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN
      REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
      MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN
      ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION];
      X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `&2 * pi` THEN
      REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN
      X_GEN_TAC `y:real^N` THEN
      DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
      REMOVE_THEN "*" (fun th ->
       MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN
      ASM_REWRITE_TAC[] THEN STRIP_TAC THEN STRIP_TAC THEN
      ASM_REWRITE_TAC[] THEN
      REWRITE_TAC[COMPLEX_EQ_MUL_RCANCEL; II_NZ; GSYM COMPLEX_SUB_RDISTRIB;
            COMPLEX_NORM_MUL; CX_INJ; COMPLEX_NORM_II; REAL_MUL_RID] THEN
      REWRITE_TAC[GSYM CX_SUB; COMPLEX_NORM_CX] THEN
      REWRITE_TAC[REAL_EQ_MUL_LCANCEL; GSYM REAL_SUB_LDISTRIB] THEN
      REWRITE_TAC[GSYM REAL_SUB_RDISTRIB; REAL_ABS_MUL] THEN
      REWRITE_TAC[REAL_EQ_MUL_RCANCEL; PI_NZ; REAL_ABS_PI] THEN
      REWRITE_TAC[REAL_ABS_NUM; REAL_OF_NUM_EQ; ARITH_EQ] THEN
      DISCH_TAC THEN REWRITE_TAC[REAL_ARITH
       `&2 * p <= &2 * a * p <=> &0 <= &2 * p * (a - &1)`] THEN
      MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN
      MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[PI_POS_LE; REAL_SUB_LE] THEN
      MATCH_MP_TAC REAL_ABS_INTEGER_LEMMA THEN
      ASM_SIMP_TAC[INTEGER_CLOSED; REAL_SUB_0]]);
      ALL_TAC] THEN
  GEN_REWRITE_TAC I [TAUT `p ==> q ==> F <=> ~(p /\ q)`] THEN
  DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
   `(!x. x IN s ==> P x) /\ (!x. x IN t ==> Q x)
    ==> ~(v = {}) /\ ~(w = {}) /\ v UNION w SUBSET s INTER t
         ==> ~(!y z. y IN v /\ z IN w ==> ~(P y /\ Q y /\ P z /\ Q z))`)) THEN
  ANTS_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[]] THEN
  REPEAT GEN_TAC THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (COMPLEX_RING
   `y + p = n /\ y - p = m /\ z + q = n /\ z - q = m ==> q:complex = p`)) THEN
  REWRITE_TAC[DROP_VEC; COMPLEX_MUL_RZERO; COMPLEX_ENTIRE; CX_INJ] THEN
  REWRITE_TAC[PI_NZ; II_NZ; REAL_OF_NUM_EQ; ARITH_EQ]);;

let CONTRACTIBLE_IMP_UNICOHERENT = prove
 (`!u:real^N->bool. contractible u ==> unicoherent u`,
  SIMP_TAC[BORSUKIAN_IMP_UNICOHERENT; CONTRACTIBLE_IMP_BORSUKIAN]);;

let CONVEX_IMP_UNICOHERENT = prove
 (`!u:real^N->bool. convex u ==> unicoherent u`,
  SIMP_TAC[BORSUKIAN_IMP_UNICOHERENT; CONVEX_IMP_BORSUKIAN]);;

let UNICOHERENT_UNIV = prove
 (`unicoherent(:real^N)`,
  SIMP_TAC[CONVEX_IMP_UNICOHERENT; CONVEX_UNIV]);;

let UNICOHERENT_MONOTONE_IMAGE_COMPACT = prove
 (`!f:real^M->real^N s t.
        f continuous_on s /\ IMAGE f s = t /\ compact s /\
        (!y. y IN t ==> connected {x | x IN s /\ f x = y}) /\
        unicoherent s
        ==> unicoherent t`,
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN `compact(t:real^N->bool)` ASSUME_TAC THENL
   [ASM_MESON_TAC[COMPACT_CONTINUOUS_IMAGE]; REWRITE_TAC[unicoherent]] THEN
  MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
  ASM_SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED] THEN
  STRIP_TAC THEN
  FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [unicoherent]) THEN
  DISCH_THEN(MP_TAC o SPECL
   [`{x | x IN s /\ (f:real^M->real^N) x IN u}`;
    `{x | x IN s /\ (f:real^M->real^N) x IN v}`]) THEN
  ASM_SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED; SUBSET_RESTRICT;
               CONTINUOUS_CLOSED_PREIMAGE; CONJ_ASSOC] THEN
  REWRITE_TAC[IMP_CONJ_ALT] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN

  MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^N->bool`]
    CONNECTED_CLOSED_MONOTONE_PREIMAGE) THEN

  ASM_REWRITE_TAC[] THEN
  ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_IMP_CLOSED_MAP]; ALL_TAC] THEN
  DISCH_TAC THEN ASM_SIMP_TAC[] THEN
  DISCH_THEN(MP_TAC o ISPEC `f:real^M->real^N` o MATCH_MP
   (REWRITE_RULE[IMP_CONJ_ALT] CONNECTED_CONTINUOUS_IMAGE)) THEN
  ANTS_TAC THENL
   [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
        CONTINUOUS_ON_SUBSET)) THEN SET_TAC[];
    MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* Several common variants of unicoherence for R^n.                          *)
(* ------------------------------------------------------------------------- *)

let CONNECTED_FRONTIER_SIMPLE = prove
 (`!s. connected(s) /\ connected((:real^N) DIFF s) ==> connected(frontier s)`,
  REPEAT STRIP_TAC THEN REWRITE_TAC[FRONTIER_CLOSURES] THEN
  MATCH_MP_TAC(REWRITE_RULE[unicoherent] UNICOHERENT_UNIV) THEN
  REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN
  ASM_SIMP_TAC[CLOSED_CLOSURE; CONNECTED_CLOSURE] THEN
  MATCH_MP_TAC(SET_RULE
   `s SUBSET closure s /\ t SUBSET closure t /\ s UNION t = UNIV
    ==> closure s UNION closure t = UNIV`) THEN
  REWRITE_TAC[CLOSURE_SUBSET] THEN SET_TAC[]);;

let CONNECTED_FRONTIER_COMPONENT_COMPLEMENT = prove
 (`!s c:real^N->bool.
        connected s /\ c IN components((:real^N) DIFF s)
        ==> connected(frontier c)`,
  REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_FRONTIER_SIMPLE THEN
  CONJ_TAC THENL
   [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED];
    MATCH_MP_TAC COMPONENT_COMPLEMENT_CONNECTED THEN
    EXISTS_TAC `s:real^N->bool` THEN
    ASM_REWRITE_TAC[SUBSET_UNIV; CONNECTED_UNIV]]);;

let CONNECTED_FRONTIER_DISJOINT = prove
 (`!s t:real^N->bool.
     connected s /\ connected t /\ DISJOINT s t /\ frontier s SUBSET frontier t
     ==> connected(frontier s)`,
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `s = (:real^N)` THEN
  ASM_REWRITE_TAC[FRONTIER_UNIV; CONNECTED_EMPTY] THEN
  SUBGOAL_THEN `?c. c IN components((:real^N) DIFF s) /\ t SUBSET c`
  STRIP_ASSUME_TAC THENL
   [MATCH_MP_TAC EXISTS_COMPONENT_SUPERSET THEN ASM SET_TAC[]; ALL_TAC] THEN
  SUBGOAL_THEN `frontier s:real^N->bool = frontier c` SUBST1_TAC THENL
   [ALL_TAC; ASM_MESON_TAC[CONNECTED_FRONTIER_COMPONENT_COMPLEMENT]] THEN
  MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
   [REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
    REWRITE_TAC[frontier; IN_DIFF] THEN CONJ_TAC THENL
     [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET] o
       MATCH_MP SUBSET_CLOSURE) THEN
      ASM_MESON_TAC[SUBSET; frontier; IN_DIFF];
      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV
        [GSYM FRONTIER_COMPLEMENT]) THEN
      REWRITE_TAC[frontier] THEN
      MATCH_MP_TAC(SET_RULE `u SUBSET t ==> x IN s DIFF t ==> ~(x IN u)`) THEN
      MATCH_MP_TAC SUBSET_INTERIOR THEN
      ASM_MESON_TAC[IN_COMPONENTS_SUBSET]];
    GEN_REWRITE_TAC RAND_CONV [GSYM FRONTIER_COMPLEMENT] THEN
    ASM_MESON_TAC[FRONTIER_OF_COMPONENTS_SUBSET]]);;

let SEPARATION_BY_COMPONENT_CLOSED_POINTWISE = prove
 (`!s a b. closed s /\ ~connected_component ((:real^N) DIFF s) a b
           ==> ?c. c IN components s /\
                   ~connected_component((:real^N) DIFF c) a b`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THENL
   [EXISTS_TAC `connected_component s (a:real^N)` THEN
    ASM_REWRITE_TAC[IN_COMPONENTS] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN
    REWRITE_TAC[IN_UNIV; IN_DIFF] THEN REWRITE_TAC[IN] THEN
    ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ];
    ALL_TAC] THEN
  ASM_CASES_TAC `(b:real^N) IN s` THENL
   [EXISTS_TAC `connected_component s (b:real^N)` THEN
    ASM_REWRITE_TAC[IN_COMPONENTS] THEN
    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
    DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN
    REWRITE_TAC[IN_UNIV; IN_DIFF] THEN REWRITE_TAC[IN] THEN
    ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ];
    ALL_TAC] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IRREDUCIBLE_SEPARATOR) THEN
  DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
  SUBGOAL_THEN `?c:real^N->bool. c IN components s /\ t SUBSET c` MP_TAC THENL
   [MATCH_MP_TAC EXISTS_COMPONENT_SUPERSET THEN ASM_REWRITE_TAC[];
    MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN
    ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `~(t b) ==> s SUBSET t ==> ~(s b)`)) THEN
    REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN
    ASM SET_TAC[]] THEN
  CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MP_TAC(ISPECL [`connected_component ((:real^N) DIFF t) a`;
                 `connected_component ((:real^N) DIFF t) b`]
        CONNECTED_FRONTIER_DISJOINT) THEN
  REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; CONNECTED_COMPONENT_DISJOINT] THEN
  ASM_REWRITE_TAC[IN] THEN ONCE_REWRITE_TAC[CONNECTED_COMPONENT_SYM_EQ] THEN
  SUBGOAL_THEN
   `frontier(connected_component ((:real^N) DIFF t) a) = t /\
    frontier(connected_component ((:real^N) DIFF t) b) = t`
   (fun th -> ASM_REWRITE_TAC[th; SUBSET_REFL]) THEN
  CONJ_TAC THEN MATCH_MP_TAC FRONTIER_MINIMAL_SEPARATING_CLOSED_POINTWISE THENL
   [EXISTS_TAC `b:real^N`; EXISTS_TAC `a:real^N`] THEN
  ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[CONNECTED_COMPONENT_SYM_EQ] THEN
  ASM_SIMP_TAC[] THEN ASM SET_TAC[]);;

let SEPARATION_BY_COMPONENT_CLOSED = prove
 (`!s. closed s /\ ~connected((:real^N) DIFF s)
       ==> ?c. c IN components s /\ ~connected((:real^N) DIFF c)`,
  REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT; IN_DIFF; IN_UNIV] THEN
  MP_TAC SEPARATION_BY_COMPONENT_CLOSED_POINTWISE THEN
  MATCH_MP_TAC MONO_FORALL THEN
  MESON_TAC[REWRITE_RULE[SUBSET] IN_COMPONENTS_SUBSET]);;

let SEPARATION_BY_UNION_CLOSED_POINTWISE = prove
 (`!s t a b. closed s /\ closed t /\ DISJOINT s t /\
             connected_component ((:real^N) DIFF s) a b /\
             connected_component ((:real^N) DIFF t) a b
             ==> connected_component ((:real^N) DIFF (s UNION t)) a b`,
  REPEAT GEN_TAC THEN
  REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  DISCH_THEN(CONJUNCTS_THEN (fun th ->
    ASSUME_TAC th THEN MP_TAC(MATCH_MP CONNECTED_COMPONENT_IN th))) THEN
  REWRITE_TAC[IN_DIFF; IN_UNIV] THEN REPEAT STRIP_TAC THEN
  GEN_REWRITE_TAC I [TAUT `p <=> ~ ~ p`] THEN DISCH_THEN(MP_TAC o MATCH_MP
   (REWRITE_RULE[IMP_CONJ_ALT] SEPARATION_BY_COMPONENT_CLOSED_POINTWISE)) THEN
  ASM_SIMP_TAC[CLOSED_UNION; NOT_EXISTS_THM] THEN
  X_GEN_TAC `c:real^N->bool` THEN
  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  REWRITE_TAC[] THEN
  SUBGOAL_THEN `(c:real^N->bool) SUBSET s \/ c SUBSET t` STRIP_ASSUME_TAC THENL
   [FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
    FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN
    REWRITE_TAC[CONNECTED_CLOSED; NOT_EXISTS_THM] THEN
    DISCH_THEN(MP_TAC o SPECL [`s:real^N->bool`; `t:real^N->bool`]) THEN
    ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
    UNDISCH_TAC `connected_component ((:real^N) DIFF s) a b`;
    UNDISCH_TAC `connected_component ((:real^N) DIFF t) a b`] THEN
  MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s b ==> t b`) THEN
  REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN
  ASM SET_TAC[]);;

let SEPARATION_BY_UNION_CLOSED = prove
 (`!s t:real^N->bool.
        closed s /\ closed t /\ DISJOINT s t /\
        connected((:real^N) DIFF s) /\
        connected((:real^N) DIFF t)
        ==> connected((:real^N) DIFF (s UNION t))`,
  SIMP_TAC[CONNECTED_IFF_CONNECTED_COMPONENT; IN_DIFF; IN_UNION; IN_UNIV] THEN
  MESON_TAC[SEPARATION_BY_UNION_CLOSED_POINTWISE]);;

let OPEN_UNICOHERENT_UNIV = prove
 (`!s t. open s /\ open t /\ connected s /\ connected t /\
         s UNION t = (:real^N)
         ==> connected(s INTER t)`,
  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE
   `s INTER t = UNIV DIFF ((UNIV DIFF s) UNION (UNIV DIFF t))`] THEN
  MATCH_MP_TAC SEPARATION_BY_UNION_CLOSED THEN
  ASM_SIMP_TAC[GSYM OPEN_CLOSED; SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN
  ASM SET_TAC[]);;

let SEPARATION_BY_COMPONENT_OPEN = prove
 (`!s. open s /\ ~connected((:real^N) DIFF s)
       ==> ?c. c IN components s /\ ~connected((:real^N) DIFF c)`,
  let lemma = prove
   (`!s t u. closed s /\ closed t /\ s INTER t = {} /\
             connected u /\ ~(u INTER s = {}) /\ ~(u INTER t = {})
             ==> ?c. c IN components((:real^N) DIFF (s UNION t)) /\
                     ~(c INTER u = {}) /\
                     ~(frontier c INTER s = {}) /\
                     ~(frontier c INTER t = {})`,
    REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[MESON[]
     `(?x. P x /\ Q x /\ R x) <=> ~(!x. P x /\ Q x ==> ~R x)`] THEN
    DISCH_TAC THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_CLOSED]) THEN
    REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC
     [`s UNION
       UNIONS {c | c IN components((:real^N) DIFF (s UNION t)) /\
                   frontier c SUBSET s}`;
      `t UNION
        UNIONS {c | c IN components((:real^N) DIFF (s UNION t)) /\
                    frontier c SUBSET t}`] THEN
    REPLICATE_TAC 2 (CONJ_TAC THENL
     [REWRITE_TAC[GSYM FRONTIER_SUBSET_EQ] THEN
      MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s SUBSET t UNION u`) THEN
      MATCH_MP_TAC(MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)
          (SPEC_ALL FRONTIER_UNION_SUBSET)) THEN
      ASM_REWRITE_TAC[UNION_SUBSET; FRONTIER_SUBSET_EQ] THEN
      MATCH_MP_TAC(MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)
          (SPEC_ALL FRONTIER_UNIONS_SUBSET_CLOSURE)) THEN
      MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_REWRITE_TAC[UNIONS_SUBSET] THEN
      SIMP_TAC[FORALL_IN_GSPEC];
      ALL_TAC]) THEN
    REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC SUBSET_TRANS THEN
      EXISTS_TAC `(s UNION t) UNION
                   UNIONS {c | c IN components((:real^N) DIFF (s UNION t)) /\
                   ~(c INTER u = {})}` THEN
      CONJ_TAC THENL
       [MP_TAC(ISPEC `(:real^N) DIFF (s UNION t)` UNIONS_COMPONENTS) THEN
        SET_TAC[];
        MATCH_MP_TAC(SET_RULE
         `c SUBSET d UNION e
          ==> (s UNION t) UNION c SUBSET (s UNION d) UNION (t UNION e)`) THEN
        REWRITE_TAC[GSYM UNIONS_UNION] THEN MATCH_MP_TAC SUBSET_UNIONS THEN
        ONCE_REWRITE_TAC[SUBSET] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNION] 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[DE_MORGAN_THM] THEN
        MATCH_MP_TAC(SET_RULE
         `c SUBSET s UNION t
          ==> c INTER s = {} \/ c INTER t = {}
              ==> c SUBSET s \/ c SUBSET t`) THEN
        FIRST_ASSUM(MP_TAC o MATCH_MP FRONTIER_OF_COMPONENTS_SUBSET) THEN
        REWRITE_TAC[FRONTIER_COMPLEMENT] THEN
        MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN
        ASM_SIMP_TAC[FRONTIER_SUBSET_EQ; CLOSED_UNION]];
      MATCH_MP_TAC(SET_RULE
       `c UNION d SUBSET UNIV DIFF (s UNION t) /\ s INTER t = {} /\ DISJOINT c d
        ==> (s UNION c) INTER (t UNION d) INTER u = {}`) THEN
      ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
       [REWRITE_TAC[GSYM UNIONS_UNION] THEN
        GEN_REWRITE_TAC RAND_CONV [UNIONS_COMPONENTS] THEN
        MATCH_MP_TAC SUBSET_UNIONS THEN SET_TAC[];
        MATCH_MP_TAC(SET_RULE
         `(!s. s IN c ==> !t. t IN c' ==> s INTER t = {})
          ==> DISJOINT (UNIONS c) (UNIONS c')`) THEN
        REWRITE_TAC[FORALL_IN_GSPEC] THEN
        MP_TAC(ISPEC `(:real^N) DIFF (s UNION t)` COMPONENTS_NONOVERLAP) THEN
        SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN
        X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN
        X_GEN_TAC `c':real^N->bool` THEN
        ASM_CASES_TAC `c':real^N->bool = c` THEN ASM_REWRITE_TAC[] THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
         `c SUBSET s ==> s INTER t = {} /\ ~(c = {}) ==> ~(c SUBSET t)`)) THEN
        ASM_REWRITE_TAC[FRONTIER_EQ_EMPTY] THEN
        FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN
        FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
        ASM SET_TAC[]];
      ASM SET_TAC[];
      ASM SET_TAC[]]) in
  GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
  ASM_SIMP_TAC[CONNECTED_CLOSED_SET; GSYM OPEN_CLOSED;
               LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->bool`] THEN STRIP_TAC THEN
  MP_TAC(ISPECL [`t:real^N->bool`; `u:real^N->bool`; `(:real^N)`]
          lemma) THEN
  ASM_REWRITE_TAC[CONNECTED_UNIV; SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] 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
  DISCH_TAC THEN MP_TAC(ISPEC `c:real^N->bool` CONNECTED_FRONTIER_SIMPLE) THEN
  FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN
  ASM_REWRITE_TAC[] THEN REWRITE_TAC[CONNECTED_CLOSED] THEN
  MAP_EVERY EXISTS_TAC [`t:real^N->bool`; `u:real^N->bool`] THEN
  ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP FRONTIER_OF_COMPONENTS_SUBSET) THEN
  MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN
  ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN
  ASM_REWRITE_TAC[FRONTIER_SUBSET_EQ; GSYM OPEN_CLOSED]);;

let SEPARATION_BY_UNION_OPEN = prove
 (`!s t:real^N->bool.
        open s /\ open t /\ DISJOINT s t /\
        connected((:real^N) DIFF s) /\
        connected((:real^N) DIFF t)
        ==> connected((:real^N) DIFF (s UNION t))`,
  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE
   `UNIV DIFF (s UNION t) = (UNIV DIFF s) INTER (UNIV DIFF t)`] THEN
  MATCH_MP_TAC(REWRITE_RULE[unicoherent] UNICOHERENT_UNIV) THEN
  REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN
  ASM_REWRITE_TAC[GSYM OPEN_CLOSED] THEN ASM SET_TAC[]);;

let CONNECTED_INTER_DISJOINT_OPEN_FRONTIERS = prove
 (`!s t:real^N->bool.
        open s /\ connected s /\ open t /\ connected t /\
        DISJOINT (frontier s) (frontier t)
        ==> connected(s INTER t)`,
  let lemma = prove
   (`~(f = {}) ==> s UNION UNIONS f = UNIONS {s UNION c | c IN f}`,
    REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in
  REPEAT STRIP_TAC THEN
  MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN
  ASM_REWRITE_TAC[INTER_EMPTY; CONNECTED_EMPTY] THEN
  MAP_EVERY ASM_CASES_TAC [`s = (:real^N)`; `t = (:real^N)`] THEN
  ASM_REWRITE_TAC[INTER_UNIV; CONNECTED_UNIV] THEN
  ASM_CASES_TAC `s INTER t:real^N->bool = {}` THEN
  ASM_REWRITE_TAC[CONNECTED_EMPTY] THEN
  MP_TAC(ISPECL
   [`s UNION UNIONS {c | c IN components((:real^N) DIFF closure t) /\
                         ~(c INTER s = {})}`;
    `t UNION UNIONS {c | c IN components((:real^N) DIFF closure s) /\
                         ~(c INTER t = {})}`]
   OPEN_UNICOHERENT_UNIV) THEN
  ANTS_TAC THENL
   [REPEAT CONJ_TAC THENL
     [MATCH_MP_TAC OPEN_UNION THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC OPEN_UNIONS THEN REWRITE_TAC[IN_ELIM_THM] THEN
      MESON_TAC[OPEN_COMPONENTS; closed; CLOSED_CLOSURE];
      MATCH_MP_TAC OPEN_UNION THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC OPEN_UNIONS THEN REWRITE_TAC[IN_ELIM_THM] THEN
      MESON_TAC[OPEN_COMPONENTS; closed; CLOSED_CLOSURE];
      MATCH_MP_TAC(MESON[]
       `(s = {} \/ ~(s = {}) ==> connected(u UNION UNIONS s))
        ==> connected(u UNION UNIONS s)`) THEN
      STRIP_TAC THEN ASM_REWRITE_TAC[UNION_EMPTY; UNIONS_0] THEN
      ASM_SIMP_TAC[lemma] THEN MATCH_MP_TAC CONNECTED_UNIONS THEN
      REWRITE_TAC[FORALL_IN_GSPEC] THEN
      CONJ_TAC THENL
       [ASM_MESON_TAC[CONNECTED_UNION; IN_COMPONENTS_CONNECTED; UNION_COMM];
        ALL_TAC] THEN
      MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ ~(s = {}) ==> ~(t = {})`) THEN
      EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_INTERS] THEN
      REWRITE_TAC[FORALL_IN_GSPEC; SUBSET_UNION];
      MATCH_MP_TAC(MESON[]
       `(s = {} \/ ~(s = {}) ==> connected(u UNION UNIONS s))
        ==> connected(u UNION UNIONS s)`) THEN
      STRIP_TAC THEN ASM_REWRITE_TAC[UNION_EMPTY; UNIONS_0] THEN
      ASM_SIMP_TAC[lemma] THEN MATCH_MP_TAC CONNECTED_UNIONS THEN
      REWRITE_TAC[FORALL_IN_GSPEC] THEN
      CONJ_TAC THENL
       [ASM_MESON_TAC[CONNECTED_UNION; IN_COMPONENTS_CONNECTED; UNION_COMM];
        ALL_TAC] THEN
      MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ ~(s = {}) ==> ~(t = {})`) THEN
      EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_INTERS] THEN
      REWRITE_TAC[FORALL_IN_GSPEC; SUBSET_UNION];
      GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN
      REWRITE_TAC[IN_UNION; UNIONS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN
      ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN
      ASM_CASES_TAC `(x:real^N) IN t` THEN ASM_REWRITE_TAC[] THEN
      FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o MATCH_MP (SET_RULE
       `DISJOINT s t ==> !x. ~(x IN s) \/ ~(x IN t)`)) THEN
      ASM_SIMP_TAC[frontier; INTERIOR_OPEN; IN_DIFF] THEN STRIP_TAC THENL
       [SUBGOAL_THEN `x IN UNIONS(components((:real^N) DIFF closure s))`
        MP_TAC THENL
         [ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; IN_DIFF; IN_UNIV];
          ALL_TAC] THEN
        REWRITE_TAC[IN_UNIONS] THEN
        DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
        ASM_CASES_TAC `c INTER t:real^N->bool = {}` THENL
         [ALL_TAC; ASM_MESON_TAC[]] THEN
        SUBGOAL_THEN `c INTER closure(t:real^N->bool) = {}` ASSUME_TAC THENL
         [ASM_MESON_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_COMPONENTS;
                        closed; CLOSED_CLOSURE];
          ALL_TAC] THEN
        SUBGOAL_THEN `x IN UNIONS(components((:real^N) DIFF closure t))`
        MP_TAC THENL
         [ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; IN_DIFF; IN_UNIV] THEN
          ASM SET_TAC[];
          ALL_TAC] THEN
        REWRITE_TAC[IN_UNIONS] THEN
        DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN
        ASM_CASES_TAC `d INTER s:real^N->bool = {}` THENL
         [ALL_TAC; ASM_MESON_TAC[]] THEN
        SUBGOAL_THEN `d INTER closure(s:real^N->bool) = {}` ASSUME_TAC THENL
         [ASM_MESON_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_COMPONENTS;
                        closed; CLOSED_CLOSURE];
          ALL_TAC];
        SUBGOAL_THEN `x IN UNIONS(components((:real^N) DIFF closure t))`
        MP_TAC THENL
         [ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; IN_DIFF; IN_UNIV];
          ALL_TAC] THEN
        REWRITE_TAC[IN_UNIONS] THEN
        DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN
        ASM_CASES_TAC `d INTER s:real^N->bool = {}` THENL
         [ALL_TAC; ASM_MESON_TAC[]] THEN
        SUBGOAL_THEN `d INTER closure(s:real^N->bool) = {}` ASSUME_TAC THENL
         [ASM_MESON_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_COMPONENTS;
                        closed; CLOSED_CLOSURE];
          ALL_TAC] THEN
        SUBGOAL_THEN `x IN UNIONS(components((:real^N) DIFF closure s))`
        MP_TAC THENL
         [ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; IN_DIFF; IN_UNIV] THEN
          ASM SET_TAC[];
          ALL_TAC] THEN
        REWRITE_TAC[IN_UNIONS] THEN
        DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
        ASM_CASES_TAC `c INTER t:real^N->bool = {}` THENL
         [ALL_TAC; ASM_MESON_TAC[]] THEN
        SUBGOAL_THEN `c INTER closure(t:real^N->bool) = {}` ASSUME_TAC THENL
         [ASM_MESON_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_COMPONENTS;
                        closed; CLOSED_CLOSURE];
          ALL_TAC]] THEN
     (FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
       `DISJOINT s t ==> !c d. ~(c = {}) /\ c SUBSET s /\ d SUBSET t /\ c = d
                               ==> p`)) THEN
      MAP_EVERY EXISTS_TAC
       [`frontier c:real^N->bool`; `frontier d:real^N->bool`] THEN
      REPEAT CONJ_TAC THENL
       [REWRITE_TAC[FRONTIER_EQ_EMPTY; DE_MORGAN_THM] THEN
        ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY; IN_COMPONENTS_SUBSET;
                      SET_RULE `s SUBSET UNIV DIFF t /\ s = UNIV ==> t = {}`;
                      CLOSURE_EQ_EMPTY];
        ASM_MESON_TAC[FRONTIER_OF_COMPONENTS_SUBSET;FRONTIER_COMPLEMENT;
                      FRONTIER_CLOSURE_SUBSET; SUBSET_TRANS];
        ASM_MESON_TAC[FRONTIER_OF_COMPONENTS_SUBSET;FRONTIER_COMPLEMENT;
                      FRONTIER_CLOSURE_SUBSET; SUBSET_TRANS];
        AP_TERM_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN
        MATCH_MP_TAC COMPONENTS_MAXIMAL THENL
         [EXISTS_TAC `(:real^N) DIFF closure t`;
          EXISTS_TAC `(:real^N) DIFF closure s`] THEN
        ASM_REWRITE_TAC[] THEN
        (CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED];
         ASM SET_TAC[]])])];
      ALL_TAC] THEN
    MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
    MATCH_MP_TAC(SET_RULE
     `s INTER t' = {} /\ t INTER s' = {} /\ s' INTER t' = {}
      ==> (s UNION s') INTER (t UNION t') = s INTER t`) THEN
    REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC;
                UNIONS_SUBSET] THEN
    REPEAT CONJ_TAC THEN X_GEN_TAC `d:real^N->bool` THENL
     [MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN
      MP_TAC(ISPECL [`(:real^N) DIFF closure s`; `d:real^N->bool`]
        IN_COMPONENTS_SUBSET) THEN
      SET_TAC[];
      MP_TAC(ISPEC `t:real^N->bool` CLOSURE_SUBSET) THEN
      MP_TAC(ISPECL [`(:real^N) DIFF closure t`; `d:real^N->bool`]
        IN_COMPONENTS_SUBSET) THEN
      SET_TAC[];
      STRIP_TAC THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC] THEN
    MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
     `DISJOINT s t
      ==> !c d. c SUBSET s /\ d SUBSET t /\ ~(c INTER d = {}) ==> F`)) THEN
    MAP_EVERY EXISTS_TAC
     [`frontier c:real^N->bool`; `frontier d:real^N->bool`] THEN
    REPEAT(CONJ_TAC THENL
     [ASM_MESON_TAC[FRONTIER_OF_COMPONENTS_SUBSET;FRONTIER_COMPLEMENT;
                      FRONTIER_CLOSURE_SUBSET; SUBSET_TRANS]; ALL_TAC]) THEN
    MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN CONJ_TAC THENL
     [MATCH_MP_TAC CONNECTED_FRONTIER_COMPONENT_COMPLEMENT THEN
      EXISTS_TAC `closure s:real^N->bool` THEN
      ASM_MESON_TAC[CONNECTED_CLOSURE];
      ALL_TAC] THEN
    ONCE_REWRITE_TAC[SET_RULE `c DIFF d = c INTER (UNIV DIFF d)`] THEN
    ONCE_REWRITE_TAC[INTER_COMM] THEN CONJ_TAC THEN
    MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN
    ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
     [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED];
      ALL_TAC;
      MATCH_MP_TAC COMPONENT_COMPLEMENT_CONNECTED THEN
      EXISTS_TAC `closure t:real^N->bool` THEN
      ASM_SIMP_TAC[CONNECTED_UNIV; SUBSET_UNIV; CONNECTED_CLOSURE];
      ALL_TAC;
      ALL_TAC] THEN
    REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN
    MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN
    MP_TAC(ISPEC `t:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]);;

let NONSEPARATION_BY_COMPONENT_EQ = prove
 (`!s. (open s \/ closed s)
       ==> ((!c. c IN components s ==> connected((:real^N) DIFF c)) <=>
            connected((:real^N) DIFF s))`,
  REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
   [ASM_MESON_TAC[SEPARATION_BY_COMPONENT_OPEN];
    ALL_TAC;
    ASM_MESON_TAC[SEPARATION_BY_COMPONENT_CLOSED];
    ALL_TAC] THEN
  MATCH_MP_TAC COMPONENT_COMPLEMENT_CONNECTED THEN
  EXISTS_TAC `(:real^N) DIFF s` THEN
  ASM_REWRITE_TAC[CONNECTED_UNIV; SUBSET_UNIV;
                  SET_RULE `UNIV DIFF (UNIV DIFF s) = s`]);;

(* ------------------------------------------------------------------------- *)
(* Another interesting equivalent of an inessential mapping into C-{0}       *)
(* ------------------------------------------------------------------------- *)

let INESSENTIAL_EQ_EXTENSIBLE = prove
 (`!f s.
   closed s
   ==> ((?a. homotopic_with (\h. T) (s,(:complex) DIFF {Cx(&0)}) f (\t. a)) <=>
        (?g. g continuous_on (:real^N) /\
             (!x. x IN s ==> g x = f x) /\ (!x. ~(g x = Cx(&0)))))`,
  REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL
   [DISCH_THEN(X_CHOOSE_TAC `a:complex`) THEN
    ASM_CASES_TAC `s:real^N->bool = {}` THENL
     [EXISTS_TAC `\x:real^N. Cx(&1)` THEN
      ASM_REWRITE_TAC[CONTINUOUS_ON_CONST; NOT_IN_EMPTY] THEN
      CONV_TAC COMPLEX_RING;
      ALL_TAC] THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
    FIRST_ASSUM(MP_TAC o
      SPEC `(:real^N)` o
      MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ_ALT]
        (REWRITE_RULE[CONJ_ASSOC] BORSUK_HOMOTOPY_EXTENSION)) o
      GEN_REWRITE_RULE I [HOMOTOPIC_WITH_SYM]) THEN
    ASM_REWRITE_TAC[GSYM CLOSED_IN; SUBTOPOLOGY_UNIV] THEN
    SIMP_TAC[OPEN_IMP_ANR; OPEN_DIFF; OPEN_UNIV; CLOSED_SING] THEN
    ASM_SIMP_TAC[CLOSED_UNIV; CONTINUOUS_ON_CONST] THEN
    ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN
    ASM SET_TAC[];
    DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN
    REWRITE_TAC[INESSENTIAL_EQ_CONTINUOUS_LOGARITHM] THEN
    MP_TAC(ISPECL [`vec 0:real^N`; `&1`] HOMEOMORPHIC_BALL_UNIV) THEN
    REWRITE_TAC[REAL_LT_01; homeomorphic; LEFT_IMP_EXISTS_THM] THEN
    MAP_EVERY X_GEN_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN
    REWRITE_TAC[homeomorphism; IN_UNIV] THEN STRIP_TAC THEN
    MP_TAC(ISPECL [`(g:real^N->complex) o (h:real^N->real^N)`;
                   `vec 0:real^N`; `&1`] CONTINUOUS_LOGARITHM_ON_BALL) THEN
    ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; o_THM] THEN
    DISCH_THEN(X_CHOOSE_THEN `j:real^N->complex` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `(j:real^N->complex) o (k:real^N->real^N)` THEN
    ASM_SIMP_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_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[]]);;

(* ------------------------------------------------------------------------- *)
(* Another simple case where sphere maps are nullhomotopic.                  *)
(* ------------------------------------------------------------------------- *)

let INESSENTIAL_SPHEREMAP_2 = prove
 (`!f:real^M->real^N a r b s.
        2 < dimindex(:M) /\ dimindex(:N) = 2 /\
        f continuous_on sphere(a,r) /\
        IMAGE f (sphere(a,r)) SUBSET (sphere(b,s))
        ==> ?c. homotopic_with (\z. T) (sphere(a,r),sphere(b,s)) f (\x. c)`,
  let lemma = prove
   (`!f:real^N->real^2 a r.
          2 < dimindex(:N) /\
          f continuous_on sphere(a,r) /\
          IMAGE f (sphere(a,r)) SUBSET (sphere(vec 0,&1))
          ==> ?c. homotopic_with (\z. T) (sphere(a,r),sphere(vec 0,&1))
                                 f (\x. c)`,
    REPEAT STRIP_TAC THEN
    REWRITE_TAC[INESSENTIAL_EQ_CONTINUOUS_LOGARITHM_CIRCLE] THEN
    MP_TAC(ISPECL [`f:real^N->real^2`; `sphere(a:real^N,r)`]
          CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED) THEN
    ASM_SIMP_TAC[SIMPLY_CONNECTED_SPHERE_EQ; LOCALLY_PATH_CONNECTED_SPHERE] THEN
    ANTS_TAC THENL
     [ASM_REWRITE_TAC[ARITH_RULE `3 <= n <=> 2 < n`] THEN FIRST_X_ASSUM
       (MATCH_MP_TAC o MATCH_MP (SET_RULE
          `IMAGE f s SUBSET t ==> (!x. P x ==> ~(x IN t))
          ==> !x. x IN s ==> ~P(f x)`)) THEN
      SIMP_TAC[COMPLEX_NORM_0; IN_SPHERE_0] THEN REAL_ARITH_TAC;
      DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^2` STRIP_ASSUME_TAC) THEN
      EXISTS_TAC `Im o (g:real^N->real^2)` THEN CONJ_TAC THENL
       [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
        ASM_REWRITE_TAC[CONTINUOUS_ON_CX_IM];
        X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
        ASM_SIMP_TAC[] THEN AP_TERM_TAC THEN
        REWRITE_TAC[o_DEF; COMPLEX_EQ; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX] THEN
        FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
        REWRITE_TAC[FORALL_IN_IMAGE] THEN
        DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
        ASM_SIMP_TAC[IN_SPHERE_0; NORM_CEXP; REAL_EXP_EQ_1] THEN
        REAL_ARITH_TAC]])
  and hslemma = prove
   (`!a:real^M r b:real^N s.
        dimindex(:M) = dimindex(:N) /\ &0 < r /\ &0 < s
        ==> (sphere(a,r) homeomorphic sphere(b,s))`,
    REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th ->
      let t = `?a:real^M b:real^N. ~(sphere(a,r) homeomorphic sphere(b,s))` in
      MP_TAC(DISCH t (GEOM_EQUAL_DIMENSION_RULE th (ASSUME t)))) THEN
    ASM_SIMP_TAC[HOMEOMORPHIC_SPHERES] THEN MESON_TAC[]) in
  REPEAT STRIP_TAC THEN ASM_CASES_TAC `s <= &0` THEN
  ASM_SIMP_TAC[NULLHOMOTOPIC_INTO_CONTRACTIBLE; CONTRACTIBLE_SPHERE] THEN
  RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN
  SUBGOAL_THEN
   `(sphere(b:real^N,s)) homeomorphic (sphere(vec 0:real^2,&1))`
  MP_TAC THENL
   [ASM_SIMP_TAC[hslemma; REAL_LT_01; DIMINDEX_2];
    REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM]] THEN
  MAP_EVERY X_GEN_TAC [`h:real^N->real^2`; `k:real^2->real^N`] THEN
  REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN
  MP_TAC(ISPECL
   [`(h:real^N->real^2) o (f:real^M->real^N)`;
    `a:real^M`; `r:real`] lemma) THEN
  ASM_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_THEN `c:real^2` (fun th ->
      EXISTS_TAC `(k:real^2->real^N) c` THEN MP_TAC th)) THEN
    DISCH_THEN(MP_TAC o ISPEC `k:real^2->real^N` o MATCH_MP
     (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN
    DISCH_THEN(MP_TAC o SPEC `sphere(b:real^N,s)`) THEN
    ASM_REWRITE_TAC[SUBSET_REFL] THEN
    MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN
    REWRITE_TAC[o_DEF] THEN ASM SET_TAC[]]);;

(* ------------------------------------------------------------------------- *)
(* Janiszewski's theorem.                                                    *)
(* ------------------------------------------------------------------------- *)

let JANISZEWSKI = prove
 (`!s t a b:real^2.
        compact s /\ closed t /\ connected(s INTER t) /\
        connected_component ((:real^2) DIFF s) a b /\
        connected_component ((:real^2) DIFF t) a b
        ==> connected_component ((:real^2) DIFF (s UNION t)) a b`,
  let lemma = prove
   (`!s t a b:real^2.
          compact s /\ compact t /\ connected(s INTER t) /\
          connected_component ((:real^2) DIFF s) a b /\
          connected_component ((:real^2) DIFF t) a b
          ==> connected_component ((:real^2) DIFF (s UNION t)) a b`,
    REPEAT GEN_TAC THEN
    REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
    DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
    FIRST_X_ASSUM(CONJUNCTS_THEN(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN)) THEN
    REWRITE_TAC[IN_DIFF; IN_UNIV] THEN STRIP_TAC THEN STRIP_TAC THEN
    ASM_SIMP_TAC[GSYM BORSUK_MAPS_HOMOTOPIC_IN_CONNECTED_COMPONENT_EQ;
                 DIMINDEX_2; LE_REFL; COMPACT_UNION; IN_UNION] THEN
    ONCE_REWRITE_TAC[HOMOTOPIC_CIRCLEMAPS_DIV] THEN
    REWRITE_TAC[INESSENTIAL_EQ_CONTINUOUS_LOGARITHM_CIRCLE] THEN
    ASM_SIMP_TAC[BORSUK_MAP_INTO_SPHERE; CONTINUOUS_ON_BORSUK_MAP;
                 IN_UNION] THEN
    DISCH_THEN(CONJUNCTS_THEN2
     (X_CHOOSE_THEN `g:real^2->real` STRIP_ASSUME_TAC)
     (X_CHOOSE_THEN `h:real^2->real` STRIP_ASSUME_TAC)) THEN
    SUBGOAL_THEN
     `closed_in (subtopology euclidean (s UNION t)) s /\
      closed_in (subtopology euclidean (s UNION t)) (t:real^2->bool)`
    STRIP_ASSUME_TAC THENL
     [REWRITE_TAC[CLOSED_IN_CLOSED] THEN CONJ_TAC THENL
       [EXISTS_TAC `s:real^2->bool`; EXISTS_TAC `t:real^2->bool`] THEN
      ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM SET_TAC[];
      ALL_TAC] THEN
    ASM_CASES_TAC `s INTER t:real^2->bool = {}` THENL
     [EXISTS_TAC `(\x. if x IN s then g x else h x):real^2->real` THEN
      CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
      REWRITE_TAC[o_DEF; COND_RAND] THEN
      MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
      ASM_REWRITE_TAC[GSYM o_DEF] THEN ASM SET_TAC[];
      ALL_TAC] THEN
    MP_TAC(ISPECL
     [`\x:real^2. lift(g x) - lift(h x)`; `s INTER t:real^2->bool`]
     CONTINUOUS_DISCRETE_RANGE_CONSTANT) THEN
    ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
     [CONJ_TAC THENL
       [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
        REWRITE_TAC[GSYM CONTINUOUS_ON_CX_LIFT] THEN
        REWRITE_TAC[GSYM o_DEF] THEN
        ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET];
        REWRITE_TAC[o_DEF]] THEN
      X_GEN_TAC `x:real^2` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN
      EXISTS_TAC `&2 * pi` THEN
      REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN
      X_GEN_TAC `y:real^2` THEN
      DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
      ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN
      REWRITE_TAC[GSYM LIFT_SUB; LIFT_EQ; NORM_LIFT] THEN DISCH_TAC THEN
      ONCE_REWRITE_TAC[REAL_RING `a - b:real = c - d <=> a - c = b - d`] THEN
      REWRITE_TAC[GSYM CX_INJ] THEN
      MATCH_MP_TAC(COMPLEX_RING `ii * w = ii * z ==> w = z`) THEN
      MATCH_MP_TAC COMPLEX_EQ_CEXP THEN CONJ_TAC THENL
       [REWRITE_TAC[IM_MUL_II; RE_CX] THEN ASM_REAL_ARITH_TAC;
        REWRITE_TAC[CX_SUB; COMPLEX_SUB_LDISTRIB; CEXP_SUB] THEN
        ASM_MESON_TAC[]];
      REWRITE_TAC[EXISTS_LIFT; GSYM LIFT_SUB; LIFT_EQ; IN_INTER] THEN
      REWRITE_TAC[REAL_EQ_SUB_RADD; LEFT_IMP_EXISTS_THM] THEN
      X_GEN_TAC `z:real` THEN DISCH_TAC THEN
      EXISTS_TAC `(\x. if x IN s then g x else z + h x):real^2->real` THEN
      CONJ_TAC THENL
       [REWRITE_TAC[o_DEF; COND_RAND] THEN
        MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
        ASM_SIMP_TAC[TAUT `~(p /\ ~p)`; CX_ADD; GSYM o_DEF] THEN
        REWRITE_TAC[o_DEF; CX_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
        ASM_REWRITE_TAC[CONTINUOUS_ON_CONST; GSYM o_DEF];
        X_GEN_TAC `x:real^2` THEN REWRITE_TAC[] THEN
        COND_CASES_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
        ASM_SIMP_TAC[] THEN DISCH_TAC THEN
        SUBGOAL_THEN
         `?w:real^2. cexp(ii * Cx(h w)) = cexp (ii * Cx(z + h w))`
         (CHOOSE_THEN MP_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN
        REWRITE_TAC[CX_ADD; COMPLEX_ADD_LDISTRIB; CEXP_ADD] THEN
        REWRITE_TAC[COMPLEX_FIELD `a = b * a <=> a = Cx(&0) \/ b = Cx(&1)`;
                    CEXP_NZ]]]) in
  REPEAT STRIP_TAC THEN
  SUBGOAL_THEN
   `?c:real^2->bool.
       compact c /\ connected c /\ a IN c /\ b IN c /\ c INTER t = {}`
  STRIP_ASSUME_TAC THENL
   [SUBGOAL_THEN `path_component((:real^2) DIFF t) a b` MP_TAC THENL
     [ASM_MESON_TAC[OPEN_PATH_CONNECTED_COMPONENT; closed; COMPACT_IMP_CLOSED];
      REWRITE_TAC[path_component; SET_RULE
        `s SUBSET UNIV DIFF t <=> s INTER t = {}`]] THEN
    DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^2` STRIP_ASSUME_TAC) THEN
    EXISTS_TAC `path_image(g:real^1->real^2)` THEN
    ASM_SIMP_TAC[CONNECTED_PATH_IMAGE; COMPACT_PATH_IMAGE] THEN
    ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE];
    ALL_TAC] THEN
  MP_TAC(ISPECL [`c UNION s:real^2->bool`; `vec 0:real^2`]
        BOUNDED_SUBSET_BALL) THEN
  ASM_SIMP_TAC[BOUNDED_UNION; COMPACT_IMP_BOUNDED; LEFT_IMP_EXISTS_THM] THEN
  X_GEN_TAC `r:real` THEN STRIP_TAC THEN
  MP_TAC(ISPECL [`s:real^2->bool`;
                 `(t INTER cball(vec 0,r)) UNION sphere(vec 0:real^2,r)`;
                 `a:real^2`; `b:real^2`] lemma) THEN
  ASM_SIMP_TAC[COMPACT_UNION; CLOSED_INTER_COMPACT;
               COMPACT_SPHERE; COMPACT_CBALL] THEN
  ANTS_TAC THENL
   [CONJ_TAC THENL
     [UNDISCH_TAC `connected(s INTER t:real^2->bool)` THEN
      MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC;
      REWRITE_TAC[connected_component] THEN EXISTS_TAC `c:real^2->bool`] THEN
    MP_TAC(ISPECL [`vec 0:real^2`; `r:real`] CBALL_DIFF_SPHERE) THEN
    ASM SET_TAC[];
    REWRITE_TAC[connected_component] THEN MATCH_MP_TAC MONO_EXISTS THEN
    X_GEN_TAC `u:real^2->bool` THEN
    SIMP_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN
    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
    MP_TAC(ISPECL
     [`u:real^2->bool`; `cball(vec 0:real^2,r)`] CONNECTED_INTER_FRONTIER) THEN
    ASM_REWRITE_TAC[FRONTIER_CBALL] THEN
    MP_TAC(ISPECL [`vec 0:real^2`; `r:real`] BALL_SUBSET_CBALL) THEN
    ASM SET_TAC[]]);;

let JANISZEWSKI_GEN = prove
 (`!s t a b:real^N.
        dimindex(:N) <= 2 /\
        compact s /\ closed t /\ connected(s INTER t) /\
        connected_component ((:real^N) DIFF s) a b /\
        connected_component ((:real^N) DIFF t) a b
        ==> connected_component ((:real^N) DIFF (s UNION t)) a b`,
  REPEAT GEN_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL
   [ASM_SIMP_TAC[CONNECTED_COMPONENT_1_GEN] THEN SET_TAC[];
    ASM_SIMP_TAC[ARITH_RULE `1 <= n /\ ~(n = 1) ==> (n <= 2 <=> n = 2)`;
                 DIMINDEX_GE_1] THEN
    ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[GSYM DIMINDEX_2] THEN
    DISCH_THEN(fun th ->
     MATCH_ACCEPT_TAC(GEOM_EQUAL_DIMENSION_RULE th JANISZEWSKI))]);;

let JANISZEWSKI_CONNECTED = prove
 (`!s t:real^2->bool.
       compact s /\ closed t /\ connected(s INTER t) /\
       connected ((:real^2) DIFF s) /\ connected ((:real^2) DIFF t)
       ==> connected((:real^2) DIFF (s UNION t))`,
  REPEAT GEN_TAC THEN
  REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
  REWRITE_TAC[IN_DIFF; IN_UNIV; IN_UNION] THEN
  ASM_MESON_TAC[JANISZEWSKI]);;

let JANISZEWSKI_DUAL = prove
 (`!s t:real^2->bool.
        compact s /\ compact t /\ connected s /\ connected t /\
        connected((:real^2) DIFF (s UNION t))
         ==> connected(s INTER t)`,
  REPEAT STRIP_TAC THEN
  MP_TAC(ISPEC `s UNION t:real^2->bool` BORSUKIAN_IMP_UNICOHERENT) THEN
  ASM_SIMP_TAC[BORSUKIAN_SEPARATION_COMPACT; COMPACT_UNION; unicoherent] THEN
  DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
  CONJ_TAC THEN MATCH_MP_TAC CLOSED_SUBSET THEN
  ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN SET_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* The Jordan Curve theorem.                                                 *)
(* ------------------------------------------------------------------------- *)

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
  SUBGOAL_THEN
   `path_image(c:real^1->real^2) homeomorphic sphere(vec 0:real^2,&1)`
  ASSUME_TAC THENL
   [ASM_SIMP_TAC[HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE; REAL_LT_01];
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP SIMPLE_PATH_IMP_PATH) THEN
    FIRST_ASSUM(ASSUME_TAC o MATCH_MP COMPACT_PATH_IMAGE) THEN
    ABBREV_TAC `s:real^2->bool = path_image c`] THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        JORDAN_BROUWER_SEPARATION)) THEN
  REWRITE_TAC[REAL_LT_01] THEN DISCH_TAC THEN
  MP_TAC(ISPEC `(:real^2) DIFF s` COBOUNDED_UNBOUNDED_COMPONENTS) THEN
  MP_TAC(ISPEC `(:real^2) DIFF s` COBOUNDED_HAS_BOUNDED_COMPONENT) THEN
  ASM_SIMP_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`; COMPACT_IMP_BOUNDED;
               DIMINDEX_2; LE_REFL; IMP_IMP] THEN
  REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `ins:real^2->bool` THEN
  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `out:real^2->bool` THEN
  STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
  REPLICATE_TAC 5 (GEN_REWRITE_TAC I [CONJ_ASSOC]) THEN
  MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
   [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY; IN_COMPONENTS_CONNECTED;
                  OPEN_COMPONENTS; closed; COMPACT_IMP_CLOSED];
    STRIP_TAC] THEN
  MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
   [ASM_MESON_TAC[COMPONENTS_EQ]; DISCH_TAC] THEN
  MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL
   [CONJ_TAC THEN MATCH_MP_TAC JORDAN_BROUWER_FRONTIER THEN
    REWRITE_TAC[DIMINDEX_2; LE_REFL] THEN ASM_MESON_TAC[];
    STRIP_TAC] THEN
  GEN_REWRITE_TAC RAND_CONV [UNIONS_COMPONENTS] THEN
  REWRITE_TAC[GSYM UNIONS_2] THEN AP_TERM_TAC THEN
  MATCH_MP_TAC(SET_RULE
   `a IN s /\ b IN s /\ (!c. c IN s /\ ~(c = a) /\ ~(c = b) ==> F)
    ==> {a,b} = s`) THEN
  ASM_REWRITE_TAC[] THEN X_GEN_TAC `mid:real^2->bool` THEN STRIP_TAC THEN
  SUBGOAL_THEN `frontier mid:real^2->bool = s` ASSUME_TAC THENL
   [MATCH_MP_TAC JORDAN_BROUWER_FRONTIER THEN
    REWRITE_TAC[DIMINDEX_2; LE_REFL] THEN ASM_MESON_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN `open(mid:real^2->bool) /\ connected mid /\ ~(mid = {})`
  STRIP_ASSUME_TAC THENL
   [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY; IN_COMPONENTS_CONNECTED;
                  OPEN_COMPONENTS; closed; COMPACT_IMP_CLOSED];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `?a b:real^2.
        a IN s /\ b IN s  /\ ~(a = b) /\
        ?g. arc g /\ pathstart g = a /\ pathfinish g = b /\
            path_image g DIFF {a,b} SUBSET mid`
  STRIP_ASSUME_TAC THENL
   [SUBGOAL_THEN `?a b:real^2. a IN s /\ b IN s /\ ~(a = b)`
    STRIP_ASSUME_TAC THENL
     [MATCH_MP_TAC(SET_RULE
       `(!c. s SUBSET {c} ==> F) ==> ?a b. a IN s /\ b IN s /\ ~(a = b)`) THEN
      ASM_MESON_TAC[INFINITE_SIMPLE_PATH_IMAGE; INFINITE; FINITE_SING;
                    FINITE_SUBSET];
      ALL_TAC] THEN
    MP_TAC(ISPECL
     [`mid:real^2->bool`; `s INTER ball(a:real^2,dist(a,b))`;
      `s INTER ball(b:real^2,dist(a,b))`]
     DENSE_ACCESSIBLE_FRONTIER_POINT_PAIRS) THEN
    ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN ANTS_TAC THENL
     [SUBGOAL_THEN
       `a IN ball(a:real^2,dist(a,b)) /\ b IN ball(b,dist(a,b)) /\
        ~(a IN ball(b,dist(a,b))) /\ ~(b IN ball(a,dist(a,b)))`
      MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
      ASM_REWRITE_TAC[IN_BALL; DIST_REFL; GSYM DIST_NZ] THEN
      REWRITE_TAC[DIST_SYM] THEN REAL_ARITH_TAC;
      REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM]] THEN
    X_GEN_TAC `g:real^1->real^2` THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC
     [`pathstart g:real^2`; `pathfinish g:real^2`] THEN
    ASM_SIMP_TAC[ARC_DISTINCT_ENDS] THEN EXISTS_TAC `g:real^1->real^2` THEN
    ASM_REWRITE_TAC[] THEN
    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
        SUBSET_TRANS)) THEN
    REWRITE_TAC[OPEN_CLOSED_INTERVAL_1; path_image; pathstart; pathfinish] THEN
    SET_TAC[];
    ALL_TAC] THEN
  MP_TAC(ISPECL [`c:real^1->real^2`; `a:real^2`; `b:real^2`]
     EXISTS_DOUBLE_ARC) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`u:real^1->real^2`; `d:real^1->real^2`] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN `?x:real^2 y:real^2. x IN ins /\ y IN out`
  STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
  MP_TAC(ISPECL
   [`(path_image u UNION path_image g):real^2->bool`;
    `(path_image d UNION path_image g):real^2->bool`;
    `x:real^2`; `y:real^2`] JANISZEWSKI) THEN
  ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5)
      [COMPACT_UNION; COMPACT_IMP_CLOSED; COMPACT_PATH_IMAGE;
       ARC_IMP_PATH; NOT_IMP] THEN
  REPEAT CONJ_TAC THENL
   [SUBGOAL_THEN
     `(path_image u UNION path_image g) INTER
      (path_image d UNION path_image g) = path_image(g:real^1->real^2)`
     (fun th -> ASM_SIMP_TAC[CONNECTED_ARC_IMAGE; th]) THEN
    MATCH_MP_TAC(SET_RULE
     `u INTER d SUBSET s ==> (u UNION s) INTER (d UNION s) = s`) THEN
    ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN
    ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE;
                  ARC_IMP_PATH];
    REWRITE_TAC[connected_component] THEN
    EXISTS_TAC `ins UNION out UNION (s DIFF path_image u):real^2->bool` THEN
    ASM_REWRITE_TAC[IN_UNION] THEN CONJ_TAC THENL
     [ONCE_REWRITE_TAC[SET_RULE `s UNION t UNION u =
                                (s UNION u) UNION (t UNION u)`] THEN
      MATCH_MP_TAC CONNECTED_UNION THEN REPEAT CONJ_TAC THENL
       [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
        EXISTS_TAC `ins:real^2->bool` THEN
        ASM_SIMP_TAC[UNION_SUBSET; CLOSURE_UNION_FRONTIER; SUBSET_UNION] THEN
        ASM SET_TAC[];
        MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
        EXISTS_TAC `out:real^2->bool` THEN
        ASM_SIMP_TAC[UNION_SUBSET; CLOSURE_UNION_FRONTIER; SUBSET_UNION] THEN
        ASM SET_TAC[];
        MATCH_MP_TAC(SET_RULE
         `~(u = {}) ==> ~((s UNION u) INTER (t UNION u) = {})`) THEN
        SUBGOAL_THEN `~(path_image d SUBSET {a:real^2,b})`
        MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
        DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
          FINITE_SUBSET)) THEN
        REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN
        ASM_SIMP_TAC[INFINITE_ARC_IMAGE; GSYM INFINITE]];
      SUBGOAL_THEN `ins INTER out = {} /\ ins INTER mid = {} /\
                    (mid:real^2->bool) INTER out = {}`
      MP_TAC THENL [ASM_MESON_TAC[COMPONENTS_NONOVERLAP]; ALL_TAC] THEN
      REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN
      ASM SET_TAC[]];
    REWRITE_TAC[connected_component] THEN
    EXISTS_TAC `ins UNION out UNION (s DIFF path_image d):real^2->bool` THEN
    ASM_REWRITE_TAC[IN_UNION] THEN CONJ_TAC THENL
     [ONCE_REWRITE_TAC[SET_RULE `s UNION t UNION u =
                                (s UNION u) UNION (t UNION u)`] THEN
      MATCH_MP_TAC CONNECTED_UNION THEN REPEAT CONJ_TAC THENL
       [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
        EXISTS_TAC `ins:real^2->bool` THEN
        ASM_SIMP_TAC[UNION_SUBSET; CLOSURE_UNION_FRONTIER; SUBSET_UNION] THEN
        ASM SET_TAC[];
        MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
        EXISTS_TAC `out:real^2->bool` THEN
        ASM_SIMP_TAC[UNION_SUBSET; CLOSURE_UNION_FRONTIER; SUBSET_UNION] THEN
        ASM SET_TAC[];
        MATCH_MP_TAC(SET_RULE
         `~(u = {}) ==> ~((s UNION u) INTER (t UNION u) = {})`) THEN
        SUBGOAL_THEN `~(path_image u SUBSET {a:real^2,b})`
        MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
        DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
          FINITE_SUBSET)) THEN
        REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN
        ASM_SIMP_TAC[INFINITE_ARC_IMAGE; GSYM INFINITE]];
      SUBGOAL_THEN `ins INTER out = {} /\ ins INTER mid = {} /\
                    (mid:real^2->bool) INTER out = {}`
      MP_TAC THENL [ASM_MESON_TAC[COMPONENTS_NONOVERLAP]; ALL_TAC] THEN
      REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN
      ASM SET_TAC[]];
    SUBGOAL_THEN `~(connected_component ((:real^2) DIFF s) x y)` MP_TAC THENL
     [REWRITE_TAC[connected_component] THEN
      DISCH_THEN(X_CHOOSE_THEN `t:real^2->bool` STRIP_ASSUME_TAC) THEN
      MP_TAC(ISPECL [`(:real^2) DIFF s`; `t:real^2->bool`]
        COMPONENTS_MAXIMAL) THEN
      DISCH_THEN(fun th ->
        MP_TAC(SPEC `ins:real^2->bool` th) THEN
        MP_TAC(SPEC `out:real^2->bool` th)) THEN ASM SET_TAC[];
      REWRITE_TAC[CONTRAPOS_THM] THEN
      MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s y ==> t y`) THEN
      REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN
      ASM SET_TAC[]]]);;

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 DISCH_TAC THEN
  FIRST_ASSUM(MP_TAC o MATCH_MP JORDAN_CURVE_THEOREM) THEN
  REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
  MAP_EVERY X_GEN_TAC [`ins:real^2->bool`; `out:real^2->bool`] THEN
  STRIP_TAC THEN
  SUBGOAL_THEN `inside(path_image c) :real^2->bool = ins /\
                outside(path_image c):real^2->bool = out `
   (fun th -> ASM_REWRITE_TAC[th]) THEN
  MATCH_MP_TAC INSIDE_OUTSIDE_UNIQUE THEN ASM_SIMP_TAC[JORDAN_DISCONNECTED]);;

(* ------------------------------------------------------------------------- *)
(* Triple-curve or "theta-curve" theorem. Proof that there is no fourth      *)
(* component taken from Kuratowski's Topology vol 2, para 61, II.            *)
(* ------------------------------------------------------------------------- *)

let SPLIT_INSIDE_SIMPLE_CLOSED_CURVE = prove
 (`!c1 c2 c a b:real^2.
        ~(a = b) /\
        simple_path c1 /\ pathstart c1 = a /\ pathfinish c1 = b /\
        simple_path c2 /\ pathstart c2 = a /\ pathfinish c2 = b /\
        simple_path c /\ pathstart c = a /\ pathfinish c = b /\
        path_image c1 INTER path_image c2 = {a,b} /\
        path_image c1 INTER path_image c = {a,b} /\
        path_image c2 INTER path_image c = {a,b} /\
        ~(path_image c INTER inside(path_image c1 UNION path_image c2) = {})
        ==> inside(path_image c1 UNION path_image c) INTER
            inside(path_image c2 UNION path_image c) = {} /\
            inside(path_image c1 UNION path_image c) UNION
            inside(path_image c2 UNION path_image c) UNION
            (path_image c DIFF {a,b}) =
            inside(path_image c1 UNION path_image c2)`,
  REPEAT GEN_TAC THEN STRIP_TAC THEN
  MAP_EVERY (MP_TAC o C ISPEC JORDAN_INSIDE_OUTSIDE)
   [`(c1 ++ reversepath c2):real^1->real^2`;
    `(c1 ++ reversepath c):real^1->real^2`;
    `(c2 ++ reversepath c):real^1->real^2`] THEN
  ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN;
               PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH;
               SIMPLE_PATH_JOIN_LOOP; SIMPLE_PATH_IMP_ARC;
               PATH_IMAGE_JOIN; SIMPLE_PATH_IMP_PATH; PATH_IMAGE_REVERSEPATH;
               SIMPLE_PATH_REVERSEPATH; ARC_REVERSEPATH;
               SUBSET_REFL] THEN
  REPLICATE_TAC 3 STRIP_TAC THEN
  SUBGOAL_THEN
   `path_image(c:real^1->real^2) INTER
    outside(path_image c1 UNION path_image c2) = {}`
  ASSUME_TAC THENL
   [MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
    SUBGOAL_THEN
     `connected(path_image(c:real^1->real^2) DIFF
                {pathstart c,pathfinish c})`
    MP_TAC THENL [ASM_SIMP_TAC[CONNECTED_SIMPLE_PATH_ENDLESS]; ALL_TAC] THEN
    ASM_REWRITE_TAC[connected] THEN
    MAP_EVERY EXISTS_TAC
     [`inside(path_image c1 UNION path_image c2):real^2->bool`;
      `outside(path_image c1 UNION path_image c2):real^2->bool`] THEN
    ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `outside(path_image c1 UNION path_image c2) SUBSET
    outside(path_image c1 UNION path_image (c:real^1->real^2)) /\
    outside(path_image c1 UNION path_image c2) SUBSET
    outside(path_image c2 UNION path_image c)`
  STRIP_ASSUME_TAC THENL
   [CONJ_TAC THENL
     [ALL_TAC; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [UNION_COMM]] THEN
    MATCH_MP_TAC OUTSIDE_UNION_OUTSIDE_UNION THEN ASM_REWRITE_TAC[] THEN
    ONCE_REWRITE_TAC[UNION_COMM] THEN ASM_REWRITE_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `path_image(c1:real^1->real^2) INTER
    inside(path_image c2 UNION path_image c) = {}`
  ASSUME_TAC THENL
   [MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
    SUBGOAL_THEN
     `frontier(outside(path_image c1 UNION path_image c2)):real^2->bool =
      frontier(outside(path_image c2 UNION path_image c))`
    MP_TAC THENL
     [AP_TERM_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN
      GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [UNION_COMM] THEN
      MATCH_MP_TAC OUTSIDE_UNION_OUTSIDE_UNION THEN
      MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
      SUBGOAL_THEN
       `connected(path_image(c1:real^1->real^2) DIFF
                  {pathstart c1,pathfinish c1})`
      MP_TAC THENL [ASM_SIMP_TAC[CONNECTED_SIMPLE_PATH_ENDLESS]; ALL_TAC] THEN
      ASM_REWRITE_TAC[connected] THEN
      MAP_EVERY EXISTS_TAC
       [`inside(path_image c2 UNION path_image c):real^2->bool`;
        `outside(path_image c2 UNION path_image c):real^2->bool`] THEN
      ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
      MP_TAC(ISPEC `c:real^1->real^2` NONEMPTY_SIMPLE_PATH_ENDLESS) THEN
      ASM_REWRITE_TAC[] THEN ASM SET_TAC[]];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `path_image(c2:real^1->real^2) INTER
    inside(path_image c1 UNION path_image c) = {}`
  ASSUME_TAC THENL
   [MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
    SUBGOAL_THEN
     `frontier(outside(path_image c1 UNION path_image c2)):real^2->bool =
      frontier(outside(path_image c1 UNION path_image c))`
    MP_TAC THENL
     [AP_TERM_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN
      MATCH_MP_TAC OUTSIDE_UNION_OUTSIDE_UNION THEN
      MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
      SUBGOAL_THEN
       `connected(path_image(c2:real^1->real^2) DIFF
                  {pathstart c2,pathfinish c2})`
      MP_TAC THENL [ASM_SIMP_TAC[CONNECTED_SIMPLE_PATH_ENDLESS]; ALL_TAC] THEN
      ASM_REWRITE_TAC[connected] THEN
      MAP_EVERY EXISTS_TAC
       [`inside(path_image c1 UNION path_image c):real^2->bool`;
        `outside(path_image c1 UNION path_image c):real^2->bool`] THEN
      ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
      MP_TAC(ISPEC `c:real^1->real^2` NONEMPTY_SIMPLE_PATH_ENDLESS) THEN
      ASM_REWRITE_TAC[] THEN ASM SET_TAC[]];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `inside(path_image c1 UNION path_image (c:real^1->real^2)) SUBSET
    inside(path_image c1 UNION path_image c2) /\
    inside(path_image c2 UNION path_image (c:real^1->real^2)) SUBSET
    inside(path_image c1 UNION path_image c2)`
  STRIP_ASSUME_TAC THENL
   [CONJ_TAC THEN REWRITE_TAC[INSIDE_OUTSIDE] THEN
    REWRITE_TAC[SET_RULE `UNIV DIFF t SUBSET UNIV DIFF s <=> s SUBSET t`] THENL
     [ALL_TAC; GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [UNION_COMM]] THEN
    MATCH_MP_TAC(SET_RULE
     `out1 SUBSET out2 /\ c2 DIFF (c1 UNION c) SUBSET out2
      ==> (c1 UNION c2) UNION out1 SUBSET (c1 UNION c) UNION out2`) THEN
    ASM_REWRITE_TAC[] THEN
    REWRITE_TAC[OUTSIDE_INSIDE] THEN ASM SET_TAC[];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `inside(path_image c1 UNION path_image c :real^2->bool) SUBSET
    outside(path_image c2 UNION path_image c) /\
    inside(path_image c2 UNION path_image c) SUBSET
    outside(path_image c1 UNION path_image c)`
  STRIP_ASSUME_TAC THENL
   [REWRITE_TAC[SUBSET] THEN CONJ_TAC THEN
    X_GEN_TAC `x:real^2` THEN DISCH_TAC THENL
     [SUBGOAL_THEN `?z:real^2. z IN path_image c1 /\
                               z IN outside(path_image c2 UNION path_image c)`
      (CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THENL
       [REWRITE_TAC[OUTSIDE_INSIDE; IN_DIFF; IN_UNION; IN_UNIV] THEN
        MP_TAC(ISPEC `c1:real^1->real^2` NONEMPTY_SIMPLE_PATH_ENDLESS) THEN
        ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
        ALL_TAC] THEN
      DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
      REWRITE_TAC[OUTSIDE; IN_ELIM_THM; CONTRAPOS_THM] THEN
      MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
      MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN REWRITE_TAC[IN] THEN
      MP_TAC(ASSUME
       `open(outside(path_image c2 UNION path_image c):real^2->bool)`) THEN
      REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
      DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN ASM_REWRITE_TAC[] THEN
      DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
      MP_TAC(ASSUME
       `frontier(inside(path_image c1 UNION path_image c):real^2->bool) =
        path_image c1 UNION path_image c`) THEN
      GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN
      DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN REWRITE_TAC[frontier] THEN
      ASM_SIMP_TAC[IN_UNION; IN_DIFF; CLOSURE_APPROACHABLE; IN_ELIM_THM] THEN
      DISCH_THEN(MP_TAC o SPEC `e:real` o CONJUNCT1) THEN
      ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
      X_GEN_TAC `w:real^2` THEN STRIP_TAC THEN
      MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `w:real^2` THEN
      REWRITE_TAC[connected_component] THEN CONJ_TAC THENL
       [EXISTS_TAC
         `outside(path_image c2 UNION path_image c:real^2->bool)` THEN
        ASM_REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`;
                        OUTSIDE_NO_OVERLAP] THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
        ASM_REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] IN_BALL];
        EXISTS_TAC `inside(path_image c1 UNION path_image c:real^2->bool)` THEN
        ASM_REWRITE_TAC[] THEN
        MATCH_MP_TAC(SET_RULE
         `inside(c1 UNION c) INTER (c1 UNION c) = {} /\
          c2 INTER inside(c1 UNION c) = {}
          ==> inside(c1 UNION c) SUBSET UNIV DIFF (c2 UNION c)`) THEN
        ASM_REWRITE_TAC[INSIDE_NO_OVERLAP]];
      SUBGOAL_THEN `?z:real^2. z IN path_image c2 /\
                               z IN outside(path_image c1 UNION path_image c)`
      (CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THENL
       [REWRITE_TAC[OUTSIDE_INSIDE; IN_DIFF; IN_UNION; IN_UNIV] THEN
        MP_TAC(ISPEC `c2:real^1->real^2` NONEMPTY_SIMPLE_PATH_ENDLESS) THEN
        ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
        ALL_TAC] THEN
      DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
      REWRITE_TAC[OUTSIDE; IN_ELIM_THM; CONTRAPOS_THM] THEN
      MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
      MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN REWRITE_TAC[IN] THEN
      MP_TAC(ASSUME
       `open(outside(path_image c1 UNION path_image c):real^2->bool)`) THEN
      REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
      DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN ASM_REWRITE_TAC[] THEN
      DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
      MP_TAC(ASSUME
       `frontier(inside(path_image c2 UNION path_image c):real^2->bool) =
        path_image c2 UNION path_image c`) THEN
      GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN
      DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN REWRITE_TAC[frontier] THEN
      ASM_SIMP_TAC[IN_UNION; IN_DIFF; CLOSURE_APPROACHABLE; IN_ELIM_THM] THEN
      DISCH_THEN(MP_TAC o SPEC `e:real` o CONJUNCT1) THEN
      ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
      X_GEN_TAC `w:real^2` THEN STRIP_TAC THEN
      MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `w:real^2` THEN
      REWRITE_TAC[connected_component] THEN CONJ_TAC THENL
       [EXISTS_TAC
         `outside(path_image c1 UNION path_image c:real^2->bool)` THEN
        ASM_REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`;
                        OUTSIDE_NO_OVERLAP] THEN
        FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
        ASM_REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] IN_BALL];
        EXISTS_TAC `inside(path_image c2 UNION path_image c:real^2->bool)` THEN
        ASM_REWRITE_TAC[] THEN
        MATCH_MP_TAC(SET_RULE
         `inside(c2 UNION c) INTER (c2 UNION c) = {} /\
          c1 INTER inside(c2 UNION c) = {}
          ==> inside(c2 UNION c) SUBSET UNIV DIFF (c1 UNION c)`) THEN
        ASM_REWRITE_TAC[INSIDE_NO_OVERLAP]]];
    ALL_TAC] THEN
  CONJ_TAC THENL
   [MATCH_MP_TAC(SET_RULE
     `!u. s SUBSET u /\ t INTER u = {} ==> s INTER t = {}`) THEN
    EXISTS_TAC `outside(path_image c2 UNION path_image c):real^2->bool` THEN
    ASM_REWRITE_TAC[INSIDE_INTER_OUTSIDE];
    ALL_TAC] THEN
  SUBGOAL_THEN
   `outside (path_image c1 UNION path_image c) INTER
    outside (path_image c2 UNION path_image c):real^2->bool
    SUBSET outside (path_image c1 UNION path_image c2)`
  MP_TAC THENL
   [ALL_TAC;
    ONCE_REWRITE_TAC[SET_RULE `s INTER t = u <=>
                        (UNIV DIFF s) UNION (UNIV DIFF t) = UNIV DIFF u`] THEN
    REWRITE_TAC[GSYM UNION_WITH_INSIDE] THEN ASM SET_TAC[]] THEN
  MATCH_MP_TAC COMPONENTS_MAXIMAL THEN
  EXISTS_TAC `(:real^2) DIFF (path_image c1 UNION path_image c2)` THEN
  MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
   [ASM_REWRITE_TAC[OUTSIDE_IN_COMPONENTS]; DISCH_TAC] THEN
  CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
  MP_TAC(ISPECL
   [`closure(inside(path_image c1 UNION path_image c)):real^2->bool`;
    `closure(inside(path_image c2 UNION path_image c)):real^2->bool`]
   JANISZEWSKI_CONNECTED) THEN
  ASM_REWRITE_TAC[COMPACT_CLOSURE; CLOSED_CLOSURE] THEN
  ASM_REWRITE_TAC[CLOSURE_UNION_FRONTIER;
                  SET_RULE `UNIV DIFF (UNIV DIFF s) = s`;
                  ONCE_REWRITE_RULE[UNION_COMM] UNION_WITH_INSIDE] THEN
  REWRITE_TAC[SET_RULE
   `UNIV DIFF ((UNIV DIFF s) UNION (UNIV DIFF t)) = s INTER t`] THEN
  DISCH_THEN MATCH_MP_TAC THEN
  SUBGOAL_THEN `connected(path_image c:real^2->bool)` MP_TAC THENL
   [ASM_SIMP_TAC[CONNECTED_SIMPLE_PATH_IMAGE]; ALL_TAC] THEN
  MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
  REWRITE_TAC[GSYM UNION_WITH_INSIDE] THEN ASM SET_TAC[]);;
