Multivariate/moretop.ml

   1 (* ========================================================================= *)
   2 (* Additional topology theory.                                               *)
   3 (*                                                                           *)
   4 (*              (c) Copyright, John Harrison 1998-2013                       *)
   5 (* ========================================================================= *)
   6
   7 needs "Multivariate/realanalysis.ml";;
   8
   9 (* ------------------------------------------------------------------------- *)
  10 (* Injective map into R is also an open map w.r.t. the universe, and this    *)
  11 (* is actually an implication in both directions for an interval. Compare    *)
  12 (* the local form in INJECTIVE_INTO_1D_IMP_OPEN_MAP (not a bi-implication).  *)
  13 (* ------------------------------------------------------------------------- *)
  14
  15 let INJECTIVE_EQ_1D_OPEN_MAP_UNIV = prove
  16  (`!f:real^1->real^1 s.
  17         f continuous_on s /\ is_interval s
  18         ==>  ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=>
  19               (!t. open t /\ t SUBSET s ==> open(IMAGE f t)))`,
  20   REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
  21    [ONCE_REWRITE_TAC[OPEN_SUBOPEN] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN
  22     X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN
  23     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
  24     DISCH_THEN(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[] THEN
  25     REWRITE_TAC[BALL_1] THEN
  26     DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
  27     EXISTS_TAC `IMAGE (f:real^1->real^1)
  28                       (segment (x - lift d,x + lift d))` THEN
  29     MP_TAC(ISPECL
  30      [`f:real^1->real^1`; `x - lift d`; `x + lift d`]
  31      CONTINUOUS_INJECTIVE_IMAGE_OPEN_SEGMENT_1) THEN
  32     REWRITE_TAC[SEGMENT_1; DROP_ADD; DROP_SUB; LIFT_DROP] THEN
  33     ASM_CASES_TAC `drop x - d <= drop x + d` THENL
  34      [ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM SEGMENT_1];
  35       ASM_REAL_ARITH_TAC] THEN
  36     ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN
  37     REPEAT STRIP_TAC THENL
  38      [ASM_REWRITE_TAC[OPEN_SEGMENT_1];
  39       MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1] THEN
  40       REWRITE_TAC[DROP_ADD; DROP_SUB; LIFT_DROP] THEN ASM_REAL_ARITH_TAC;
  41       MATCH_MP_TAC IMAGE_SUBSET THEN
  42       ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET_TRANS]];
  43     MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
  44     MP_TAC(ISPECL [`f:real^1->real^1`; `x:real^1`; `y:real^1`]
  45         CONTINUOUS_IVT_LOCAL_EXTREMUM) THEN
  46     ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
  47      [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT_EQ; IS_INTERVAL_CONVEX_1;
  48                     CONTINUOUS_ON_SUBSET];
  49       DISCH_THEN(X_CHOOSE_TAC `z:real^1`) THEN
  50       FIRST_ASSUM(MP_TAC o SPEC `segment(x:real^1,y)`) THEN
  51       REWRITE_TAC[OPEN_SEGMENT_1; NOT_IMP] THEN CONJ_TAC THENL
  52        [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; IS_INTERVAL_CONVEX_1;
  53                       SUBSET_TRANS; SEGMENT_OPEN_SUBSET_CLOSED];
  54         FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC) THEN
  55         REWRITE_TAC[open_def; FORALL_IN_IMAGE] THEN
  56         DISCH_THEN(MP_TAC o SPEC `z:real^1`) THEN ASM_REWRITE_TAC[] THEN
  57         DISCH_THEN(X_CHOOSE_THEN `e:real`
  58          (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
  59         FIRST_X_ASSUM DISJ_CASES_TAC THENL
  60          [DISCH_THEN(MP_TAC o SPEC `(f:real^1->real^1) z + lift(e / &2)`);
  61           DISCH_THEN(MP_TAC o SPEC `(f:real^1->real^1) z - lift(e / &2)`)] THEN
  62         ASM_REWRITE_TAC[NORM_ARITH `dist(a + b:real^N,a) = norm b`;
  63                         NORM_ARITH `dist(a - b:real^N,a) = norm b`; NORM_LIFT;
  64                         REAL_ARITH `abs(e / &2) < e <=> &0 < e`] THEN
  65         REWRITE_TAC[IN_IMAGE] THEN
  66         DISCH_THEN(X_CHOOSE_THEN `w:real^1` (STRIP_ASSUME_TAC o GSYM)) THEN
  67         FIRST_X_ASSUM(MP_TAC o SPEC `w:real^1`) THEN
  68         ASM_SIMP_TAC[REWRITE_RULE[SUBSET] SEGMENT_OPEN_SUBSET_CLOSED] THEN
  69         REWRITE_TAC[DROP_ADD; DROP_SUB; LIFT_DROP] THEN
  70         ASM_REAL_ARITH_TAC]]]);;
  71
  72 (* ------------------------------------------------------------------------- *)
  73 (* Map f:S^m->S^n for m < n is nullhomotopic.                                *)
  74 (* ------------------------------------------------------------------------- *)
  75
  76 let INESSENTIAL_SPHEREMAP_LOWDIM_GEN = prove
  77  (`!f:real^M->real^N s t.
  78      convex s /\ bounded s /\ convex t /\ bounded t /\ aff_dim s < aff_dim t /\
  79      f continuous_on relative_frontier s /\
  80      IMAGE f (relative_frontier s) SUBSET (relative_frontier t)
  81      ==> ?c. homotopic_with (\z. T)
  82                 (relative_frontier s,relative_frontier t) f (\x. c)`,
  83   let lemma1 = prove
  84    (`!f:real^N->real^N s t.
  85         subspace s /\ subspace t /\ dim s < dim t /\ s SUBSET t /\
  86         f differentiable_on sphere(vec 0,&1) INTER s
  87         ==> ~(IMAGE f (sphere(vec 0,&1) INTER s) = sphere(vec 0,&1) INTER t)`,
  88     REPEAT STRIP_TAC THEN
  89     ABBREV_TAC
  90      `(g:real^N->real^N) =
  91       \x. norm(x) % (f:real^N->real^N)(inv(norm x) % x)` THEN
  92     SUBGOAL_THEN
  93      `(g:real^N->real^N) differentiable_on s DELETE (vec 0)`
  94     ASSUME_TAC THENL
  95      [EXPAND_TAC "g" THEN MATCH_MP_TAC DIFFERENTIABLE_ON_MUL THEN
  96       SIMP_TAC[o_DEF; DIFFERENTIABLE_ON_NORM; IN_DELETE] THEN
  97       GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
  98       MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN CONJ_TAC THENL
  99        [MATCH_MP_TAC DIFFERENTIABLE_ON_MUL THEN
 100         REWRITE_TAC[DIFFERENTIABLE_ON_ID] THEN
 101         SUBGOAL_THEN
 102          `lift o (\x:real^N. inv(norm x)) =
 103           (lift o inv o drop) o (\x. lift(norm x))`
 104         SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN
 105         MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN
 106         SIMP_TAC[DIFFERENTIABLE_ON_NORM; IN_DELETE] THEN
 107         MATCH_MP_TAC DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON THEN
 108         SIMP_TAC[FORALL_IN_IMAGE; IN_DELETE; GSYM REAL_DIFFERENTIABLE_AT] THEN
 109         REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN
 110         MATCH_MP_TAC REAL_DIFFERENTIABLE_INV_ATREAL THEN
 111         ASM_REWRITE_TAC[REAL_DIFFERENTIABLE_ID; NORM_EQ_0];
 112         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
 113             DIFFERENTIABLE_ON_SUBSET)) THEN
 114         ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; IN_INTER;
 115                      SUBSPACE_MUL; NORM_MUL; IN_DELETE] THEN
 116         SIMP_TAC[REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0]];
 117       ALL_TAC] THEN
 118     SUBGOAL_THEN
 119      `IMAGE (g:real^N->real^N) (s DELETE vec 0) = t DELETE (vec 0)`
 120     ASSUME_TAC THENL
 121      [UNDISCH_TAC `IMAGE (f:real^N->real^N) (sphere (vec 0,&1) INTER s) =
 122                    sphere (vec 0,&1) INTER t` THEN
 123       REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
 124       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE;
 125                   IN_INTER; IN_SPHERE_0] THEN
 126       EXPAND_TAC "g" THEN REWRITE_TAC[IN_IMAGE; IN_INTER; IN_SPHERE_0] THEN
 127       SIMP_TAC[IN_DELETE; VECTOR_MUL_EQ_0; NORM_EQ_0] THEN
 128       MATCH_MP_TAC(TAUT
 129        `(p ==> r) /\ (p ==> q ==> s) ==> p /\ q ==> r /\ s`) THEN
 130       CONJ_TAC THENL [ALL_TAC; DISCH_TAC] THEN
 131       DISCH_THEN(fun th -> X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
 132         MP_TAC(SPEC `inv(norm x) % x:real^N` th)) THEN
 133       ASM_SIMP_TAC[SUBSPACE_MUL; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM;
 134                    REAL_MUL_LINV; NORM_EQ_0;
 135                    NORM_ARITH `norm x = &1 ==> ~(x:real^N = vec 0)`] THEN
 136       DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
 137       EXISTS_TAC `norm(x:real^N) % y:real^N` THEN
 138       ASM_SIMP_TAC[SUBSPACE_MUL; NORM_MUL; REAL_ABS_NORM; REAL_MUL_RID] THEN
 139       ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; NORM_EQ_0] THEN
 140       ASM_REWRITE_TAC[VECTOR_MUL_LID; VECTOR_MUL_EQ_0; NORM_EQ_0] THEN
 141       ASM_SIMP_TAC[NORM_ARITH `norm x = &1 ==> ~(x:real^N = vec 0)`] THEN
 142       UNDISCH_THEN `inv(norm x) % x = (f:real^N->real^N) y`
 143        (SUBST1_TAC o SYM) THEN
 144       ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; NORM_EQ_0] THEN
 145       REWRITE_TAC[VECTOR_MUL_LID];
 146       ALL_TAC] THEN
 147     MP_TAC(ISPECL [`t:real^N->bool`; `(:real^N)`]
 148           DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS) THEN
 149     ASM_REWRITE_TAC[SUBSPACE_UNIV; DIM_UNIV; IN_UNIV; SUBSET_UNIV] THEN
 150     ABBREV_TAC `t' = {y:real^N | !x. x IN t ==> orthogonal x y}` THEN
 151     DISCH_TAC THEN
 152     SUBGOAL_THEN `subspace(t':real^N->bool)` ASSUME_TAC THENL
 153      [EXPAND_TAC "t'" THEN REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTORS];
 154       ALL_TAC] THEN
 155     SUBGOAL_THEN
 156      `?fst snd. linear fst /\ linear snd /\
 157                 (!z. fst(z) IN t /\ snd z IN t' /\ fst z + snd z = z) /\
 158                 (!x y:real^N. x IN t /\ y IN t'
 159                               ==> fst(x + y) = x /\ snd(x + y) = y)`
 160     STRIP_ASSUME_TAC THENL
 161      [MP_TAC(ISPEC `t:real^N->bool` ORTHOGONAL_SUBSPACE_DECOMP_EXISTS) THEN
 162       REWRITE_TAC[SKOLEM_THM] THEN
 163       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `fst:real^N->real^N` THEN
 164       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `snd:real^N->real^N` THEN
 165       DISCH_THEN(MP_TAC o GSYM) THEN
 166       ASM_SIMP_TAC[SPAN_OF_SUBSPACE; FORALL_AND_THM] THEN STRIP_TAC THEN
 167       MATCH_MP_TAC(TAUT `r /\ (r ==> p /\ q /\ s) ==> p /\ q /\ r /\ s`) THEN
 168       CONJ_TAC THENL
 169        [EXPAND_TAC "t'" THEN REWRITE_TAC[IN_ELIM_THM] THEN
 170         ASM_MESON_TAC[ORTHOGONAL_SYM];
 171         DISCH_TAC] THEN
 172       MATCH_MP_TAC(TAUT `r /\ (r ==> p /\ q) ==> p /\ q /\ r`) THEN
 173       CONJ_TAC THENL
 174        [REPEAT GEN_TAC THEN STRIP_TAC THEN
 175         MATCH_MP_TAC ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE THEN
 176         MAP_EVERY EXISTS_TAC [`t:real^N->bool`; `t':real^N->bool`] THEN
 177         ASM_SIMP_TAC[SPAN_OF_SUBSPACE] THEN ASM SET_TAC[];
 178         DISCH_TAC] THEN
 179       REWRITE_TAC[linear] THEN
 180       MATCH_MP_TAC(TAUT `(p /\ r) /\ (q /\ s) ==> (p /\ q) /\ (r /\ s)`) THEN
 181       REWRITE_TAC[AND_FORALL_THM] THEN CONJ_TAC THEN REPEAT GEN_TAC THEN
 182       MATCH_MP_TAC ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE THEN
 183       MAP_EVERY EXISTS_TAC [`t:real^N->bool`; `t':real^N->bool`] THEN
 184       ASM_SIMP_TAC[SPAN_OF_SUBSPACE; SUBSPACE_ADD; SUBSPACE_MUL] THEN
 185       (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
 186       ASM_REWRITE_TAC[GSYM VECTOR_ADD_LDISTRIB] THEN
 187       ONCE_REWRITE_TAC[VECTOR_ARITH
 188        `(x + y) + (x' + y'):real^N = (x + x') + (y + y')`] THEN
 189       ASM_REWRITE_TAC[];
 190       ALL_TAC] THEN
 191     MP_TAC(ISPECL
 192      [`\x:real^N. (g:real^N->real^N)(fst x) + snd x`;
 193       `{x + y:real^N | x IN (s DELETE vec 0) /\ y IN t'}`]
 194         NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE) THEN
 195     REWRITE_TAC[LE_REFL; NOT_IMP] THEN REPEAT CONJ_TAC THENL
 196      [MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN
 197       MP_TAC(ISPECL [`s:real^N->bool`; `t':real^N->bool`] DIM_SUMS_INTER) THEN
 198       ASM_REWRITE_TAC[IN_DELETE] THEN
 199       FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE
 200        `t' + t = n ==> s < t /\ d' <= d /\ i = 0
 201            ==> d + i = s + t' ==> d' < n`)) THEN
 202       ASM_REWRITE_TAC[DIM_EQ_0] THEN CONJ_TAC THENL
 203        [MATCH_MP_TAC DIM_SUBSET THEN SET_TAC[]; EXPAND_TAC "t'"] THEN
 204       REWRITE_TAC[SUBSET; IN_INTER; IN_SING; IN_ELIM_THM] THEN
 205       ASM_MESON_TAC[SUBSET; ORTHOGONAL_REFL];
 206       MATCH_MP_TAC DIFFERENTIABLE_ON_ADD THEN
 207       ASM_SIMP_TAC[DIFFERENTIABLE_ON_LINEAR] THEN
 208       GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
 209       MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN
 210       ASM_SIMP_TAC[DIFFERENTIABLE_ON_LINEAR] THEN
 211       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
 212         DIFFERENTIABLE_ON_SUBSET)) THEN
 213       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
 214       RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[IN_DELETE];
 215       SUBGOAL_THEN
 216        `~negligible {x + y | x IN IMAGE (g:real^N->real^N) (s DELETE vec 0) /\
 217                              y IN t'}`
 218       MP_TAC THENL
 219        [ASM_REWRITE_TAC[] THEN
 220         SUBGOAL_THEN `negligible(t':real^N->bool)` MP_TAC THENL
 221          [MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN ASM_ARITH_TAC;
 222           REWRITE_TAC[TAUT `p ==> ~q <=> ~(p /\ q)`]] THEN
 223         REWRITE_TAC[GSYM NEGLIGIBLE_UNION_EQ] THEN
 224         MP_TAC NOT_NEGLIGIBLE_UNIV THEN MATCH_MP_TAC EQ_IMP THEN
 225         AP_TERM_TAC THEN AP_TERM_TAC THEN
 226         REWRITE_TAC[EXTENSION; IN_UNION; IN_UNIV; IN_ELIM_THM; IN_DELETE] THEN
 227         X_GEN_TAC `z:real^N` THEN
 228         REWRITE_TAC[TAUT `p \/ q <=> ~p ==> q`] THEN DISCH_TAC THEN
 229         EXISTS_TAC `(fst:real^N->real^N) z` THEN
 230         EXISTS_TAC `(snd:real^N->real^N) z` THEN
 231         ASM_SIMP_TAC[] THEN ASM_MESON_TAC[VECTOR_ADD_LID];
 232         REWRITE_TAC[CONTRAPOS_THM] THEN
 233         MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN
 234         REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM;
 235                     FORALL_IN_IMAGE; IN_DELETE] THEN
 236         X_GEN_TAC `x:real^N` THEN REPEAT DISCH_TAC THEN
 237         X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
 238         REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `x + y:real^N` THEN
 239         RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[] THEN ASM
 240         SET_TAC[]]]) in
 241   let lemma2 = prove
 242    (`!f:real^N->real^N s t.
 243           subspace s /\ subspace t /\ dim s < dim t /\ s SUBSET t /\
 244           f continuous_on sphere(vec 0,&1) INTER s /\
 245           IMAGE f (sphere(vec 0,&1) INTER s) SUBSET sphere(vec 0,&1) INTER t
 246           ==> ?c. homotopic_with (\x. T)
 247                           (sphere(vec 0,&1) INTER s,sphere(vec 0,&1) INTER t)
 248                           f (\x. c)`,
 249     REPEAT STRIP_TAC THEN
 250     MP_TAC(ISPECL [`f:real^N->real^N`; `sphere(vec 0:real^N,&1) INTER s`;
 251                    `&1 / &2`; `t:real^N->bool`;]
 252           STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION_SUBSPACE) THEN
 253     CONV_TAC REAL_RAT_REDUCE_CONV THEN
 254     ASM_SIMP_TAC[COMPACT_INTER_CLOSED; COMPACT_SPHERE; CLOSED_SUBSPACE] THEN
 255     ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE]] THEN
 256     DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC) THEN
 257     SUBGOAL_THEN
 258      `!x. x IN sphere(vec 0,&1) INTER s ==> ~((g:real^N->real^N) x = vec 0)`
 259     ASSUME_TAC THENL
 260      [X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
 261       FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
 262       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
 263       REWRITE_TAC[FORALL_IN_IMAGE; IN_SPHERE_0] THEN
 264       RULE_ASSUM_TAC(REWRITE_RULE[IN_SPHERE_0]) THEN
 265       DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
 266       ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_INTER; IN_SPHERE_0] THEN
 267       CONV_TAC NORM_ARITH;
 268       ALL_TAC] THEN
 269     SUBGOAL_THEN `(g:real^N->real^N) differentiable_on
 270                   sphere(vec 0,&1) INTER s`
 271     ASSUME_TAC THENL
 272      [ASM_SIMP_TAC[DIFFERENTIABLE_ON_VECTOR_POLYNOMIAL_FUNCTION]; ALL_TAC] THEN
 273     ABBREV_TAC `(h:real^N->real^N) = \x. inv(norm(g x)) % g x` THEN
 274     SUBGOAL_THEN
 275      `!x. x IN sphere(vec 0,&1) INTER s
 276           ==> (h:real^N->real^N) x IN sphere(vec 0,&1) INTER t`
 277     ASSUME_TAC THENL
 278      [REPEAT STRIP_TAC THEN EXPAND_TAC "h" THEN
 279       ASM_SIMP_TAC[SUBSPACE_MUL; IN_INTER; IN_SPHERE_0; NORM_MUL] THEN
 280       REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NORM] THEN
 281       ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0; GSYM IN_SPHERE_0];
 282       ALL_TAC] THEN
 283     SUBGOAL_THEN
 284      `(h:real^N->real^N) differentiable_on sphere(vec 0,&1) INTER s`
 285     ASSUME_TAC THENL
 286      [EXPAND_TAC "h" THEN MATCH_MP_TAC DIFFERENTIABLE_ON_MUL THEN
 287       ASM_SIMP_TAC[DIFFERENTIABLE_ON_VECTOR_POLYNOMIAL_FUNCTION; o_DEF] THEN
 288       SUBGOAL_THEN
 289        `(\x. lift(inv(norm((g:real^N->real^N) x)))) =
 290         (lift o inv o drop) o (\x. lift(norm x)) o (g:real^N->real^N)`
 291       SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN
 292       MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN CONJ_TAC THENL
 293        [MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN
 294         ASM_SIMP_TAC[DIFFERENTIABLE_ON_VECTOR_POLYNOMIAL_FUNCTION] THEN
 295         MATCH_MP_TAC DIFFERENTIABLE_ON_NORM THEN
 296         ASM_REWRITE_TAC[SET_RULE
 297          `~(z IN IMAGE f s) <=> !x. x IN s ==> ~(f x = z)`];
 298         MATCH_MP_TAC DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON THEN
 299         REWRITE_TAC[GSYM REAL_DIFFERENTIABLE_AT] THEN
 300         REWRITE_TAC[FORALL_IN_IMAGE; IN_SPHERE_0] THEN
 301         X_GEN_TAC `x:real^N` THEN
 302         ASM_CASES_TAC `x:real^N = vec 0` THEN
 303         ASM_REWRITE_TAC[NORM_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN DISCH_TAC THEN
 304         REWRITE_TAC[GSYM REAL_DIFFERENTIABLE_AT; o_THM] THEN
 305         GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN
 306         MATCH_MP_TAC REAL_DIFFERENTIABLE_INV_ATREAL THEN
 307         ASM_SIMP_TAC[REAL_DIFFERENTIABLE_ID; NORM_EQ_0; IN_SPHERE_0]];
 308       ALL_TAC] THEN
 309     SUBGOAL_THEN
 310      `?c. homotopic_with (\z. T)
 311              (sphere(vec 0,&1) INTER s,sphere(vec 0,&1) INTER t)
 312              (h:real^N->real^N) (\x. c)`
 313     MP_TAC THENL
 314      [ALL_TAC;
 315       MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
 316       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_TRANS) THEN
 317       SUBGOAL_THEN
 318        `homotopic_with (\z. T)
 319                        (sphere(vec 0:real^N,&1) INTER s,t DELETE (vec 0:real^N))
 320                        f g`
 321       MP_TAC THENL
 322        [MATCH_MP_TAC HOMOTOPIC_WITH_LINEAR THEN
 323         ASM_SIMP_TAC[CONTINUOUS_ON_VECTOR_POLYNOMIAL_FUNCTION] THEN
 324         X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[SET_RULE
 325           `s SUBSET t DELETE v <=> s SUBSET t /\ ~(v IN s)`] THEN
 326         CONJ_TAC THENL
 327          [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
 328           ASM_SIMP_TAC[SUBSPACE_IMP_CONVEX] THEN ASM SET_TAC[];
 329           DISCH_THEN(MP_TAC o MATCH_MP SEGMENT_BOUND) THEN
 330           SUBGOAL_THEN
 331            `(f:real^N->real^N) x IN sphere(vec 0,&1) /\
 332             norm(f x - g x) < &1/ &2`
 333           MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
 334           REWRITE_TAC[IN_SPHERE_0] THEN CONV_TAC NORM_ARITH];
 335         DISCH_THEN(MP_TAC o
 336           ISPECL [`\y:real^N. inv(norm y) % y`;
 337                   `sphere(vec 0:real^N,&1) INTER t`] o
 338           MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
 339           HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN
 340         ASM_REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL
 341          [CONJ_TAC THENL
 342            [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
 343             REWRITE_TAC[o_DEF; CONTINUOUS_ON_ID] THEN
 344             MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
 345             SIMP_TAC[IN_DELETE; NORM_EQ_0] THEN
 346             REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_NORM];
 347             REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE; IN_INTER] THEN
 348             ASM_SIMP_TAC[SUBSPACE_MUL; IN_SPHERE_0; NORM_MUL; REAL_ABS_MUL] THEN
 349             SIMP_TAC[REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0]];
 350           MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN
 351           RULE_ASSUM_TAC(REWRITE_RULE
 352            [SUBSET; IN_INTER; FORALL_IN_IMAGE; IN_SPHERE_0]) THEN
 353           ASM_SIMP_TAC[IN_SPHERE_0; IN_INTER;
 354                        REAL_INV_1; VECTOR_MUL_LID]]]] THEN
 355     SUBGOAL_THEN
 356      `?c. c IN (sphere(vec 0,&1) INTER t) DIFF
 357                (IMAGE (h:real^N->real^N) (sphere(vec 0,&1) INTER s))`
 358     MP_TAC THENL
 359      [MATCH_MP_TAC(SET_RULE
 360        `t SUBSET s /\ ~(t = s) ==> ?a. a IN s DIFF t`) THEN
 361       CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC lemma1] THEN
 362       ASM_REWRITE_TAC[];
 363       REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_INTER; IN_DIFF; IN_IMAGE] THEN
 364       REWRITE_TAC[SET_RULE
 365        `~(?x. P x /\ x IN s /\ x IN t) <=>
 366         (!x. x IN s INTER t ==> ~(P x))`] THEN
 367       X_GEN_TAC `c:real^N` THEN STRIP_TAC] THEN
 368     EXISTS_TAC `--c:real^N` THEN
 369     SUBGOAL_THEN
 370      `homotopic_with (\z. T)
 371                      (sphere(vec 0:real^N,&1) INTER s,t DELETE (vec 0:real^N))
 372                      h (\x. --c)`
 373     MP_TAC THENL
 374      [MATCH_MP_TAC HOMOTOPIC_WITH_LINEAR THEN
 375       ASM_SIMP_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_ON; CONTINUOUS_ON_CONST] THEN
 376       X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[SET_RULE
 377         `s SUBSET t DELETE v <=> s SUBSET t /\ ~(v IN s)`] THEN
 378       CONJ_TAC THENL
 379        [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
 380         ASM_SIMP_TAC[SUBSPACE_IMP_CONVEX; INSERT_SUBSET; SUBSPACE_NEG] THEN
 381         ASM SET_TAC[];
 382         DISCH_TAC THEN MP_TAC(ISPECL
 383          [`(h:real^N->real^N) x`; `vec 0:real^N`; `--c:real^N`]
 384          MIDPOINT_BETWEEN) THEN
 385         ASM_REWRITE_TAC[BETWEEN_IN_SEGMENT; DIST_0; NORM_NEG] THEN
 386         SUBGOAL_THEN `((h:real^N->real^N) x) IN sphere(vec 0,&1) /\
 387                       (c:real^N) IN sphere(vec 0,&1)`
 388         MP_TAC THENL [ASM SET_TAC[]; SIMP_TAC[IN_SPHERE_0]] THEN
 389         STRIP_TAC THEN REWRITE_TAC[midpoint; VECTOR_ARITH
 390          `vec 0:real^N = inv(&2) % (x + --y) <=> x = y`] THEN
 391         ASM SET_TAC[]];
 392       DISCH_THEN(MP_TAC o
 393         ISPECL [`\y:real^N. inv(norm y) % y`;
 394                 `sphere(vec 0:real^N,&1) INTER t`] o
 395         MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
 396         HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN
 397       ASM_REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL
 398        [CONJ_TAC THENL
 399          [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
 400           REWRITE_TAC[o_DEF; CONTINUOUS_ON_ID] THEN
 401           MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
 402           SIMP_TAC[IN_DELETE; NORM_EQ_0] THEN
 403           REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_NORM];
 404           REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE; IN_INTER] THEN
 405           ASM_SIMP_TAC[SUBSPACE_MUL; IN_SPHERE_0; NORM_MUL; REAL_ABS_MUL] THEN
 406           SIMP_TAC[REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0]];
 407         MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN
 408         RULE_ASSUM_TAC(REWRITE_RULE
 409          [SUBSET; IN_INTER; FORALL_IN_IMAGE; IN_SPHERE_0]) THEN
 410         ASM_SIMP_TAC[IN_SPHERE_0; IN_INTER; REAL_INV_1; VECTOR_MUL_LID;
 411                      NORM_NEG]]]) in
 412   let lemma3 = prove
 413    (`!s:real^M->bool u:real^N->bool.
 414           bounded s /\ convex s /\ subspace u /\ aff_dim s <= &(dim u)
 415           ==> ?t. subspace t /\ t SUBSET u /\
 416                   (~(s = {}) ==> aff_dim t = aff_dim s) /\
 417                   (relative_frontier s) homeomorphic
 418                   (sphere(vec 0,&1) INTER t)`,
 419     REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL
 420      [STRIP_TAC THEN EXISTS_TAC `{vec 0:real^N}` THEN
 421       ASM_REWRITE_TAC[SUBSPACE_TRIVIAL; RELATIVE_FRONTIER_EMPTY] THEN
 422       ASM_SIMP_TAC[HOMEOMORPHIC_EMPTY;
 423                    SET_RULE `s INTER {a} = {} <=> ~(a IN s)`;
 424                    IN_SPHERE_0; NORM_0; SING_SUBSET; SUBSPACE_0] THEN
 425       CONV_TAC REAL_RAT_REDUCE_CONV;
 426       FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^M` MP_TAC o
 427           GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
 428       GEOM_ORIGIN_TAC `a:real^M` THEN
 429       SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; INT_OF_NUM_LE; GSYM DIM_UNIV] THEN
 430       REPEAT STRIP_TAC] THEN
 431     FIRST_ASSUM(MP_TAC o MATCH_MP CHOOSE_SUBSPACE_OF_SUBSPACE) THEN
 432     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
 433     ASM_SIMP_TAC[SPAN_OF_SUBSPACE; AFF_DIM_DIM_SUBSPACE; INT_OF_NUM_EQ] THEN
 434     STRIP_TAC THEN
 435     TRANS_TAC HOMEOMORPHIC_TRANS
 436      `relative_frontier(ball(vec 0:real^N,&1) INTER t)` THEN
 437     CONJ_TAC THENL
 438      [MATCH_MP_TAC HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS THEN
 439       ASM_SIMP_TAC[CONVEX_INTER; BOUNDED_INTER; BOUNDED_BALL;
 440                    SUBSPACE_IMP_CONVEX; CONVEX_BALL] THEN
 441       ONCE_REWRITE_TAC[INTER_COMM] THEN
 442       FIRST_ASSUM(ASSUME_TAC o MATCH_MP SUBSPACE_0) THEN
 443       SUBGOAL_THEN `~(t INTER ball(vec 0:real^N,&1) = {})` ASSUME_TAC THENL
 444        [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `vec 0:real^N` THEN
 445         ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_LT_01];
 446         ASM_SIMP_TAC[AFF_DIM_CONVEX_INTER_OPEN; OPEN_BALL;
 447                      SUBSPACE_IMP_CONVEX] THEN
 448         ASM_SIMP_TAC[AFF_DIM_DIM_0; HULL_INC]];
 449       MATCH_MP_TAC(MESON[HOMEOMORPHIC_REFL] `s = t ==> s homeomorphic t`) THEN
 450       SIMP_TAC[GSYM FRONTIER_BALL; REAL_LT_01] THEN
 451       MATCH_MP_TAC RELATIVE_FRONTIER_CONVEX_INTER_AFFINE THEN
 452       ASM_SIMP_TAC[CONVEX_BALL; SUBSPACE_IMP_AFFINE;
 453                    GSYM MEMBER_NOT_EMPTY] THEN
 454       EXISTS_TAC `vec 0:real^N` THEN
 455       ASM_SIMP_TAC[CENTRE_IN_BALL; INTERIOR_OPEN; OPEN_BALL;
 456                    SUBSPACE_0; IN_INTER; REAL_LT_01]]) in
 457     ONCE_REWRITE_TAC[MESON[] `(!a b c. P a b c) <=> (!b c a. P a b c)`] THEN
 458     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
 459     REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
 460     REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN REPEAT GEN_TAC THEN
 461     ASM_CASES_TAC `s:real^M->bool = {}` THENL
 462      [ASM_SIMP_TAC[HOMOTOPIC_WITH; RELATIVE_FRONTIER_EMPTY; PCROSS_EMPTY;
 463                    NOT_IN_EMPTY; IMAGE_CLAUSES; CONTINUOUS_ON_EMPTY];
 464       ALL_TAC] THEN
 465     ASM_CASES_TAC `t:real^N->bool = {}` THEN
 466     ASM_SIMP_TAC[AFF_DIM_EMPTY; GSYM INT_NOT_LE; AFF_DIM_GE] THEN
 467     STRIP_TAC THEN
 468     MP_TAC(ISPECL [`t:real^N->bool`; `(:real^N)`] lemma3) THEN
 469     ASM_REWRITE_TAC[DIM_UNIV; SUBSPACE_UNIV; AFF_DIM_LE_UNIV] THEN
 470     DISCH_THEN(X_CHOOSE_THEN `t':real^N->bool` STRIP_ASSUME_TAC) THEN
 471     FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT) THEN
 472     DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP
 473       HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY_NULL th]) THEN
 474     MP_TAC(ISPECL [`s:real^M->bool`; `t':real^N->bool`] lemma3) THEN
 475     ASM_SIMP_TAC[GSYM AFF_DIM_DIM_SUBSPACE] THEN
 476     ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN
 477     DISCH_THEN(X_CHOOSE_THEN `s':real^N->bool` STRIP_ASSUME_TAC) THEN
 478     FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT) THEN
 479     DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP
 480       HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL th]) THEN
 481     REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma2 THEN
 482     ASM_SIMP_TAC[GSYM INT_OF_NUM_LT; GSYM AFF_DIM_DIM_SUBSPACE] THEN
 483     ASM_INT_ARITH_TAC);;
 484
 485 let INESSENTIAL_SPHEREMAP_LOWDIM = prove
 486  (`!f:real^M->real^N a r b s.
 487         dimindex(:M) < dimindex(:N) /\
 488         f continuous_on sphere(a,r) /\
 489         IMAGE f (sphere(a,r)) SUBSET (sphere(b,s))
 490         ==> ?c. homotopic_with (\z. T) (sphere(a,r),sphere(b,s)) f (\x. c)`,
 491   REPEAT GEN_TAC THEN ASM_CASES_TAC `s <= &0` THEN
 492   ASM_SIMP_TAC[NULLHOMOTOPIC_INTO_CONTRACTIBLE; CONTRACTIBLE_SPHERE] THEN
 493   ASM_CASES_TAC `r <= &0` THEN
 494   ASM_SIMP_TAC[NULLHOMOTOPIC_FROM_CONTRACTIBLE; CONTRACTIBLE_SPHERE] THEN
 495   ASM_SIMP_TAC[GSYM FRONTIER_CBALL; INTERIOR_CBALL; BALL_EQ_EMPTY;
 496                CONV_RULE(RAND_CONV SYM_CONV) (SPEC_ALL
 497                RELATIVE_FRONTIER_NONEMPTY_INTERIOR)] THEN
 498   STRIP_TAC THEN MATCH_MP_TAC INESSENTIAL_SPHEREMAP_LOWDIM_GEN THEN
 499   ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; AFF_DIM_CBALL] THEN
 500   ASM_REWRITE_TAC[GSYM REAL_NOT_LE; INT_OF_NUM_LT]);;
 501
 502 let HOMEOMORPHIC_SPHERES_EQ,HOMOTOPY_EQUIVALENT_SPHERES_EQ =
 503  (CONJ_PAIR o prove)
 504  (`(!a:real^M b:real^N r s.
 505         sphere(a,r) homeomorphic sphere(b,s) <=>
 506         r < &0 /\ s < &0 \/ r = &0 /\ s = &0 \/
 507         &0 < r /\ &0 < s /\ dimindex(:M) = dimindex(:N)) /\
 508    (!a:real^M b:real^N r s.
 509         sphere(a,r) homotopy_equivalent sphere(b,s) <=>
 510         r < &0 /\ s < &0 \/ r = &0 /\ s = &0 \/
 511         &0 < r /\ &0 < s /\ dimindex(:M) = dimindex(:N))`,
 512   let lemma = prove
 513    (`!a:real^M r b:real^N s.
 514           dimindex(:M) < dimindex(:N) /\ &0 < r /\ &0 < s
 515           ==> ~(sphere(a,r) homotopy_equivalent sphere(b,s))`,
 516     REPEAT STRIP_TAC THEN
 517     FIRST_ASSUM(MP_TAC o ISPEC `sphere(a:real^M,r)` o
 518         MATCH_MP HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY) THEN
 519     MATCH_MP_TAC(TAUT `~p /\ q ==> (p <=> q) ==> F`) THEN CONJ_TAC THENL
 520      [SUBGOAL_THEN `~(sphere(a:real^M,r) = {})` MP_TAC THENL
 521        [REWRITE_TAC[SPHERE_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC;
 522         REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM]] THEN
 523       X_GEN_TAC `c:real^M` THEN DISCH_TAC THEN
 524       DISCH_THEN(MP_TAC o SPECL[`\a:real^M. a`; `(\a. c):real^M->real^M`]) THEN
 525       SIMP_TAC[CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID;
 526                IMAGE_ID; SUBSET_REFL] THEN
 527       REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
 528       SUBGOAL_THEN `~(contractible(sphere(a:real^M,r)))` MP_TAC THENL
 529        [REWRITE_TAC[CONTRACTIBLE_SPHERE] THEN ASM_REAL_ARITH_TAC;
 530         REWRITE_TAC[contractible] THEN MESON_TAC[]];
 531       MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^M->real^N`] THEN
 532       STRIP_TAC THEN
 533       MP_TAC(ISPEC `g:real^M->real^N` INESSENTIAL_SPHEREMAP_LOWDIM) THEN
 534       MP_TAC(ISPEC `f:real^M->real^N` INESSENTIAL_SPHEREMAP_LOWDIM) THEN
 535       ASM_REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN DISCH_THEN
 536        (MP_TAC o SPECL [`a:real^M`; `r:real`; `b:real^N`; `s:real`]) THEN
 537       ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ; RIGHT_IMP_FORALL_THM] THEN
 538       REPEAT GEN_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN
 539        (fun th -> CONJUNCTS_THEN (ASSUME_TAC o MATCH_MP
 540                          HOMOTOPIC_WITH_IMP_SUBSET) th THEN
 541                   MP_TAC th) THEN
 542       MATCH_MP_TAC(MESON[HOMOTOPIC_WITH_TRANS; HOMOTOPIC_WITH_SYM]
 543           `homotopic_with p (s,t) c d
 544             ==> homotopic_with p (s,t) f c /\
 545                 homotopic_with p (s,t) g d
 546                 ==> homotopic_with p (s,t) f g`) THEN
 547       REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN DISJ2_TAC THEN
 548       MP_TAC(ISPECL [`b:real^N`; `s:real`] PATH_CONNECTED_SPHERE) THEN
 549       ANTS_TAC THENL
 550        [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE
 551          `m < n ==> 1 <= m ==> 2 <= n`)) THEN REWRITE_TAC[DIMINDEX_GE_1];
 552         REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
 553         DISCH_THEN MATCH_MP_TAC THEN
 554         SUBGOAL_THEN `~(sphere(a:real^M,r) = {})` MP_TAC THENL
 555          [REWRITE_TAC[SPHERE_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC;
 556           ASM SET_TAC[]]]]) in
 557   REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
 558   MATCH_MP_TAC(TAUT
 559    `(r ==> p) /\ (q ==> r) /\ (p ==> q) ==> (r <=> q) /\ (p <=> q)`) THEN
 560   REWRITE_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT] THEN
 561   ASM_CASES_TAC `r < &0` THEN
 562   ASM_SIMP_TAC[SPHERE_EMPTY; SPHERE_EQ_EMPTY;
 563                HOMEOMORPHIC_EMPTY; HOMOTOPY_EQUIVALENT_EMPTY]
 564   THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
 565   ASM_CASES_TAC `s < &0` THEN
 566   ASM_SIMP_TAC[SPHERE_EMPTY; SPHERE_EQ_EMPTY;
 567                HOMEOMORPHIC_EMPTY; HOMOTOPY_EQUIVALENT_EMPTY]
 568   THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
 569   ASM_CASES_TAC `r = &0` THEN
 570   ASM_SIMP_TAC[SPHERE_SING; REAL_LT_REFL; HOMEOMORPHIC_SING;
 571                HOMOTOPY_EQUIVALENT_SING; CONTRACTIBLE_SPHERE;
 572                ONCE_REWRITE_RULE[HOMOTOPY_EQUIVALENT_SYM]
 573                    HOMOTOPY_EQUIVALENT_SING]
 574   THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
 575   ASM_CASES_TAC `s = &0` THEN
 576   ASM_SIMP_TAC[SPHERE_SING; REAL_LT_REFL; HOMEOMORPHIC_SING;
 577                HOMOTOPY_EQUIVALENT_SING; CONTRACTIBLE_SPHERE;
 578                ONCE_REWRITE_RULE[HOMOTOPY_EQUIVALENT_SYM]
 579                    HOMOTOPY_EQUIVALENT_SING]
 580   THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
 581   SUBGOAL_THEN `&0 < r /\ &0 < s` STRIP_ASSUME_TAC THENL
 582    [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN
 583   CONJ_TAC THENL
 584    [DISCH_THEN(fun th ->
 585       let t = `?a:real^M b:real^N. ~(sphere(a,r) homeomorphic sphere(b,s))` in
 586       MP_TAC(DISCH t (GEOM_EQUAL_DIMENSION_RULE th (ASSUME t)))) THEN
 587     ASM_SIMP_TAC[HOMEOMORPHIC_SPHERES] THEN MESON_TAC[];
 588     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
 589     REWRITE_TAC[ARITH_RULE `~(m:num = n) <=> m < n \/ n < m`] THEN
 590     STRIP_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[HOMOTOPY_EQUIVALENT_SYM]] THEN
 591     ASM_SIMP_TAC[lemma]]);;
 592
 593 let SIMPLY_CONNECTED_SPHERE_GEN = prove
 594  (`!s. convex s /\ bounded s /\ &3 <= aff_dim s
 595        ==> simply_connected(relative_frontier s)`,
 596   REPEAT STRIP_TAC THEN
 597   ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_CIRCLEMAP;
 598                PATH_CONNECTED_SPHERE_GEN;
 599                INT_ARITH `&3:int <= x ==> ~(x = &1)`] THEN
 600   SUBGOAL_THEN `sphere(vec 0:real^2,&1) = relative_frontier(cball(vec 0,&1))`
 601   SUBST1_TAC THENL
 602    [REWRITE_TAC[RELATIVE_FRONTIER_CBALL; REAL_OF_NUM_EQ; ARITH]; ALL_TAC] THEN
 603   REPEAT STRIP_TAC THEN
 604   MATCH_MP_TAC INESSENTIAL_SPHEREMAP_LOWDIM_GEN THEN
 605   ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; AFF_DIM_CBALL] THEN
 606   REWRITE_TAC[DIMINDEX_2; REAL_LT_01] THEN ASM_INT_ARITH_TAC);;
 607
 608 let SIMPLY_CONNECTED_SPHERE = prove
 609  (`!a:real^N r. 3 <= dimindex(:N) ==> simply_connected(sphere(a,r))`,
 610   REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
 611    (REAL_ARITH `r < &0 \/ r = &0 \/ &0 < r`) THEN
 612   ASM_SIMP_TAC[SPHERE_EMPTY; SIMPLY_CONNECTED_EMPTY] THEN
 613   ASM_SIMP_TAC[SPHERE_SING; CONVEX_SING; CONVEX_IMP_SIMPLY_CONNECTED] THEN
 614   MP_TAC(ISPEC `cball(a:real^N,r)` SIMPLY_CONNECTED_SPHERE_GEN) THEN
 615   ASM_SIMP_TAC[AFF_DIM_CBALL; RELATIVE_FRONTIER_CBALL; CONVEX_CBALL;
 616                BOUNDED_CBALL; REAL_LT_IMP_NE; INT_OF_NUM_LE]);;
 617
 618 let SIMPLY_CONNECTED_PUNCTURED_CONVEX = prove
 619  (`!s a:real^N.
 620         convex s /\ &3 <= aff_dim s ==> simply_connected(s DELETE a)`,
 621   REPEAT STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN relative_interior s` THENL
 622    [ALL_TAC;
 623     MATCH_MP_TAC CONTRACTIBLE_IMP_SIMPLY_CONNECTED THEN
 624     MATCH_MP_TAC CONTRACTIBLE_CONVEX_TWEAK_BOUNDARY_POINTS THEN
 625     EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
 626     MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN
 627     MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]] THEN
 628   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR_CBALL]) THEN
 629   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
 630    (X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC)) THEN
 631   MP_TAC(ISPECL
 632    [`cball(a:real^N,e) INTER affine hull s`; `s:real^N->bool`; `a:real^N`]
 633         HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_CONVEX) THEN
 634   ANTS_TAC THENL
 635    [ALL_TAC;
 636     MATCH_MP_TAC(MESON[HOMOTOPY_EQUIVALENT_SIMPLE_CONNECTEDNESS]
 637      `simply_connected s
 638       ==> s homotopy_equivalent t ==> simply_connected t`) THEN
 639     MATCH_MP_TAC SIMPLY_CONNECTED_SPHERE_GEN] THEN
 640   ASM_SIMP_TAC[CONVEX_INTER; AFFINE_AFFINE_HULL; AFFINE_IMP_CONVEX;
 641                CONVEX_CBALL; BOUNDED_INTER; BOUNDED_CBALL] THEN
 642   REPEAT CONJ_TAC THENL
 643    [W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_INTERIOR_CONVEX_INTER_AFFINE o
 644         rand o snd) THEN
 645     REWRITE_TAC[CONVEX_CBALL; AFFINE_AFFINE_HULL; INTERIOR_CBALL] THEN
 646     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM; IN_INTER] THEN
 647     DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_SIMP_TAC[CENTRE_IN_BALL] THEN
 648     ANTS_TAC THENL
 649      [ALL_TAC;
 650       DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC[CENTRE_IN_BALL; IN_INTER]] THEN
 651     ASM_MESON_TAC[SUBSET; HULL_SUBSET; RELATIVE_INTERIOR_SUBSET];
 652     REWRITE_TAC[relative_frontier] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
 653      (SET_RULE `s SUBSET u ==> c = s ==> c DIFF i SUBSET u`)) THEN
 654     REWRITE_TAC[CLOSURE_EQ] THEN MATCH_MP_TAC CLOSED_INTER THEN
 655     REWRITE_TAC[CLOSED_AFFINE_HULL; CLOSED_CBALL];
 656     ONCE_REWRITE_TAC[INTER_COMM] THEN
 657     W(MP_TAC o PART_MATCH (lhs o rand)
 658
 659       AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR o rand o snd);
 660     ONCE_REWRITE_TAC[INTER_COMM] THEN
 661     W(MP_TAC o PART_MATCH (lhs o rand) AFF_DIM_CONVEX_INTER_NONEMPTY_INTERIOR o
 662         rand o snd)] THEN
 663   ASM_SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; GSYM MEMBER_NOT_EMPTY;
 664                LEFT_IMP_EXISTS_THM; IN_INTER] THEN
 665   DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN
 666   ASM_SIMP_TAC[INTERIOR_CBALL; CENTRE_IN_BALL; HULL_INC; HULL_SUBSET;
 667                AFF_DIM_AFFINE_HULL]);;
 668
 669 let SIMPLY_CONNECTED_PUNCTURED_UNIVERSE = prove
 670  (`!a. 3 <= dimindex(:N) ==> simply_connected((:real^N) DELETE a)`,
 671   GEN_TAC THEN DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `&1`] o
 672     MATCH_MP SIMPLY_CONNECTED_SPHERE) THEN
 673   MATCH_MP_TAC EQ_IMP THEN
 674   MATCH_MP_TAC HOMOTOPY_EQUIVALENT_SIMPLE_CONNECTEDNESS THEN
 675   MP_TAC(ISPECL [`cball(a:real^N,&1)`; `a:real^N`]
 676         HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_AFFINE_HULL) THEN
 677   REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; RELATIVE_INTERIOR_CBALL;
 678               RELATIVE_FRONTIER_CBALL] THEN
 679   CONV_TAC REAL_RAT_REDUCE_CONV THEN
 680   SIMP_TAC[CENTRE_IN_BALL; AFFINE_HULL_NONEMPTY_INTERIOR; INTERIOR_CBALL;
 681            BALL_EQ_EMPTY; REAL_OF_NUM_LE; ARITH; REAL_LT_01]);;
 682
 683 let SIMPLY_CONNECTED_CONVEX_DIFF_FINITE = prove
 684  (`!s t:real^N->bool.
 685         convex s /\ &3 <= aff_dim s /\ FINITE t
 686         ==> simply_connected(s DIFF t)`,
 687   let lemma = prove
 688    (`!P. (?u v. P u /\ P v /\ ~(u = v)) /\
 689          (!c. P c ==> ~(s INTER {x:real^N | x$k = c} = {}))
 690          ==> ?u v. u IN s INTER {x | P(x$k)} /\ v IN s INTER {x | P(x$k)} /\
 691                    ~(u = v)`,
 692     REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th ->
 693       MP_TAC(SPEC `u:real` th) THEN MP_TAC(SPEC `v:real` th)) THEN
 694     ASM SET_TAC[]) in
 695   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN
 696   WF_INDUCT_TAC `CARD(t:real^N->bool)` THEN
 697   X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN
 698   ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN
 699   REPEAT_TCL DISJ_CASES_THEN STRIP_ASSUME_TAC (SET_RULE
 700    `s INTER t = {} \/ ?a:real^N. s INTER t = {a} \/
 701     ?a b. ~(a = b) /\ a IN s /\ a IN t /\ b IN s /\ b IN t`) THEN
 702   ASM_SIMP_TAC[CONVEX_IMP_SIMPLY_CONNECTED; SIMPLY_CONNECTED_PUNCTURED_CONVEX;
 703                DIFF_EMPTY; SET_RULE `s DIFF {a} = s DELETE a`] THEN
 704   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN
 705   REWRITE_TAC[NOT_IMP; LEFT_IMP_EXISTS_THM; NOT_FORALL_THM] THEN
 706   X_GEN_TAC `k:num` THEN STRIP_TAC THEN
 707   FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH
 708    `~(x = y) ==> x < y \/ y < x`)) THEN
 709   POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN
 710   ONCE_REWRITE_TAC[REWRITE_RULE[IMP_CONJ_ALT] IMP_IMP] THEN
 711   MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`b:real^N`; `a:real^N`] THEN
 712   MATCH_MP_TAC(MESON[]
 713    `(!a b. R a b ==> R b a) /\ (!a b. P a b ==> R a b)
 714     ==> !a b. P a b \/ P b a ==> R a b`) THEN
 715   CONJ_TAC THENL [REWRITE_TAC[CONJ_ACI]; REPEAT STRIP_TAC] THEN
 716   RULE_ASSUM_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP]) THEN
 717   SUBGOAL_THEN
 718    `!s t. s DIFF t =
 719           {x | x IN s /\ x$k < (b:real^N)$k} DIFF
 720           {x | x IN t /\ x$k < b$k} UNION
 721           {x:real^N | x IN s /\ (a:real^N)$k < x$k} DIFF
 722           {x | x IN t /\ a$k < x$k}`
 723    (fun th -> ONCE_REWRITE_TAC[th] THEN ASSUME_TAC(GSYM th))
 724   THENL
 725    [FIRST_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH
 726      `a < b ==> !x. a < x \/ x < b`)) THEN SET_TAC[];
 727     MATCH_MP_TAC SIMPLY_CONNECTED_UNION THEN ASM_REWRITE_TAC[]] THEN
 728   REPEAT CONJ_TAC THENL
 729    [REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} DIFF {x | x IN t /\ P x} =
 730                           (s DIFF t) INTER {x | P x}`] THEN
 731     MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN
 732     REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT];
 733     REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} DIFF {x | x IN t /\ P x} =
 734                           (s DIFF t) INTER {x | P x}`] THEN
 735     MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN
 736     REWRITE_TAC[GSYM real_gt; OPEN_HALFSPACE_COMPONENT_GT];
 737     FIRST_X_ASSUM MATCH_MP_TAC THEN
 738     ASM_SIMP_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`;
 739       FINITE_INTER; CONVEX_INTER; CONVEX_HALFSPACE_COMPONENT_LT] THEN
 740     CONJ_TAC THENL
 741      [MATCH_MP_TAC CARD_PSUBSET THEN ASM SET_TAC[REAL_LT_REFL];
 742       ALL_TAC] THEN
 743     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH
 744      `&3:int <= x ==> y = x ==> &3 <= y`)) THEN
 745     MATCH_MP_TAC AFF_DIM_CONVEX_INTER_OPEN THEN
 746     ASM_REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT] THEN
 747     ASM SET_TAC[];
 748     FIRST_X_ASSUM MATCH_MP_TAC THEN
 749     ASM_SIMP_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`;
 750       FINITE_INTER; CONVEX_INTER;
 751       REWRITE_RULE[real_gt] CONVEX_HALFSPACE_COMPONENT_GT] THEN
 752     CONJ_TAC THENL
 753      [MATCH_MP_TAC CARD_PSUBSET THEN ASM SET_TAC[REAL_LT_REFL];
 754       ALL_TAC] THEN
 755     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH
 756      `&3:int <= x ==> y = x ==> &3 <= y`)) THEN
 757     MATCH_MP_TAC AFF_DIM_CONVEX_INTER_OPEN THEN
 758     ASM_REWRITE_TAC[REWRITE_RULE[real_gt] OPEN_HALFSPACE_COMPONENT_GT] THEN
 759     ASM SET_TAC[];
 760     ALL_TAC;
 761     ALL_TAC] THEN
 762   REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} DIFF {x | x IN t /\ P x} =
 763                         (s DIFF t) INTER {x | P x}`] THEN
 764   REWRITE_TAC[SET_RULE `(s INTER u) INTER (s INTER v) = s INTER (u INTER v)`;
 765               SET_RULE `(s DIFF t) INTER u = (s INTER u) DIFF t`] THEN
 766   REWRITE_TAC[SET_RULE `s INTER u DIFF s INTER t = s INTER u DIFF t`] THENL
 767    [MATCH_MP_TAC PATH_CONNECTED_CONVEX_DIFF_COUNTABLE THEN
 768     ASM_SIMP_TAC[FINITE_IMP_COUNTABLE; CONVEX_INTER; COLLINEAR_AFF_DIM;
 769                  CONVEX_HALFSPACE_COMPONENT_LT;
 770                  REWRITE_RULE[real_gt] CONVEX_HALFSPACE_COMPONENT_GT] THEN
 771     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH
 772      `&3:int <= x ==> y = x ==> ~(y <= &1)`)) THEN
 773     MATCH_MP_TAC AFF_DIM_CONVEX_INTER_OPEN THEN
 774     ASM_SIMP_TAC[OPEN_INTER; OPEN_HALFSPACE_COMPONENT_LT;
 775                  REWRITE_RULE[real_gt] OPEN_HALFSPACE_COMPONENT_GT] THEN
 776     MATCH_MP_TAC(MESON[INFINITE; FINITE_EMPTY]
 777      `INFINITE s ==> ~(s = {})`);
 778     REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN
 779     MATCH_MP_TAC(MESON[FINITE_SUBSET; INFINITE]
 780      `INFINITE s /\ FINITE t ==> ~(s SUBSET t)`) THEN
 781     ASM_REWRITE_TAC[]] THEN
 782  (ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5)
 783    [CONNECTED_FINITE_IFF_SING; INFINITE; CONVEX_CONNECTED;
 784     CONVEX_INTER; CONVEX_HALFSPACE_COMPONENT_LT;
 785     REWRITE_RULE[real_gt] CONVEX_HALFSPACE_COMPONENT_GT] THEN
 786   MATCH_MP_TAC(SET_RULE
 787    `!u v. u IN s /\ v IN s /\ ~(u = v) ==> ~(s = {} \/ ?z. s = {z})`) THEN
 788   REWRITE_TAC[SET_RULE `{x | P x} INTER {x | Q x} = {x | Q x /\ P x}`] THEN
 789   MP_TAC lemma THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL
 790    [EXISTS_TAC `a$k + &1 / &3 * ((b:real^N)$k - (a:real^N)$k)` THEN
 791     EXISTS_TAC `a$k + &2 / &3 * ((b:real^N)$k - (a:real^N)$k)` THEN
 792     ASM_REAL_ARITH_TAC;
 793     X_GEN_TAC `c:real` THEN STRIP_TAC THEN
 794     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_ELIM_THM] THEN
 795     SUBGOAL_THEN `!x:real^N. x$k = basis k dot x` (fun t -> SIMP_TAC[t]) THENL
 796      [ASM_MESON_TAC[DOT_BASIS]; MATCH_MP_TAC CONNECTED_IVT_HYPERPLANE] THEN
 797     MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN
 798     ASM_SIMP_TAC[CONVEX_CONNECTED; DOT_BASIS; REAL_LT_IMP_LE]]));;
 799
 800 (* ------------------------------------------------------------------------- *)
 801 (* Some technical lemmas about extending maps from cell complexes.           *)
 802 (* ------------------------------------------------------------------------- *)
 803
 804 let EXTEND_MAP_CELL_COMPLEX_TO_SPHERE,
 805     EXTEND_MAP_CELL_COMPLEX_TO_SPHERE_COFINITE = (CONJ_PAIR o prove)
 806  (`(!f:real^M->real^N m s t.
 807         FINITE m /\ (!c. c IN m ==> polytope c /\ aff_dim c < aff_dim t) /\
 808         (!c1 c2. c1 IN m /\ c2 IN m
 809                  ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2) /\
 810         s SUBSET UNIONS m /\ closed s /\ convex t /\ bounded t /\
 811         f continuous_on s /\ IMAGE f s SUBSET relative_frontier t
 812         ==> ?g. g continuous_on UNIONS m /\
 813                 IMAGE g (UNIONS m) SUBSET relative_frontier t /\
 814                 !x. x IN s ==> g x = f x) /\
 815    (!f:real^M->real^N m s t.
 816         FINITE m /\ (!c. c IN m ==> polytope c /\ aff_dim c <= aff_dim t) /\
 817         (!c1 c2. c1 IN m /\ c2 IN m
 818                  ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2) /\
 819         s SUBSET UNIONS m /\ closed s /\ convex t /\ bounded t /\
 820         f continuous_on s /\ IMAGE f s SUBSET relative_frontier t
 821         ==> ?k g. FINITE k /\ DISJOINT k s /\
 822                   g continuous_on (UNIONS m DIFF k) /\
 823                   IMAGE g (UNIONS m DIFF k) SUBSET relative_frontier t /\
 824                   !x. x IN s ==> g x = f x)`,
 825   let wemma = prove
 826    (`!h:real^M->real^N k t f.
 827           (!s. s IN f ==> ?g. g continuous_on s /\
 828                               IMAGE g s SUBSET t /\
 829                               !x. x IN s INTER k ==> g x = h x) /\
 830           FINITE f /\ (!s. s IN f ==> closed s) /\
 831           (!s t. s IN f /\ t IN f /\ ~(s = t) ==> (s INTER t) SUBSET k)
 832           ==> ?g. g continuous_on (UNIONS f) /\
 833                   IMAGE g (UNIONS f) SUBSET t /\
 834                   !x. x IN (UNIONS f) INTER k ==> g x = h x`,
 835     REPLICATE_TAC 3 GEN_TAC THEN
 836     ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> q ==> p /\ r ==> s`] THEN
 837     MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
 838     REWRITE_TAC[UNIONS_0; IMAGE_CLAUSES; EMPTY_SUBSET; CONTINUOUS_ON_EMPTY;
 839                 INTER_EMPTY; NOT_IN_EMPTY] THEN
 840     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_INSERT] THEN
 841     REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; SUBSET_REFL] THEN
 842     MAP_EVERY X_GEN_TAC [`s:real^M->bool`; `u:(real^M->bool)->bool`] THEN
 843     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC
 844      (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN
 845     ASM_SIMP_TAC[UNIONS_INSERT] THEN
 846     DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
 847     ASM_CASES_TAC `(s:real^M->bool) UNION UNIONS u = UNIONS u` THENL
 848      [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN
 849     FIRST_X_ASSUM(X_CHOOSE_THEN `f:real^M->real^N` STRIP_ASSUME_TAC) THEN
 850     EXISTS_TAC `\x. if x IN s then (f:real^M->real^N) x else g x` THEN
 851     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
 852     MATCH_MP_TAC CONTINUOUS_ON_CASES THEN ASM_SIMP_TAC[CLOSED_UNIONS] THEN
 853     ASM SET_TAC[]) in
 854   let lemma = prove
 855    (`!h:real^M->real^N k t f.
 856           (!s. s IN f ==> ?g. g continuous_on s /\
 857                               IMAGE g s SUBSET t /\
 858                               !x. x IN s INTER k ==> g x = h x) /\
 859           FINITE f /\ (!s. s IN f ==> closed s) /\
 860           (!s t. s IN f /\ t IN f /\ ~(s SUBSET t) /\ ~(t SUBSET s)
 861                  ==> (s INTER t) SUBSET k)
 862           ==> ?g. g continuous_on (UNIONS f) /\
 863                   IMAGE g (UNIONS f) SUBSET t /\
 864                   !x. x IN (UNIONS f) INTER k ==> g x = h x`,
 865     REPEAT STRIP_TAC THEN
 866     FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP UNIONS_MAXIMAL_SETS) THEN
 867     MATCH_MP_TAC wemma THEN
 868     ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM] THEN ASM SET_TAC[]) in
 869   let zemma = prove
 870    (`!f:real^M->real^N m n t.
 871           FINITE m /\ (!c. c IN m ==> polytope c) /\
 872           n SUBSET m /\ (!c. c IN m DIFF n ==> aff_dim c < aff_dim t) /\
 873           (!c1 c2. c1 IN m /\ c2 IN m
 874                    ==> (c1 INTER c2) face_of c1 /\ (c1 INTER c2) face_of c2) /\
 875           convex t /\ bounded t /\
 876           f continuous_on (UNIONS n) /\
 877           IMAGE f (UNIONS n) SUBSET relative_frontier t
 878           ==> ?g. g continuous_on (UNIONS m) /\
 879                   IMAGE g (UNIONS m) SUBSET relative_frontier t /\
 880                   (!x. x IN UNIONS n ==> g x = f x)`,
 881     REPEAT STRIP_TAC THEN
 882     ASM_CASES_TAC `m DIFF n:(real^M->bool)->bool = {}` THENL
 883      [SUBGOAL_THEN `(UNIONS m:real^M->bool) SUBSET UNIONS n` ASSUME_TAC THENL
 884        [ASM SET_TAC[]; EXISTS_TAC `f:real^M->real^N`] THEN
 885       REWRITE_TAC[] THEN CONJ_TAC THENL
 886        [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]];
 887       ALL_TAC] THEN
 888     SUBGOAL_THEN
 889      `!i. &i <= aff_dim t
 890           ==> ?g. g continuous_on
 891                   (UNIONS
 892                    (n UNION {d | ?c. c IN m /\ d face_of c /\
 893                                       aff_dim d < &i})) /\
 894                   IMAGE g (UNIONS
 895                    (n UNION {d | ?c. c IN m /\ d face_of c /\
 896                                       aff_dim d < &i}))
 897                   SUBSET relative_frontier t /\
 898                   (!x. x IN UNIONS n ==> g x = (f:real^M->real^N) x)`
 899     MP_TAC THENL
 900      [ALL_TAC;
 901       MP_TAC(ISPEC `aff_dim(t:real^N->bool)` INT_OF_NUM_EXISTS) THEN
 902       MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN
 903       CONJ_TAC THENL
 904        [ASM_MESON_TAC[AFF_DIM_GE; MEMBER_NOT_EMPTY;
 905                       INT_ARITH `--(&1):int <= s /\ s < t ==> &0 <= t`];
 906         ALL_TAC] THEN
 907       DISCH_THEN(X_CHOOSE_TAC `i:num`) THEN
 908       DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN
 909       SUBGOAL_THEN
 910        `UNIONS (n UNION {d | ?c. c IN m /\ d face_of c /\ aff_dim d < &i}) =
 911         UNIONS m:real^M->bool`
 912        (fun th -> REWRITE_TAC[th]) THEN
 913       FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
 914       MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
 915        [MATCH_MP_TAC UNIONS_MONO THEN REWRITE_TAC[IN_UNION] THEN
 916         REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN
 917         REWRITE_TAC[FORALL_AND_THM; FORALL_IN_GSPEC] THEN
 918         CONJ_TAC THENL [ASM_MESON_TAC[SUBSET]; GEN_TAC] THEN
 919         MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[FACE_OF_IMP_SUBSET];
 920         MATCH_MP_TAC SUBSET_UNIONS THEN REWRITE_TAC[SUBSET; IN_UNION] THEN
 921         X_GEN_TAC `d:real^M->bool` THEN DISCH_TAC THEN
 922         ASM_CASES_TAC `(d:real^M->bool) IN n` THEN
 923         ASM_SIMP_TAC[IN_ELIM_THM] THEN
 924         EXISTS_TAC `d:real^M->bool` THEN
 925         ASM_SIMP_TAC[FACE_OF_REFL; POLYTOPE_IMP_CONVEX] THEN
 926         ASM SET_TAC[]]] THEN
 927     MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
 928      [REWRITE_TAC[INT_ARITH `d < &0 <=> (--(&1) <= d ==> d:int = --(&1))`] THEN
 929       REWRITE_TAC[AFF_DIM_GE; AFF_DIM_EQ_MINUS1] THEN
 930       SUBGOAL_THEN
 931        `{d:real^M->bool| ?c. c IN m /\ d face_of c /\ d = {}} = {{}}`
 932        (fun th -> REWRITE_TAC[th])
 933       THENL
 934        [GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `d:real^M->bool` THEN
 935         REWRITE_TAC[IN_SING; IN_ELIM_THM] THEN
 936         ASM_CASES_TAC `d:real^M->bool = {}` THEN
 937         ASM_REWRITE_TAC[EMPTY_FACE_OF] THEN ASM SET_TAC[];
 938         REWRITE_TAC[UNIONS_UNION; UNIONS_1; UNION_EMPTY] THEN
 939         ASM_MESON_TAC[]];
 940       ALL_TAC] THEN
 941     X_GEN_TAC `p:num` THEN REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN
 942     REWRITE_TAC[INT_ARITH `p + &1 <= x <=> p:int < x`] THEN
 943     DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
 944     ASM_SIMP_TAC[INT_LT_IMP_LE] THEN
 945     DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` STRIP_ASSUME_TAC) THEN
 946     REWRITE_TAC[INT_ARITH `x:int < p + &1 <=> x <= p`] THEN
 947     SUBGOAL_THEN `~(t:real^N->bool = {})` ASSUME_TAC THENL
 948      [ASM_MESON_TAC[AFF_DIM_EMPTY; INT_ARITH `~(&p:int < --(&1))`];
 949       ALL_TAC] THEN
 950     SUBGOAL_THEN `~(relative_frontier t:real^N->bool = {})` ASSUME_TAC THENL
 951      [ASM_REWRITE_TAC[RELATIVE_FRONTIER_EQ_EMPTY] THEN DISCH_TAC THEN
 952       MP_TAC(ISPEC `t:real^N->bool` AFFINE_BOUNDED_EQ_LOWDIM) THEN
 953       ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC;
 954       ALL_TAC] THEN
 955     SUBGOAL_THEN
 956      `!d. d IN n UNION {d | ?c. c IN m /\ d face_of c /\ aff_dim d <= &p}
 957           ==> ?g. (g:real^M->real^N) continuous_on d /\
 958                   IMAGE g d SUBSET relative_frontier t /\
 959                   !x. x IN d INTER
 960                       UNIONS
 961                     (n UNION {d | ?c. c IN m /\ d face_of c /\ aff_dim d < &p})
 962                       ==> g x = h x`
 963     MP_TAC THENL
 964      [X_GEN_TAC `d:real^M->bool` THEN
 965       ASM_CASES_TAC `(d:real^M->bool) SUBSET UNIONS
 966                  (n UNION {d | ?c. c IN m /\ d face_of c /\ aff_dim d < &p})`
 967       THENL
 968        [DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `h:real^M->real^N` THEN
 969         REWRITE_TAC[] THEN CONJ_TAC THENL
 970          [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]];
 971         ALL_TAC] THEN
 972       ASM_CASES_TAC `?a:real^M. d = {a}` THENL
 973        [FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^M` SUBST_ALL_TAC) THEN
 974         DISCH_THEN(K ALL_TAC) THEN ASM_SIMP_TAC[CONTINUOUS_ON_SING; SET_RULE
 975          `~({a} SUBSET s) ==> ~(x IN {a} INTER s)`] THEN
 976         REWRITE_TAC[SUBSET; FORALL_IN_IMAGE;
 977                     FORALL_IN_INSERT; NOT_IN_EMPTY] THEN
 978         MATCH_MP_TAC(MESON[] `(?c. P(\x. c)) ==> (?f. P f)`) THEN
 979         ASM SET_TAC[];
 980         ALL_TAC] THEN
 981       SUBGOAL_THEN `~(d:real^M->bool = {})` ASSUME_TAC THENL
 982        [ASM SET_TAC[]; ALL_TAC] THEN
 983       FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE
 984        `~(s SUBSET UNIONS f) ==> ~(s IN f)`)) THEN
 985       REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP
 986        (SET_RULE `~(d IN s UNION t) /\ d IN s UNION u
 987                   ==> ~(d IN s) /\ d IN u DIFF t`)) THEN
 988       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
 989       DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
 990        `d IN
 991         {d | ?c. c IN m /\ d face_of c /\ aff_dim d <= &p} DIFF
 992         {d | ?c. c IN m /\ d face_of c /\ aff_dim d < &p}
 993         ==> ?c. c IN m /\ d face_of c /\
 994                 (aff_dim d <= &p /\ ~(aff_dim d < &p))`)) THEN
 995       REWRITE_TAC[INT_ARITH `d:int <= p /\ ~(d < p) <=> d = p`] THEN
 996       DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN
 997       MP_TAC(ISPECL [`h:real^M->real^N`; `relative_frontier d:real^M->bool`;
 998         `t:real^N->bool`] NULLHOMOTOPIC_INTO_RELATIVE_FRONTIER_EXTENSION) THEN
 999       ASM_REWRITE_TAC[CLOSED_RELATIVE_FRONTIER;
1000                       RELATIVE_FRONTIER_EQ_EMPTY] THEN
1001       SUBGOAL_THEN
1002        `relative_frontier d SUBSET
1003         UNIONS {e:real^M->bool | e face_of c /\ aff_dim e < &p}`
1004       ASSUME_TAC THENL
1005        [W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_FRONTIER_OF_POLYHEDRON o
1006           lhand o snd) THEN
1007         ANTS_TAC THENL
1008          [ASM_MESON_TAC[POLYTOPE_IMP_POLYHEDRON; FACE_OF_POLYTOPE_POLYTOPE];
1009           DISCH_THEN SUBST1_TAC] THEN
1010         MATCH_MP_TAC SUBSET_UNIONS THEN
1011         ASM_SIMP_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM; facet_of] THEN
1012         X_GEN_TAC `f:real^M->bool` THEN REPEAT STRIP_TAC THENL
1013          [ASM_MESON_TAC[FACE_OF_TRANS]; INT_ARITH_TAC];
1014         ALL_TAC] THEN
1015       ANTS_TAC THENL
1016        [REPEAT CONJ_TAC THENL
1017          [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1018             CONTINUOUS_ON_SUBSET)) THEN
1019           ASM SET_TAC[];
1020           ASM_MESON_TAC[AFFINE_BOUNDED_EQ_TRIVIAL; FACE_OF_POLYTOPE_POLYTOPE;
1021                         POLYTOPE_IMP_BOUNDED];
1022           ASM SET_TAC[]];
1023         ALL_TAC] THEN
1024       MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN
1025       CONJ_TAC THENL
1026        [MATCH_MP_TAC INESSENTIAL_SPHEREMAP_LOWDIM_GEN THEN
1027         ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
1028          [ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE; POLYTOPE_IMP_CONVEX];
1029           ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE; POLYTOPE_IMP_BOUNDED];
1030           FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1031             CONTINUOUS_ON_SUBSET)) THEN
1032           ASM SET_TAC[];
1033           ASM SET_TAC[]];
1034         MATCH_MP_TAC MONO_EXISTS] THEN
1035       X_GEN_TAC `g:real^M->real^N` THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL
1036        [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV];
1037         ASM SET_TAC[];
1038         ALL_TAC] THEN
1039       REWRITE_TAC[INTER_UNIONS] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
1040        (SET_RULE `(!x. x IN s ==> P x) ==> t SUBSET s
1041                   ==> !x. x IN t ==> P x`)) THEN
1042       REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN
1043       X_GEN_TAC `e:real^M->bool` THEN DISCH_TAC THEN
1044       MATCH_MP_TAC FACE_OF_SUBSET_RELATIVE_FRONTIER THEN CONJ_TAC THENL
1045        [MATCH_MP_TAC(MESON[]
1046          `(d INTER e) face_of d /\ (d INTER e) face_of e
1047           ==> (d INTER e) face_of d`) THEN
1048         MATCH_MP_TAC FACE_OF_INTER_SUBFACE THEN
1049         EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
1050         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNION]) THEN
1051         REWRITE_TAC[IN_ELIM_THM] THEN
1052         STRIP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
1053         ASM_MESON_TAC[FACE_OF_REFL; SUBSET; POLYTOPE_IMP_CONVEX];
1054         REWRITE_TAC[SET_RULE `d INTER e = d <=> d SUBSET e`] THEN
1055         DISCH_TAC THEN
1056         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNION]) THEN
1057         REWRITE_TAC[IN_ELIM_THM] THEN
1058         DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN
1059         ASM_MESON_TAC[AFF_DIM_SUBSET; INT_NOT_LE]];
1060       ALL_TAC] THEN
1061     DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] lemma)) THEN
1062     ANTS_TAC THENL
1063      [ALL_TAC;
1064       MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN ASM SET_TAC[]] THEN
1065     CONJ_TAC THENL
1066      [REWRITE_TAC[FINITE_UNION] THEN
1067       CONJ_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN
1068       MATCH_MP_TAC FINITE_SUBSET THEN
1069       EXISTS_TAC `UNIONS {{d:real^M->bool | d face_of c} | c IN m}` THEN
1070       CONJ_TAC THENL
1071        [REWRITE_TAC[FINITE_UNIONS; FORALL_IN_GSPEC] THEN
1072         ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN
1073         ASM_MESON_TAC[FINITE_POLYTOPE_FACES];
1074         REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]];
1075       ALL_TAC] THEN
1076     CONJ_TAC THENL
1077      [REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN
1078       ASM_MESON_TAC[FACE_OF_IMP_CLOSED; POLYTOPE_IMP_CLOSED;
1079                     POLYTOPE_IMP_CONVEX; SUBSET];
1080       ALL_TAC] THEN
1081     MAP_EVERY X_GEN_TAC [`d:real^M->bool`; `e:real^M->bool`] THEN
1082     REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN
1083     DISCH_THEN(CONJUNCTS_THEN2 (DISJ_CASES_THEN2 ASSUME_TAC
1084      (X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC)) MP_TAC)
1085     THENL [ASM SET_TAC[]; ALL_TAC] THEN
1086     DISCH_THEN(CONJUNCTS_THEN2 (DISJ_CASES_THEN2 ASSUME_TAC
1087      (X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC)) MP_TAC)
1088     THENL [ASM SET_TAC[]; STRIP_TAC] THEN
1089     REWRITE_TAC[UNIONS_UNION] THEN
1090     MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s SUBSET t UNION u`) THEN
1091     MATCH_MP_TAC(SET_RULE `x IN s ==> x SUBSET UNIONS s`) THEN
1092     REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `c:real^M->bool` THEN
1093     ASM_REWRITE_TAC[] THEN
1094     SUBGOAL_THEN `d INTER e face_of (d:real^M->bool) /\
1095                   d INTER e face_of e`
1096     STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[FACE_OF_INTER_SUBFACE]; ALL_TAC] THEN
1097     CONJ_TAC THENL [ASM_MESON_TAC[FACE_OF_TRANS]; ALL_TAC] THEN
1098     TRANS_TAC INT_LTE_TRANS `aff_dim(d:real^M->bool)` THEN
1099     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN
1100     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
1101      [ASM_MESON_TAC[POLYTOPE_IMP_CONVEX; FACE_OF_IMP_CONVEX];
1102       ASM SET_TAC[]]) in
1103   let memma = prove
1104    (`!h:real^M->real^N k t u f.
1105           (!s. s IN f ==> ?a g. ~(a IN u) /\ g continuous_on (s DELETE a) /\
1106                                IMAGE g (s DELETE a) SUBSET t /\
1107                                !x. x IN s INTER k ==> g x = h x) /\
1108           FINITE f /\ (!s. s IN f ==> closed s) /\
1109           (!s t. s IN f /\ t IN f /\ ~(s = t) ==> (s INTER t) SUBSET k)
1110           ==> ?c g. FINITE c /\ DISJOINT c u /\ CARD c <= CARD f /\
1111                     g continuous_on (UNIONS f DIFF c) /\
1112                     IMAGE g (UNIONS f DIFF c) SUBSET t /\
1113                     !x. x IN (UNIONS f DIFF c) INTER k ==> g x = h x`,
1114     REPLICATE_TAC 4 GEN_TAC THEN
1115     ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> q ==> p /\ r ==> s`] THEN
1116     MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1117     REWRITE_TAC[UNIONS_0; IMAGE_CLAUSES; EMPTY_SUBSET; CONTINUOUS_ON_EMPTY;
1118                 INTER_EMPTY; NOT_IN_EMPTY; EMPTY_DIFF] THEN
1119     CONJ_TAC THENL
1120      [MESON_TAC[DISJOINT_EMPTY; FINITE_EMPTY; CARD_CLAUSES; LE_REFL];
1121       ALL_TAC] THEN
1122     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_INSERT] THEN
1123     REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; SUBSET_REFL] THEN
1124     MAP_EVERY X_GEN_TAC [`s:real^M->bool`; `u:(real^M->bool)->bool`] THEN
1125     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC
1126      (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN
1127     ASM_SIMP_TAC[UNIONS_INSERT] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
1128     MAP_EVERY X_GEN_TAC [`c:real^M->bool`; `g:real^M->real^N`] THEN
1129     STRIP_TAC THEN ASM_SIMP_TAC[CARD_CLAUSES] THEN
1130     ASM_CASES_TAC `(s:real^M->bool) UNION UNIONS u = UNIONS u` THENL
1131      [ASM_SIMP_TAC[] THEN ASM_MESON_TAC[ARITH_RULE `x <= y ==> x <= SUC y`];
1132       ALL_TAC] THEN
1133     FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^M`
1134      (X_CHOOSE_THEN `f:real^M->real^N` STRIP_ASSUME_TAC)) THEN
1135     EXISTS_TAC `(a:real^M) INSERT c` THEN
1136     ASM_SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; RIGHT_EXISTS_AND_THM] THEN
1137     REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ASM_ARITH_TAC; ALL_TAC] THEN
1138     EXISTS_TAC `\x. if x IN s then (f:real^M->real^N) x else g x` THEN
1139     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
1140     MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
1141     EXISTS_TAC `(s DIFF ((a:real^M) INSERT c)) UNION
1142                 (UNIONS u DIFF ((a:real^M) INSERT c))` THEN
1143     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
1144     MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN REPEAT CONJ_TAC THENL
1145      [REWRITE_TAC[CLOSED_IN_CLOSED] THEN
1146       EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[];
1147       REWRITE_TAC[CLOSED_IN_CLOSED] THEN
1148       EXISTS_TAC `UNIONS u:real^M->bool` THEN ASM_SIMP_TAC[CLOSED_UNIONS];
1149       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1150             CONTINUOUS_ON_SUBSET));
1151       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1152             CONTINUOUS_ON_SUBSET));
1153       ALL_TAC] THEN
1154     ASM SET_TAC[]) in
1155   let temma = prove
1156    (`!h:real^M->real^N k t u f.
1157           (!s. s IN f ==> ?a g. ~(a IN u) /\ g continuous_on (s DELETE a) /\
1158                                 IMAGE g (s DELETE a) SUBSET t /\
1159                                 !x. x IN s INTER k ==> g x = h x) /\
1160           FINITE f /\ (!s. s IN f ==> closed s) /\
1161           (!s t. s IN f /\ t IN f /\  ~(s SUBSET t) /\ ~(t SUBSET s)
1162                  ==> (s INTER t) SUBSET k)
1163           ==> ?c g. FINITE c /\ DISJOINT c u /\ CARD c <= CARD f /\
1164                     g continuous_on (UNIONS f DIFF c) /\
1165                     IMAGE g (UNIONS f DIFF c) SUBSET t /\
1166                     !x. x IN (UNIONS f DIFF c) INTER k ==> g x = h x`,
1167     REPEAT STRIP_TAC THEN
1168     MP_TAC(ISPECL [`h:real^M->real^N`; `k:real^M->bool`; `t:real^N->bool`;
1169                    `u:real^M->bool`;
1170                    `{t:real^M->bool | t IN f /\
1171                                       (!u. u IN f ==> ~(t PSUBSET u))}`]
1172           memma) THEN
1173     ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM; UNIONS_MAXIMAL_SETS] THEN
1174     ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
1175     REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
1176     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
1177     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1178           LE_TRANS)) THEN
1179     MATCH_MP_TAC CARD_SUBSET THEN
1180     ASM_SIMP_TAC[] THEN SET_TAC[]) in
1181   let bemma = prove
1182    (`!f:real^M->real^N m n t.
1183         FINITE m /\ (!c. c IN m ==> polytope c) /\
1184         n SUBSET m /\ (!c. c IN m DIFF n ==> aff_dim c <= aff_dim t) /\
1185         (!c1 c2. c1 IN m /\ c2 IN m
1186                  ==> (c1 INTER c2) face_of c1 /\ (c1 INTER c2) face_of c2) /\
1187         convex t /\ bounded t /\
1188         f continuous_on (UNIONS n) /\
1189         IMAGE f (UNIONS n) SUBSET relative_frontier t
1190         ==> ?k g. FINITE k /\ DISJOINT k (UNIONS n) /\ CARD k <= CARD m /\
1191                   g continuous_on (UNIONS m DIFF k) /\
1192                   IMAGE g (UNIONS m DIFF k) SUBSET relative_frontier t /\
1193                   (!x. x IN UNIONS n ==> g x = f x)`,
1194     REPEAT STRIP_TAC THEN
1195     MP_TAC(ISPECL [`f:real^M->real^N`;
1196          `n UNION {d:real^M->bool | ?c. c IN m DIFF n /\ d face_of c /\
1197                                         aff_dim d < aff_dim(t:real^N->bool)}`;
1198          `n:(real^M->bool)->bool`; `t:real^N->bool`] zemma) THEN
1199     ASM_REWRITE_TAC[SUBSET_UNION; SET_RULE
1200      `(n UNION m) DIFF n = m DIFF n`] THEN
1201     SIMP_TAC[IN_DIFF; IN_ELIM_THM; LEFT_IMP_EXISTS_THM;
1202              LEFT_AND_EXISTS_THM] THEN
1203     ANTS_TAC THENL
1204      [REPEAT CONJ_TAC THENL
1205        [ASM_REWRITE_TAC[FINITE_UNION] THEN
1206         CONJ_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN
1207         MATCH_MP_TAC FINITE_SUBSET THEN
1208         EXISTS_TAC `UNIONS {{d:real^M->bool | d face_of c} | c IN m}` THEN
1209         CONJ_TAC THENL
1210          [REWRITE_TAC[FINITE_UNIONS; FORALL_IN_GSPEC] THEN
1211           ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN
1212           ASM_MESON_TAC[FINITE_POLYTOPE_FACES];
1213           REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]];
1214         REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN
1215         ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE; SUBSET];
1216         REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN
1217         ASM_MESON_TAC[FACE_OF_INTER_SUBFACE; SUBSET; FACE_OF_REFL;
1218                       POLYTOPE_IMP_CONVEX; FACE_OF_IMP_CONVEX]];
1219       ALL_TAC] THEN
1220     DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` STRIP_ASSUME_TAC) THEN
1221     SUBGOAL_THEN
1222      `!d. d IN m
1223           ==> ?a g. ~(a IN UNIONS n) /\
1224                     (g:real^M->real^N) continuous_on (d DELETE a) /\
1225                     IMAGE g (d DELETE a) SUBSET relative_frontier t /\
1226                     !x. x IN d INTER
1227                          UNIONS
1228                           (n UNION {d | ?c. (c IN m /\ ~(c IN n)) /\
1229                                             d face_of c /\
1230                                             aff_dim d < aff_dim t})
1231                         ==> g x = h x`
1232     MP_TAC THENL
1233      [X_GEN_TAC `d:real^M->bool` THEN DISCH_TAC THEN
1234       ASM_CASES_TAC `(d:real^M->bool) SUBSET
1235                      UNIONS(n UNION {d | ?c. (c IN m /\ ~(c IN n)) /\
1236                                              d face_of c /\
1237                                      aff_dim d < aff_dim(t:real^N->bool)})`
1238       THENL
1239        [SUBGOAL_THEN `~(UNIONS n = (:real^M))` MP_TAC THENL
1240          [MATCH_MP_TAC(MESON[NOT_BOUNDED_UNIV]
1241            `bounded s ==> ~(s = UNIV)`) THEN
1242           MATCH_MP_TAC BOUNDED_UNIONS THEN
1243           ASM_MESON_TAC[POLYTOPE_IMP_BOUNDED; SUBSET; FINITE_SUBSET];
1244           GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [EXTENSION]] THEN
1245         REWRITE_TAC[IN_UNIV; NOT_FORALL_THM] THEN
1246         MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^M` THEN
1247         STRIP_TAC THEN EXISTS_TAC `h:real^M->real^N` THEN
1248         ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
1249          [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET;
1250                         SET_RULE `s SUBSET t ==> s DELETE a SUBSET t`];
1251           ASM SET_TAC[]];
1252         ALL_TAC] THEN
1253       ASM_CASES_TAC `(d:real^M->bool) IN n` THENL [ASM SET_TAC[]; ALL_TAC] THEN
1254       DISJ_CASES_THEN MP_TAC (SPEC
1255        `relative_interior(d:real^M->bool) = {}` EXCLUDED_MIDDLE)
1256       THENL
1257        [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY; POLYTOPE_IMP_CONVEX] THEN
1258         ASM SET_TAC[];
1259         REWRITE_TAC[GSYM MEMBER_NOT_EMPTY]] THEN
1260       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^M` THEN STRIP_TAC THEN
1261       SUBGOAL_THEN
1262        `relative_frontier d SUBSET
1263         UNIONS {e:real^M->bool | e face_of d /\
1264                                  aff_dim e < aff_dim(t:real^N->bool)}`
1265       ASSUME_TAC THENL
1266        [W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_FRONTIER_OF_POLYHEDRON o
1267           lhand o snd) THEN
1268         ANTS_TAC THENL
1269          [ASM_MESON_TAC[POLYTOPE_IMP_POLYHEDRON; FACE_OF_POLYTOPE_POLYTOPE];
1270           DISCH_THEN SUBST1_TAC] THEN
1271         MATCH_MP_TAC SUBSET_UNIONS THEN
1272         ASM_SIMP_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM; facet_of] THEN
1273         ASM_SIMP_TAC[INT_ARITH `d - &1:int < t <=> d <= t`; IN_DIFF];
1274         ALL_TAC] THEN
1275       MP_TAC(ISPECL [`d:real^M->bool`; `a:real^M`]
1276           RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL) THEN
1277       ASM_SIMP_TAC[POLYTOPE_IMP_CONVEX; POLYTOPE_IMP_BOUNDED] THEN
1278       REWRITE_TAC[retract_of; LEFT_IMP_EXISTS_THM; retraction] THEN
1279       X_GEN_TAC `r:real^M->real^M` THEN STRIP_TAC THEN
1280       EXISTS_TAC `(h:real^M->real^N) o (r:real^M->real^M)` THEN
1281       REPEAT CONJ_TAC THENL
1282        [REWRITE_TAC[IN_UNIONS] THEN
1283         DISCH_THEN(X_CHOOSE_THEN `e:real^M->bool` STRIP_ASSUME_TAC) THEN
1284         SUBGOAL_THEN
1285          `e INTER d face_of e /\ e INTER d face_of (d:real^M->bool)`
1286         MP_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
1287         DISCH_THEN(MP_TAC o MATCH_MP
1288           (REWRITE_RULE[IMP_CONJ] FACE_OF_SUBSET_RELATIVE_FRONTIER) o
1289           CONJUNCT2) THEN
1290         REWRITE_TAC[NOT_IMP; relative_frontier] THEN
1291         MP_TAC(ISPEC `d:real^M->bool` RELATIVE_INTERIOR_SUBSET) THEN
1292         ASM SET_TAC[];
1293         MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
1294         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1295             CONTINUOUS_ON_SUBSET)) THEN
1296         SIMP_TAC[HULL_SUBSET; SET_RULE
1297                   `s SUBSET t ==> s DELETE a SUBSET t DELETE a`];
1298         REWRITE_TAC[IMAGE_o] THEN
1299         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
1300          `IMAGE h t SUBSET u ==> s SUBSET t ==> IMAGE h s SUBSET u`));
1301         SIMP_TAC[INTER_UNIONS; o_THM] THEN
1302         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
1303          (SET_RULE `(!x. x IN s ==> r x = x) ==> t SUBSET s
1304                     ==> !x. x IN t ==> h(r x) = h x`)) THEN
1305         REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN
1306         X_GEN_TAC `e:real^M->bool` THEN DISCH_TAC THEN
1307         MATCH_MP_TAC FACE_OF_SUBSET_RELATIVE_FRONTIER THEN
1308         CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
1309         MATCH_MP_TAC(MESON[]
1310          `(d INTER e) face_of d /\ (d INTER e) face_of e
1311           ==> (d INTER e) face_of d`) THEN
1312         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNION]) THEN
1313         REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THENL
1314          [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
1315         MATCH_MP_TAC FACE_OF_INTER_SUBFACE THEN
1316         MAP_EVERY EXISTS_TAC [`d:real^M->bool`; `c:real^M->bool`] THEN
1317         ASM_SIMP_TAC[FACE_OF_REFL; POLYTOPE_IMP_CONVEX]] THEN
1318       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
1319        `IMAGE r (h DELETE a) SUBSET t ==> d SUBSET h /\ t SUBSET u
1320         ==> IMAGE r (d DELETE a) SUBSET u`)) THEN
1321       REWRITE_TAC[HULL_SUBSET] THEN ASM SET_TAC[];
1322       ALL_TAC] THEN
1323     DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] temma)) THEN
1324     ANTS_TAC THENL
1325      [ALL_TAC;
1326       REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
1327       STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]] THEN
1328     ASM_SIMP_TAC[POLYTOPE_IMP_CLOSED] THEN
1329     MAP_EVERY X_GEN_TAC [`d:real^M->bool`; `e:real^M->bool`] THEN
1330     STRIP_TAC THEN REWRITE_TAC[UNIONS_UNION] THEN
1331     ASM_CASES_TAC `(d:real^M->bool) IN n` THENL [ASM SET_TAC[]; ALL_TAC] THEN
1332     MATCH_MP_TAC(SET_RULE `x IN s ==> x SUBSET t UNION UNIONS s`) THEN
1333     REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `d:real^M->bool` THEN
1334     ASM_REWRITE_TAC[] THEN
1335     ASM_CASES_TAC `d INTER e:real^M->bool = d` THENL
1336       [ASM SET_TAC[]; ALL_TAC] THEN
1337     ASM_SIMP_TAC[] THEN TRANS_TAC INT_LTE_TRANS `aff_dim(d:real^M->bool)` THEN
1338     ASM_SIMP_TAC[IN_DIFF] THEN MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN
1339     ASM_MESON_TAC[POLYTOPE_IMP_CONVEX]) in
1340   CONJ_TAC THENL
1341    [REPEAT STRIP_TAC THEN
1342     SUBGOAL_THEN `compact(s:real^M->bool)` ASSUME_TAC THENL
1343      [ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN
1344       ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_UNIONS; POLYTOPE_IMP_BOUNDED];
1345       ALL_TAC] THEN
1346     MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`;
1347                    `relative_frontier t:real^N->bool`]
1348           NEIGHBOURHOOD_EXTENSION_INTO_ANR) THEN
1349     ASM_SIMP_TAC[LEFT_FORALL_IMP_THM; ENR_IMP_ANR;
1350                  ENR_RELATIVE_FRONTIER_CONVEX] THEN
1351     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
1352     MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `g:real^M->real^N`] THEN
1353     STRIP_TAC THEN
1354     MP_TAC(ISPECL [`s:real^M->bool`; `(:real^M) DIFF v`]
1355           SEPARATE_COMPACT_CLOSED) THEN
1356     ASM_SIMP_TAC[GSYM OPEN_CLOSED; IN_DIFF; IN_UNIV] THEN
1357     ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
1358     ONCE_REWRITE_TAC[TAUT `p /\ ~q ==> r <=> p /\ ~r ==> q`] THEN
1359     REWRITE_TAC[REAL_NOT_LE; LEFT_IMP_EXISTS_THM] THEN
1360     X_GEN_TAC `d:real` THEN STRIP_TAC THEN
1361     MP_TAC(ISPECL [`m:(real^M->bool)->bool`; `aff_dim(t:real^N->bool) - &1`;
1362                    `d:real`] CELL_COMPLEX_SUBDIVISION_EXISTS) THEN
1363     ASM_SIMP_TAC[INT_ARITH `x:int <= t - &1 <=> x < t`] THEN
1364     DISCH_THEN(X_CHOOSE_THEN `n:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
1365     MP_TAC(ISPECL
1366      [`g:real^M->real^N`; `n:(real^M->bool)->bool`;
1367       `{c:real^M->bool | c IN n /\ c SUBSET v}`; `t:real^N->bool`]
1368      zemma) THEN
1369     ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
1370      [ASM_SIMP_TAC[SUBSET_RESTRICT; IN_DIFF] THEN CONJ_TAC THENL
1371        [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1372           CONTINUOUS_ON_SUBSET)) THEN
1373         ASM SET_TAC[];
1374         ASM SET_TAC[]];
1375       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^M->real^N` THEN
1376       STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN
1377       DISCH_TAC THEN TRANS_TAC EQ_TRANS `(g:real^M->real^N) x` THEN
1378       CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
1379       SUBGOAL_THEN `(x:real^M) IN UNIONS n` MP_TAC THENL
1380        [ASM SET_TAC[]; ALL_TAC] THEN
1381       REWRITE_TAC[IN_UNIONS] THEN MATCH_MP_TAC MONO_EXISTS THEN
1382       X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
1383       ASM_REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[SUBSET] THEN
1384       X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
1385       EXISTS_TAC `x:real^M` THEN ASM_REWRITE_TAC[] THEN
1386       MATCH_MP_TAC REAL_LET_TRANS THEN
1387       EXISTS_TAC `diameter(c:real^M->bool)` THEN
1388       ASM_SIMP_TAC[dist] THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN
1389       ASM_SIMP_TAC[POLYTOPE_IMP_BOUNDED]];
1390     REPEAT STRIP_TAC THEN
1391     SUBGOAL_THEN `compact(s:real^M->bool)` ASSUME_TAC THENL
1392      [ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN
1393       ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_UNIONS; POLYTOPE_IMP_BOUNDED];
1394       ALL_TAC] THEN
1395     MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`;
1396                    `relative_frontier t:real^N->bool`]
1397           NEIGHBOURHOOD_EXTENSION_INTO_ANR) THEN
1398     ASM_SIMP_TAC[LEFT_FORALL_IMP_THM; ENR_IMP_ANR;
1399                  ENR_RELATIVE_FRONTIER_CONVEX] THEN
1400     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
1401     MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `g:real^M->real^N`] THEN
1402     STRIP_TAC THEN
1403     MP_TAC(ISPECL [`s:real^M->bool`; `(:real^M) DIFF v`]
1404           SEPARATE_COMPACT_CLOSED) THEN
1405     ASM_SIMP_TAC[GSYM OPEN_CLOSED; IN_DIFF; IN_UNIV] THEN
1406     ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
1407     ONCE_REWRITE_TAC[TAUT `p /\ ~q ==> r <=> p /\ ~r ==> q`] THEN
1408     REWRITE_TAC[REAL_NOT_LE; LEFT_IMP_EXISTS_THM] THEN
1409     X_GEN_TAC `d:real` THEN STRIP_TAC THEN
1410     MP_TAC(ISPECL [`m:(real^M->bool)->bool`; `aff_dim(t:real^N->bool)`;
1411                    `d:real`] CELL_COMPLEX_SUBDIVISION_EXISTS) THEN
1412     ASM_SIMP_TAC[] THEN
1413     DISCH_THEN(X_CHOOSE_THEN `n:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
1414     MP_TAC(ISPECL
1415      [`g:real^M->real^N`; `n:(real^M->bool)->bool`;
1416       `{c:real^M->bool | c IN n /\ c SUBSET v}`; `t:real^N->bool`]
1417      bemma) THEN
1418     ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
1419      [ASM_SIMP_TAC[SUBSET_RESTRICT; IN_DIFF] THEN CONJ_TAC THENL
1420        [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1421           CONTINUOUS_ON_SUBSET)) THEN
1422         ASM SET_TAC[];
1423         ASM SET_TAC[]];
1424       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN
1425       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^M->real^N` THEN
1426       STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
1427        [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
1428          `DISJOINT k u ==> s SUBSET u ==> DISJOINT k s`)) THEN
1429         REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC;
1430         X_GEN_TAC `x:real^M` THEN
1431         DISCH_TAC THEN TRANS_TAC EQ_TRANS `(g:real^M->real^N) x` THEN
1432         CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]] THEN
1433       (SUBGOAL_THEN `(x:real^M) IN UNIONS n` MP_TAC THENL
1434         [ASM SET_TAC[]; ALL_TAC] THEN
1435        REWRITE_TAC[IN_UNIONS] THEN MATCH_MP_TAC MONO_EXISTS THEN
1436        X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
1437        ASM_REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[SUBSET] THEN
1438        X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
1439        EXISTS_TAC `x:real^M` THEN ASM_REWRITE_TAC[] THEN
1440        MATCH_MP_TAC REAL_LET_TRANS THEN
1441         EXISTS_TAC `diameter(c:real^M->bool)` THEN
1442        ASM_SIMP_TAC[dist] THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN
1443        ASM_SIMP_TAC[POLYTOPE_IMP_BOUNDED])]]);;
1444
1445 (* ------------------------------------------------------------------------- *)
1446 (* Special cases and corollaries involving spheres.                          *)
1447 (* ------------------------------------------------------------------------- *)
1448
1449 let EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_SIMPLE = prove
1450  (`!f:real^M->real^N s t u.
1451         compact s /\ convex u /\ bounded u /\ aff_dim t <= aff_dim u /\
1452         s SUBSET t /\ f continuous_on s /\ IMAGE f s SUBSET relative_frontier u
1453         ==> ?k g. FINITE k /\ k SUBSET t /\ DISJOINT k s /\
1454                   g continuous_on (t DIFF k) /\
1455                   IMAGE g (t DIFF k) SUBSET relative_frontier u /\
1456                   !x. x IN s ==> g x = f x`,
1457   let lemma = prove
1458    (`!f:A->B->bool P k.
1459         INFINITE {x | P x} /\ FINITE k /\
1460         (!x y. P x /\ P y /\ ~(x = y) ==> DISJOINT (f x) (f y))
1461         ==> ?x. P x /\ DISJOINT k (f x)`,
1462     REWRITE_TAC[INFINITE] THEN REPEAT STRIP_TAC THEN
1463     REWRITE_TAC[SET_RULE `(?x. P x /\ DISJOINT k (f x)) <=>
1464                           ~(!x. ?y. P x ==> y IN k /\ y IN f x)`] THEN
1465     REWRITE_TAC[SKOLEM_THM] THEN
1466     DISCH_THEN(X_CHOOSE_TAC `g:A->B`) THEN
1467     MP_TAC(ISPECL [`g:A->B`; `{x:A | P x}`] FINITE_IMAGE_INJ_EQ) THEN
1468     ASM_REWRITE_TAC[IN_ELIM_THM; NOT_IMP] THEN
1469     CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
1470     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
1471       (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN
1472     ASM SET_TAC[]) in
1473   SUBGOAL_THEN
1474    `!f:real^M->real^N s t u.
1475         compact s /\ convex u /\ bounded u /\ aff_dim t <= aff_dim u /\
1476         s SUBSET t /\ f continuous_on s /\ IMAGE f s SUBSET relative_frontier u
1477         ==> ?k g. FINITE k /\ DISJOINT k s /\
1478                   g continuous_on (t DIFF k) /\
1479                   IMAGE g (t DIFF k) SUBSET relative_frontier u /\
1480                   !x. x IN s ==> g x = f x`
1481   MP_TAC THENL
1482    [ALL_TAC;
1483     REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
1484     DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
1485     ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
1486     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN
1487     DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC) THEN
1488     EXISTS_TAC `k INTER t:real^M->bool` THEN
1489     ASM_SIMP_TAC[FINITE_INTER; INTER_SUBSET] THEN
1490     REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC; ASM SET_TAC[]] THEN
1491     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1492             CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]] THEN
1493   SUBGOAL_THEN
1494    `!f:real^M->real^N s t u.
1495         compact s /\ s SUBSET t /\ affine t /\
1496         convex u /\ bounded u /\ aff_dim t <= aff_dim u /\
1497         f continuous_on s /\ IMAGE f s SUBSET relative_frontier u
1498         ==> ?k g. FINITE k /\ DISJOINT k s /\
1499                   g continuous_on (t DIFF k) /\
1500                   IMAGE g (t DIFF k) SUBSET relative_frontier u /\
1501                   !x. x IN s ==> g x = f x`
1502   ASSUME_TAC THENL
1503    [ALL_TAC;
1504     REPEAT STRIP_TAC THEN
1505     SUBGOAL_THEN
1506      `?k g. FINITE k /\ DISJOINT k s /\
1507             g continuous_on (affine hull t DIFF k) /\
1508             IMAGE g (affine hull t DIFF k) SUBSET relative_frontier u /\
1509             !x. x IN s ==> g x = (f:real^M->real^N) x`
1510     MP_TAC THENL
1511      [FIRST_X_ASSUM MATCH_MP_TAC THEN
1512       ASM_SIMP_TAC[AFF_DIM_AFFINE_HULL; AFFINE_AFFINE_HULL] THEN
1513       TRANS_TAC SUBSET_TRANS `t:real^M->bool` THEN
1514       ASM_REWRITE_TAC[HULL_SUBSET];
1515       REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
1516       STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
1517       CONJ_TAC THENL
1518        [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1519             CONTINUOUS_ON_SUBSET));
1520         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
1521             SUBSET_TRANS)) THEN
1522         MATCH_MP_TAC IMAGE_SUBSET] THEN
1523       MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF k SUBSET t DIFF k`) THEN
1524       REWRITE_TAC[HULL_SUBSET]]] THEN
1525   REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL
1526    [ASM_CASES_TAC `relative_frontier(u:real^N->bool) = {}` THENL
1527      [RULE_ASSUM_TAC(REWRITE_RULE[RELATIVE_FRONTIER_EQ_EMPTY]) THEN
1528       UNDISCH_TAC `bounded(u:real^N->bool)` THEN
1529       ASM_SIMP_TAC[AFFINE_BOUNDED_EQ_LOWDIM] THEN DISCH_TAC THEN
1530       SUBGOAL_THEN `aff_dim(t:real^M->bool) <= &0` MP_TAC THENL
1531        [ASM_INT_ARITH_TAC; ALL_TAC] THEN
1532       SIMP_TAC[AFF_DIM_GE; INT_ARITH
1533        `--(&1):int <= x ==> (x <= &0 <=> x = --(&1) \/ x = &0)`] THEN
1534       REWRITE_TAC[AFF_DIM_EQ_MINUS1; AFF_DIM_EQ_0] THEN
1535       DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC (X_CHOOSE_TAC `a:real^M`)) THEN
1536       EXISTS_TAC `{a:real^M}` THEN
1537       ASM_REWRITE_TAC[DISJOINT_EMPTY; FINITE_SING; NOT_IN_EMPTY;
1538                       EMPTY_DIFF; DIFF_EQ_EMPTY; IMAGE_CLAUSES;
1539                       CONTINUOUS_ON_EMPTY; EMPTY_SUBSET];
1540       EXISTS_TAC `{}:real^M->bool` THEN
1541       FIRST_X_ASSUM(X_CHOOSE_TAC `y:real^N` o
1542         GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
1543       ASM_SIMP_TAC[FINITE_EMPTY; DISJOINT_EMPTY; NOT_IN_EMPTY; DIFF_EMPTY] THEN
1544       EXISTS_TAC `(\x. y):real^M->real^N` THEN
1545       REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]];
1546     ALL_TAC] THEN
1547   FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN
1548   DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC) THEN
1549   REWRITE_TAC[INSERT_SUBSET] THEN
1550   DISCH_THEN(X_CHOOSE_THEN `b:real^M` STRIP_ASSUME_TAC) THEN
1551   MP_TAC(ISPECL
1552    [`f:real^M->real^N`;
1553     `{interval[--(b + vec 1):real^M,b + vec 1] INTER t}`;
1554     `s:real^M->bool`; `u:real^N->bool`]
1555    EXTEND_MAP_CELL_COMPLEX_TO_SPHERE_COFINITE) THEN
1556   SUBGOAL_THEN
1557    `interval[--b,b] SUBSET interval[--(b + vec 1):real^M,b + vec 1]`
1558   ASSUME_TAC THENL
1559    [REWRITE_TAC[SUBSET_INTERVAL; VECTOR_ADD_COMPONENT; VECTOR_NEG_COMPONENT;
1560                 VEC_COMPONENT] THEN
1561     REAL_ARITH_TAC;
1562     ALL_TAC] THEN
1563   ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FINITE_SING] THEN
1564   REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; IMP_IMP] THEN
1565   REWRITE_TAC[INTER_IDEMPOT; UNIONS_1; FACE_OF_REFL_EQ; SUBSET_INTER] THEN
1566   ANTS_TAC THENL
1567    [ASM_SIMP_TAC[HULL_SUBSET; COMPACT_IMP_CLOSED] THEN REPEAT CONJ_TAC THENL
1568      [MATCH_MP_TAC POLYTOPE_INTER_POLYHEDRON THEN
1569       ASM_SIMP_TAC[POLYTOPE_INTERVAL; AFFINE_IMP_POLYHEDRON];
1570       TRANS_TAC INT_LE_TRANS `aff_dim(t:real^M->bool)` THEN
1571       ASM_SIMP_TAC[AFF_DIM_SUBSET; INTER_SUBSET];
1572       ASM_SIMP_TAC[CONVEX_INTER; CONVEX_INTERVAL; AFFINE_IMP_CONVEX];
1573       ASM SET_TAC[]];
1574     REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
1575   MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `g:real^M->real^N`] THEN
1576   STRIP_TAC THEN EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
1577   SUBGOAL_THEN
1578    `?d:real. (&1 / &2 <= d /\ d <= &1) /\
1579              DISJOINT k (frontier(interval[--(b + lambda i. d):real^M,
1580                                              (b + lambda i. d)]))`
1581   STRIP_ASSUME_TAC THENL
1582    [MATCH_MP_TAC lemma THEN
1583     ASM_SIMP_TAC[INFINITE; FINITE_REAL_INTERVAL; REAL_NOT_LE] THEN
1584     CONV_TAC REAL_RAT_REDUCE_CONV THEN
1585     MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[] THEN
1586     CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
1587     MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN REPEAT STRIP_TAC THEN
1588     REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE
1589      `c SUBSET i' ==> DISJOINT (c DIFF i) (c' DIFF i')`) THEN
1590     REWRITE_TAC[INTERIOR_INTERVAL; CLOSURE_INTERVAL] THEN
1591     SIMP_TAC[SUBSET_INTERVAL; VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT;
1592              LAMBDA_BETA] THEN
1593     ASM_REAL_ARITH_TAC;
1594     ALL_TAC] THEN
1595   ABBREV_TAC `c:real^M = b + lambda i. d` THEN SUBGOAL_THEN
1596    `interval[--b:real^M,b] SUBSET interval(--c,c) /\
1597     interval[--b:real^M,b] SUBSET interval[--c,c] /\
1598     interval[--c,c] SUBSET interval[--(b + vec 1):real^M,b + vec 1]`
1599   STRIP_ASSUME_TAC THENL
1600    [REWRITE_TAC[SUBSET_INTERVAL] THEN EXPAND_TAC "c" THEN REPEAT CONJ_TAC THEN
1601     SIMP_TAC[VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN
1602     MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
1603     REWRITE_TAC[VEC_COMPONENT] THEN ASM_REAL_ARITH_TAC;
1604     ALL_TAC] THEN
1605   EXISTS_TAC
1606    `(g:real^M->real^N) o
1607     closest_point (interval[--c,c] INTER t)` THEN
1608   REPEAT CONJ_TAC THENL
1609    [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
1610      [MATCH_MP_TAC CONTINUOUS_ON_CLOSEST_POINT THEN
1611       ASM_SIMP_TAC[CONVEX_INTER; CLOSED_INTER; CLOSED_INTERVAL; CLOSED_AFFINE;
1612         AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; CONVEX_INTERVAL] THEN
1613       ASM SET_TAC[];
1614       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1615           CONTINUOUS_ON_SUBSET))];
1616     REWRITE_TAC[IMAGE_o] THEN
1617     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
1618         SUBSET_TRANS)) THEN
1619     MATCH_MP_TAC IMAGE_SUBSET;
1620     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[o_THM] THEN
1621     TRANS_TAC EQ_TRANS `(g:real^M->real^N) x` THEN
1622     CONJ_TAC THENL [AP_TERM_TAC; ASM SET_TAC[]] THEN
1623     MATCH_MP_TAC CLOSEST_POINT_SELF THEN
1624     ASM_SIMP_TAC[IN_INTER; HULL_INC] THEN ASM SET_TAC[]] THEN
1625   (REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF] THEN
1626    X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN CONJ_TAC THENL
1627     [MATCH_MP_TAC(SET_RULE
1628       `closest_point s x IN s /\ s SUBSET u ==> closest_point s x IN u`) THEN
1629      CONJ_TAC THENL [MATCH_MP_TAC CLOSEST_POINT_IN_SET; ASM SET_TAC[]] THEN
1630      ASM_SIMP_TAC[CLOSED_INTER; CLOSED_INTERVAL; CLOSED_AFFINE] THEN
1631      ASM SET_TAC[];
1632      ALL_TAC] THEN
1633    ASM_CASES_TAC `x IN interval[--c:real^M,c]` THEN
1634    ASM_SIMP_TAC[CLOSEST_POINT_SELF; IN_INTER] THEN
1635    MATCH_MP_TAC(SET_RULE
1636     `closest_point s x IN relative_frontier s /\
1637      DISJOINT k (relative_frontier s)
1638      ==> ~(closest_point s x IN k)`) THEN
1639    CONJ_TAC THENL
1640     [MATCH_MP_TAC CLOSEST_POINT_IN_RELATIVE_FRONTIER THEN
1641      ASM_SIMP_TAC[CLOSED_INTER; CLOSED_AFFINE; CLOSED_INTERVAL] THEN
1642      CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_DIFF]] THEN CONJ_TAC THENL
1643       [ALL_TAC; ASM_MESON_TAC[SUBSET; RELATIVE_INTERIOR_SUBSET; IN_INTER]] THEN
1644      ONCE_REWRITE_TAC[INTER_COMM] THEN
1645      W(MP_TAC o PART_MATCH (lhs o rand)
1646        AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR o rand o snd) THEN
1647      ASM_SIMP_TAC[HULL_HULL; AFFINE_AFFINE_HULL; AFFINE_IMP_CONVEX] THEN
1648      ASM_SIMP_TAC[HULL_P] THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
1649      REWRITE_TAC[INTERIOR_INTERVAL] THEN ASM SET_TAC[];
1650      W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_FRONTIER_CONVEX_INTER_AFFINE o
1651        rand o snd) THEN
1652      ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
1653      REWRITE_TAC[CONVEX_INTERVAL; AFFINE_AFFINE_HULL; INTERIOR_INTERVAL] THEN
1654      ASM SET_TAC[]]));;
1655
1656 let EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_GEN = prove
1657  (`!f:real^M->real^N s t u p.
1658         compact s /\ convex u /\ bounded u /\
1659         affine t /\ aff_dim t <= aff_dim u /\ s SUBSET t /\
1660         f continuous_on s /\ IMAGE f s SUBSET relative_frontier u /\
1661         (!c. c IN components(t DIFF s) /\ bounded c ==> ~(c INTER p = {}))
1662         ==> ?k g. FINITE k /\ k SUBSET p /\ k SUBSET t /\ DISJOINT k s /\
1663                   g continuous_on (t DIFF k) /\
1664                   IMAGE g (t DIFF k) SUBSET relative_frontier u /\
1665                   !x. x IN s ==> g x = f x`,
1666   let lemma0 = prove
1667    (`!u t s v. closed_in (subtopology euclidean u) v /\ t SUBSET u /\
1668                s = v INTER t
1669                ==> closed_in (subtopology euclidean t) s`,
1670     REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED; LEFT_AND_EXISTS_THM] THEN
1671     MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]) in
1672   let lemma1 = prove
1673    (`!f:A->B->bool P k.
1674         INFINITE {x | P x} /\ FINITE k /\
1675         (!x y. P x /\ P y /\ ~(x = y) ==> DISJOINT (f x) (f y))
1676         ==> ?x. P x /\ DISJOINT k (f x)`,
1677     REWRITE_TAC[INFINITE] THEN REPEAT STRIP_TAC THEN
1678     REWRITE_TAC[SET_RULE `(?x. P x /\ DISJOINT k (f x)) <=>
1679                           ~(!x. ?y. P x ==> y IN k /\ y IN f x)`] THEN
1680     REWRITE_TAC[SKOLEM_THM] THEN
1681     DISCH_THEN(X_CHOOSE_TAC `g:A->B`) THEN
1682     MP_TAC(ISPECL [`g:A->B`; `{x:A | P x}`] FINITE_IMAGE_INJ_EQ) THEN
1683     ASM_REWRITE_TAC[IN_ELIM_THM; NOT_IMP] THEN
1684     CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
1685     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
1686       (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN
1687     ASM SET_TAC[]) in
1688   let lemma2 = prove
1689    (`!f:real^M->real^N s t k p u.
1690           FINITE k /\ affine u /\
1691           f continuous_on ((u:real^M->bool) DIFF k) /\
1692           IMAGE f ((u:real^M->bool) DIFF k) SUBSET t /\
1693           (!c. c IN components((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})
1694                ==> ~(c INTER p = {})) /\
1695           closed_in (subtopology euclidean u) s /\ DISJOINT k s /\ k SUBSET u
1696           ==> ?g. g continuous_on ((u:real^M->bool) DIFF p) /\
1697                   IMAGE g ((u:real^M->bool) DIFF p) SUBSET t /\
1698                   !x. x IN s ==> g x = f x`,
1699     REPEAT GEN_TAC THEN ASM_CASES_TAC `k:real^M->bool = {}` THENL
1700      [ASM_REWRITE_TAC[DIFF_EMPTY] THEN REPEAT STRIP_TAC THEN
1701       EXISTS_TAC `f:real^M->real^N` THEN REWRITE_TAC[] THEN CONJ_TAC THENL
1702        [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_DIFF]; ASM SET_TAC[]];
1703       STRIP_TAC] THEN
1704     FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
1705     SUBGOAL_THEN `~(((u:real^M->bool) DIFF s) INTER k = {})` MP_TAC THENL
1706      [ASM SET_TAC[]; ALL_TAC] THEN
1707     GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV o LAND_CONV)
1708      [UNIONS_COMPONENTS] THEN
1709     REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN
1710     REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN
1711     X_GEN_TAC `co:real^M->bool` THEN STRIP_TAC THEN
1712     SUBGOAL_THEN `locally connected (u:real^M->bool)` ASSUME_TAC THENL
1713      [ASM_SIMP_TAC[AFFINE_IMP_CONVEX; CONVEX_IMP_LOCALLY_CONNECTED];
1714       ALL_TAC] THEN
1715     SUBGOAL_THEN
1716      `!c. c IN components ((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})
1717           ==> ?a g. a IN c /\ a IN p /\
1718                     g continuous_on (s UNION (c DELETE a)) /\
1719                     IMAGE g (s UNION (c DELETE a)) SUBSET t /\
1720                     !x. x IN s ==> g x = (f:real^M->real^N) x`
1721     MP_TAC THENL
1722      [X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
1723       FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
1724       FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN
1725       ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
1726       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^M` THEN
1727       STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
1728       SUBGOAL_THEN `open_in (subtopology euclidean u) (c:real^M->bool)`
1729       MP_TAC THENL
1730        [MATCH_MP_TAC OPEN_IN_TRANS THEN
1731         EXISTS_TAC `u DIFF s:real^M->bool` THEN
1732         ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN
1733         MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN
1734         ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
1735         EXISTS_TAC `u:real^M->bool` THEN
1736         ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL];
1737         DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th)] THEN
1738       REWRITE_TAC[OPEN_IN_CONTAINS_CBALL] THEN
1739       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `a:real^M`)) THEN
1740       ASM_REWRITE_TAC[] THEN
1741       DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
1742       SUBGOAL_THEN `ball(a:real^M,d) INTER u SUBSET c` ASSUME_TAC THENL
1743        [ASM_MESON_TAC[BALL_SUBSET_CBALL; SUBSET_TRANS;
1744                       SET_RULE `b SUBSET c ==> b INTER u SUBSET c INTER u`];
1745         ALL_TAC] THEN
1746       MP_TAC(ISPECL
1747       [`ball(a:real^M,d) INTER u`; `c:real^M->bool`;
1748         `s UNION c:real^M->bool`; `c INTER k:real^M->bool`]
1749           HOMEOMORPHISM_GROUPING_POINTS_EXISTS_GEN) THEN
1750       ASM_REWRITE_TAC[INTER_SUBSET; SUBSET_UNION; UNION_SUBSET] THEN
1751       ANTS_TAC THENL
1752        [REPEAT CONJ_TAC THENL
1753          [MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN
1754           EXISTS_TAC `u:real^M->bool` THEN
1755           ASM_SIMP_TAC[HULL_MINIMAL; HULL_SUBSET];
1756           MP_TAC(ISPECL [`c:real^M->bool`; `u:real^M->bool`]
1757              AFFINE_HULL_OPEN_IN) THEN
1758           ASM_SIMP_TAC[HULL_P] THEN ASM SET_TAC[];
1759           REWRITE_TAC[HULL_SUBSET];
1760           ASM_MESON_TAC[IN_COMPONENTS_CONNECTED];
1761           ASM_MESON_TAC[FINITE_SUBSET; INTER_SUBSET];
1762           MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN
1763           EXISTS_TAC `u:real^M->bool` THEN
1764           ASM_REWRITE_TAC[] THEN
1765           ASM_MESON_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; INTER_COMM];
1766           REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
1767           EXISTS_TAC `a:real^M` THEN REWRITE_TAC[CENTRE_IN_BALL] THEN
1768           ASM SET_TAC[]];
1769         REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM]] THEN
1770       MAP_EVERY X_GEN_TAC [`h:real^M->real^M`; `k:real^M->real^M`] THEN
1771       REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN
1772       MP_TAC(ISPECL [`cball(a:real^M,d) INTER u`; `a:real^M`]
1773           RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL) THEN
1774       MP_TAC(ISPECL [`cball(a:real^M,d)`; `u:real^M->bool`]
1775           RELATIVE_INTERIOR_CONVEX_INTER_AFFINE) THEN
1776       MP_TAC(ISPECL [`cball(a:real^M,d)`; `u:real^M->bool`]
1777           RELATIVE_FRONTIER_CONVEX_INTER_AFFINE) THEN
1778       MP_TAC(ISPECL [`u:real^M->bool`; `cball(a:real^M,d)`]
1779           (ONCE_REWRITE_RULE[INTER_COMM]
1780              AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR)) THEN
1781       ASM_SIMP_TAC[CONVEX_CBALL; FRONTIER_CBALL; INTERIOR_CBALL] THEN
1782       SUBGOAL_THEN `a IN ball(a:real^M,d) INTER u` ASSUME_TAC THENL
1783        [ASM_REWRITE_TAC[CENTRE_IN_BALL; IN_INTER] THEN ASM SET_TAC[];
1784         ALL_TAC] THEN
1785       REPLICATE_TAC 3
1786        (ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC]) THEN
1787       ASM_SIMP_TAC[CONVEX_INTER; CONVEX_CBALL; AFFINE_IMP_CONVEX] THEN
1788       ANTS_TAC THENL
1789        [ASM_MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET; BOUNDED_CBALL];
1790         ALL_TAC] THEN
1791       ASM_REWRITE_TAC[retract_of; retraction] THEN
1792       DISCH_THEN(X_CHOOSE_THEN `r:real^M->real^M` STRIP_ASSUME_TAC) THEN
1793       EXISTS_TAC
1794        `(f:real^M->real^N) o (k:real^M->real^M) o
1795         (\x. if x IN ball(a,d) then r x else x)` THEN
1796       REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
1797        [ALL_TAC;
1798         X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[o_THM] THEN
1799         COND_CASES_TAC THENL
1800          [ASM SET_TAC[]; AP_TERM_TAC THEN ASM SET_TAC[]]] THEN
1801       ABBREV_TAC `j = \x:real^M. if x IN ball(a,d) then r x else x` THEN
1802       SUBGOAL_THEN
1803        `(j:real^M->real^M) continuous_on ((u:real^M->bool) DELETE a)`
1804       ASSUME_TAC THENL
1805        [EXPAND_TAC "j" THEN
1806         SUBGOAL_THEN
1807          `u DELETE (a:real^M) =
1808           (cball(a,d) DELETE a) INTER u UNION
1809           ((u:real^M->bool) DIFF ball(a,d))`
1810          (fun th -> SUBST1_TAC th THEN
1811                     MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
1812                     SUBST1_TAC(SYM th))
1813         THENL
1814          [MP_TAC(ISPECL [`a:real^M`; `d:real`] BALL_SUBSET_CBALL) THEN
1815           ASM SET_TAC[];
1816           ALL_TAC] THEN
1817         REWRITE_TAC[IN_DIFF; IN_INTER; IN_DELETE; CONTINUOUS_ON_ID] THEN
1818         REPEAT CONJ_TAC THENL
1819          [ALL_TAC; ALL_TAC;
1820           FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1821             CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[];
1822           REWRITE_TAC[GSYM BALL_UNION_SPHERE] THEN ASM SET_TAC[]] THEN
1823         REWRITE_TAC[CLOSED_IN_CLOSED] THENL
1824          [EXISTS_TAC `cball(a:real^M,d)` THEN REWRITE_TAC[CLOSED_CBALL];
1825           EXISTS_TAC `(:real^M) DIFF ball(a,d)` THEN
1826           REWRITE_TAC[GSYM OPEN_CLOSED; OPEN_BALL]] THEN
1827         MP_TAC(ISPECL [`a:real^M`; `d:real`] BALL_SUBSET_CBALL) THEN
1828         MP_TAC(ISPECL [`a:real^M`; `d:real`] CENTRE_IN_BALL) THEN
1829         ASM SET_TAC[];
1830         ALL_TAC] THEN
1831       SUBGOAL_THEN
1832        `IMAGE (j:real^M->real^M) (s UNION c DELETE a) SUBSET
1833         (s UNION c DIFF ball(a,d))`
1834       ASSUME_TAC THENL
1835        [EXPAND_TAC "j" THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
1836         X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
1837         COND_CASES_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
1838         SUBGOAL_THEN `(r:real^M->real^M) x IN sphere(a,d)` MP_TAC THENL
1839          [MP_TAC(ISPECL [`a:real^M`; `d:real`] CENTRE_IN_BALL) THEN
1840           ASM SET_TAC[];
1841           REWRITE_TAC[GSYM CBALL_DIFF_BALL] THEN ASM SET_TAC[]];
1842         ALL_TAC] THEN
1843       CONJ_TAC THENL
1844        [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN
1845         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1846             CONTINUOUS_ON_SUBSET))
1847         THENL [ASM SET_TAC[]; ASM SET_TAC[]; ALL_TAC];
1848         ONCE_REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
1849          (SET_RULE `IMAGE f u SUBSET t
1850                     ==> s SUBSET u ==> IMAGE f s SUBSET t`))] THEN
1851       REWRITE_TAC[IMAGE_o] THEN
1852       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
1853         `s SUBSET u ==> IMAGE f u SUBSET t ==> IMAGE f s SUBSET t`)) THEN
1854       REWRITE_TAC[SUBSET; IN_UNIV; IN_DIFF; FORALL_IN_IMAGE] THEN
1855       ASM SET_TAC[];
1856       ALL_TAC] THEN
1857     GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
1858     REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
1859     MAP_EVERY X_GEN_TAC
1860      [`a:(real^M->bool)->real^M`; `h:(real^M->bool)->real^M->real^N`] THEN
1861     DISCH_TAC THEN MP_TAC(ISPECL
1862      [`h:(real^M->bool)->real^M->real^N`;
1863       `\c:real^M->bool. s UNION (c DELETE (a c))`;
1864       `s UNION UNIONS
1865        { c DELETE (a c) |
1866          c IN components ((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})}`;
1867       `{c | c IN components ((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})}`]
1868      PASTING_LEMMA_EXISTS_CLOSED) THEN
1869     SUBGOAL_THEN
1870      `FINITE {c | c IN components((u:real^M->bool) DIFF s) /\
1871                   ~(c INTER k = {})}`
1872     ASSUME_TAC THENL
1873      [MP_TAC(ISPECL
1874        [`\c:real^M->bool. c INTER k`;
1875         `{c | c IN components ((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})}`]
1876        FINITE_IMAGE_INJ_EQ) THEN
1877       REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL
1878        [MESON_TAC[COMPONENTS_EQ;
1879                   SET_RULE
1880                     `s INTER k = t INTER k /\ ~(s INTER k = {})
1881                      ==> ~(s INTER t = {})`];
1882         DISCH_THEN(SUBST1_TAC o SYM) THEN
1883         REWRITE_TAC[GSYM SIMPLE_IMAGE; IN_ELIM_THM]] THEN
1884       MP_TAC(ISPEC
1885        `{c INTER k |c| c IN components((u:real^M->bool) DIFF s) /\
1886                        ~(c INTER k = {})}`
1887         FINITE_UNIONS) THEN
1888       MATCH_MP_TAC(TAUT `p ==> (p <=> q /\ r) ==> q`) THEN
1889       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
1890         FINITE_SUBSET)) THEN
1891       REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[];
1892       ALL_TAC] THEN
1893     ASM_REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL
1894      [REPEAT CONJ_TAC THENL
1895        [REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[];
1896         X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN ASM_SIMP_TAC[] THEN
1897         MATCH_MP_TAC lemma0 THEN
1898         MAP_EVERY EXISTS_TAC [`u:real^M->bool`; `s UNION c:real^M->bool`] THEN
1899         REPEAT CONJ_TAC THENL
1900          [MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENT THEN
1901           ASM_REWRITE_TAC[];
1902           ASM_REWRITE_TAC[UNION_SUBSET; UNIONS_SUBSET; FORALL_IN_GSPEC] THEN
1903           MESON_TAC[IN_COMPONENTS_SUBSET;
1904                     SET_RULE `c SUBSET u DIFF s ==> c DELETE a SUBSET u`];
1905           ASM_SIMP_TAC[CLOSED_UNION_COMPLEMENT_COMPONENT; UNIONS_GSPEC] THEN
1906           MATCH_MP_TAC(SET_RULE
1907            `~(a IN t) /\ c DELETE a SUBSET t
1908             ==> s UNION c DELETE a = (s UNION c) INTER (s UNION t)`) THEN
1909           CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
1910           REWRITE_TAC[IN_ELIM_THM; IN_DELETE] THEN
1911           DISCH_THEN(X_CHOOSE_THEN `c':real^M->bool` STRIP_ASSUME_TAC) THEN
1912           MP_TAC(ISPECL [`(u:real^M->bool) DIFF s`;
1913                           `c:real^M->bool`; `c':real^M->bool`]
1914             COMPONENTS_EQ) THEN
1915           ASM_CASES_TAC `c':real^M->bool = c` THENL
1916            [ASM_MESON_TAC[]; ALL_TAC] THEN
1917           ASM SET_TAC[]];
1918         MAP_EVERY X_GEN_TAC
1919          [`c1:real^M->bool`; `c2:real^M->bool`; `x:real^M`] THEN
1920         STRIP_TAC THEN ASM_CASES_TAC `c2:real^M->bool = c1` THEN
1921         ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE
1922           `x IN u INTER (s UNION c1 DELETE a) INTER (s UNION c2 DELETE b)
1923            ==> (c1 INTER c2 = {}) ==> x IN s`)) THEN
1924         ANTS_TAC THENL [ASM_MESON_TAC[COMPONENTS_EQ]; ASM_SIMP_TAC[]]];
1925       DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC)] THEN
1926     MP_TAC
1927      (ISPECL [`\x. x IN s UNION
1928                         UNIONS {c | c IN components((u:real^M->bool) DIFF s) /\
1929                                     c INTER k = {}}`;
1930               `f:real^M->real^N`;
1931               `g:real^M->real^N`;
1932               `s UNION
1933                UNIONS {c | c IN components((u:real^M->bool) DIFF s) /\
1934                            c INTER k = {}}`;
1935               `s UNION
1936                UNIONS { c DELETE (a c) |
1937                         c IN components((u:real^M->bool) DIFF s) /\
1938                         ~(c INTER k = {})}`]
1939           CONTINUOUS_ON_CASES_LOCAL) THEN
1940     ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
1941      [REPEAT CONJ_TAC THENL
1942        [MATCH_MP_TAC lemma0 THEN EXISTS_TAC `u:real^M->bool` THEN
1943         EXISTS_TAC `u DIFF
1944                     UNIONS {c DELETE a c |
1945                             c IN components ((u:real^M->bool) DIFF s) /\
1946                             ~(c INTER k = {})}` THEN
1947         REPEAT CONJ_TAC THENL
1948           [MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN
1949            MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN
1950            X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN
1951            MATCH_MP_TAC OPEN_IN_DELETE THEN MATCH_MP_TAC OPEN_IN_TRANS THEN
1952            EXISTS_TAC `u DIFF s:real^M->bool` THEN
1953            ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN
1954            MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN
1955            ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
1956            EXISTS_TAC `u:real^M->bool` THEN
1957            ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL];
1958            ASM_REWRITE_TAC[UNION_SUBSET] THEN
1959            REWRITE_TAC[UNIONS_SUBSET; IN_ELIM_THM] THEN
1960            MESON_TAC[IN_COMPONENTS_SUBSET;
1961                      SET_RULE `c SUBSET u DIFF s ==> c DELETE a SUBSET u /\
1962                                                      c SUBSET u`];
1963            REWRITE_TAC[SET_RULE
1964             `(s UNION t) UNION (s UNION u) = (s UNION t) UNION u`] THEN
1965            MATCH_MP_TAC(SET_RULE
1966             `s SUBSET u /\ t INTER s = {}
1967              ==> s = (u DIFF t) INTER (s UNION t)`) THEN
1968            CONJ_TAC THENL
1969             [ASM_REWRITE_TAC[UNION_SUBSET] THEN
1970              REWRITE_TAC[UNIONS_SUBSET; IN_ELIM_THM] THEN
1971              MESON_TAC[IN_COMPONENTS_SUBSET;
1972                        SET_RULE `c SUBSET u DIFF s ==> c DELETE a SUBSET u /\
1973                                                        c SUBSET u`];
1974              ALL_TAC] THEN
1975            REWRITE_TAC[EMPTY_UNION; SET_RULE
1976             `c INTER (s UNION t) = (s INTER c) UNION (c INTER t)`] THEN
1977            CONJ_TAC THENL
1978             [MATCH_MP_TAC(SET_RULE
1979               `t SUBSET UNIV DIFF s ==> s INTER t = {}`) THEN
1980              REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN GEN_TAC THEN
1981              DISCH_THEN(CONJUNCTS_THEN2
1982                (MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)
1983                MP_TAC) THEN ASM SET_TAC[];
1984              REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN
1985              X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
1986              X_GEN_TAC `c':real^M->bool` THEN STRIP_TAC THEN
1987              MP_TAC(ISPECL [`(u:real^M->bool) DIFF s`;
1988                             `c:real^M->bool`; `c':real^M->bool`]
1989                COMPONENTS_EQ) THEN
1990              ASM_CASES_TAC `c':real^M->bool = c` THENL
1991               [ASM_MESON_TAC[]; ASM SET_TAC[]]]];
1992         MATCH_MP_TAC lemma0 THEN EXISTS_TAC `u:real^M->bool` THEN
1993         EXISTS_TAC
1994          `UNIONS {s UNION c |c| c IN components ((u:real^M->bool) DIFF s) /\
1995                                 ~(c INTER k = {})}` THEN
1996         REPEAT CONJ_TAC THENL
1997          [MATCH_MP_TAC CLOSED_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN
1998           ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
1999           ASM_SIMP_TAC[FINITE_IMAGE] THEN REPEAT STRIP_TAC THEN
2000           MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENT THEN
2001           ASM_REWRITE_TAC[];
2002           ASM_REWRITE_TAC[UNION_SUBSET] THEN
2003           REWRITE_TAC[UNIONS_SUBSET; IN_ELIM_THM] THEN
2004           MESON_TAC[IN_COMPONENTS_SUBSET;
2005                     SET_RULE `c SUBSET u DIFF s ==> c DELETE a SUBSET u /\
2006                                                     c SUBSET u`];
2007           MATCH_MP_TAC(SET_RULE
2008            `t SUBSET u /\ u INTER s SUBSET t ==> t = u INTER (s UNION t)`) THEN
2009           CONJ_TAC THENL
2010            [REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]; ALL_TAC] THEN
2011           MATCH_MP_TAC(SET_RULE
2012            `u INTER t SUBSET s ==> u INTER (s UNION t) SUBSET s UNION v`) THEN
2013           MATCH_MP_TAC(SET_RULE
2014           `((UNIV DIFF s) INTER t) INTER u SUBSET s
2015            ==> t INTER u SUBSET s`) THEN
2016           GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o TOP_DEPTH_CONV)
2017            [INTER_UNIONS] THEN
2018           REWRITE_TAC[SET_RULE
2019            `{g x | x IN {f y | P y}} = {g(f y) | P y}`] THEN
2020           REWRITE_TAC[SET_RULE
2021            `(UNIV DIFF s) INTER (s UNION c) = c DIFF s`] THEN
2022           REWRITE_TAC[SET_RULE
2023            `t INTER u SUBSET s <=> t INTER ((UNIV DIFF s) INTER u) = {}`] THEN
2024           ONCE_REWRITE_TAC[INTER_UNIONS] THEN
2025           REWRITE_TAC[EMPTY_UNIONS; FORALL_IN_GSPEC; INTER_UNIONS] THEN
2026           X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
2027           X_GEN_TAC `c':real^M->bool` THEN STRIP_TAC THEN
2028           MP_TAC(ISPECL [`(u:real^M->bool) DIFF s`;
2029                `c:real^M->bool`; `c':real^M->bool`]
2030             COMPONENTS_EQ) THEN
2031           ASM_CASES_TAC `c':real^M->bool = c` THENL
2032            [ASM_MESON_TAC[]; ASM SET_TAC[]]];
2033         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2034           CONTINUOUS_ON_SUBSET)) THEN
2035         REWRITE_TAC[UNION_SUBSET] THEN
2036         CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
2037         REWRITE_TAC[UNIONS_SUBSET; IN_ELIM_THM] THEN
2038         GEN_TAC THEN
2039         DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)
2040           MP_TAC) THEN ASM SET_TAC[];
2041         REWRITE_TAC[TAUT `p /\ ~p <=> F`] THEN X_GEN_TAC `x:real^M` THEN
2042         REWRITE_TAC[IN_UNION] THEN
2043         ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THENL
2044          [ASM SET_TAC[]; ALL_TAC] THEN
2045         REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_DELETE] THEN
2046         DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `c:real^M->bool`)
2047           (X_CHOOSE_TAC `c':real^M->bool`)) THEN
2048         MP_TAC(ISPECL [`(u:real^M->bool) DIFF s`;
2049                         `c:real^M->bool`; `c':real^M->bool`]
2050             COMPONENTS_EQ) THEN
2051         ASM_CASES_TAC `c':real^M->bool = c` THENL
2052          [ASM_MESON_TAC[]; ASM SET_TAC[]]];
2053       MATCH_MP_TAC(MESON[CONTINUOUS_ON_SUBSET]
2054        `t SUBSET s /\ P f
2055         ==> f continuous_on s ==> ?g. g continuous_on t /\ P g`) THEN
2056       REWRITE_TAC[] THEN CONJ_TAC THENL
2057        [REWRITE_TAC[SET_RULE
2058          `(s UNION t) UNION (s UNION u) = s UNION (t UNION u)`] THEN
2059         MATCH_MP_TAC(SET_RULE
2060          `(u DIFF s) DIFF p SUBSET t
2061           ==> u DIFF p SUBSET s UNION t`) THEN
2062         GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [UNIONS_COMPONENTS] THEN
2063         REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[];
2064         SIMP_TAC[IN_UNION]] THEN
2065       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF; IN_UNION; IN_UNIV] THEN
2066       X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
2067       ASM_CASES_TAC `(x:real^M) IN s` THENL [ASM SET_TAC[]; ALL_TAC] THEN
2068       ASM_REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN COND_CASES_TAC THENL
2069        [ASM SET_TAC[]; ALL_TAC] THEN
2070       SUBGOAL_THEN
2071         `x IN ((u:real^M->bool) DIFF s)` MP_TAC THENL
2072           [ASM SET_TAC[]; ALL_TAC] THEN
2073       GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [UNIONS_COMPONENTS] THEN
2074       REWRITE_TAC[IN_UNIONS] THEN
2075       DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN
2076       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN
2077       DISCH_THEN(MP_TAC o SPEC `c:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN
2078       DISCH_TAC THEN
2079       FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `c:real^M->bool`]) THEN
2080       ASM_REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]]) in
2081   let lemma3 = prove
2082    (`!f:real^M->real^N s t u p.
2083           compact s /\ convex u /\ bounded u /\
2084           affine t /\ aff_dim t <= aff_dim u /\ s SUBSET t /\
2085           f continuous_on s /\ IMAGE f s SUBSET relative_frontier u /\
2086           (!c. c IN components(t DIFF s) ==> ~(c INTER p = {}))
2087           ==> ?k g. FINITE k /\ k SUBSET p /\ k SUBSET t /\ DISJOINT k s /\
2088                     g continuous_on (t DIFF k) /\
2089                     IMAGE g (t DIFF k) SUBSET relative_frontier u /\
2090                     !x. x IN s ==> g x = f x`,
2091     REPEAT STRIP_TAC THEN
2092     MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`;
2093                    `t:real^M->bool`; `u:real^N->bool`]
2094           EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_SIMPLE) THEN
2095     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
2096     MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `g:real^M->real^N`] THEN
2097     STRIP_TAC THEN
2098     SUBGOAL_THEN
2099      `!x. ?y. x IN k
2100               ==> ?c. c IN components (t DIFF s:real^M->bool) /\
2101                       x IN c /\ y IN c /\ y IN p`
2102     MP_TAC THENL
2103      [X_GEN_TAC `x:real^M` THEN REWRITE_TAC[RIGHT_EXISTS_IMP_THM] THEN
2104       DISCH_TAC THEN
2105       SUBGOAL_THEN `(x:real^M) IN (t DIFF s)` MP_TAC THENL
2106        [ASM SET_TAC[]; ALL_TAC] THEN
2107       GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [UNIONS_COMPONENTS] THEN
2108       ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
2109       REWRITE_TAC[IN_UNIONS; RIGHT_EXISTS_AND_THM] THEN
2110       MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[];
2111       REWRITE_TAC[SKOLEM_THM] THEN
2112       DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^M` (LABEL_TAC "*"))] THEN
2113     EXISTS_TAC `IMAGE (h:real^M->real^M) k` THEN
2114     MP_TAC(ISPECL
2115      [`g:real^M->real^N`; `s:real^M->bool`;
2116       `relative_frontier u:real^N->bool`; `k:real^M->bool`;
2117       `IMAGE (h:real^M->real^M) k`; `t:real^M->bool`] lemma2) THEN
2118     ASM_SIMP_TAC[AFFINE_AFFINE_HULL; FINITE_IMAGE] THEN ANTS_TAC THENL
2119      [CONJ_TAC THENL
2120        [X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
2121         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
2122         ONCE_REWRITE_TAC[INTER_COMM] THEN
2123         REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; EXISTS_IN_IMAGE; IN_INTER] THEN
2124         MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^M` THEN
2125         STRIP_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `x:real^M`) THEN
2126         ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
2127         X_GEN_TAC `c':real^M->bool` THEN STRIP_TAC THEN
2128         MP_TAC(ISPECL [`(t:real^M->bool) DIFF s`;
2129                        `c:real^M->bool`; `c':real^M->bool`]
2130           COMPONENTS_EQ) THEN
2131         ASM_CASES_TAC `c':real^M->bool = c` THENL [ALL_TAC; ASM SET_TAC[]] THEN
2132         ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
2133         MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN
2134         EXISTS_TAC `(:real^M)` THEN
2135         ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN
2136         ASM_SIMP_TAC[COMPACT_IMP_CLOSED; SUBSET_UNIV]];
2137       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^M->real^N` THEN
2138       STRIP_TAC THEN ASM_SIMP_TAC[] THEN
2139       REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s ==> ~(x IN t)`] THEN
2140       ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
2141       ASM_MESON_TAC[IN_COMPONENTS_SUBSET; SUBSET; IN_DIFF]]) in
2142   REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL
2143    [ASM_CASES_TAC `relative_frontier(u:real^N->bool) = {}` THENL
2144      [RULE_ASSUM_TAC(REWRITE_RULE[RELATIVE_FRONTIER_EQ_EMPTY]) THEN
2145       UNDISCH_TAC `bounded(u:real^N->bool)` THEN
2146       ASM_SIMP_TAC[AFFINE_BOUNDED_EQ_LOWDIM] THEN DISCH_TAC THEN
2147       SUBGOAL_THEN `aff_dim(t:real^M->bool) <= &0` MP_TAC THENL
2148        [ASM_INT_ARITH_TAC; ALL_TAC] THEN
2149       SIMP_TAC[AFF_DIM_GE; INT_ARITH
2150        `--(&1):int <= x ==> (x <= &0 <=> x = --(&1) \/ x = &0)`] THEN
2151       REWRITE_TAC[AFF_DIM_EQ_MINUS1; AFF_DIM_EQ_0] THEN
2152       DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC (X_CHOOSE_TAC `a:real^M`)) THENL
2153        [EXISTS_TAC `{}:real^M->bool` THEN
2154         ASM_REWRITE_TAC[EMPTY_DIFF; FINITE_EMPTY; CONTINUOUS_ON_EMPTY;
2155                         IMAGE_CLAUSES; NOT_IN_EMPTY] THEN
2156         SET_TAC[];
2157         FIRST_X_ASSUM(MP_TAC o SPEC `{a:real^M}`) THEN
2158         ASM_REWRITE_TAC[DIFF_EMPTY; IN_COMPONENTS_SELF] THEN
2159         REWRITE_TAC[CONNECTED_SING; NOT_INSERT_EMPTY; BOUNDED_SING] THEN
2160         DISCH_TAC THEN EXISTS_TAC `{a:real^M}` THEN
2161         ASM_REWRITE_TAC[DIFF_EQ_EMPTY; CONTINUOUS_ON_EMPTY; NOT_IN_EMPTY;
2162                         FINITE_SING; IMAGE_CLAUSES; EMPTY_SUBSET] THEN
2163         ASM SET_TAC[]];
2164       EXISTS_TAC `{}:real^M->bool` THEN
2165       FIRST_X_ASSUM(X_CHOOSE_TAC `y:real^N` o
2166         GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
2167       ASM_SIMP_TAC[FINITE_EMPTY; DISJOINT_EMPTY; NOT_IN_EMPTY; DIFF_EMPTY] THEN
2168       EXISTS_TAC `(\x. y):real^M->real^N` THEN
2169       REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]];
2170     ALL_TAC] THEN
2171   FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN
2172   DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC) THEN
2173   REWRITE_TAC[INSERT_SUBSET] THEN
2174   DISCH_THEN(X_CHOOSE_THEN `b:real^M` STRIP_ASSUME_TAC) THEN
2175   MP_TAC(ISPECL
2176    [`f:real^M->real^N`; `s:real^M->bool`;
2177     `t:real^M->bool`; `u:real^N->bool`;
2178     `p UNION (UNIONS {c | c IN components (t DIFF s) /\ ~bounded c} DIFF
2179               interval[--(b + vec 1):real^M,b + vec 1])`]
2180         lemma3) THEN
2181   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
2182    [X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
2183     ASM_CASES_TAC `bounded(c:real^M->bool)` THENL
2184      [FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN
2185       ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
2186       ALL_TAC] THEN
2187     SUBGOAL_THEN
2188      `~(c SUBSET interval[--(b + vec 1):real^M,b + vec 1])`
2189     MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
2190     ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_INTERVAL];
2191     ALL_TAC] THEN
2192   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
2193   MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `g:real^M->real^N`] THEN
2194   STRIP_TAC THEN
2195   EXISTS_TAC `k INTER interval[--(b + vec 1):real^M,b + vec 1]` THEN
2196   ASM_SIMP_TAC[FINITE_INTER; RIGHT_EXISTS_AND_THM] THEN
2197   REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
2198   SUBGOAL_THEN
2199    `interval[--b,b] SUBSET interval[--(b + vec 1):real^M,b + vec 1]`
2200   ASSUME_TAC THENL
2201    [REWRITE_TAC[SUBSET_INTERVAL; VECTOR_ADD_COMPONENT; VECTOR_NEG_COMPONENT;
2202                 VEC_COMPONENT] THEN
2203     REAL_ARITH_TAC;
2204     ALL_TAC] THEN
2205   SUBGOAL_THEN
2206    `?d:real. (&1 / &2 <= d /\ d <= &1) /\
2207              DISJOINT k (frontier(interval[--(b + lambda i. d):real^M,
2208                                              (b + lambda i. d)]))`
2209   STRIP_ASSUME_TAC THENL
2210    [MATCH_MP_TAC lemma1 THEN
2211     ASM_SIMP_TAC[INFINITE; FINITE_REAL_INTERVAL; REAL_NOT_LE] THEN
2212     CONV_TAC REAL_RAT_REDUCE_CONV THEN
2213     MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[] THEN
2214     CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
2215     MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN REPEAT STRIP_TAC THEN
2216     REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE
2217      `c SUBSET i' ==> DISJOINT (c DIFF i) (c' DIFF i')`) THEN
2218     REWRITE_TAC[INTERIOR_INTERVAL; CLOSURE_INTERVAL] THEN
2219     SIMP_TAC[SUBSET_INTERVAL; VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT;
2220              LAMBDA_BETA] THEN
2221     ASM_REAL_ARITH_TAC;
2222     ALL_TAC] THEN
2223   ABBREV_TAC `c:real^M = b + lambda i. d` THEN SUBGOAL_THEN
2224    `interval[--b:real^M,b] SUBSET interval(--c,c) /\
2225     interval[--b:real^M,b] SUBSET interval[--c,c] /\
2226     interval[--c,c] SUBSET interval[--(b + vec 1):real^M,b + vec 1]`
2227   STRIP_ASSUME_TAC THENL
2228    [REWRITE_TAC[SUBSET_INTERVAL] THEN EXPAND_TAC "c" THEN REPEAT CONJ_TAC THEN
2229     SIMP_TAC[VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN
2230     MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
2231     REWRITE_TAC[VEC_COMPONENT] THEN ASM_REAL_ARITH_TAC;
2232     ALL_TAC] THEN
2233   EXISTS_TAC
2234    `(g:real^M->real^N) o
2235     closest_point (interval[--c,c] INTER t)` THEN
2236   REPEAT CONJ_TAC THENL
2237    [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
2238      [MATCH_MP_TAC CONTINUOUS_ON_CLOSEST_POINT THEN
2239       ASM_SIMP_TAC[CONVEX_INTER; CLOSED_INTER; CLOSED_INTERVAL; CLOSED_AFFINE;
2240         AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; CONVEX_INTERVAL] THEN
2241       ASM SET_TAC[];
2242       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2243           CONTINUOUS_ON_SUBSET))];
2244     REWRITE_TAC[IMAGE_o] THEN
2245     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
2246         SUBSET_TRANS)) THEN
2247     MATCH_MP_TAC IMAGE_SUBSET;
2248     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[o_THM] THEN
2249     TRANS_TAC EQ_TRANS `(g:real^M->real^N) x` THEN
2250     CONJ_TAC THENL [AP_TERM_TAC; ASM SET_TAC[]] THEN
2251     MATCH_MP_TAC CLOSEST_POINT_SELF THEN
2252     ASM_SIMP_TAC[IN_INTER; HULL_INC] THEN ASM SET_TAC[]] THEN
2253   (REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF] THEN
2254    X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN CONJ_TAC THENL
2255     [MATCH_MP_TAC(SET_RULE
2256       `closest_point s x IN s /\ s SUBSET u ==> closest_point s x IN u`) THEN
2257      CONJ_TAC THENL [MATCH_MP_TAC CLOSEST_POINT_IN_SET; ASM SET_TAC[]] THEN
2258      ASM_SIMP_TAC[CLOSED_INTER; CLOSED_INTERVAL; CLOSED_AFFINE] THEN
2259      ASM SET_TAC[];
2260      ALL_TAC] THEN
2261    ASM_CASES_TAC `x IN interval[--c:real^M,c]` THEN
2262    ASM_SIMP_TAC[CLOSEST_POINT_SELF; IN_INTER] THENL
2263     [ASM SET_TAC[]; ALL_TAC] THEN
2264    MATCH_MP_TAC(SET_RULE
2265     `closest_point s x IN relative_frontier s /\
2266      DISJOINT k (relative_frontier s)
2267      ==> ~(closest_point s x IN k)`) THEN
2268    CONJ_TAC THENL
2269     [MATCH_MP_TAC CLOSEST_POINT_IN_RELATIVE_FRONTIER THEN
2270      ASM_SIMP_TAC[CLOSED_INTER; CLOSED_AFFINE; CLOSED_INTERVAL] THEN
2271      CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_DIFF]] THEN CONJ_TAC THENL
2272       [ALL_TAC; ASM_MESON_TAC[SUBSET; RELATIVE_INTERIOR_SUBSET; IN_INTER]] THEN
2273      ONCE_REWRITE_TAC[INTER_COMM] THEN
2274      W(MP_TAC o PART_MATCH (lhs o rand)
2275        AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR o rand o snd) THEN
2276      ASM_SIMP_TAC[HULL_HULL; AFFINE_AFFINE_HULL; AFFINE_IMP_CONVEX] THEN
2277      ASM_SIMP_TAC[HULL_P] THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
2278      REWRITE_TAC[INTERIOR_INTERVAL] THEN ASM SET_TAC[];
2279      W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_FRONTIER_CONVEX_INTER_AFFINE o
2280        rand o snd) THEN
2281      ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
2282      REWRITE_TAC[CONVEX_INTERVAL; AFFINE_AFFINE_HULL; INTERIOR_INTERVAL] THEN
2283      ASM SET_TAC[]]));;
2284
2285 let EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE = prove
2286  (`!f:real^M->real^N s t a r p.
2287         compact s /\ affine t /\ aff_dim t <= &(dimindex(:N)) /\ s SUBSET t /\
2288         &0 <= r /\ f continuous_on s /\ IMAGE f s SUBSET sphere(a,r) /\
2289         (!c. c IN components(t DIFF s) /\ bounded c ==> ~(c INTER p = {}))
2290         ==> ?k g. FINITE k /\ k SUBSET p /\ k SUBSET t /\ DISJOINT k s /\
2291                   g continuous_on (t DIFF k) /\
2292                   IMAGE g (t DIFF k) SUBSET sphere(a,r) /\
2293                   !x. x IN s ==> g x = f x`,
2294   REPEAT GEN_TAC THEN ASM_CASES_TAC `r = &0` THENL
2295    [ASM_SIMP_TAC[SPHERE_SING] THEN STRIP_TAC THEN
2296     EXISTS_TAC `{}:real^M->bool` THEN
2297     EXISTS_TAC `(\x. a):real^M->real^N` THEN
2298     REWRITE_TAC[CONTINUOUS_ON_CONST; FINITE_EMPTY] THEN ASM SET_TAC[];
2299     MP_TAC(ISPECL [`a:real^N`; `r:real`] RELATIVE_FRONTIER_CBALL) THEN
2300     ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
2301     STRIP_TAC THEN MATCH_MP_TAC EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_GEN THEN
2302     ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; AFF_DIM_CBALL] THEN
2303     COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]);;
2304
2305 let EXTEND_MAP_UNIV_TO_SPHERE_COFINITE = prove
2306  (`!f:real^M->real^N s a r p.
2307      dimindex(:M) <= dimindex(:N) /\ &0 <= r /\
2308      compact s /\ f continuous_on s /\ IMAGE f s SUBSET sphere(a,r) /\
2309      (!c. c IN components((:real^M) DIFF s) /\ bounded c
2310           ==> ~(c INTER p = {}))
2311      ==> ?k g. FINITE k /\ k SUBSET p /\ DISJOINT k s /\
2312                g continuous_on ((:real^M) DIFF k) /\
2313                IMAGE g ((:real^M) DIFF k) SUBSET sphere(a,r) /\
2314                !x. x IN s ==> g x = f x`,
2315   REPEAT STRIP_TAC THEN
2316   MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `(:real^M)`;
2317                  `a:real^N`; `r:real`; `p:real^M->bool`]
2318         EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE) THEN
2319   ASM_REWRITE_TAC[AFFINE_UNIV; SUBSET_UNIV; AFF_DIM_UNIV; INT_OF_NUM_LE]);;
2320
2321 let EXTEND_MAP_UNIV_TO_SPHERE_NO_BOUNDED_COMPONENT = prove
2322  (`!f:real^M->real^N s a r.
2323      dimindex(:M) <= dimindex(:N) /\ &0 <= r /\
2324      compact s /\ f continuous_on s /\ IMAGE f s SUBSET sphere(a,r) /\
2325      (!c. c IN components((:real^M) DIFF s) ==> ~bounded c)
2326      ==> ?g. g continuous_on (:real^M) /\
2327              IMAGE g (:real^M) SUBSET sphere(a,r) /\
2328              !x. x IN s ==> g x = f x`,
2329   REPEAT STRIP_TAC THEN
2330   MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`;  `a:real^N`; `r:real`;
2331                  `{}:real^M->bool`] EXTEND_MAP_UNIV_TO_SPHERE_COFINITE) THEN
2332   ASM_SIMP_TAC[IMP_CONJ; SUBSET_EMPTY; RIGHT_EXISTS_AND_THM] THEN
2333   ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
2334   REWRITE_TAC[UNWIND_THM2; FINITE_EMPTY; DISJOINT_EMPTY; DIFF_EMPTY] THEN
2335   MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]);;
2336
2337 let EXTEND_MAP_SPHERE_TO_SPHERE_GEN = prove
2338  (`!f:real^M->real^N c s t.
2339         closed c /\ c SUBSET relative_frontier s /\ convex s /\ bounded s /\
2340         convex t /\ bounded t /\ aff_dim s <= aff_dim t /\
2341         f continuous_on c /\ IMAGE f c SUBSET relative_frontier t
2342          ==> ?g. g continuous_on (relative_frontier s) /\
2343                  IMAGE g (relative_frontier s) SUBSET relative_frontier t /\
2344                  !x. x IN c ==> g x = f x`,
2345   REPEAT STRIP_TAC THEN
2346   SUBGOAL_THEN
2347    `?p:real^M->bool. polytope p /\ aff_dim p = aff_dim(s:real^M->bool)`
2348   STRIP_ASSUME_TAC THENL
2349    [MATCH_MP_TAC CHOOSE_POLYTOPE THEN
2350     ASM_REWRITE_TAC[AFF_DIM_GE; AFF_DIM_LE_UNIV];
2351     ALL_TAC] THEN
2352   MP_TAC(ISPECL [`s:real^M->bool`; `p:real^M->bool`]
2353         HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS) THEN
2354   ASM_SIMP_TAC[POLYTOPE_IMP_CONVEX; POLYTOPE_IMP_BOUNDED; homeomorphic] THEN
2355   REWRITE_TAC[HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN
2356   MAP_EVERY X_GEN_TAC [`h:real^M->real^M`; `k:real^M->real^M`] THEN
2357   STRIP_TAC THEN
2358   MP_TAC(ISPECL
2359    [`(f:real^M->real^N) o (k:real^M->real^M)`;
2360     `{f:real^M->bool | f face_of p /\ ~(f = p)}`;
2361     `IMAGE (h:real^M->real^M) c`;
2362     `t:real^N->bool`] EXTEND_MAP_CELL_COMPLEX_TO_SPHERE) THEN
2363   ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN
2364   ASM_SIMP_TAC[GSYM RELATIVE_FRONTIER_OF_POLYHEDRON_ALT;
2365                POLYTOPE_IMP_POLYHEDRON] THEN
2366   REWRITE_TAC[IN_ELIM_THM; GSYM IMAGE_o; o_THM] THEN ANTS_TAC THENL
2367    [REPEAT CONJ_TAC THENL
2368      [MATCH_MP_TAC FINITE_SUBSET THEN
2369       EXISTS_TAC `{f:real^M->bool | f face_of p}` THEN
2370       ASM_SIMP_TAC[FINITE_POLYTOPE_FACES] THEN SET_TAC[];
2371       ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE;
2372                     FACE_OF_AFF_DIM_LT; POLYTOPE_IMP_CONVEX; INT_LTE_TRANS];
2373       ASM_MESON_TAC[FACE_OF_INTER; FACE_OF_SUBSET;
2374                     INTER_SUBSET; FACE_OF_INTER; FACE_OF_IMP_SUBSET];
2375       ASM SET_TAC[];
2376       MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
2377       MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
2378       CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN
2379       ASM_REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN
2380       FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
2381         BOUNDED_SUBSET)) THEN
2382       ASM_SIMP_TAC[BOUNDED_RELATIVE_FRONTIER];
2383       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
2384       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2385         CONTINUOUS_ON_SUBSET)) THEN
2386       ASM SET_TAC[];
2387       REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]];
2388     DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
2389     EXISTS_TAC `(g:real^M->real^N) o (h:real^M->real^M)` THEN
2390     REWRITE_TAC[IMAGE_o; o_THM] THEN
2391     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
2392     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
2393     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2394       CONTINUOUS_ON_SUBSET)) THEN
2395     ASM SET_TAC[]]);;
2396
2397 let EXTEND_MAP_SPHERE_TO_SPHERE = prove
2398  (`!f:real^M->real^N c a r b s.
2399         dimindex(:M) <= dimindex(:N) /\ closed c /\ c SUBSET sphere(a,r) /\
2400         f continuous_on c /\ IMAGE f c SUBSET sphere(b,s) /\
2401         (&0 <= r /\ c = {} ==> &0 <= s)
2402         ==> ?g. g continuous_on sphere(a,r) /\
2403                 IMAGE g (sphere(a,r)) SUBSET sphere(b,s) /\
2404                 !x. x IN c ==> g x = f x`,
2405   REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THEN
2406   ASM_SIMP_TAC[SPHERE_EMPTY; NOT_IN_EMPTY; CONTINUOUS_ON_EMPTY;
2407                IMAGE_CLAUSES; EMPTY_SUBSET]
2408   THENL [MESON_TAC[]; ASM_REWRITE_TAC[GSYM REAL_NOT_LT]] THEN
2409   ASM_CASES_TAC `sphere(b:real^N,s) = {}` THENL
2410    [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SPHERE_EQ_EMPTY]) THEN
2411     ASM SET_TAC[];
2412     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SPHERE_EQ_EMPTY])] THEN
2413   REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
2414   RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN
2415   ASM_CASES_TAC `r = &0` THEN
2416   ASM_SIMP_TAC[SPHERE_SING; CONTINUOUS_ON_SING; REAL_LE_REFL] THENL
2417    [ASM_CASES_TAC `c:real^M->bool = {}` THENL
2418      [DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC(MESON[]
2419        `(?c. P(\x. c)) ==> ?f. P f`) THEN ASM SET_TAC[];
2420       DISCH_TAC THEN EXISTS_TAC `f:real^M->real^N` THEN ASM SET_TAC[]];
2421     ALL_TAC] THEN
2422   ASM_CASES_TAC `s = &0` THENL
2423    [ASM_SIMP_TAC[SPHERE_SING] THEN STRIP_TAC THEN
2424     EXISTS_TAC `(\x. b):real^M->real^N` THEN
2425     REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[];
2426     ALL_TAC] THEN
2427   STRIP_TAC THEN
2428   MP_TAC(ISPECL [`f:real^M->real^N`; `c:real^M->bool`;
2429                  `cball(a:real^M,r)`; `cball(b:real^N,s)`]
2430         EXTEND_MAP_SPHERE_TO_SPHERE_GEN) THEN
2431   ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; AFF_DIM_CBALL;
2432                   RELATIVE_FRONTIER_CBALL] THEN
2433   DISCH_THEN MATCH_MP_TAC THEN
2434   REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[INT_OF_NUM_LE]) THEN
2435   ASM_REAL_ARITH_TAC);;
2436
2437 let EXTEND_MAP_SPHERE_TO_SPHERE_COFINITE_GEN = prove
2438  (`!f:real^M->real^N s t u p.
2439         convex t /\ bounded t /\ convex u /\ bounded u /\
2440         aff_dim t <= aff_dim u + &1 /\
2441         closed s /\ s SUBSET relative_frontier t /\
2442         f continuous_on s /\ IMAGE f s SUBSET relative_frontier u /\
2443         (!c. c IN components(relative_frontier t DIFF s) ==> ~(c INTER p = {}))
2444         ==> ?k g. FINITE k /\ k SUBSET p /\
2445                   k SUBSET relative_frontier t /\ DISJOINT k s /\
2446                   g continuous_on (relative_frontier t DIFF k) /\
2447                   IMAGE g (relative_frontier t DIFF k) SUBSET
2448                   relative_frontier u /\
2449                   !x. x IN s ==> g x = f x`,
2450   REPEAT GEN_TAC THEN
2451   ASM_CASES_TAC `s = (relative_frontier t:real^M->bool)` THENL
2452    [ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
2453     MAP_EVERY EXISTS_TAC [`{}:real^M->bool`; `f:real^M->real^N`] THEN
2454     ASM_REWRITE_TAC[FINITE_EMPTY; DIFF_EMPTY] THEN SET_TAC[];
2455     POP_ASSUM MP_TAC] THEN
2456   ASM_CASES_TAC `relative_frontier t:real^M->bool = {}` THENL
2457    [ASM SET_TAC[]; REPEAT STRIP_TAC] THEN
2458   SUBGOAL_THEN
2459    `?c q:real^M. c IN components (relative_frontier t DIFF s) /\
2460                  q IN c /\ q IN relative_frontier t /\ ~(q IN s) /\ q IN p`
2461   STRIP_ASSUME_TAC THENL
2462    [MP_TAC(ISPEC `(relative_frontier t:real^M->bool) DIFF s`
2463       UNIONS_COMPONENTS) THEN
2464     DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
2465      `s = u ==> ~(s = {}) ==> ~(u = {})`)) THEN
2466     ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[EMPTY_UNIONS]] THEN
2467     REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN
2468     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^M->bool` THEN
2469     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
2470     FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN
2471     ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
2472     MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN
2473     ASM_REWRITE_TAC[GSYM IN_DIFF] THEN
2474     ASM_MESON_TAC[SUBSET; IN_COMPONENTS_SUBSET];
2475     ALL_TAC] THEN
2476   SUBGOAL_THEN
2477    `?af. affine af /\ aff_dim(t:real^M->bool) = aff_dim(af:real^M->bool) + &1`
2478   STRIP_ASSUME_TAC THENL
2479    [MP_TAC(ISPECL [`(:real^M)`; `aff_dim(t:real^M->bool) - &1`]
2480         CHOOSE_AFFINE_SUBSET) THEN
2481     REWRITE_TAC[SUBSET_UNIV; AFFINE_UNIV] THEN ANTS_TAC THENL
2482      [MATCH_MP_TAC(INT_ARITH
2483        `&0:int <= t /\ t <= n ==> --a <= t - a /\ t - &1 <= n`) THEN
2484       REWRITE_TAC[AFF_DIM_LE_UNIV; AFF_DIM_UNIV; AFF_DIM_POS_LE] THEN
2485       ASM_MESON_TAC[RELATIVE_FRONTIER_EMPTY; NOT_IN_EMPTY];
2486       MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN INT_ARITH_TAC];
2487     ALL_TAC] THEN
2488   MP_TAC(ISPECL [`t:real^M->bool`; `af:real^M->bool`; `q:real^M`]
2489         HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN) THEN
2490   ASM_REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN
2491   MAP_EVERY X_GEN_TAC [`h:real^M->real^M`; `k:real^M->real^M`] THEN
2492   STRIP_TAC THEN MP_TAC(ISPECL
2493    [`(f:real^M->real^N) o (k:real^M->real^M)`;
2494     `IMAGE (h:real^M->real^M) s`;
2495     `(af:real^M->bool)`;
2496     `u:real^N->bool`;
2497     `IMAGE (h:real^M->real^M) (p INTER relative_frontier t DELETE q)`]
2498    EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_GEN) THEN
2499   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
2500    [REPEAT CONJ_TAC THENL
2501      [MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN CONJ_TAC THENL
2502        [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2503           CONTINUOUS_ON_SUBSET)) THEN
2504         ASM SET_TAC[];
2505         ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET;
2506                       COMPACT_RELATIVE_FRONTIER_BOUNDED]];
2507       ASM_INT_ARITH_TAC;
2508       ASM SET_TAC[];
2509       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
2510       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2511           CONTINUOUS_ON_SUBSET)) THEN
2512       ASM SET_TAC[];
2513       REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
2514       X_GEN_TAC `l:real^M->bool` THEN STRIP_TAC THEN
2515       SUBGOAL_THEN `~(l:real^M->bool = {})` ASSUME_TAC THENL
2516        [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]; ALL_TAC] THEN
2517       SUBGOAL_THEN `?x:real^M. x IN l` STRIP_ASSUME_TAC THENL
2518        [ASM SET_TAC[]; ALL_TAC] THEN
2519       SUBGOAL_THEN `l SUBSET af DIFF IMAGE (h:real^M->real^M) s`
2520       ASSUME_TAC THENL
2521        [ASM_MESON_TAC[IN_COMPONENTS_SUBSET]; ALL_TAC] THEN
2522       SUBGOAL_THEN `connected(l:real^M->bool)` ASSUME_TAC THENL
2523        [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN
2524       SUBGOAL_THEN
2525        `?r. r IN components (relative_frontier t DIFF s) /\
2526             IMAGE (k:real^M->real^M) l SUBSET r`
2527       STRIP_ASSUME_TAC THENL
2528        [REWRITE_TAC[IN_COMPONENTS; LEFT_AND_EXISTS_THM] THEN
2529         EXISTS_TAC `connected_component (relative_frontier t DIFF s)
2530                                         ((k:real^M->real^M) x)` THEN
2531         EXISTS_TAC `(k:real^M->real^M) x` THEN REWRITE_TAC[] THEN
2532         CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
2533         MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
2534         ASM_SIMP_TAC[FUN_IN_IMAGE] THEN
2535         CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
2536         MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
2537         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2538           CONTINUOUS_ON_SUBSET)) THEN
2539         ASM SET_TAC[];
2540         ALL_TAC] THEN
2541       FIRST_X_ASSUM(MP_TAC o SPEC `r:real^M->bool`) THEN
2542       ASM_REWRITE_TAC[] THEN
2543       GEN_REWRITE_TAC LAND_CONV [GSYM MEMBER_NOT_EMPTY] THEN
2544       REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_INTER] THEN
2545       X_GEN_TAC `z:real^M` THEN STRIP_TAC THEN
2546       SUBGOAL_THEN `r SUBSET ((relative_frontier t:real^M->bool) DIFF s)`
2547       ASSUME_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_SUBSET]; ALL_TAC] THEN
2548       SUBGOAL_THEN `connected(r:real^M->bool)` ASSUME_TAC THENL
2549        [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN
2550       ASM_CASES_TAC `(q:real^M) IN r` THENL
2551        [ALL_TAC;
2552         REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
2553         EXISTS_TAC `(h:real^M->real^M) z` THEN REWRITE_TAC[IN_INTER] THEN
2554         CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
2555         MATCH_MP_TAC(SET_RULE `!s. x IN s /\ s SUBSET t ==> x IN t`) THEN
2556         EXISTS_TAC `IMAGE (h:real^M->real^M) r` THEN
2557         ASM_SIMP_TAC[FUN_IN_IMAGE] THEN MATCH_MP_TAC COMPONENTS_MAXIMAL THEN
2558         EXISTS_TAC `af DIFF IMAGE (h:real^M->real^M) s` THEN
2559         ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
2560          [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
2561           FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2562             CONTINUOUS_ON_SUBSET)) THEN
2563           ASM SET_TAC[];
2564           REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF; IN_ELIM_THM] THEN
2565           X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN
2566           CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
2567           REWRITE_TAC[SET_RULE
2568            `~(h y IN IMAGE h s) <=> !y'. y' IN s ==> ~(h y = h y')`] THEN
2569           X_GEN_TAC `y':real^M` THEN DISCH_TAC THEN
2570           DISCH_THEN(MP_TAC o AP_TERM `k:real^M->real^M`) THEN
2571           MATCH_MP_TAC(MESON[]
2572            `k(h y) = y /\ k(h y') = y' /\ ~(y = y')
2573             ==> k(h y) = k(h y') ==> F`) THEN
2574           ASM SET_TAC[];
2575           ASM SET_TAC[]]] THEN
2576       SUBGOAL_THEN
2577        `?n. open_in (subtopology euclidean (relative_frontier t)) n /\
2578             (q:real^M) IN n /\ n INTER IMAGE (k:real^M->real^M) l = {}`
2579       STRIP_ASSUME_TAC THENL
2580        [EXISTS_TAC `relative_frontier t DIFF
2581                     IMAGE (k:real^M->real^M) (closure l)` THEN
2582         SUBGOAL_THEN `closure l SUBSET (af:real^M->bool)` ASSUME_TAC THENL
2583          [MATCH_MP_TAC CLOSURE_MINIMAL THEN
2584           ASM_SIMP_TAC[CLOSED_AFFINE] THEN ASM SET_TAC[];
2585           ALL_TAC] THEN
2586         REPEAT CONJ_TAC THENL
2587          [MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
2588           MATCH_MP_TAC CLOSED_SUBSET THEN
2589           CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
2590           MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
2591           MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
2592           ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN
2593           FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2594             CONTINUOUS_ON_SUBSET)) THEN
2595           ASM SET_TAC[];
2596           ASM SET_TAC[];
2597           MP_TAC(ISPEC `l:real^M->bool` CLOSURE_SUBSET) THEN SET_TAC[]];
2598         ALL_TAC] THEN
2599       FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
2600       SUBGOAL_THEN
2601        `?w. connected w /\ w SUBSET r DELETE q /\
2602             (k:real^M->real^M) x IN w /\ ~((n DELETE q) INTER w = {})`
2603       STRIP_ASSUME_TAC THENL
2604        [ALL_TAC;
2605         MATCH_MP_TAC(TAUT `F ==> p`) THEN
2606         SUBGOAL_THEN `IMAGE (h:real^M->real^M) w SUBSET l` MP_TAC THENL
2607          [ALL_TAC; ASM SET_TAC[]] THEN
2608         MATCH_MP_TAC COMPONENTS_MAXIMAL THEN
2609         EXISTS_TAC `af DIFF IMAGE (h:real^M->real^M) s` THEN
2610         ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
2611          [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
2612           FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2613             CONTINUOUS_ON_SUBSET)) THEN
2614           ASM SET_TAC[];
2615           REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF; IN_ELIM_THM] THEN
2616           X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN
2617           CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
2618           REWRITE_TAC[SET_RULE
2619            `~(h y IN IMAGE h s) <=> !y'. y' IN s ==> ~(h y = h y')`] THEN
2620           X_GEN_TAC `y':real^M` THEN DISCH_TAC THEN
2621           DISCH_THEN(MP_TAC o AP_TERM `k:real^M->real^M`) THEN
2622           MATCH_MP_TAC(MESON[]
2623            `k(h y) = y /\ k(h y') = y' /\ ~(y = y')
2624             ==> k(h y) = k(h y') ==> F`) THEN
2625           ASM SET_TAC[];
2626           ASM SET_TAC[]]] THEN
2627       SUBGOAL_THEN `path_connected(r:real^M->bool)` MP_TAC THENL
2628        [W(MP_TAC o PART_MATCH (lhand o rand) PATH_CONNECTED_EQ_CONNECTED_LPC o
2629           snd) THEN
2630         ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
2631         MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
2632         EXISTS_TAC `(relative_frontier t:real^M->bool)` THEN
2633         ASM_SIMP_TAC[LOCALLY_PATH_CONNECTED_SPHERE_GEN] THEN
2634         MATCH_MP_TAC OPEN_IN_TRANS THEN
2635         EXISTS_TAC `(relative_frontier t:real^M->bool) DIFF s` THEN
2636         CONJ_TAC THENL
2637          [MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN
2638           ASM_REWRITE_TAC[] THEN
2639           MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
2640           EXISTS_TAC `(relative_frontier t:real^M->bool)` THEN
2641           ASM_SIMP_TAC[LOCALLY_CONNECTED_SPHERE_GEN];
2642           ALL_TAC] THEN
2643         MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
2644         MATCH_MP_TAC CLOSED_SUBSET THEN ASM_REWRITE_TAC[];
2645         ALL_TAC] THEN
2646       REWRITE_TAC[PATH_CONNECTED_ARCWISE] THEN
2647       DISCH_THEN(MP_TAC o SPECL [`(k:real^M->real^M) x`; `q:real^M`]) THEN
2648       ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
2649       DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC) THEN
2650       FIRST_X_ASSUM(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC o
2651         GEN_REWRITE_RULE I [arc]) THEN
2652       DISCH_TAC THEN
2653       SUBGOAL_THEN
2654        `open_in (subtopology euclidean (interval[vec 0,vec 1]))
2655                 {x | x IN interval[vec 0,vec 1] /\
2656                      (g:real^1->real^M) x IN n}`
2657       MP_TAC THENL
2658        [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
2659         EXISTS_TAC `(relative_frontier t:real^M->bool)` THEN
2660         ASM_REWRITE_TAC[GSYM path; GSYM path_image] THEN
2661         ASM SET_TAC[];
2662         ALL_TAC] THEN
2663       REWRITE_TAC[OPEN_IN_CONTAINS_CBALL] THEN
2664       REWRITE_TAC[IN_ELIM_THM; SUBSET_RESTRICT] THEN
2665       DISCH_THEN(MP_TAC o SPEC `vec 1:real^1`) THEN
2666       REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
2667       ANTS_TAC THENL [ASM_MESON_TAC[pathfinish]; ALL_TAC] THEN
2668       DISCH_THEN(X_CHOOSE_THEN `r:real`
2669         (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
2670       ABBREV_TAC `t' = lift(&1 - min (&1 / &2) r)` THEN
2671       SUBGOAL_THEN `t' IN interval[vec 0:real^1,vec 1]` ASSUME_TAC THENL
2672        [EXPAND_TAC "t'" THEN SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
2673         ASM_REAL_ARITH_TAC;
2674         ALL_TAC] THEN
2675       GEN_REWRITE_TAC LAND_CONV [SUBSET] THEN
2676       DISCH_THEN(MP_TAC o SPEC `t':real^1`) THEN
2677       ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM; IN_CBALL; DIST_REAL;
2678                       DROP_VEC; GSYM drop] THEN
2679       ANTS_TAC THENL
2680        [EXPAND_TAC "t'" THEN REWRITE_TAC[LIFT_DROP] THEN ASM_REAL_ARITH_TAC;
2681         DISCH_TAC] THEN
2682       EXISTS_TAC `IMAGE (g:real^1->real^M) (interval[vec 0,t'])` THEN
2683       REPEAT CONJ_TAC THENL
2684        [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
2685         REWRITE_TAC[CONNECTED_INTERVAL] THEN
2686         MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
2687         EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
2688         ASM_REWRITE_TAC[GSYM path; SUBSET_INTERVAL_1] THEN
2689         ASM_REWRITE_TAC[REAL_LE_REFL; GSYM IN_INTERVAL_1];
2690         REWRITE_TAC[SET_RULE
2691          `s SUBSET t DELETE q <=> s SUBSET t /\ !x. x IN s ==> ~(x = q)`] THEN
2692         CONJ_TAC THENL
2693          [TRANS_TAC SUBSET_TRANS
2694             `IMAGE (g:real^1->real^M) (interval[vec 0,vec 1])` THEN
2695           CONJ_TAC THENL
2696            [MATCH_MP_TAC IMAGE_SUBSET THEN
2697             ASM_REWRITE_TAC[REAL_LE_REFL; GSYM IN_INTERVAL_1;
2698                             SUBSET_INTERVAL_1];
2699             ASM_REWRITE_TAC[GSYM path_image]];
2700           REWRITE_TAC[FORALL_IN_IMAGE] THEN
2701           X_GEN_TAC `t'':real^1` THEN DISCH_TAC THEN
2702           FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV)
2703            [SYM th]) THEN
2704           REWRITE_TAC[pathfinish] THEN DISCH_TAC THEN
2705           FIRST_X_ASSUM(MP_TAC o SPECL [`t'':real^1`; `vec 1:real^1`]) THEN
2706           ASM_REWRITE_TAC[GSYM DROP_EQ] THEN
2707           UNDISCH_TAC `t'' IN interval[vec 0:real^1,t']` THEN
2708           EXPAND_TAC "t'" THEN
2709           REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
2710           ASM_REAL_ARITH_TAC];
2711         REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 0:real^1` THEN
2712         CONJ_TAC THENL [ASM_MESON_TAC[pathstart]; ALL_TAC] THEN
2713         EXPAND_TAC "t'" THEN
2714         REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
2715         ASM_REAL_ARITH_TAC;
2716         REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
2717         ONCE_REWRITE_TAC[INTER_COMM] THEN
2718         REWRITE_TAC[EXISTS_IN_IMAGE; IN_INTER] THEN
2719         EXISTS_TAC `t':real^1` THEN CONJ_TAC THENL
2720          [EXPAND_TAC "t'" THEN
2721           REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
2722           ASM_REAL_ARITH_TAC;
2723           ASM_REWRITE_TAC[IN_DELETE] THEN
2724           FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV)
2725            [SYM th]) THEN
2726           REWRITE_TAC[pathfinish] THEN DISCH_TAC THEN
2727           FIRST_X_ASSUM(MP_TAC o SPECL [`t':real^1`; `vec 1:real^1`]) THEN
2728           ASM_REWRITE_TAC[GSYM DROP_EQ] THEN
2729           EXPAND_TAC "t'" THEN
2730           REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
2731           ASM_REAL_ARITH_TAC]]];
2732     ALL_TAC] THEN
2733   ASM_SIMP_TAC[DOT_BASIS; LE_REFL; DIMINDEX_GE_1; LEFT_IMP_EXISTS_THM] THEN
2734   MAP_EVERY X_GEN_TAC [`tk:real^M->bool`; `g:real^M->real^N`] THEN
2735   REWRITE_TAC[o_THM] THEN
2736   STRIP_TAC THEN EXISTS_TAC `q INSERT IMAGE (k:real^M->real^M) tk` THEN
2737   EXISTS_TAC `(g:real^M->real^N) o (h:real^M->real^M)` THEN
2738   ASM_SIMP_TAC[FINITE_INSERT; FINITE_IMAGE; o_THM] THEN REPEAT CONJ_TAC THENL
2739    [MATCH_MP_TAC(SET_RULE
2740      `a IN t /\ s SUBSET t DELETE a ==> a INSERT s SUBSET t`) THEN
2741     ASM_REWRITE_TAC[] THEN
2742     TRANS_TAC SUBSET_TRANS
2743       `p INTER (relative_frontier t:real^M->bool) DELETE q` THEN
2744     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
2745     ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
2746      (SET_RULE `t SUBSET IMAGE h s ==> IMAGE k (IMAGE h s) SUBSET s
2747             ==> IMAGE k t SUBSET s`)) THEN
2748     REWRITE_TAC[GSYM IMAGE_o] THEN
2749     MATCH_MP_TAC(SET_RULE
2750      `(!x. x IN s ==> f x = x) ==> IMAGE f s SUBSET s`) THEN
2751     REWRITE_TAC[o_THM] THEN ASM SET_TAC[];
2752     ASM SET_TAC[];
2753     ASM SET_TAC[];
2754     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
2755     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2756         CONTINUOUS_ON_SUBSET)) THEN
2757     ASM SET_TAC[];
2758     REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
2759     ASM SET_TAC[]]);;
2760
2761 let EXTEND_MAP_SPHERE_TO_SPHERE_COFINITE = prove
2762  (`!f:real^M->real^N s a d b e p.
2763         dimindex(:M) <= dimindex(:N) + 1 /\
2764         (&0 < d /\ s = {} ==> &0 <= e) /\
2765         closed s /\ s SUBSET sphere(a,d) /\
2766         f continuous_on s /\ IMAGE f s SUBSET sphere(b,e) /\
2767         (!c. c IN components(sphere(a,d) DIFF s) ==> ~(c INTER p = {}))
2768         ==> ?k g. FINITE k /\ k SUBSET p /\
2769                   k SUBSET sphere(a,d) /\ DISJOINT k s /\
2770                   g continuous_on (sphere(a,d) DIFF k) /\
2771                   IMAGE g (sphere(a,d) DIFF k) SUBSET sphere(b,e) /\
2772                   !x. x IN s ==> g x = f x`,
2773   REPEAT GEN_TAC THEN ASM_CASES_TAC `s = sphere(a:real^M,d)` THENL
2774    [ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
2775     MAP_EVERY EXISTS_TAC [`{}:real^M->bool`; `f:real^M->real^N`] THEN
2776     ASM_REWRITE_TAC[FINITE_EMPTY; DIFF_EMPTY] THEN SET_TAC[];
2777     POP_ASSUM MP_TAC] THEN
2778   ASM_CASES_TAC `d < &0` THENL
2779    [ASM_SIMP_TAC[SPHERE_EMPTY] THEN SET_TAC[]; ALL_TAC] THEN
2780   ASM_CASES_TAC `d = &0` THENL
2781    [ASM_SIMP_TAC[SPHERE_SING] THEN
2782     ASM_CASES_TAC `s:real^M->bool = {}` THENL
2783      [ASM_REWRITE_TAC[]; ASM SET_TAC[]] THEN
2784     REPEAT STRIP_TAC THEN
2785     EXISTS_TAC `{a:real^M}` THEN
2786     REWRITE_TAC[FINITE_SING; CONTINUOUS_ON_EMPTY; DIFF_EQ_EMPTY] THEN
2787     FIRST_X_ASSUM(MP_TAC o SPEC `{a:real^M}`) THEN
2788     REWRITE_TAC[DIFF_EMPTY; IN_COMPONENTS_SELF; CONNECTED_SING] THEN
2789     REWRITE_TAC[IMAGE_CLAUSES] THEN SET_TAC[];
2790     ALL_TAC] THEN
2791   SUBGOAL_THEN `&0 < d` ASSUME_TAC THENL
2792    [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
2793   ASM_CASES_TAC `e = &0` THENL
2794    [ASM_SIMP_TAC[SPHERE_SING] THEN REPEAT STRIP_TAC THEN
2795     EXISTS_TAC `{}:real^M->bool` THEN
2796     EXISTS_TAC `(\x. b):real^M->real^N` THEN
2797     REWRITE_TAC[CONTINUOUS_ON_CONST; FINITE_EMPTY] THEN ASM SET_TAC[];
2798     REPEAT STRIP_TAC] THEN
2799   SUBGOAL_THEN `&0 <= e` ASSUME_TAC THENL
2800    [ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_SIMP_TAC[] THEN
2801     MP_TAC(SYM(ISPECL [`b:real^N`; `e:real`] SPHERE_EQ_EMPTY)) THEN
2802     SIMP_TAC[GSYM REAL_NOT_LT] THEN ASM SET_TAC[];
2803     ALL_TAC] THEN
2804   SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL
2805    [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
2806   MP_TAC(ISPECL
2807    [`f:real^M->real^N`; `s:real^M->bool`; `cball(a:real^M,d)`;
2808     `cball(b:real^N,e)`; `p:real^M->bool`]
2809    EXTEND_MAP_SPHERE_TO_SPHERE_COFINITE_GEN) THEN
2810   ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL] THEN
2811   REWRITE_TAC[AFF_DIM_CBALL] THEN
2812   MP_TAC(ISPECL [`a:real^M`; `d:real`] RELATIVE_FRONTIER_CBALL) THEN
2813   MP_TAC(ISPECL [`b:real^N`; `e:real`] RELATIVE_FRONTIER_CBALL) THEN
2814   ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN SUBST1_TAC) THEN
2815   ASM_REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_LE]);;
2816
2817 (* ------------------------------------------------------------------------- *)
2818 (* Borsuk-style characterization of separation.                              *)
2819 (* ------------------------------------------------------------------------- *)
2820
2821 let CONTINUOUS_ON_BORSUK_MAP = prove
2822  (`!s a:real^N.
2823         ~(a IN s) ==> (\x. inv(norm (x - a)) % (x - a)) continuous_on s`,
2824   REPEAT STRIP_TAC THEN
2825   MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF] THEN CONJ_TAC THENL
2826     [MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV); ALL_TAC] THEN
2827   SIMP_TAC[CONTINUOUS_ON_LIFT_NORM_COMPOSE; CONTINUOUS_ON_SUB;
2828            CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN
2829   REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_MESON_TAC[]);;
2830
2831 let BORSUK_MAP_INTO_SPHERE = prove
2832  (`!s a:real^N.
2833         IMAGE (\x. inv(norm (x - a)) % (x - a)) s SUBSET sphere(vec 0,&1) <=>
2834         ~(a IN s)`,
2835   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0] THEN
2836   REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN
2837   REWRITE_TAC[REAL_FIELD `inv x * x = &1 <=> ~(x = &0)`] THEN
2838   REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN MESON_TAC[]);;
2839
2840 let BORSUK_MAPS_HOMOTOPIC_IN_PATH_COMPONENT = prove
2841  (`!s a b. path_component ((:real^N) DIFF s) a b
2842            ==> homotopic_with (\x. T) (s,sphere(vec 0,&1))
2843                    (\x. inv(norm(x - a)) % (x - a))
2844                    (\x. inv(norm(x - b)) % (x - b))`,
2845   REPEAT GEN_TAC THEN REWRITE_TAC[path_component; LEFT_IMP_EXISTS_THM] THEN
2846   REWRITE_TAC[path; path_image; pathstart; pathfinish; SUBSET;
2847               FORALL_IN_IMAGE; IN_UNIV; IN_DIFF] THEN
2848   X_GEN_TAC `g:real^1->real^N` THEN STRIP_TAC THEN
2849   SIMP_TAC[HOMOTOPIC_WITH] THEN
2850   EXISTS_TAC `\z. inv(norm(sndcart z - g(fstcart z))) %
2851                   (sndcart z - (g:real^1->real^N)(fstcart z))` THEN
2852   ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_SPHERE_0;
2853                SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
2854   CONJ_TAC THENL
2855    [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL
2856      [MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
2857       ASM_SIMP_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART;
2858                    NORM_EQ_0; VECTOR_SUB_EQ] THEN CONJ_TAC
2859       THENL [MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE; ASM_MESON_TAC[]];
2860       ALL_TAC] THEN
2861     MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
2862     SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
2863     GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
2864     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
2865     SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
2866     REWRITE_TAC[IMAGE_FSTCART_PCROSS] THEN ASM_MESON_TAC[CONTINUOUS_ON_EMPTY];
2867     REPEAT STRIP_TAC THEN
2868     REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN
2869     MATCH_MP_TAC REAL_MUL_LINV THEN
2870     ASM_REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_MESON_TAC[]]);;
2871
2872 let NON_EXTENSIBLE_BORSUK_MAP = prove
2873  (`!s c a:real^N.
2874         compact s /\ c IN components((:real^N) DIFF s) /\ bounded c /\ a IN c
2875         ==> ~(?g. g continuous_on (s UNION c) /\
2876                   IMAGE g (s UNION c) SUBSET sphere (vec 0,&1) /\
2877                   (!x. x IN s ==> g x = inv(norm(x - a)) % (x - a)))`,
2878   REPEAT STRIP_TAC THEN
2879   FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
2880   REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN
2881   ASM_REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
2882   SUBGOAL_THEN `c = connected_component ((:real^N) DIFF s) a` SUBST_ALL_TAC
2883   THENL [ASM_MESON_TAC[IN_COMPONENTS; CONNECTED_COMPONENT_EQ]; ALL_TAC] THEN
2884   MP_TAC(ISPECL
2885    [`s UNION connected_component ((:real^N) DIFF s) a`; `a:real^N`]
2886       BOUNDED_SUBSET_BALL) THEN
2887   ASM_SIMP_TAC[BOUNDED_UNION; COMPACT_IMP_BOUNDED] THEN
2888   DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
2889   FIRST_ASSUM(MP_TAC o SPEC `a:real^N` o MATCH_MP NO_RETRACTION_CBALL) THEN
2890   REWRITE_TAC[retract_of; retraction] THEN
2891   EXISTS_TAC `\x. if x IN connected_component ((:real^N) DIFF s) a
2892                   then a + r % g(x)
2893                   else a + r % inv(norm(x - a)) % (x - a)` THEN
2894   REWRITE_TAC[SPHERE_SUBSET_CBALL] THEN REPEAT CONJ_TAC THENL
2895    [SUBGOAL_THEN `cball(a:real^N,r) =
2896                   (s UNION connected_component ((:real^N) DIFF s) a) UNION
2897                   (cball(a,r) DIFF connected_component ((:real^N) DIFF s) a)`
2898     SUBST1_TAC THENL
2899      [MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN ASM
2900       SET_TAC[];
2901       ALL_TAC] THEN
2902     MATCH_MP_TAC CONTINUOUS_ON_CASES THEN REPEAT CONJ_TAC THENL
2903      [MATCH_MP_TAC CLOSED_UNION_COMPLEMENT_COMPONENT THEN
2904       ASM_SIMP_TAC[IN_COMPONENTS; COMPACT_IMP_CLOSED; IN_UNIV; IN_DIFF] THEN
2905       ASM_MESON_TAC[];
2906       MATCH_MP_TAC CLOSED_DIFF THEN
2907       ASM_SIMP_TAC[CLOSED_CBALL; OPEN_CONNECTED_COMPONENT; GSYM closed;
2908                    COMPACT_IMP_CLOSED];
2909       MATCH_MP_TAC CONTINUOUS_ON_ADD THEN SIMP_TAC[CONTINUOUS_ON_CONST] THEN
2910       MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN ASM_SIMP_TAC[CONTINUOUS_ON_CONST];
2911       MATCH_MP_TAC CONTINUOUS_ON_ADD THEN SIMP_TAC[CONTINUOUS_ON_CONST] THEN
2912       MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
2913       MATCH_MP_TAC CONTINUOUS_ON_BORSUK_MAP THEN
2914       ASM_SIMP_TAC[CENTRE_IN_CBALL; IN_DIFF; REAL_LT_IMP_LE] THEN
2915       REWRITE_TAC[IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
2916       ASM_REWRITE_TAC[IN_DIFF; IN_UNIV];
2917       REPEAT STRIP_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
2918       FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]];
2919
2920       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
2921       REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
2922       ASM_REWRITE_TAC[IN_SPHERE; NORM_ARITH `dist(a:real^N,a + x) = norm x`;
2923                       NORM_MUL] THEN
2924       ASM_SIMP_TAC[REAL_ABS_INV; REAL_ABS_NORM; VECTOR_SUB_EQ;
2925         REAL_FIELD `&0 < r ==> abs r = r /\ (r * x = r <=> x = &1)`;
2926         REAL_FIELD `inv x * x = &1 <=> ~(x = &0)`; NORM_EQ_0]
2927       THENL
2928        [ONCE_REWRITE_TAC[GSYM IN_SPHERE_0] THEN ASM SET_TAC[];
2929         UNDISCH_TAC `~(x IN connected_component ((:real^N) DIFF s) a)` THEN
2930         SIMP_TAC[CONTRAPOS_THM; IN] THEN
2931         ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ; IN_DIFF; IN_UNIV]];
2932       SIMP_TAC[IN_SPHERE; ONCE_REWRITE_RULE[NORM_SUB] dist] THEN
2933       ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN
2934       REWRITE_TAC[VECTOR_ARITH `a + &1 % (x - a):real^N = x`] THEN
2935       REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
2936       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
2937        `s UNION t SUBSET u ==> !x. x IN t /\ ~(x IN u) ==> wev`)) THEN
2938       EXISTS_TAC `x:real^N` THEN
2939       ASM_REWRITE_TAC[ONCE_REWRITE_RULE[NORM_SUB] dist; IN_BALL;
2940                       REAL_LT_REFL]]);;
2941
2942 let BORSUK_MAP_ESSENTIAL_BOUNDED_COMPONENT = prove
2943  (`!s a. compact s /\ ~(a IN s)
2944          ==> (bounded(connected_component ((:real^N) DIFF s) a) <=>
2945               ~(?c. homotopic_with (\x. T) (s,sphere(vec 0:real^N,&1))
2946                                    (\x. inv(norm(x - a)) % (x - a)) (\x. c)))`,
2947   REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL
2948    [ASM_SIMP_TAC[DIFF_EMPTY; CONNECTED_COMPONENT_UNIV; NOT_BOUNDED_UNIV] THEN
2949     SIMP_TAC[HOMOTOPIC_WITH; NOT_IN_EMPTY; PCROSS_EMPTY; IMAGE_CLAUSES;
2950              CONTINUOUS_ON_EMPTY; EMPTY_SUBSET];
2951     ALL_TAC] THEN
2952   EQ_TAC THENL
2953    [ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN
2954     REPEAT DISCH_TAC THEN
2955     MP_TAC(ISPECL
2956      [`\x:real^N. inv(norm(x - a)) % (x - a)`; `s:real^N->bool`;
2957       `vec 0:real^N`; `&1`]
2958      NULLHOMOTOPIC_INTO_SPHERE_EXTENSION) THEN
2959     ASM_SIMP_TAC[COMPACT_IMP_CLOSED; NOT_IMP; CONTINUOUS_ON_BORSUK_MAP;
2960                  BORSUK_MAP_INTO_SPHERE] THEN
2961     MP_TAC(ISPECL [`s:real^N->bool`;
2962         `connected_component ((:real^N) DIFF s) a`;
2963         `a:real^N`] NON_EXTENSIBLE_BORSUK_MAP) THEN
2964     ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
2965      [GEN_REWRITE_TAC RAND_CONV [IN] THEN
2966       REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
2967       ASM_REWRITE_TAC[IN_COMPONENTS; IN_DIFF; IN_UNIV] THEN ASM_MESON_TAC[];
2968       REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
2969       GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
2970        [MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; SET_TAC[]]];
2971     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN
2972     DISCH_TAC THEN
2973     FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL o
2974       MATCH_MP COMPACT_IMP_BOUNDED) THEN
2975     DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
2976     SUBGOAL_THEN
2977      `?b. b IN connected_component ((:real^N) DIFF s) a /\
2978           ~(b IN ball(vec 0,r))`
2979     MP_TAC THENL
2980      [REWRITE_TAC[SET_RULE `(?b. b IN s /\ ~(b IN t)) <=> ~(s SUBSET t)`] THEN
2981       ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL];
2982       DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC)] THEN
2983     SUBGOAL_THEN
2984      `?c. homotopic_with (\x. T) (ball(vec 0:real^N,r),sphere (vec 0,&1))
2985                          (\x. inv (norm (x - b)) % (x - b)) (\x. c)`
2986     MP_TAC THENL
2987      [MATCH_MP_TAC NULLHOMOTOPIC_FROM_CONTRACTIBLE THEN
2988       ASM_SIMP_TAC[CONTINUOUS_ON_BORSUK_MAP; BORSUK_MAP_INTO_SPHERE;
2989                    CONVEX_IMP_CONTRACTIBLE; CONVEX_BALL];
2990       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN STRIP_TAC] THEN
2991     MATCH_MP_TAC HOMOTOPIC_WITH_TRANS THEN
2992     EXISTS_TAC `\x:real^N. inv(norm (x - b)) % (x - b)` THEN CONJ_TAC THENL
2993      [MATCH_MP_TAC BORSUK_MAPS_HOMOTOPIC_IN_PATH_COMPONENT THEN
2994       ASM_SIMP_TAC[OPEN_PATH_CONNECTED_COMPONENT; GSYM closed;
2995                    COMPACT_IMP_CLOSED] THEN  ASM_MESON_TAC[IN];
2996       ASM_MESON_TAC[HOMOTOPIC_WITH_SUBSET_LEFT]]]);;
2997
2998 let HOMOTOPIC_BORSUK_MAPS_IN_BOUNDED_COMPONENT = prove
2999  (`!s a b.
3000         compact s /\ ~(a IN s) /\ ~(b IN s) /\
3001         bounded (connected_component ((:real^N) DIFF s) a) /\
3002         homotopic_with (\x. T) (s,sphere(vec 0,&1))
3003                                (\x. inv(norm(x - a)) % (x - a))
3004                                (\x. inv(norm(x - b)) % (x - b))
3005         ==> connected_component ((:real^N) DIFF s) a b`,
3006   REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [GSYM IN] THEN
3007   MP_TAC(ISPECL
3008    [`s:real^N->bool`; `connected_component ((:real^N) DIFF s) a`;
3009     `a:real^N`] NON_EXTENSIBLE_BORSUK_MAP) THEN
3010   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
3011    [GEN_REWRITE_TAC RAND_CONV [IN] THEN
3012     REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
3013     ASM_REWRITE_TAC[IN_COMPONENTS; IN_DIFF; IN_UNIV] THEN ASM_MESON_TAC[];
3014     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM]] THEN
3015   DISCH_TAC THEN REWRITE_TAC[] THEN
3016   MATCH_MP_TAC BORSUK_HOMOTOPY_EXTENSION THEN
3017   EXISTS_TAC `\x:real^N. inv(norm(x - b)) % (x - b)` THEN
3018   ASM_SIMP_TAC[COMPACT_IMP_CLOSED; ANR_SPHERE;
3019                CLOSED_SUBSET; SUBSET_UNION] THEN
3020   ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN
3021   ASM_SIMP_TAC[CONTINUOUS_ON_BORSUK_MAP; IN_UNION; BORSUK_MAP_INTO_SPHERE] THEN
3022   REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
3023   MATCH_MP_TAC CLOSED_UNION_COMPLEMENT_COMPONENT THEN
3024   ASM_SIMP_TAC[COMPACT_IMP_CLOSED; IN_COMPONENTS; IN_DIFF; IN_UNIV] THEN
3025   ASM_MESON_TAC[]);;
3026
3027 let BORSUK_MAPS_HOMOTOPIC_IN_CONNECTED_COMPONENT_EQ = prove
3028  (`!s a b. 2 <= dimindex(:N) /\ compact s /\ ~(a IN s) /\ ~(b IN s)
3029            ==> (homotopic_with (\x. T) (s,sphere(vec 0,&1))
3030                    (\x. inv(norm(x - a)) % (x - a))
3031                    (\x. inv(norm(x - b)) % (x - b)) <=>
3032                 connected_component ((:real^N) DIFF s) a b)`,
3033   REPEAT STRIP_TAC THEN EQ_TAC THENL
3034    [DISCH_TAC;
3035     ASM_SIMP_TAC[GSYM OPEN_PATH_CONNECTED_COMPONENT; GSYM closed;
3036                  COMPACT_IMP_CLOSED] THEN
3037     REWRITE_TAC[BORSUK_MAPS_HOMOTOPIC_IN_PATH_COMPONENT]] THEN
3038   ASM_CASES_TAC `bounded(connected_component ((:real^N) DIFF s) a)` THENL
3039    [MATCH_MP_TAC HOMOTOPIC_BORSUK_MAPS_IN_BOUNDED_COMPONENT THEN
3040     ASM_REWRITE_TAC[];
3041     ALL_TAC] THEN
3042   ASM_CASES_TAC `bounded(connected_component ((:real^N) DIFF s) b)` THENL
3043    [ONCE_REWRITE_TAC[CONNECTED_COMPONENT_SYM_EQ] THEN
3044     MATCH_MP_TAC HOMOTOPIC_BORSUK_MAPS_IN_BOUNDED_COMPONENT THEN
3045     ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN
3046     ASM_REWRITE_TAC[];
3047     ALL_TAC] THEN
3048   MP_TAC(ISPECL [`(:real^N) DIFF s`; `a:real^N`; `b:real^N`]
3049         COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT) THEN
3050   ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EQ; IN_DIFF; IN_UNIV;
3051                   SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN
3052   ASM_SIMP_TAC[COMPACT_IMP_BOUNDED]);;
3053
3054 let BORSUK_SEPARATION_THEOREM_GEN = prove
3055  (`!s:real^N->bool.
3056     compact s
3057     ==> ((!c. c IN components((:real^N) DIFF s) ==> ~bounded c) <=>
3058          (!f. f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0:real^N,&1)
3059               ==> ?c. homotopic_with (\x. T) (s,sphere(vec 0,&1)) f (\x. c)))`,
3060   REPEAT STRIP_TAC THEN EQ_TAC THENL
3061    [ALL_TAC;
3062     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
3063     REWRITE_TAC[NOT_FORALL_THM; components; EXISTS_IN_GSPEC; NOT_IMP;
3064                 IN_UNIV; IN_DIFF] THEN
3065     DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
3066     EXISTS_TAC `\x:real^N. inv(norm(x - a)) % (x - a)` THEN
3067     ASM_SIMP_TAC[GSYM BORSUK_MAP_ESSENTIAL_BOUNDED_COMPONENT;
3068                  CONTINUOUS_ON_BORSUK_MAP; BORSUK_MAP_INTO_SPHERE]] THEN
3069   DISCH_TAC THEN X_GEN_TAC `f:real^N->real^N` THEN STRIP_TAC THEN
3070   MP_TAC(ISPECL
3071    [`f:real^N->real^N`; `s:real^N->bool`; `vec 0:real^N`; `&1:real`]
3072         EXTEND_MAP_UNIV_TO_SPHERE_NO_BOUNDED_COMPONENT) THEN
3073   ASM_REWRITE_TAC[LE_REFL; REAL_POS] THEN
3074   DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC) THEN
3075   MP_TAC(ISPECL
3076    [`g:real^N->real^N`; `(:real^N)`; `sphere(vec 0:real^N,&1)`]
3077         NULLHOMOTOPIC_FROM_CONTRACTIBLE) THEN
3078   ASM_REWRITE_TAC[CONTRACTIBLE_UNIV] THEN
3079   MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
3080   DISCH_THEN(MP_TAC o SPEC `s:real^N->bool` o MATCH_MP
3081    (REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_SUBSET_LEFT)) THEN
3082   REWRITE_TAC[SUBSET_UNIV] THEN
3083   MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT]
3084         HOMOTOPIC_WITH_EQ) THEN
3085   ASM_SIMP_TAC[]);;
3086
3087 let BORSUK_SEPARATION_THEOREM = prove
3088  (`!s:real^N->bool.
3089       2 <= dimindex(:N) /\ compact s
3090       ==> (connected((:real^N) DIFF s) <=>
3091            !f. f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0:real^N,&1)
3092                ==> ?c. homotopic_with (\x. T) (s,sphere(vec 0,&1)) f (\x. c))`,
3093   SIMP_TAC[GSYM BORSUK_SEPARATION_THEOREM_GEN] THEN
3094   X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN EQ_TAC THENL
3095    [DISCH_TAC THEN
3096     MP_TAC(ISPEC `(:real^N) DIFF s` COMPONENTS_EQ_SING) THEN
3097     MP_TAC(ISPEC `(:real^N) DIFF s` COBOUNDED_IMP_UNBOUNDED) THEN
3098     ASM_CASES_TAC `(:real^N) DIFF s = {}` THEN
3099     ASM_SIMP_TAC[COMPACT_IMP_BOUNDED; SET_RULE `UNIV DIFF (UNIV DIFF s) = s`;
3100                  BOUNDED_EMPTY; FORALL_IN_INSERT; NOT_IN_EMPTY];
3101
3102     REWRITE_TAC[components; FORALL_IN_GSPEC; IN_DIFF; IN_UNIV] THEN
3103     DISCH_TAC THEN REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENT_EQ] THEN
3104     REWRITE_TAC[IN_DIFF; IN_UNIV] THEN REPEAT STRIP_TAC THEN
3105     MATCH_MP_TAC COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT THEN
3106     ASM_SIMP_TAC[COMPACT_IMP_BOUNDED;
3107                  SET_RULE `UNIV DIFF (UNIV DIFF s) = s`]]);;
3108
3109 let HOMOTOPY_EQUIVALENT_SEPARATION = prove
3110  (`!s t. compact s /\ compact t /\ s homotopy_equivalent t
3111          ==> (connected((:real^N) DIFF s) <=> connected((:real^N) DIFF t))`,
3112   let special = prove
3113    (`!s:real^1->bool.
3114           bounded s /\ connected((:real^1) DIFF s) ==> s = {}`,
3115     REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1] THEN REPEAT STRIP_TAC THEN
3116     FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_OPEN_INTERVAL) THEN
3117     REWRITE_TAC[LEFT_IMP_EXISTS_THM; EXTENSION; NOT_IN_EMPTY] THEN
3118     MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN
3119     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IS_INTERVAL_1]) THEN
3120     DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `b:real^1`]) THEN
3121     REWRITE_TAC[IN_UNIV; IN_DIFF; SUBSET; IN_INTERVAL_1] THEN
3122     MESON_TAC[REAL_LT_REFL; REAL_LT_IMP_LE]) in
3123   REPEAT STRIP_TAC THEN
3124   SUBGOAL_THEN `1 <= dimindex(:N)` MP_TAC THENL
3125    [REWRITE_TAC[DIMINDEX_GE_1];
3126     REWRITE_TAC[ARITH_RULE `1 <= n <=> n = 1 \/ 2 <= n`] THEN
3127     REWRITE_TAC[GSYM DIMINDEX_1]] THEN
3128   STRIP_TAC THENL
3129    [ASSUME_TAC(GEOM_EQUAL_DIMENSION_RULE(ASSUME `dimindex(:N) = dimindex(:1)`)
3130        special) THEN
3131     EQ_TAC THEN DISCH_TAC THENL
3132      [FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`);
3133       FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`)] THEN
3134     ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN DISCH_TAC THEN
3135     UNDISCH_TAC `(s:real^N->bool) homotopy_equivalent (t:real^N->bool)` THEN
3136     ASM_REWRITE_TAC[HOMOTOPY_EQUIVALENT_EMPTY] THEN DISCH_TAC THEN
3137     ASM_REWRITE_TAC[CONNECTED_UNIV; DIFF_EMPTY];
3138     REPEAT STRIP_TAC THEN ASM_SIMP_TAC[BORSUK_SEPARATION_THEOREM] THEN
3139     MATCH_MP_TAC HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL THEN
3140     ASM_REWRITE_TAC[]]);;
3141
3142 let JORDAN_BROUWER_SEPARATION = prove
3143  (`!s a:real^N r.
3144         &0 < r /\ s homeomorphic sphere(a,r) ==> ~connected((:real^N) DIFF s)`,
3145   REPEAT GEN_TAC THEN STRIP_TAC THEN
3146   MP_TAC(ISPECL [`s:real^N->bool`; `sphere(a:real^N,r)`]
3147         HOMOTOPY_EQUIVALENT_SEPARATION) THEN
3148   ANTS_TAC THENL
3149    [ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS; COMPACT_SPHERE;
3150                   HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT];
3151     DISCH_THEN SUBST1_TAC] THEN
3152   DISCH_TAC THEN MP_TAC(ISPECL
3153    [`(:real^N) DIFF sphere(a,r)`;
3154     `ball(a:real^N,r)`] CONNECTED_INTER_FRONTIER) THEN
3155   ASM_SIMP_TAC[FRONTIER_BALL; NOT_IMP] THEN REPEAT CONJ_TAC THENL
3156    [REWRITE_TAC[GSYM CBALL_DIFF_BALL] THEN MATCH_MP_TAC(SET_RULE
3157      `~(b = {})
3158       ==> ~((UNIV DIFF (c DIFF b)) INTER b = {})`) THEN
3159     ASM_SIMP_TAC[BALL_EQ_EMPTY; REAL_NOT_LE];
3160     MATCH_MP_TAC(SET_RULE
3161      `~(s UNION t = UNIV) ==> ~(UNIV DIFF t DIFF s = {})`) THEN
3162     REWRITE_TAC[BALL_UNION_SPHERE] THEN
3163     MESON_TAC[BOUNDED_CBALL; NOT_BOUNDED_UNIV];
3164     SET_TAC[]]);;
3165
3166 let JORDAN_BROUWER_FRONTIER = prove
3167  (`!s t a:real^N r.
3168      2 <= dimindex(:N) /\
3169      s homeomorphic sphere(a,r) /\ t IN components((:real^N) DIFF s)
3170      ==> frontier t = s`,
3171   let lemma = prove
3172    (`!s a r. 2 <= dimindex(:N) /\ &0 < r /\ s PSUBSET sphere(a,r)
3173              ==> connected((:real^N) DIFF s)`,
3174     REWRITE_TAC[PSUBSET_ALT; SUBSET; IN_SPHERE; GSYM REAL_LE_ANTISYM] THEN
3175     REPEAT STRIP_TAC THEN
3176     SUBGOAL_THEN
3177      `(:real^N) DIFF s =
3178       {x:real^N | dist(a,x) <= r /\ ~(x IN s)} UNION
3179       {x:real^N | r <= dist(a,x) /\ ~(x IN s)}`
3180     SUBST1_TAC THENL
3181      [SET_TAC[REAL_LE_TOTAL]; MATCH_MP_TAC CONNECTED_UNION] THEN
3182     REPEAT CONJ_TAC THENL
3183      [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
3184       EXISTS_TAC `ball(a:real^N,r)` THEN
3185       ASM_SIMP_TAC[CONNECTED_BALL; CLOSURE_BALL; SUBSET; IN_BALL; IN_CBALL;
3186                    IN_ELIM_THM] THEN
3187       ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_NOT_LE];
3188       MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
3189       EXISTS_TAC `(:real^N) DIFF cball(a,r)` THEN
3190       REWRITE_TAC[CLOSURE_COMPLEMENT; SUBSET; IN_DIFF; IN_UNIV;
3191                   IN_BALL; IN_CBALL; IN_ELIM_THM; INTERIOR_CBALL] THEN
3192       CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_NOT_LE]] THEN
3193       MATCH_MP_TAC CONNECTED_OPEN_DIFF_CBALL THEN
3194       ASM_REWRITE_TAC[SUBSET_UNIV; CONNECTED_UNIV; OPEN_UNIV];
3195       ASM SET_TAC[]]) in
3196   MAP_EVERY X_GEN_TAC
3197    [`s:real^N->bool`; `c:real^N->bool`; `a:real^N`; `r:real`] THEN
3198   ASM_CASES_TAC `r < &0` THENL
3199    [ASM_SIMP_TAC[SPHERE_EMPTY; HOMEOMORPHIC_EMPTY; IMP_CONJ; DIFF_EMPTY] THEN
3200     SIMP_TAC[snd(EQ_IMP_RULE(SPEC_ALL COMPONENTS_EQ_SING));
3201              UNIV_NOT_EMPTY; CONNECTED_UNIV; IN_SING; FRONTIER_UNIV];
3202     ALL_TAC] THEN
3203   ASM_CASES_TAC `r = &0` THENL
3204    [ASM_SIMP_TAC[HOMEOMORPHIC_FINITE_STRONG; SPHERE_SING; FINITE_SING] THEN
3205     SIMP_TAC[CARD_CLAUSES; FINITE_EMPTY; GSYM HAS_SIZE; NOT_IN_EMPTY] THEN
3206     REWRITE_TAC[HAS_SIZE_CLAUSES; UNWIND_THM2; NOT_IN_EMPTY; IMP_CONJ] THEN
3207     SIMP_TAC[LEFT_IMP_EXISTS_THM; CONNECTED_PUNCTURED_UNIVERSE; IN_SING;
3208              snd(EQ_IMP_RULE(SPEC_ALL COMPONENTS_EQ_SING)); FRONTIER_SING;
3209              SET_RULE `UNIV DIFF s = {} <=> s = UNIV`; FRONTIER_COMPLEMENT;
3210              MESON[BOUNDED_SING; NOT_BOUNDED_UNIV] `~((:real^N) = {a})`];
3211     ALL_TAC] THEN
3212   SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
3213   REPEAT STRIP_TAC THEN MATCH_MP_TAC FRONTIER_MINIMAL_SEPARATING_CLOSED THEN
3214   ASM_REWRITE_TAC[] THEN
3215   FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN
3216   SIMP_TAC[COMPACT_SPHERE; COMPACT_IMP_CLOSED] THEN DISCH_TAC THEN
3217   CONJ_TAC THENL [ASM_MESON_TAC[JORDAN_BROUWER_SEPARATION]; ALL_TAC] THEN
3218   REPEAT STRIP_TAC THEN
3219   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
3220   REWRITE_TAC[HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN
3221   MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN
3222   STRIP_TAC THEN
3223   MP_TAC(ISPECL [`t:real^N->bool`; `IMAGE (f:real^N->real^N) t`]
3224         HOMOTOPY_EQUIVALENT_SEPARATION) THEN
3225   ANTS_TAC THENL
3226    [MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
3227      [ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET; PSUBSET];
3228       DISCH_TAC THEN
3229       SUBGOAL_THEN `t homeomorphic (IMAGE (f:real^N->real^N) t)` MP_TAC THENL
3230        [REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC
3231          [`f:real^N->real^N`; `g:real^N->real^N`] THEN
3232         ASM_REWRITE_TAC[HOMEOMORPHISM] THEN REPEAT CONJ_TAC THEN
3233         TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
3234           (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))) THEN ASM SET_TAC[];
3235         ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS;
3236                       HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT]]];
3237       DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC lemma THEN
3238       MAP_EVERY EXISTS_TAC [`a:real^N`; `r:real`] THEN ASM SET_TAC[]]);;
3239
3240 let JORDAN_BROUWER_NONSEPARATION = prove
3241  (`!s t a:real^N r.
3242         2 <= dimindex(:N) /\
3243         s homeomorphic sphere(a,r) /\ t PSUBSET s
3244         ==> connected((:real^N) DIFF t)`,
3245   REPEAT STRIP_TAC THEN
3246   SUBGOAL_THEN
3247    `!c. c IN components((:real^N) DIFF s)
3248         ==> connected(c UNION (s DIFF t))`
3249   ASSUME_TAC THENL
3250    [REPEAT STRIP_TAC THEN
3251     MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
3252     EXISTS_TAC `c:real^N->bool` THEN
3253     CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN
3254     CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[UNION_SUBSET; CLOSURE_SUBSET]] THEN
3255     SUBGOAL_THEN `s:real^N->bool = frontier c` SUBST1_TAC THENL
3256      [ASM_MESON_TAC[JORDAN_BROUWER_FRONTIER]; ALL_TAC] THEN
3257     REWRITE_TAC[frontier] THEN SET_TAC[];
3258     ALL_TAC] THEN
3259   SUBGOAL_THEN
3260     `~(components((:real^N) DIFF s) = {})`
3261   ASSUME_TAC THENL
3262    [REWRITE_TAC[COMPONENTS_EQ_EMPTY; SET_RULE
3263      `UNIV DIFF s = {} <=> s = UNIV`] THEN
3264     ASM_MESON_TAC[NOT_BOUNDED_UNIV; COMPACT_EQ_BOUNDED_CLOSED;
3265                   HOMEOMORPHIC_COMPACTNESS; COMPACT_SPHERE];
3266     ALL_TAC] THEN
3267   SUBGOAL_THEN
3268    `(:real^N) DIFF t =
3269     UNIONS {c UNION (s DIFF t) | c | c IN components((:real^N) DIFF s)}`
3270   SUBST1_TAC THENL
3271    [MP_TAC(ISPEC `(:real^N) DIFF s` UNIONS_COMPONENTS) THEN
3272     REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[];
3273     MATCH_MP_TAC CONNECTED_UNIONS THEN
3274     ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN
3275     REWRITE_TAC[INTERS_GSPEC] THEN ASM SET_TAC[]]);;
3276
3277 let JORDAN_BROUWER_ACCESSIBILITY = prove
3278  (`!s c a:real^N r v x.
3279         2 <= dimindex(:N) /\
3280         s homeomorphic sphere(a,r) /\
3281         c IN components((:real^N) DIFF s) /\ x IN c /\
3282         open_in (subtopology euclidean s) v /\ ~(v = {})
3283         ==> ?g. arc g /\
3284                 IMAGE g (interval[vec 0,vec 1] DELETE (vec 1)) SUBSET c /\
3285                 pathstart g = x /\
3286                 pathfinish g IN v`,
3287   REPEAT STRIP_TAC THEN
3288   FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN
3289   REWRITE_TAC[COMPACT_SPHERE] THEN
3290   REWRITE_TAC[closed; COMPACT_EQ_BOUNDED_CLOSED] THEN STRIP_TAC THEN
3291   MATCH_MP_TAC DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED THEN
3292   ASM_REWRITE_TAC[] THEN
3293   ASM_MESON_TAC[JORDAN_BROUWER_FRONTIER; OPEN_COMPONENTS;
3294                 IN_COMPONENTS_CONNECTED]);;
3295
3296 (* ------------------------------------------------------------------------- *)
3297 (* Invariance of domain and corollaries.                                     *)
3298 (* ------------------------------------------------------------------------- *)
3299
3300 let INVARIANCE_OF_DOMAIN = prove
3301  (`!f:real^N->real^N s.
3302         f continuous_on s /\ open s /\
3303         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
3304         ==> open(IMAGE f s)`,
3305   let lemma = prove
3306    (`!f:real^N->real^N a r.
3307           f continuous_on cball(a,r) /\ &0 < r /\
3308           (!x y. x IN cball(a,r) /\ y IN cball(a,r) /\ f x = f y ==> x = y)
3309           ==> open(IMAGE f (ball(a,r)))`,
3310     REPEAT STRIP_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL
3311      [MP_TAC(ISPECL [`(:real^N)`; `(:real^1)`] ISOMETRIES_SUBSPACES) THEN
3312       ASM_SIMP_TAC[SUBSPACE_UNIV; DIM_UNIV; DIMINDEX_1;
3313                    LEFT_IMP_EXISTS_THM] THEN
3314       MAP_EVERY X_GEN_TAC [`h:real^N->real^1`; `k:real^1->real^N`] THEN
3315       REWRITE_TAC[IN_UNIV] THEN STRIP_TAC THEN
3316       MP_TAC(ISPECL [`(h:real^N->real^1) o f o (k:real^1->real^N)`;
3317                      `IMAGE (h:real^N->real^1) (cball(a,r))`]
3318           INJECTIVE_EQ_1D_OPEN_MAP_UNIV) THEN
3319       MATCH_MP_TAC(TAUT
3320        `p /\ q /\ r /\ (s ==> t)
3321         ==> (p /\ q ==> (r <=> s)) ==> t`) THEN
3322       REPEAT CONJ_TAC THENL
3323        [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN
3324         ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; GSYM IMAGE_o] THEN
3325         ASM_REWRITE_TAC[o_DEF; IMAGE_ID];
3326         REWRITE_TAC[IS_INTERVAL_CONNECTED_1] THEN
3327         MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
3328         ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; CONNECTED_CBALL];
3329         ASM_SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM;
3330                      FORALL_IN_IMAGE; o_DEF] THEN
3331         ASM SET_TAC[];
3332         DISCH_THEN(MP_TAC o SPEC `IMAGE (h:real^N->real^1) (ball(a,r))`) THEN
3333         ASM_SIMP_TAC[IMAGE_SUBSET; BALL_SUBSET_CBALL; GSYM IMAGE_o] THEN
3334         ANTS_TAC THENL
3335          [MP_TAC(ISPECL [`a:real^N`; `r:real`] OPEN_BALL); ALL_TAC] THEN
3336         MATCH_MP_TAC EQ_IMP THENL
3337          [CONV_TAC SYM_CONV;
3338           REWRITE_TAC[GSYM o_ASSOC] THEN ONCE_REWRITE_TAC[IMAGE_o] THEN
3339           ASM_REWRITE_TAC[o_DEF; ETA_AX]] THEN
3340         MATCH_MP_TAC OPEN_BIJECTIVE_LINEAR_IMAGE_EQ THEN
3341         ASM_MESON_TAC[]];
3342        FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE
3343         `~(n = 1) ==> 1 <= n ==> 2 <= n`)) THEN
3344        REWRITE_TAC[DIMINDEX_GE_1] THEN DISCH_TAC] THEN
3345     REPEAT STRIP_TAC THEN
3346     MP_TAC(ISPECL [`IMAGE (f:real^N->real^N) (sphere(a,r))`;
3347                    `a:real^N`; `r:real`]
3348           JORDAN_BROUWER_SEPARATION) THEN
3349     ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
3350      [ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
3351       MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN EXISTS_TAC `f:real^N->real^N` THEN
3352       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET; SPHERE_SUBSET_CBALL;
3353                     COMPACT_SPHERE];
3354       DISCH_TAC] THEN
3355     MP_TAC(ISPEC `(:real^N) DIFF IMAGE f (sphere(a:real^N,r))`
3356       COBOUNDED_HAS_BOUNDED_COMPONENT) THEN
3357     ASM_REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN
3358     ANTS_TAC THENL
3359      [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET; SPHERE_SUBSET_CBALL;
3360         COMPACT_SPHERE; COMPACT_CONTINUOUS_IMAGE; COMPACT_IMP_BOUNDED];
3361       DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC)] THEN
3362     SUBGOAL_THEN
3363      `IMAGE (f:real^N->real^N) (ball(a,r)) = c`
3364     SUBST1_TAC THENL
3365      [ALL_TAC;
3366       FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
3367           OPEN_COMPONENTS)) THEN
3368       REWRITE_TAC[GSYM closed] THEN
3369       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET; SPHERE_SUBSET_CBALL;
3370         COMPACT_SPHERE; COMPACT_CONTINUOUS_IMAGE; COMPACT_IMP_CLOSED]] THEN
3371     MATCH_MP_TAC(SET_RULE
3372      `~(c = {}) /\ (~(c INTER t = {}) ==> t SUBSET c) /\ c SUBSET t
3373       ==> t = c`) THEN
3374     REPEAT STRIP_TAC THENL
3375      [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY];
3376       FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
3377           COMPONENTS_MAXIMAL)) THEN
3378       ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
3379        [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
3380         REWRITE_TAC[CONNECTED_BALL] THEN
3381         ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; BALL_SUBSET_CBALL];
3382         REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN
3383         MP_TAC(ISPECL [`a:real^N`; `r:real`] SPHERE_SUBSET_CBALL) THEN
3384         ASM SET_TAC[]];
3385       FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
3386       FIRST_ASSUM(MP_TAC o SPEC `(:real^N) DIFF IMAGE f (cball(a:real^N,r))` o
3387         MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COMPONENTS_MAXIMAL)) THEN
3388       SIMP_TAC[SET_RULE `UNIV DIFF t SUBSET UNIV DIFF s <=> s SUBSET t`;
3389                IMAGE_SUBSET; SPHERE_SUBSET_CBALL] THEN
3390       MATCH_MP_TAC(TAUT `p /\ ~r /\ (~q ==> s) ==> (p /\ q ==> r) ==> s`) THEN
3391       REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
3392        [MATCH_MP_TAC(INST_TYPE [`:N`,`:M`]
3393           CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT) THEN
3394         EXISTS_TAC `cball(a:real^N,r)` THEN
3395         ASM_REWRITE_TAC[CONVEX_CBALL; COMPACT_CBALL] THEN
3396         ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
3397         MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN
3398         EXISTS_TAC `f:real^N->real^N` THEN ASM_REWRITE_TAC[COMPACT_CBALL];
3399         DISCH_THEN(MP_TAC o
3400           MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET)) THEN
3401         ASM_REWRITE_TAC[] THEN MATCH_MP_TAC COBOUNDED_IMP_UNBOUNDED THEN
3402         REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN
3403         ASM_MESON_TAC[COMPACT_IMP_BOUNDED; COMPACT_CONTINUOUS_IMAGE;
3404                       COMPACT_CBALL];
3405         REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN ASM SET_TAC[]]]) in
3406   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[OPEN_SUBOPEN] THEN
3407   REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
3408   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
3409   DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN
3410   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
3411   X_GEN_TAC `r:real` THEN STRIP_TAC THEN
3412   EXISTS_TAC `IMAGE (f:real^N->real^N) (ball(a,r))` THEN
3413   REPEAT CONJ_TAC THENL
3414    [MATCH_MP_TAC lemma THEN ASM_MESON_TAC[SUBSET; CONTINUOUS_ON_SUBSET];
3415     ASM_SIMP_TAC[FUN_IN_IMAGE; CENTRE_IN_BALL];
3416     MATCH_MP_TAC IMAGE_SUBSET THEN
3417     ASM_MESON_TAC[BALL_SUBSET_CBALL; SUBSET_TRANS]]);;
3418
3419 let INVARIANCE_OF_DOMAIN_SUBSPACES = prove
3420  (`!f:real^M->real^N u v s.
3421         subspace u /\ subspace v /\ dim v <= dim u /\
3422         f continuous_on s /\ IMAGE f s SUBSET v /\
3423         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
3424         open_in (subtopology euclidean u) s
3425         ==> open_in (subtopology euclidean v) (IMAGE f s)`,
3426   let lemma0 = prove
3427    (`!f:real^M->real^M s u.
3428           subspace s /\ dim s = dimindex(:N) /\
3429           f continuous_on u /\ IMAGE f u SUBSET s /\
3430           (!x y. x IN u /\ y IN u /\ f x = f y ==> x = y) /\
3431           open_in (subtopology euclidean s) u
3432           ==> open_in (subtopology euclidean s) (IMAGE f u)`,
3433     REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(:real^N)`; `s:real^M->bool`]
3434       HOMEOMORPHIC_SUBSPACES) THEN
3435     ASM_REWRITE_TAC[DIM_UNIV; SUBSPACE_UNIV] THEN
3436     REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN
3437     MAP_EVERY X_GEN_TAC [`h:real^N->real^M`; `k:real^M->real^N`] THEN
3438     STRIP_TAC THEN MP_TAC(ISPECL
3439      [`(k:real^M->real^N) o f o (h:real^N->real^M)`;
3440       `IMAGE (k:real^M->real^N) u`] INVARIANCE_OF_DOMAIN) THEN
3441     REWRITE_TAC[GSYM IMAGE_o; o_THM] THEN
3442     SUBGOAL_THEN
3443      `!t. open t <=>
3444           open_in (subtopology euclidean (IMAGE (k:real^M->real^N) s)) t`
3445      (fun th -> REWRITE_TAC[th])
3446     THENL [ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN]; ALL_TAC] THEN
3447     ANTS_TAC THENL
3448      [REPEAT CONJ_TAC THENL
3449        [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN
3450         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
3451             CONTINUOUS_ON_SUBSET)) THEN
3452         FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
3453         REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
3454         MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
3455         MAP_EVERY EXISTS_TAC [`h:real^N->real^M`; `s:real^M->bool`] THEN
3456         ASM_REWRITE_TAC[homeomorphism];
3457         REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
3458         FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
3459         ASM_SIMP_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN
3460         FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]];
3461       ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
3462       SUBGOAL_THEN
3463        `IMAGE f u =
3464         IMAGE (h:real^N->real^M) (IMAGE ((k o f o h) o (k:real^M->real^N)) u)`
3465       SUBST1_TAC THENL
3466        [REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC(SET_RULE
3467          `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN
3468         REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
3469         ASM_SIMP_TAC[SUBSET; o_THM] THEN ASM SET_TAC[];
3470         MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
3471         MAP_EVERY EXISTS_TAC [`k:real^M->real^N`; `(:real^N)`] THEN
3472         ASM_REWRITE_TAC[homeomorphism]]]) in
3473   let lemma1 = prove
3474    (`!f:real^N->real^N s u.
3475           subspace s /\ f continuous_on u /\ IMAGE f u SUBSET s /\
3476           (!x y. x IN u /\ y IN u /\ f x = f y ==> x = y) /\
3477           open_in (subtopology euclidean s) u
3478           ==> open_in (subtopology euclidean s) (IMAGE f u)`,
3479     REWRITE_TAC[INJECTIVE_ON_ALT] THEN REPEAT STRIP_TAC THEN
3480     FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
3481     ABBREV_TAC `s' = {y:real^N | !x. x IN s ==> orthogonal x y}` THEN
3482     SUBGOAL_THEN `subspace(s':real^N->bool)` ASSUME_TAC THENL
3483       [EXPAND_TAC "s'" THEN REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTORS];
3484        FIRST_ASSUM(ASSUME_TAC o MATCH_MP SUBSPACE_IMP_NONEMPTY)] THEN
3485     ABBREV_TAC `g:real^(N,N)finite_sum->real^(N,N)finite_sum =
3486                   \z. pastecart (f(fstcart z)) (sndcart z)` THEN
3487     SUBGOAL_THEN
3488      `g continuous_on ((u:real^N->bool) PCROSS s') /\
3489       IMAGE g (u PCROSS s') SUBSET (s:real^N->bool) PCROSS (s':real^N->bool) /\
3490       (!w z. w IN u PCROSS s' /\ z IN u PCROSS s' ==> (g w = g z <=> w = z))`
3491     STRIP_ASSUME_TAC THENL
3492      [EXPAND_TAC "g" THEN REPEAT CONJ_TAC THENL
3493        [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
3494         SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
3495         GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
3496         MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
3497         SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART;
3498                  IMAGE_FSTCART_PCROSS] THEN
3499         COND_CASES_TAC THEN ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY];
3500         REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
3501         SIMP_TAC[PASTECART_IN_PCROSS; SNDCART_PASTECART;
3502                  FSTCART_PASTECART] THEN
3503         ASM SET_TAC[];
3504         EXPAND_TAC "g" THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
3505         REWRITE_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART;
3506                     SNDCART_PASTECART] THEN
3507         ASM_SIMP_TAC[PASTECART_INJ]];
3508       ALL_TAC] THEN
3509     SUBGOAL_THEN
3510      `open_in (subtopology euclidean (s PCROSS s'))
3511               (IMAGE (g:real^(N,N)finite_sum->real^(N,N)finite_sum)
3512                      (u PCROSS s'))`
3513     MP_TAC THENL
3514      [MATCH_MP_TAC lemma0 THEN
3515       ASM_SIMP_TAC[SUBSPACE_PCROSS; OPEN_IN_PCROSS_EQ; OPEN_IN_REFL] THEN
3516       CONJ_TAC THENL [ASM_SIMP_TAC[DIM_PCROSS]; ASM_MESON_TAC[]] THEN
3517       MP_TAC(ISPECL [`s:real^N->bool`; `(:real^N)`]
3518         DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS) THEN
3519       ASM_REWRITE_TAC[SUBSET_UNIV; SUBSPACE_UNIV; IN_UNIV; DIM_UNIV] THEN
3520       ARITH_TAC;
3521       SUBGOAL_THEN
3522        `IMAGE (g:real^(N,N)finite_sum->real^(N,N)finite_sum) (u PCROSS s') =
3523         IMAGE f u PCROSS s'`
3524       SUBST1_TAC THENL
3525        [EXPAND_TAC "g" THEN
3526         REWRITE_TAC[EXTENSION; EXISTS_PASTECART; PASTECART_IN_PCROSS;
3527                     IN_IMAGE; FORALL_PASTECART; PASTECART_IN_PCROSS;
3528                     FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_INJ] THEN
3529         ASM SET_TAC[];
3530         ASM_SIMP_TAC[OPEN_IN_PCROSS_EQ; IMAGE_EQ_EMPTY] THEN
3531         STRIP_TAC THEN ASM_SIMP_TAC[IMAGE_CLAUSES; OPEN_IN_EMPTY]]]) in
3532   REWRITE_TAC[INJECTIVE_ON_ALT] THEN REPEAT STRIP_TAC THEN
3533   FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
3534   MP_TAC(ISPECL [`u:real^M->bool`; `dim(v:real^N->bool)`]
3535     CHOOSE_SUBSPACE_OF_SUBSPACE) THEN ASM_SIMP_TAC[SPAN_OF_SUBSPACE] THEN
3536   DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN
3537   MP_TAC(ISPECL [`v:real^N->bool`; `v:real^M->bool`]
3538         HOMEOMORPHIC_SUBSPACES) THEN
3539   ASM_REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN
3540   MAP_EVERY X_GEN_TAC [`h:real^N->real^M`; `k:real^M->real^N`] THEN
3541   STRIP_TAC THEN
3542   SUBGOAL_THEN
3543    `IMAGE (f:real^M->real^N) s =
3544     IMAGE (k:real^M->real^N) (IMAGE ((h:real^N->real^M) o f) s)`
3545   SUBST1_TAC THENL
3546    [REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC(SET_RULE
3547      `(!x. x IN u ==> f x = g x) ==> IMAGE f u = IMAGE g u`) THEN
3548     RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN
3549     ASM_SIMP_TAC[SUBSET; o_THM] THEN ASM SET_TAC[];
3550     MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
3551     MAP_EVERY EXISTS_TAC [`h:real^N->real^M`; `v:real^M->bool`] THEN
3552     ASM_REWRITE_TAC[homeomorphism] THEN
3553     MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `u:real^M->bool` THEN
3554     ASM_REWRITE_TAC[IMAGE_o] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
3555     REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC lemma1 THEN
3556     ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN
3557     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
3558     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
3559     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
3560           CONTINUOUS_ON_SUBSET)) THEN
3561     ASM SET_TAC[]]);;
3562
3563 let INVARIANCE_OF_DIMENSION_SUBSPACES = prove
3564  (`!f:real^M->real^N u v s.
3565       subspace u /\ subspace v /\
3566       ~(s = {}) /\ open_in (subtopology euclidean u) s /\
3567       f continuous_on s /\ IMAGE f s SUBSET v /\
3568       (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
3569       ==> dim u <= dim v`,
3570   REWRITE_TAC[GSYM NOT_LT] THEN REPEAT STRIP_TAC THEN
3571   MP_TAC(ISPECL [`u:real^M->bool`; `dim(v:real^N->bool)`]
3572     CHOOSE_SUBSPACE_OF_SUBSPACE) THEN
3573   ASM_SIMP_TAC[SPAN_OF_SUBSPACE; LE_LT] THEN
3574   DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN
3575   MP_TAC(ISPECL [`v:real^N->bool`; `t:real^M->bool`]
3576         HOMEOMORPHIC_SUBSPACES) THEN
3577   FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
3578   ASM_REWRITE_TAC[homeomorphic; homeomorphism; NOT_EXISTS_THM] THEN
3579   MAP_EVERY X_GEN_TAC [`h:real^N->real^M`; `k:real^M->real^N`] THEN
3580   STRIP_TAC THEN MP_TAC(ISPECL
3581    [`(h:real^N->real^M) o (f:real^M->real^N)`; `u:real^M->bool`;
3582     `u:real^M->bool`; `s:real^M->bool`]
3583         INVARIANCE_OF_DOMAIN_SUBSPACES) THEN
3584   ASM_REWRITE_TAC[LE_LT; NOT_IMP] THEN REPEAT CONJ_TAC THENL
3585    [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
3586     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
3587     REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
3588     REWRITE_TAC[o_THM] THEN ASM SET_TAC[];
3589     ALL_TAC] THEN
3590   SUBGOAL_THEN `IMAGE ((h:real^N->real^M) o (f:real^M->real^N)) s SUBSET t`
3591   ASSUME_TAC THENL [REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; ALL_TAC] THEN
3592   ABBREV_TAC `w = IMAGE ((h:real^N->real^M) o (f:real^M->real^N)) s` THEN
3593   DISCH_TAC THEN UNDISCH_TAC `dim(t:real^M->bool) < dim(u:real^M->bool)` THEN
3594   REWRITE_TAC[NOT_LT] THEN MP_TAC(ISPECL
3595    [`w:real^M->bool`; `u:real^M->bool`] DIM_OPEN_IN) THEN
3596   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
3597    [ASM_MESON_TAC[IMAGE_EQ_EMPTY]; DISCH_THEN(SUBST1_TAC o SYM)] THEN
3598   ASM_SIMP_TAC[DIM_SUBSET]);;
3599
3600 let INVARIANCE_OF_DOMAIN_AFFINE_SETS = prove
3601  (`!f:real^M->real^N u v s.
3602         affine u /\ affine v /\ aff_dim v <= aff_dim u /\
3603         f continuous_on s /\ IMAGE f s SUBSET v /\
3604         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
3605         open_in (subtopology euclidean u) s
3606         ==> open_in (subtopology euclidean v) (IMAGE f s)`,
3607   REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN
3608   ASM_REWRITE_TAC[IMAGE_CLAUSES; OPEN_IN_EMPTY; INJECTIVE_ON_ALT] THEN
3609   REPEAT STRIP_TAC THEN
3610   SUBGOAL_THEN `?a:real^M b:real^N. a IN s /\ a IN u /\ b IN v`
3611   STRIP_ASSUME_TAC THENL
3612    [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
3613     ASM SET_TAC[];
3614     ALL_TAC] THEN
3615   MP_TAC(ISPECL
3616    [`(\x. --b + x) o (f:real^M->real^N) o (\x. a + x)`;
3617     `IMAGE (\x:real^M. --a + x) u`; `IMAGE (\x:real^N. --b + x) v`;
3618     `IMAGE (\x:real^M. --a + x) s`] INVARIANCE_OF_DOMAIN_SUBSPACES) THEN
3619   REWRITE_TAC[IMAGE_o; INJECTIVE_ON_ALT; OPEN_IN_TRANSLATION_EQ] THEN
3620   SIMP_TAC[IMP_CONJ; GSYM INT_OF_NUM_LE; GSYM AFF_DIM_DIM_SUBSPACE] THEN
3621   ASM_REWRITE_TAC[AFF_DIM_TRANSLATION_EQ; RIGHT_FORALL_IMP_THM] THEN
3622   SIMP_TAC[FORALL_IN_IMAGE; o_THM; GSYM IMAGE_o; IMP_IMP; GSYM CONJ_ASSOC] THEN
3623   ANTS_TAC THENL
3624    [ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
3625      [CONJ_TAC THEN MATCH_MP_TAC AFFINE_IMP_SUBSPACE THEN
3626       ASM_REWRITE_TAC[AFFINE_TRANSLATION_EQ] THEN REWRITE_TAC[IN_IMAGE;
3627         VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN
3628       ASM_MESON_TAC[];
3629       REPEAT CONJ_TAC THENL
3630        [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
3631            SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);
3632         REWRITE_TAC[GSYM o_ASSOC] THEN REWRITE_TAC[IMAGE_o] THEN
3633         MATCH_MP_TAC IMAGE_SUBSET;
3634         REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]]];
3635     ALL_TAC] THEN
3636   ASM_SIMP_TAC[VECTOR_ARITH `a + --a + x:real^N = x`; GSYM IMAGE_o; o_DEF;
3637                IMAGE_ID; ETA_AX]);;
3638
3639 let INVARIANCE_OF_DIMENSION_AFFINE_SETS = prove
3640  (`!f:real^M->real^N u v s.
3641       affine u /\ affine v /\
3642       ~(s = {}) /\ open_in (subtopology euclidean u) s /\
3643       f continuous_on s /\ IMAGE f s SUBSET v /\
3644       (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
3645       ==> aff_dim u <= aff_dim v`,
3646   REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN
3647   ASM_REWRITE_TAC[IMAGE_CLAUSES; OPEN_IN_EMPTY; INJECTIVE_ON_ALT] THEN
3648   REPEAT STRIP_TAC THEN
3649   SUBGOAL_THEN `?a:real^M b:real^N. a IN s /\ a IN u /\ b IN v`
3650   STRIP_ASSUME_TAC THENL
3651    [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
3652     ASM SET_TAC[];
3653     ALL_TAC] THEN
3654   MP_TAC(ISPECL
3655    [`(\x. --b + x) o (f:real^M->real^N) o (\x. a + x)`;
3656     `IMAGE (\x:real^M. --a + x) u`; `IMAGE (\x:real^N. --b + x) v`;
3657     `IMAGE (\x:real^M. --a + x) s`] INVARIANCE_OF_DIMENSION_SUBSPACES) THEN
3658   REWRITE_TAC[IMAGE_o; INJECTIVE_ON_ALT; OPEN_IN_TRANSLATION_EQ] THEN
3659   SIMP_TAC[IMP_CONJ; GSYM INT_OF_NUM_LE; GSYM AFF_DIM_DIM_SUBSPACE] THEN
3660   ASM_REWRITE_TAC[AFF_DIM_TRANSLATION_EQ; RIGHT_FORALL_IMP_THM] THEN
3661   SIMP_TAC[FORALL_IN_IMAGE; o_THM; GSYM IMAGE_o; IMP_IMP; GSYM CONJ_ASSOC] THEN
3662   DISCH_THEN MATCH_MP_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
3663    [CONJ_TAC THEN MATCH_MP_TAC AFFINE_IMP_SUBSPACE THEN
3664     ASM_REWRITE_TAC[AFFINE_TRANSLATION_EQ] THEN REWRITE_TAC[IN_IMAGE;
3665       VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN
3666     ASM_MESON_TAC[];
3667     ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN REPEAT CONJ_TAC THENL
3668      [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
3669          SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);
3670       REWRITE_TAC[GSYM o_ASSOC] THEN REWRITE_TAC[IMAGE_o] THEN
3671       MATCH_MP_TAC IMAGE_SUBSET;
3672       REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]]] THEN
3673   ASM_SIMP_TAC[VECTOR_ARITH `a + --a + x:real^N = x`; GSYM IMAGE_o; o_DEF;
3674                IMAGE_ID; ETA_AX]);;
3675
3676 let INVARIANCE_OF_DIMENSION = prove
3677  (`!f:real^M->real^N s.
3678         f continuous_on s /\ open s /\ ~(s = {}) /\
3679         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
3680         ==> dimindex(:M) <= dimindex(:N)`,
3681   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM DIM_UNIV] THEN
3682   MATCH_MP_TAC INVARIANCE_OF_DIMENSION_SUBSPACES THEN
3683   MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `s:real^M->bool`] THEN
3684   ASM_REWRITE_TAC[SUBSPACE_UNIV; SUBSET_UNIV; SUBTOPOLOGY_UNIV;
3685                   GSYM OPEN_IN]);;
3686
3687 let CONTINUOUS_INJECTIVE_IMAGE_SUBSPACE_DIM_LE = prove
3688  (`!f:real^M->real^N s t.
3689         subspace s /\ subspace t /\
3690         f continuous_on s /\ IMAGE f s SUBSET t /\
3691         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
3692         ==> dim(s) <= dim(t)`,
3693   REPEAT STRIP_TAC THEN MATCH_MP_TAC INVARIANCE_OF_DIMENSION_SUBSPACES THEN
3694   MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `s:real^M->bool`] THEN
3695   ASM_REWRITE_TAC[OPEN_IN_REFL] THEN ASM_SIMP_TAC[SUBSPACE_IMP_NONEMPTY]);;
3696
3697 let INVARIANCE_OF_DIMENSION_CONVEX_DOMAIN = prove
3698  (`!f:real^M->real^N s t.
3699
3700         convex s /\ f continuous_on s /\ IMAGE f s SUBSET affine hull t /\
3701         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
3702         ==> aff_dim(s) <= aff_dim(t)`,
3703   REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN
3704   ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_GE] THEN
3705   MP_TAC(ISPECL
3706    [`f:real^M->real^N`; `affine hull s:real^M->bool`;
3707     `affine hull t:real^N->bool`; `relative_interior s:real^M->bool`]
3708         INVARIANCE_OF_DIMENSION_AFFINE_SETS) THEN
3709   ASM_REWRITE_TAC[AFFINE_AFFINE_HULL; AFF_DIM_AFFINE_HULL;
3710                   OPEN_IN_RELATIVE_INTERIOR] THEN
3711   DISCH_THEN MATCH_MP_TAC THEN
3712   CONJ_TAC THENL [ASM_MESON_TAC[RELATIVE_INTERIOR_EQ_EMPTY]; ALL_TAC] THEN
3713   ASSUME_TAC(ISPEC `s:real^M->bool` RELATIVE_INTERIOR_SUBSET) THEN
3714   CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]);;
3715
3716 let HOMEOMORPHIC_CONVEX_SETS = prove
3717  (`!s:real^M->bool t:real^N->bool.
3718         convex s /\ convex t /\ s homeomorphic t ==> aff_dim s = aff_dim t`,
3719   REPEAT STRIP_TAC THEN
3720   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
3721   REWRITE_TAC[LEFT_IMP_EXISTS_THM; GSYM INT_LE_ANTISYM; homeomorphism] THEN
3722   MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
3723   REPEAT STRIP_TAC THEN
3724   MATCH_MP_TAC INVARIANCE_OF_DIMENSION_CONVEX_DOMAIN THENL
3725    [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^N->real^M`] THEN
3726   ASM_REWRITE_TAC[HULL_SUBSET] THEN ASM SET_TAC[]);;
3727
3728 let HOMEOMORPHIC_CONVEX_COMPACT_SETS_EQ = prove
3729  (`!s:real^M->bool t:real^N->bool.
3730         convex s /\ compact s /\ convex t /\ compact t
3731         ==> (s homeomorphic t <=> aff_dim s = aff_dim t)`,
3732   MESON_TAC[HOMEOMORPHIC_CONVEX_SETS; HOMEOMORPHIC_CONVEX_COMPACT_SETS]);;
3733
3734 let INVARIANCE_OF_DOMAIN_GEN = prove
3735  (`!f:real^M->real^N s.
3736         dimindex(:N) <= dimindex(:M) /\ f continuous_on s /\ open s /\
3737         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
3738         ==> open(IMAGE f s)`,
3739   REPEAT STRIP_TAC THEN MP_TAC(ISPECL
3740    [`f:real^M->real^N`; `(:real^M)`; `(:real^N)`; `s:real^M->bool`]
3741    INVARIANCE_OF_DOMAIN_SUBSPACES) THEN
3742   ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; SUBSPACE_UNIV;
3743                   DIM_UNIV; SUBSET_UNIV]);;
3744
3745 let INJECTIVE_INTO_1D_IMP_OPEN_MAP_UNIV = prove
3746  (`!f:real^N->real^1 s t.
3747         f continuous_on s /\
3748         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
3749         open t /\ t SUBSET s
3750         ==> open (IMAGE f t)`,
3751   REPEAT STRIP_TAC THEN
3752   MATCH_MP_TAC INVARIANCE_OF_DOMAIN_GEN THEN
3753   ASM_REWRITE_TAC[DIMINDEX_1; DIMINDEX_GE_1] THEN CONJ_TAC THENL
3754    [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]);;
3755
3756 let CONTINUOUS_ON_INVERSE_OPEN = prove
3757  (`!f:real^M->real^N g s.
3758         dimindex(:N) <= dimindex(:M) /\
3759         f continuous_on s /\ open s /\
3760         (!x. x IN s ==> g(f x) = x)
3761         ==> g continuous_on IMAGE f s`,
3762   REPEAT STRIP_TAC THEN
3763   REWRITE_TAC[CONTINUOUS_OPEN_IN_PREIMAGE_EQ] THEN
3764   X_GEN_TAC `t:real^M->bool` THEN DISCH_TAC THEN
3765   SUBGOAL_THEN
3766    `{x | x IN IMAGE f s /\ g x IN t} = IMAGE (f:real^M->real^N) (s INTER t)`
3767   SUBST1_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC OPEN_OPEN_IN_TRANS] THEN
3768   REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
3769   CONJ_TAC THEN MATCH_MP_TAC INVARIANCE_OF_DOMAIN_GEN THEN
3770   ASM_SIMP_TAC[OPEN_INTER; IN_INTER] THEN
3771   ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]);;
3772
3773 let CONTINUOUS_ON_INVERSE_INTO_1D = prove
3774  (`!f:real^N->real^1 g s t.
3775         f continuous_on s /\
3776         (path_connected s \/ compact s \/ open s) /\
3777         IMAGE f s = t /\ (!x. x IN s ==> g(f x) = x)
3778         ==> g continuous_on t`,
3779   REPEAT STRIP_TAC THENL
3780    [REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_INVERSE_OPEN_MAP THEN
3781     MAP_EVERY EXISTS_TAC [`f:real^N->real^1`; `s:real^N->bool`] THEN
3782     ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
3783     FIRST_ASSUM(SUBST1_TAC o SYM) THEN
3784     MATCH_MP_TAC INJECTIVE_INTO_1D_IMP_OPEN_MAP THEN ASM SET_TAC[];
3785     ASM_MESON_TAC[CONTINUOUS_ON_INVERSE];
3786     FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
3787     MATCH_MP_TAC CONTINUOUS_ON_INVERSE_OPEN THEN
3788     ASM_REWRITE_TAC[DIMINDEX_1; DIMINDEX_GE_1]]);;
3789
3790 let REAL_CONTINUOUS_ON_INVERSE = prove
3791  (`!f g s. f real_continuous_on s /\
3792            (is_realinterval s \/ real_compact s \/ real_open s) /\
3793            (!x. x IN s ==> g(f x) = x)
3794            ==> g real_continuous_on (IMAGE f s)`,
3795   REPEAT GEN_TAC THEN
3796   REWRITE_TAC[REAL_CONTINUOUS_ON; real_compact; REAL_OPEN;
3797               IS_REALINTERVAL_IS_INTERVAL] THEN
3798   DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_INVERSE_INTO_1D THEN
3799   MAP_EVERY EXISTS_TAC [`lift o f o drop`; `IMAGE lift s`] THEN
3800   ASM_REWRITE_TAC[GSYM IS_INTERVAL_PATH_CONNECTED_1] THEN
3801   ASM_SIMP_TAC[FORALL_IN_IMAGE; o_DEF; LIFT_DROP; GSYM IMAGE_o]);;
3802
3803 let REAL_CONTINUOUS_ON_INVERSE_ALT = prove
3804  (`!f g s t. f real_continuous_on s /\
3805              (is_realinterval s \/ real_compact s \/ real_open s) /\
3806              IMAGE f s = t /\ (!x. x IN s ==> g(f x) = x)
3807            ==> g real_continuous_on t`,
3808   MESON_TAC[REAL_CONTINUOUS_ON_INVERSE]);;
3809
3810 let INVARIANCE_OF_DOMAIN_HOMEOMORPHISM = prove
3811  (`!f:real^M->real^N s.
3812         dimindex(:N) <= dimindex(:M) /\ f continuous_on s /\ open s /\
3813         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
3814         ==> ?g. homeomorphism (s,IMAGE f s) (f,g)`,
3815   REPEAT STRIP_TAC THEN
3816   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN
3817   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN
3818   DISCH_TAC THEN ASM_REWRITE_TAC[homeomorphism] THEN
3819   ASM_SIMP_TAC[CONTINUOUS_ON_INVERSE_OPEN] THEN ASM SET_TAC[]);;
3820
3821 let INVARIANCE_OF_DOMAIN_HOMEOMORPHIC = prove
3822  (`!f:real^M->real^N s.
3823         dimindex(:N) <= dimindex(:M) /\ f continuous_on s /\ open s /\
3824         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
3825         ==> s homeomorphic (IMAGE f s)`,
3826   REPEAT GEN_TAC THEN
3827   DISCH_THEN(MP_TAC o MATCH_MP INVARIANCE_OF_DOMAIN_HOMEOMORPHISM) THEN
3828   REWRITE_TAC[homeomorphic] THEN MESON_TAC[]);;
3829
3830 let HOMEOMORPHIC_INTERVALS_EQ = prove
3831  (`(!a b:real^M c d:real^N.
3832         interval[a,b] homeomorphic interval[c,d] <=>
3833         aff_dim(interval[a,b]) = aff_dim(interval[c,d])) /\
3834    (!a b:real^M c d:real^N.
3835         interval[a,b] homeomorphic interval(c,d) <=>
3836         interval[a,b] = {} /\ interval(c,d) = {}) /\
3837    (!a b:real^M c d:real^N.
3838         interval(a,b) homeomorphic interval[c,d] <=>
3839         interval(a,b) = {} /\ interval[c,d] = {}) /\
3840    (!a b:real^M c d:real^N.
3841         interval(a,b) homeomorphic interval(c,d) <=>
3842         interval(a,b) = {} /\ interval(c,d) = {} \/
3843         ~(interval(a,b) = {}) /\ ~(interval(c,d) = {}) /\
3844         dimindex(:M) = dimindex(:N))`,
3845   SIMP_TAC[HOMEOMORPHIC_CONVEX_COMPACT_SETS_EQ; CONVEX_INTERVAL;
3846            COMPACT_INTERVAL] THEN
3847   REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN
3848   ASM_REWRITE_TAC[HOMEOMORPHIC_EMPTY] THENL
3849    [FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN
3850     REWRITE_TAC[COMPACT_INTERVAL_EQ] THEN ASM_MESON_TAC[HOMEOMORPHIC_EMPTY];
3851     FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN
3852     REWRITE_TAC[COMPACT_INTERVAL_EQ] THEN ASM_MESON_TAC[HOMEOMORPHIC_EMPTY];
3853     MATCH_MP_TAC(TAUT
3854      `(p <=> q) /\ (~p /\ ~q ==> r) ==> p /\ q \/ ~p /\ ~q /\ r`) THEN
3855     CONJ_TAC THENL [ASM_MESON_TAC[HOMEOMORPHIC_EMPTY]; STRIP_TAC] THEN
3856     REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN
3857     MATCH_MP_TAC INVARIANCE_OF_DIMENSION THEN
3858     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THENL
3859      [ALL_TAC; GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM]] THEN
3860     MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
3861     REWRITE_TAC[homeomorphism] THEN STRIP_TAC THENL
3862      [EXISTS_TAC `interval(a:real^M,b)`;
3863       EXISTS_TAC `interval(c:real^N,d)`] THEN
3864     ASM_REWRITE_TAC[OPEN_INTERVAL] THEN ASM SET_TAC[];
3865     TRANS_TAC HOMEOMORPHIC_TRANS
3866      `IMAGE ((\x. lambda i. x$i):real^M->real^N)
3867             (interval(a,b))` THEN
3868     CONJ_TAC THENL
3869      [MATCH_MP_TAC INVARIANCE_OF_DOMAIN_HOMEOMORPHIC THEN
3870       REPEAT CONJ_TAC THENL
3871        [ASM_MESON_TAC[LE_REFL];
3872         MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN
3873         SIMP_TAC[linear; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
3874                  LAMBDA_BETA; CART_EQ];
3875         REWRITE_TAC[OPEN_INTERVAL];
3876         SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN ASM_MESON_TAC[]];
3877       ALL_TAC] THEN
3878     SUBGOAL_THEN
3879      `IMAGE ((\x. lambda i. x$i):real^M->real^N)
3880             (interval(a,b)) =
3881             interval((lambda i. a$i),(lambda i. b$i))`
3882     SUBST1_TAC THENL
3883      [MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
3884       SIMP_TAC[IN_INTERVAL; LAMBDA_BETA] THEN
3885       CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
3886       X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
3887       EXISTS_TAC `(lambda i. (y:real^N)$i):real^M` THEN
3888       SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
3889       FIRST_ASSUM(SUBST1_TAC o SYM) THEN   SIMP_TAC[CART_EQ; LAMBDA_BETA];
3890       MATCH_MP_TAC HOMEOMORPHIC_OPEN_INTERVALS THEN
3891       GEN_REWRITE_TAC I [TAUT `(p <=> q) <=> (~p <=> ~q)`] THEN
3892       SIMP_TAC[INTERVAL_NE_EMPTY; LAMBDA_BETA] THEN
3893       REPEAT(FIRST_X_ASSUM(MP_TAC o
3894         GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY])) THEN
3895       ASM_MESON_TAC[]]]);;
3896
3897 let CONTINUOUS_IMAGE_SUBSET_INTERIOR = prove
3898  (`!f:real^M->real^N s.
3899         f continuous_on s /\ dimindex(:N) <= dimindex(:M) /\
3900         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
3901         ==> IMAGE f (interior s) SUBSET interior(IMAGE f s)`,
3902   REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_MAXIMAL THEN
3903   SIMP_TAC[IMAGE_SUBSET; INTERIOR_SUBSET] THEN
3904   ASM_CASES_TAC `interior s:real^M->bool = {}` THENL
3905    [ASM_REWRITE_TAC[INTERIOR_EMPTY; OPEN_EMPTY; IMAGE_CLAUSES];
3906     MATCH_MP_TAC INVARIANCE_OF_DOMAIN_GEN] THEN
3907   ASM_REWRITE_TAC[OPEN_INTERIOR] THEN
3908   ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET; SUBSET]);;
3909
3910 let HOMEOMORPHIC_INTERIORS_SAME_DIMENSION = prove
3911  (`!s:real^M->bool t:real^N->bool.
3912         dimindex(:M) = dimindex(:N) /\ s homeomorphic t
3913         ==> (interior s) homeomorphic (interior t)`,
3914   REPEAT STRIP_TAC THEN
3915   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
3916   REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
3917   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN
3918   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN
3919   STRIP_TAC THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] INTERIOR_SUBSET] THEN
3920   REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN
3921   REPEAT CONJ_TAC THENL
3922    [SUBGOAL_THEN `t = IMAGE (f:real^M->real^N) s` SUBST1_TAC THENL
3923      [ASM SET_TAC[];
3924       MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_INTERIOR THEN
3925       ASM_MESON_TAC[LE_REFL]];
3926     SUBGOAL_THEN `s = IMAGE (g:real^N->real^M) t` SUBST1_TAC THENL
3927      [ASM SET_TAC[];
3928       MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_INTERIOR THEN
3929       ASM_MESON_TAC[LE_REFL]];
3930     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET];
3931     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET]]);;
3932
3933 let HOMEOMORPHIC_INTERIORS = prove
3934  (`!s:real^M->bool t:real^N->bool.
3935         s homeomorphic t /\ (interior s = {} <=> interior t = {})
3936         ==> (interior s) homeomorphic (interior t)`,
3937   REPEAT GEN_TAC THEN
3938   ASM_CASES_TAC `interior t:real^N->bool = {}` THEN
3939   ASM_SIMP_TAC[HOMEOMORPHIC_EMPTY] THEN STRIP_TAC THEN
3940   MATCH_MP_TAC HOMEOMORPHIC_INTERIORS_SAME_DIMENSION THEN
3941   ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM
3942    (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
3943   REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN
3944   MATCH_MP_TAC INVARIANCE_OF_DIMENSION THENL
3945    [MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `interior s:real^M->bool`];
3946     MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `interior t:real^N->bool`]] THEN
3947   ASM_REWRITE_TAC[OPEN_INTERIOR] THEN
3948   ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET; SUBSET]);;
3949
3950 let HOMEOMORPHIC_FRONTIERS_SAME_DIMENSION = prove
3951  (`!s:real^M->bool t:real^N->bool.
3952         dimindex(:M) = dimindex(:N) /\
3953         s homeomorphic t /\ closed s /\ closed t
3954         ==> (frontier s) homeomorphic (frontier t)`,
3955   REPEAT STRIP_TAC THEN
3956   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
3957   REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
3958   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN
3959   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN
3960   ASM_SIMP_TAC[REWRITE_RULE[SUBSET] FRONTIER_SUBSET_CLOSED] THEN
3961   STRIP_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
3962    [ALL_TAC; ASM_MESON_TAC[FRONTIER_SUBSET_CLOSED; CONTINUOUS_ON_SUBSET]] THEN
3963   ASM_SIMP_TAC[frontier; CLOSURE_CLOSED] THEN
3964   SUBGOAL_THEN
3965    `(!x:real^M. x IN interior s ==> f x IN interior t) /\
3966     (!y:real^N. y IN interior t ==> g y IN interior s)`
3967   MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
3968   REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN
3969   CONJ_TAC THENL
3970    [SUBGOAL_THEN `t = IMAGE (f:real^M->real^N) s` SUBST1_TAC THENL
3971      [ASM SET_TAC[];
3972       MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_INTERIOR THEN
3973       ASM_MESON_TAC[LE_REFL]];
3974     SUBGOAL_THEN `s = IMAGE (g:real^N->real^M) t` SUBST1_TAC THENL
3975      [ASM SET_TAC[];
3976       MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_INTERIOR THEN
3977       ASM_MESON_TAC[LE_REFL]]]);;
3978
3979 let HOMEOMORPHIC_FRONTIERS = prove
3980  (`!s:real^M->bool t:real^N->bool.
3981         s homeomorphic t /\ closed s /\ closed t /\
3982         (interior s = {} <=> interior t = {})
3983         ==> (frontier s) homeomorphic (frontier t)`,
3984   REPEAT GEN_TAC THEN
3985   ASM_CASES_TAC `interior t:real^N->bool = {}` THENL
3986    [ASM_SIMP_TAC[frontier; CLOSURE_CLOSED; DIFF_EMPTY]; STRIP_TAC] THEN
3987   MATCH_MP_TAC HOMEOMORPHIC_FRONTIERS_SAME_DIMENSION THEN
3988   ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM
3989    (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
3990   REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN
3991   MATCH_MP_TAC INVARIANCE_OF_DIMENSION THENL
3992    [MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `interior s:real^M->bool`];
3993     MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `interior t:real^N->bool`]] THEN
3994   ASM_REWRITE_TAC[OPEN_INTERIOR] THEN
3995   ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET; SUBSET]);;
3996
3997 let CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR = prove
3998  (`!f:real^M->real^N s t.
3999         f continuous_on s /\ IMAGE f s SUBSET t /\ aff_dim t <= aff_dim s /\
4000         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
4001         ==> IMAGE f (relative_interior s) SUBSET relative_interior(IMAGE f s)`,
4002   REPEAT STRIP_TAC THEN MATCH_MP_TAC RELATIVE_INTERIOR_MAXIMAL THEN
4003   SIMP_TAC[IMAGE_SUBSET; RELATIVE_INTERIOR_SUBSET] THEN
4004   MATCH_MP_TAC INVARIANCE_OF_DOMAIN_AFFINE_SETS THEN
4005   EXISTS_TAC `affine hull s:real^M->bool` THEN
4006   ASM_REWRITE_TAC[AFFINE_AFFINE_HULL; AFF_DIM_AFFINE_HULL] THEN
4007   REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR] THEN CONJ_TAC THENL
4008    [ASM_MESON_TAC[AFF_DIM_SUBSET; INT_LE_TRANS]; ALL_TAC] THEN
4009   ASSUME_TAC(ISPEC `s:real^M->bool` RELATIVE_INTERIOR_SUBSET) THEN
4010   REPEAT CONJ_TAC THENL
4011    [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC; ASM SET_TAC[]] THEN
4012   MATCH_MP_TAC SUBSET_TRANS THEN
4013   EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN
4014   SIMP_TAC[IMAGE_SUBSET; RELATIVE_INTERIOR_SUBSET; HULL_SUBSET]);;
4015
4016 let HOMEOMORPHIC_RELATIVE_INTERIORS_SAME_DIMENSION = prove
4017  (`!s:real^M->bool t:real^N->bool.
4018         aff_dim s = aff_dim t /\ s homeomorphic t
4019         ==> (relative_interior s) homeomorphic (relative_interior t)`,
4020   REPEAT STRIP_TAC THEN
4021   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
4022   REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
4023   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN
4024   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN
4025   STRIP_TAC THEN
4026   ASM_SIMP_TAC[REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET] THEN
4027   REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN
4028   REPEAT CONJ_TAC THENL
4029    [SUBGOAL_THEN `t = IMAGE (f:real^M->real^N) s` SUBST1_TAC THENL
4030      [ASM SET_TAC[];
4031       MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR THEN
4032       EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN
4033       ASM SET_TAC[]];
4034     SUBGOAL_THEN `s = IMAGE (g:real^N->real^M) t` SUBST1_TAC THENL
4035      [ASM SET_TAC[];
4036       MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR THEN
4037       EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN
4038       ASM SET_TAC[]];
4039     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; RELATIVE_INTERIOR_SUBSET];
4040     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; RELATIVE_INTERIOR_SUBSET]]);;
4041
4042 let HOMEOMORPHIC_RELATIVE_INTERIORS = prove
4043  (`!s:real^M->bool t:real^N->bool.
4044         s homeomorphic t /\
4045         (relative_interior s = {} <=> relative_interior t = {})
4046         ==> (relative_interior s) homeomorphic (relative_interior t)`,
4047   REPEAT GEN_TAC THEN
4048   ASM_CASES_TAC `relative_interior t:real^N->bool = {}` THEN
4049   ASM_SIMP_TAC[HOMEOMORPHIC_EMPTY] THEN STRIP_TAC THEN
4050   MATCH_MP_TAC HOMEOMORPHIC_RELATIVE_INTERIORS_SAME_DIMENSION THEN
4051   ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM
4052    (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
4053   ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN
4054   REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN CONJ_TAC THEN
4055   MATCH_MP_TAC INVARIANCE_OF_DIMENSION_AFFINE_SETS THENL
4056    [MAP_EVERY EXISTS_TAC
4057      [`f:real^M->real^N`; `relative_interior s:real^M->bool`];
4058     MAP_EVERY EXISTS_TAC
4059      [`g:real^N->real^M`; `relative_interior t:real^N->bool`]] THEN
4060   ASM_REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR; AFFINE_AFFINE_HULL] THEN
4061   (REPEAT CONJ_TAC THENL
4062     [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; RELATIVE_INTERIOR_SUBSET];
4063      ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; HULL_SUBSET; SET_RULE
4064       `(!x. x IN s ==> f x IN t) /\ s' SUBSET s /\ t SUBSET t'
4065        ==> IMAGE f s' SUBSET t'`];
4066      ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET]]));;
4067
4068 let HOMEOMORPHIC_RELATIVE_BOUNDARIES_SAME_DIMENSION = prove
4069  (`!s:real^M->bool t:real^N->bool.
4070         aff_dim s = aff_dim t /\ s homeomorphic t
4071         ==> (s DIFF relative_interior s) homeomorphic
4072             (t DIFF relative_interior t)`,
4073   REPEAT STRIP_TAC THEN
4074   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
4075   REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
4076   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN
4077   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN
4078   STRIP_TAC THEN ASM_SIMP_TAC[IN_DIFF] THEN
4079   ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
4080    [ALL_TAC; ASM_MESON_TAC[SUBSET_DIFF; CONTINUOUS_ON_SUBSET]] THEN
4081   SUBGOAL_THEN
4082    `(!x:real^M. x IN relative_interior s ==> f x IN relative_interior t) /\
4083     (!y:real^N. y IN relative_interior t ==> g y IN relative_interior s)`
4084   MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
4085   REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN
4086   CONJ_TAC THENL
4087    [SUBGOAL_THEN `t = IMAGE (f:real^M->real^N) s` SUBST1_TAC THENL
4088      [ASM SET_TAC[];
4089       MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR THEN
4090       EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN
4091       ASM SET_TAC[]];
4092     SUBGOAL_THEN `s = IMAGE (g:real^N->real^M) t` SUBST1_TAC THENL
4093      [ASM SET_TAC[];
4094       MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR THEN
4095       EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN
4096       ASM SET_TAC[]]]);;
4097
4098 let HOMEOMORPHIC_RELATIVE_BOUNDARIES = prove
4099  (`!s:real^M->bool t:real^N->bool.
4100         s homeomorphic t /\
4101         (relative_interior s = {} <=> relative_interior t = {})
4102         ==> (s DIFF relative_interior s) homeomorphic
4103             (t DIFF relative_interior t)`,
4104   REPEAT GEN_TAC THEN
4105   ASM_CASES_TAC `relative_interior t:real^N->bool = {}` THEN
4106   ASM_SIMP_TAC[DIFF_EMPTY] THEN STRIP_TAC THEN
4107   MATCH_MP_TAC HOMEOMORPHIC_RELATIVE_BOUNDARIES_SAME_DIMENSION THEN
4108   ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM
4109    (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
4110   ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN
4111   REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN CONJ_TAC THEN
4112   MATCH_MP_TAC INVARIANCE_OF_DIMENSION_AFFINE_SETS THENL
4113    [MAP_EVERY EXISTS_TAC
4114      [`f:real^M->real^N`; `relative_interior s:real^M->bool`];
4115     MAP_EVERY EXISTS_TAC
4116      [`g:real^N->real^M`; `relative_interior t:real^N->bool`]] THEN
4117   ASM_REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR; AFFINE_AFFINE_HULL] THEN
4118   (REPEAT CONJ_TAC THENL
4119     [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; RELATIVE_INTERIOR_SUBSET];
4120      ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; HULL_SUBSET; SET_RULE
4121       `(!x. x IN s ==> f x IN t) /\ s' SUBSET s /\ t SUBSET t'
4122        ==> IMAGE f s' SUBSET t'`];
4123      ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET]]));;
4124
4125 let UNIFORMLY_CONTINUOUS_HOMEOMORPHISM_UNIV_TRIVIAL = prove
4126  (`!f g s:real^N->bool.
4127         homeomorphism (s,(:real^N)) (f,g) /\ f uniformly_continuous_on s
4128         ==> s = (:real^N)`,
4129   REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphism; IN_UNIV] THEN
4130   ASM_CASES_TAC `s:real^N->bool = {}` THEN
4131   ASM_REWRITE_TAC[NOT_IN_EMPTY] THENL [SET_TAC[]; STRIP_TAC] THEN
4132   MP_TAC(ISPEC `s:real^N->bool` CLOPEN) THEN ASM_REWRITE_TAC[] THEN
4133   DISCH_THEN(SUBST1_TAC o SYM) THEN CONJ_TAC THENL
4134    [REWRITE_TAC[GSYM COMPLETE_EQ_CLOSED; complete] THEN
4135     X_GEN_TAC `x:num->real^N` THEN STRIP_TAC THEN
4136     SUBGOAL_THEN `cauchy ((f:real^N->real^N) o x)` MP_TAC THENL
4137      [ASM_MESON_TAC[UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS]; ALL_TAC] THEN
4138     REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN
4139     DISCH_THEN(X_CHOOSE_TAC `l:real^N`) THEN
4140     EXISTS_TAC `(g:real^N->real^N) l` THEN
4141     CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
4142     MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN
4143     EXISTS_TAC `(g:real^N->real^N) o (f:real^N->real^N) o (x:num->real^N)` THEN
4144     REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL
4145      [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM SET_TAC[];
4146       MATCH_MP_TAC LIM_CONTINUOUS_FUNCTION THEN ASM_SIMP_TAC[GSYM o_DEF] THEN
4147       ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV]];
4148     FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
4149     MATCH_MP_TAC INVARIANCE_OF_DOMAIN THEN
4150     ASM_REWRITE_TAC[OPEN_UNIV] THEN ASM SET_TAC[]]);;
4151
4152 let INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET_GEN = prove
4153  (`!f:real^M->real^N u s t.
4154         f continuous_on s /\ IMAGE f s SUBSET t /\
4155         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
4156         bounded u /\ convex u /\ affine t /\ aff_dim t < aff_dim u /\
4157         open_in (subtopology euclidean (relative_frontier u)) s
4158         ==> open_in (subtopology euclidean t) (IMAGE f s)`,
4159   REPEAT GEN_TAC THEN
4160   ASM_CASES_TAC `relative_frontier u:real^M->bool = {}` THEN
4161   ASM_SIMP_TAC[OPEN_IN_SUBTOPOLOGY_EMPTY; IMAGE_CLAUSES; OPEN_IN_EMPTY] THEN
4162   STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
4163   SUBGOAL_THEN
4164    `?b c:real^M. b IN relative_frontier u /\ c IN relative_frontier u /\
4165                  ~(b = c)`
4166   STRIP_ASSUME_TAC THENL
4167    [MATCH_MP_TAC(SET_RULE
4168      `~(s = {} \/ ?x. s = {x}) ==> ?a b. a IN s /\ b IN s /\ ~(a = b)`) THEN
4169     ASM_MESON_TAC[RELATIVE_FRONTIER_NOT_SING];
4170     ALL_TAC] THEN
4171   MP_TAC(ISPECL [`(:real^M)`; `aff_dim(u:real^M->bool) - &1`]
4172         CHOOSE_AFFINE_SUBSET) THEN
4173   REWRITE_TAC[SUBSET_UNIV; AFFINE_UNIV] THEN ANTS_TAC THENL
4174    [MATCH_MP_TAC(INT_ARITH
4175      `&0:int <= t /\ t <= n ==> --a <= t - a /\ t - &1 <= n`) THEN
4176     REWRITE_TAC[AFF_DIM_LE_UNIV; AFF_DIM_UNIV; AFF_DIM_POS_LE] THEN
4177     ASM_MESON_TAC[RELATIVE_FRONTIER_EMPTY; NOT_IN_EMPTY];
4178     DISCH_THEN(X_CHOOSE_THEN `af:real^M->bool` STRIP_ASSUME_TAC)] THEN
4179   MP_TAC(ISPECL [`u:real^M->bool`; `af:real^M->bool`]
4180         HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN) THEN
4181   ASM_REWRITE_TAC[INT_ARITH `x - a + a:int = x`] THEN
4182   DISCH_THEN(fun th ->
4183     MP_TAC(SPEC `c:real^M` th) THEN MP_TAC(SPEC `b:real^M` th)) THEN
4184   ASM_REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN
4185   MAP_EVERY X_GEN_TAC [`g:real^M->real^M`; `h:real^M->real^M`] THEN
4186   REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
4187   MAP_EVERY X_GEN_TAC [`j:real^M->real^M`; `k:real^M->real^M`] THEN
4188   STRIP_TAC THEN
4189   MP_TAC(ISPECL
4190    [`(f:real^M->real^N) o (k:real^M->real^M)`;
4191     `(af:real^M->bool)`;
4192     `t:real^N->bool`; `IMAGE (j:real^M->real^M) (s DELETE c)`]
4193    INVARIANCE_OF_DOMAIN_AFFINE_SETS) THEN
4194   MP_TAC(ISPECL
4195    [`(f:real^M->real^N) o (h:real^M->real^M)`;
4196     `(af:real^M->bool)`;
4197     `t:real^N->bool`; `IMAGE (g:real^M->real^M) (s DELETE b)`]
4198    INVARIANCE_OF_DOMAIN_AFFINE_SETS) THEN
4199   ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
4200   ASM_REWRITE_TAC[IMP_IMP; INT_ARITH `x:int <= y - &1 <=> x < y`] THEN
4201   MATCH_MP_TAC(TAUT
4202    `(p1 /\ p2) /\ (q1 /\ q2 ==> r) ==> (p1 ==> q1) /\ (p2 ==> q2) ==> r`) THEN
4203   REPEAT CONJ_TAC THENL
4204    [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
4205     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
4206         CONTINUOUS_ON_SUBSET)) THEN
4207     ASM SET_TAC[];
4208     REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
4209     RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_DELETE]) THEN
4210     ASM_SIMP_TAC[o_THM; IN_DELETE; IMP_CONJ] THEN ASM_MESON_TAC[];
4211     MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN MAP_EVERY EXISTS_TAC
4212      [`h:real^M->real^M`; `relative_frontier u DELETE (b:real^M)`] THEN
4213     ASM_SIMP_TAC[homeomorphism; DOT_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
4214     ASM_REWRITE_TAC[IN_ELIM_THM; OPEN_IN_OPEN] THEN
4215     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
4216     MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[];
4217     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
4218     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
4219         CONTINUOUS_ON_SUBSET)) THEN
4220     ASM SET_TAC[];
4221     REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
4222     RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_DELETE]) THEN
4223     ASM_SIMP_TAC[o_THM; IN_DELETE; IMP_CONJ] THEN ASM_MESON_TAC[];
4224     MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN MAP_EVERY EXISTS_TAC
4225      [`k:real^M->real^M`; `relative_frontier u DELETE (c:real^M)`] THEN
4226     ASM_SIMP_TAC[homeomorphism; DOT_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
4227     ASM_REWRITE_TAC[IN_ELIM_THM; OPEN_IN_OPEN] THEN
4228     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
4229     MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[];
4230     DISCH_THEN(MP_TAC o MATCH_MP OPEN_IN_UNION) THEN
4231     MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
4232     MATCH_MP_TAC EQ_TRANS THEN
4233     EXISTS_TAC `IMAGE (f:real^M->real^N)
4234                       ((s DELETE b) UNION (s DELETE c))` THEN
4235     CONJ_TAC THENL
4236      [REWRITE_TAC[IMAGE_UNION] THEN BINOP_TAC; ASM SET_TAC[]] THEN
4237     REWRITE_TAC[IMAGE_o] THEN AP_TERM_TAC THEN ASM SET_TAC[]]);;
4238
4239 let INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET = prove
4240  (`!f:real^M->real^N a r s t.
4241         f continuous_on s /\ IMAGE f s SUBSET t /\
4242         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
4243         ~(r = &0) /\ affine t /\ aff_dim t < &(dimindex(:M)) /\
4244         open_in (subtopology euclidean (sphere(a,r))) s
4245         ==> open_in (subtopology euclidean t) (IMAGE f s)`,
4246   REPEAT GEN_TAC THEN ASM_CASES_TAC `sphere(a:real^M,r) = {}` THEN
4247   ASM_SIMP_TAC[OPEN_IN_SUBTOPOLOGY_EMPTY; OPEN_IN_EMPTY; IMAGE_CLAUSES] THEN
4248   RULE_ASSUM_TAC(REWRITE_RULE[SPHERE_EQ_EMPTY; REAL_NOT_LT]) THEN
4249   STRIP_TAC THEN
4250   MP_TAC(ISPECL [`f:real^M->real^N`; `cball(a:real^M,r)`;
4251                  `s:real^M->bool`; `t:real^N->bool`]
4252         INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET_GEN) THEN
4253   ASM_REWRITE_TAC[AFF_DIM_CBALL; RELATIVE_FRONTIER_CBALL;
4254                   BOUNDED_CBALL; CONVEX_CBALL] THEN
4255   COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);;
4256
4257 let NO_EMBEDDING_SPHERE_LOWDIM = prove
4258  (`!f:real^M->real^N a r.
4259         &0 < r /\
4260         f continuous_on sphere(a,r) /\
4261         (!x y. x IN sphere(a,r) /\ y IN sphere(a,r) /\ f x = f y ==> x = y)
4262         ==> dimindex(:M) <= dimindex(:N)`,
4263   REWRITE_TAC[GSYM NOT_LT] THEN REPEAT STRIP_TAC THEN
4264   MP_TAC(ISPEC `IMAGE (f:real^M->real^N) (sphere(a:real^M,r))`
4265         COMPACT_OPEN) THEN
4266   ASM_SIMP_TAC[COMPACT_CONTINUOUS_IMAGE; IMAGE_EQ_EMPTY;
4267                COMPACT_SPHERE; SPHERE_EQ_EMPTY;
4268                REAL_ARITH `&0 < r ==> ~(r < &0)`] THEN
4269   ONCE_REWRITE_TAC[OPEN_IN] THEN
4270   ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
4271   MATCH_MP_TAC INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET THEN
4272   MAP_EVERY EXISTS_TAC [`a:real^M`; `r:real`] THEN
4273   ASM_REWRITE_TAC[AFFINE_UNIV; SUBSET_UNIV; AFF_DIM_UNIV;
4274                   OPEN_IN_REFL; INT_OF_NUM_LT] THEN
4275   ASM_REAL_ARITH_TAC);;
4276
4277 (* ------------------------------------------------------------------------- *)
4278 (* Dimension-based conditions for various homeomorphisms.                    *)
4279 (* ------------------------------------------------------------------------- *)
4280
4281 let HOMEOMORPHIC_SUBSPACES_EQ = prove
4282  (`!s:real^M->bool t:real^N->bool.
4283         subspace s /\ subspace t ==> (s homeomorphic t <=> dim s = dim t)`,
4284   REPEAT STRIP_TAC THEN EQ_TAC THENL
4285    [ALL_TAC; ASM_MESON_TAC[HOMEOMORPHIC_SUBSPACES]] THEN
4286   REWRITE_TAC[homeomorphic; HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN
4287   MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
4288   STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN
4289   MATCH_MP_TAC CONTINUOUS_INJECTIVE_IMAGE_SUBSPACE_DIM_LE THEN
4290   ASM_MESON_TAC[]);;
4291
4292 let HOMEOMORPHIC_AFFINE_SETS_EQ = prove
4293  (`!s:real^M->bool t:real^N->bool.
4294         affine s /\ affine t ==> (s homeomorphic t <=> aff_dim s = aff_dim t)`,
4295   REPEAT GEN_TAC THEN
4296   ASM_CASES_TAC `t:real^N->bool = {}` THEN
4297   ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; HOMEOMORPHIC_EMPTY] THEN
4298   POP_ASSUM MP_TAC THEN
4299   GEN_REWRITE_TAC (funpow 3 RAND_CONV) [EQ_SYM_EQ] THEN
4300   ASM_CASES_TAC `s:real^M->bool = {}` THEN
4301   ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; HOMEOMORPHIC_EMPTY] THEN
4302   POP_ASSUM MP_TAC THEN REWRITE_TAC
4303    [GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM; RIGHT_IMP_FORALL_THM] THEN
4304   MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^N`] THEN
4305   GEOM_ORIGIN_TAC `a:real^M` THEN GEOM_ORIGIN_TAC `b:real^N` THEN
4306   SIMP_TAC[AFFINE_EQ_SUBSPACE; HOMEOMORPHIC_SUBSPACES_EQ; AFF_DIM_DIM_0;
4307            HULL_INC; INT_OF_NUM_EQ] THEN
4308   MESON_TAC[]);;
4309
4310 let HOMEOMORPHIC_HYPERPLANES_EQ = prove
4311  (`!a:real^M b c:real^N d.
4312         ~(a = vec 0) /\ ~(c = vec 0)
4313         ==> ({x | a dot x = b} homeomorphic {x | c dot x = d} <=>
4314              dimindex(:M) = dimindex(:N))`,
4315   SIMP_TAC[HOMEOMORPHIC_AFFINE_SETS_EQ; AFFINE_HYPERPLANE] THEN
4316   SIMP_TAC[AFF_DIM_HYPERPLANE; INT_OF_NUM_EQ;
4317           INT_ARITH `x - &1:int = y - &1 <=> x = y`]);;
4318
4319 let HOMEOMORPHIC_UNIV_UNIV = prove
4320  (`(:real^M) homeomorphic (:real^N) <=> dimindex(:M) = dimindex(:N)`,
4321   SIMP_TAC[HOMEOMORPHIC_SUBSPACES_EQ; DIM_UNIV; SUBSPACE_UNIV]);;
4322
4323 let HOMEOMORPHIC_CBALLS_EQ = prove
4324  (`!a:real^M b:real^N r s.
4325         cball(a,r) homeomorphic cball(b,s) <=>
4326         r < &0 /\ s < &0 \/ r = &0 /\ s = &0 \/
4327         &0 < r /\ &0 < s /\ dimindex(:M) = dimindex(:N)`,
4328   let lemma =
4329     let d = `dimindex(:M) = dimindex(:N)`
4330     and t = `?a:real^M b:real^N. ~(cball(a,r) homeomorphic cball(b,s))` in
4331     DISCH d (DISCH t (GEOM_EQUAL_DIMENSION_RULE (ASSUME d) (ASSUME t))) in
4332   REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THENL
4333    [ASM_SIMP_TAC[CBALL_EMPTY; HOMEOMORPHIC_EMPTY; CBALL_EQ_EMPTY] THEN
4334     EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
4335     ALL_TAC] THEN
4336   ASM_CASES_TAC `r = &0` THEN ASM_REWRITE_TAC[REAL_LT_REFL] THENL
4337    [ASM_SIMP_TAC[CBALL_TRIVIAL; FINITE_SING; HOMEOMORPHIC_FINITE_STRONG] THEN
4338     REWRITE_TAC[FINITE_CBALL] THEN
4339     ASM_CASES_TAC `s < &0` THEN
4340     ASM_SIMP_TAC[CBALL_EMPTY; CARD_CLAUSES; FINITE_EMPTY;
4341                  NOT_IN_EMPTY; ARITH; REAL_LT_IMP_NE] THEN
4342     ASM_CASES_TAC `s = &0` THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
4343     ASM_SIMP_TAC[CBALL_TRIVIAL; CARD_CLAUSES; FINITE_EMPTY; NOT_IN_EMPTY;
4344                  REAL_LE_REFL; ARITH];
4345     ALL_TAC] THEN
4346   SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
4347   ASM_CASES_TAC `s <= &0` THEN
4348   ASM_SIMP_TAC[HOMEOMORPHIC_FINITE_STRONG; FINITE_CBALL] THENL
4349    [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
4350   SUBGOAL_THEN `&0 < s` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
4351   ASM_REWRITE_TAC[] THEN EQ_TAC THENL
4352    [REWRITE_TAC[homeomorphic; HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN
4353     MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
4354     STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN
4355     MATCH_MP_TAC INVARIANCE_OF_DIMENSION THENL
4356      [MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `ball(a:real^M,r)`] THEN
4357       MP_TAC(ISPECL [`a:real^M`; `r:real`] BALL_SUBSET_CBALL);
4358       MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `ball(b:real^N,s)`] THEN
4359       MP_TAC(ISPECL [`b:real^N`; `s:real`] BALL_SUBSET_CBALL)] THEN
4360     ASM_REWRITE_TAC[BALL_EQ_EMPTY; OPEN_BALL; REAL_NOT_LE] THEN
4361     ASM_MESON_TAC[SUBSET; CONTINUOUS_ON_SUBSET];
4362     DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN
4363     GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN
4364     REWRITE_TAC[NOT_EXISTS_THM] THEN ASM_SIMP_TAC[HOMEOMORPHIC_CBALLS]]);;
4365
4366 let HOMEOMORPHIC_BALLS_EQ = prove
4367  (`!a:real^M b:real^N r s.
4368         ball(a,r) homeomorphic ball(b,s) <=>
4369         r <= &0 /\ s <= &0 \/
4370         &0 < r /\ &0 < s /\ dimindex(:M) = dimindex(:N)`,
4371   let lemma =
4372     let d = `dimindex(:M) = dimindex(:N)`
4373     and t = `?a:real^M b:real^N. ~(ball(a,r) homeomorphic ball(b,s))` in
4374     DISCH d (DISCH t (GEOM_EQUAL_DIMENSION_RULE (ASSUME d) (ASSUME t))) in
4375   REPEAT GEN_TAC THEN ASM_CASES_TAC `r <= &0` THENL
4376    [ASM_SIMP_TAC[BALL_EMPTY; HOMEOMORPHIC_EMPTY; BALL_EQ_EMPTY] THEN
4377     EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
4378     ALL_TAC] THEN
4379   ASM_CASES_TAC `s <= &0` THENL
4380    [ASM_SIMP_TAC[BALL_EMPTY; HOMEOMORPHIC_EMPTY; BALL_EQ_EMPTY] THEN
4381     ASM_REAL_ARITH_TAC;
4382     ALL_TAC] THEN
4383   ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN
4384   ASM_REWRITE_TAC[] THEN EQ_TAC THENL
4385    [REWRITE_TAC[homeomorphic; HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN
4386     MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
4387     STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN
4388     MATCH_MP_TAC INVARIANCE_OF_DIMENSION THENL
4389      [MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `ball(a:real^M,r)`];
4390       MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `ball(b:real^N,s)`]] THEN
4391     ASM_REWRITE_TAC[BALL_EQ_EMPTY; OPEN_BALL; REAL_NOT_LE] THEN
4392     ASM SET_TAC[];
4393     DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN
4394     GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN
4395     REWRITE_TAC[NOT_EXISTS_THM] THEN ASM_SIMP_TAC[HOMEOMORPHIC_BALLS]]);;
4396
4397 let SIMPLY_CONNECTED_SPHERE_EQ = prove
4398  (`!a:real^N r.
4399         simply_connected(sphere(a,r)) <=> 3 <= dimindex(:N) \/ r <= &0`,
4400   let hslemma = prove
4401    (`!a:real^M r b:real^N s.
4402         dimindex(:M) = dimindex(:N)
4403         ==> &0 < r /\ &0 < s  ==> (sphere(a,r) homeomorphic sphere(b,s))`,
4404     REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th ->
4405       let t = `?a:real^M b:real^N. ~(sphere(a,r) homeomorphic sphere(b,s))` in
4406       MP_TAC(DISCH t (GEOM_EQUAL_DIMENSION_RULE th (ASSUME t)))) THEN
4407     ASM_SIMP_TAC[HOMEOMORPHIC_SPHERES] THEN MESON_TAC[]) in
4408   REPEAT GEN_TAC THEN
4409   ASM_CASES_TAC `r < &0` THEN
4410   ASM_SIMP_TAC[SPHERE_EMPTY; REAL_LT_IMP_LE; SIMPLY_CONNECTED_EMPTY] THEN
4411   ASM_CASES_TAC `r = &0` THEN
4412   ASM_SIMP_TAC[SPHERE_SING; REAL_LE_REFL; CONVEX_IMP_SIMPLY_CONNECTED;
4413                CONVEX_SING] THEN
4414   ASM_REWRITE_TAC[REAL_LE_LT] THEN
4415   EQ_TAC THEN REWRITE_TAC[SIMPLY_CONNECTED_SPHERE] THEN
4416   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
4417   REWRITE_TAC[ARITH_RULE `~(3 <= n) <=> (1 <= n ==> n = 1 \/ n = 2)`] THEN
4418   REWRITE_TAC[DIMINDEX_GE_1] THEN STRIP_TAC THENL
4419    [DISCH_THEN(MP_TAC o MATCH_MP SIMPLY_CONNECTED_IMP_CONNECTED) THEN
4420     ASM_REWRITE_TAC[CONNECTED_SPHERE_EQ; ARITH] THEN ASM_REAL_ARITH_TAC;
4421     RULE_ASSUM_TAC(REWRITE_RULE[GSYM DIMINDEX_2]) THEN
4422     FIRST_ASSUM(MP_TAC o ISPECL [`a:real^N`; `r:real`; `vec 0:real^2`;
4423           `&1:real`] o MATCH_MP hslemma) THEN
4424     ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
4425     DISCH_THEN(SUBST1_TAC o MATCH_MP HOMEOMORPHIC_SIMPLY_CONNECTED_EQ) THEN
4426     REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_CIRCLEMAP] THEN
4427     REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\x:real^2. x`) THEN
4428     REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID; SUBSET_REFL] THEN
4429     REWRITE_TAC[GSYM contractible; CONTRACTIBLE_SPHERE] THEN
4430     CONV_TAC REAL_RAT_REDUCE_CONV]);;
4431
4432 let SIMPLY_CONNECTED_PUNCTURED_UNIVERSE_EQ = prove
4433  (`!a. simply_connected((:real^N) DELETE a) <=> 3 <= dimindex(:N)`,
4434   GEN_TAC THEN TRANS_TAC EQ_TRANS `simply_connected(sphere(a:real^N,&1))` THEN
4435   CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SIMPLY_CONNECTED_SPHERE_EQ]] THEN
4436   CONV_TAC REAL_RAT_REDUCE_CONV THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN
4437   MATCH_MP_TAC HOMOTOPY_EQUIVALENT_SIMPLE_CONNECTEDNESS THEN
4438   MP_TAC(ISPECL [`cball(a:real^N,&1)`; `a:real^N`]
4439         HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_AFFINE_HULL) THEN
4440   REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; RELATIVE_INTERIOR_CBALL;
4441               RELATIVE_FRONTIER_CBALL] THEN
4442   CONV_TAC REAL_RAT_REDUCE_CONV THEN
4443   SIMP_TAC[CENTRE_IN_BALL; AFFINE_HULL_NONEMPTY_INTERIOR; INTERIOR_CBALL;
4444            BALL_EQ_EMPTY; REAL_OF_NUM_LE; ARITH; REAL_LT_01]);;
4445
4446 let NOT_SIMPLY_CONNECTED_CIRCLE = prove
4447  (`!a:real^2 r. &0 < r ==> ~simply_connected(sphere(a,r))`,
4448   REWRITE_TAC[SIMPLY_CONNECTED_SPHERE_EQ; DIMINDEX_2; ARITH] THEN
4449   REAL_ARITH_TAC);;
4450
4451 (* ------------------------------------------------------------------------- *)
4452 (* The power, squaring and exponential functions as covering maps.           *)
4453 (* ------------------------------------------------------------------------- *)
4454
4455 let COVERING_SPACE_POW_PUNCTURED_PLANE = prove
4456  (`!n. 0 < n
4457        ==> covering_space ((:complex) DIFF {Cx(&0)},(\z. z pow n))
4458                           ((:complex) DIFF {Cx (&0)})`,
4459   let lemma = prove
4460    (`!n. 0 < n
4461          ==> ?e. &0 < e /\
4462                  !w z. norm(w - z) < e * norm(z)
4463                        ==> (w pow n = z pow n <=> w = z)`,
4464     REPEAT STRIP_TAC THEN
4465     FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE
4466      `0 < n ==> n = 1 \/ 2 <= n`)) THEN
4467     ASM_SIMP_TAC[COMPLEX_POW_1] THENL [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN
4468     EXISTS_TAC `&2 * sin(pi / &n)` THEN CONJ_TAC THENL
4469      [REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`] THEN
4470       MATCH_MP_TAC SIN_POS_PI THEN
4471       ASM_SIMP_TAC[REAL_LT_DIV; PI_POS; REAL_OF_NUM_LT] THEN
4472       REWRITE_TAC[REAL_ARITH `x / y < x <=> &0 < x * (&1 - inv y)`] THEN
4473       MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[PI_POS; REAL_SUB_LT] THEN
4474       MATCH_MP_TAC REAL_INV_LT_1 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN
4475       ASM_ARITH_TAC;
4476       ALL_TAC] THEN
4477     REPEAT GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THENL
4478      [ASM_REWRITE_TAC[COMPLEX_NORM_0; COMPLEX_SUB_RZERO] THEN
4479       CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[] THEN
4480       SIMP_TAC[NORM_ARITH `norm(w) < x * &0 <=> F`];
4481       ALL_TAC] THEN
4482     ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; COMPLEX_NORM_NZ] THEN
4483     ASM_SIMP_TAC[COMPLEX_POW_EQ_0; COMPLEX_FIELD
4484      `~(z = Cx(&0)) ==> (w = z <=> w / z = Cx(&1))`] THEN
4485     REWRITE_TAC[GSYM COMPLEX_NORM_DIV; GSYM COMPLEX_POW_DIV] THEN
4486     ASM_SIMP_TAC[COMPLEX_FIELD
4487      `~(z = Cx(&0)) ==> (w - z) / z = w / z - Cx(&1)`] THEN
4488     ASM_CASES_TAC `w / z = Cx(&0)` THENL
4489      [ASM_REWRITE_TAC[COMPLEX_SUB_LZERO; NORM_NEG; COMPLEX_NORM_CX] THEN
4490       ASM_SIMP_TAC[COMPLEX_POW_ZERO; LE_1];
4491       UNDISCH_TAC `~(w / z = Cx(&0))` THEN
4492       UNDISCH_THEN `~(z = Cx(&0))` (K ALL_TAC) THEN
4493       REPEAT(POP_ASSUM MP_TAC) THEN
4494       SPEC_TAC(`w / z:complex`,`z:complex`) THEN REPEAT STRIP_TAC] THEN
4495     EQ_TAC THEN SIMP_TAC[COMPLEX_POW_ONE] THEN DISCH_TAC THEN
4496     UNDISCH_TAC `norm(z - Cx(&1)) < &2 * sin (pi / &n)` THEN
4497     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LT] THEN
4498     DISCH_TAC THEN MP_TAC(SPEC `n:num` COMPLEX_ROOTS_UNITY) THEN
4499     ASM_SIMP_TAC[LE_1; EXTENSION; IN_ELIM_THM] THEN
4500     DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN
4501     DISCH_THEN(X_CHOOSE_THEN `j:num` MP_TAC) THEN
4502     REWRITE_TAC[COMPLEX_RING `t * p * ii * q = ii * (t * p * q)`] THEN
4503     REWRITE_TAC[GSYM CX_MUL] THEN ASM_CASES_TAC `j = 0` THENL
4504      [ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_MUL_RZERO; CEXP_0;
4505                       COMPLEX_MUL_RZERO];
4506       STRIP_TAC THEN ASM_REWRITE_TAC[DIST_CEXP_II_1]] THEN
4507     MATCH_MP_TAC(REAL_ARITH `x <= y ==> &2 * x <= &2 * abs y`) THEN
4508     REWRITE_TAC[REAL_ARITH `(&2 * x) / &2 = x`] THEN
4509     ASM_CASES_TAC `&j / &n <= &1 / &2` THENL
4510      [ALL_TAC;
4511       SUBGOAL_THEN `sin(pi * &j / &n) = sin(pi * &(n - j) / &n)`
4512       SUBST1_TAC THENL
4513        [ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; LT_IMP_LE; REAL_OF_NUM_LT;
4514            REAL_FIELD `&0 < n ==> pi * (n - j) / n = pi - pi * j / n`] THEN
4515         REWRITE_TAC[SIN_SUB; COS_PI; SIN_PI] THEN REAL_ARITH_TAC;
4516         ALL_TAC]] THEN
4517     MATCH_MP_TAC SIN_MONO_LE THEN
4518     REWRITE_TAC[REAL_ARITH `--(pi / &2) = pi * --(&1 / &2)`; real_div] THEN
4519     SIMP_TAC[REAL_LE_LMUL_EQ; PI_POS] THEN
4520     ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; REAL_MUL_LINV; REAL_LT_IMP_NZ;
4521                  REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; REAL_OF_NUM_LT; LE_1;
4522                  ARITH_RULE `j < n ==> 1 <= n - j`; REAL_OF_NUM_LE;
4523                  REAL_ARITH `&0 <= x ==> --(&1 / &2) <= x`;
4524                  REAL_POS; REAL_LE_INV_EQ] THEN
4525     ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; LT_IMP_LE] THEN
4526     REWRITE_TAC[REAL_ARITH `n - j <= inv(&2) * n <=> inv(&2) * n <= j`] THEN
4527     ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_LE_RDIV_EQ;
4528                  REAL_OF_NUM_LT] THEN
4529     ASM_REAL_ARITH_TAC) in
4530   REPEAT STRIP_TAC THEN
4531   SIMP_TAC[covering_space; CONTINUOUS_ON_COMPLEX_POW; CONTINUOUS_ON_ID] THEN
4532   SIMP_TAC[OPEN_IN_OPEN_EQ; OPEN_DIFF; OPEN_UNIV; CLOSED_SING] THEN
4533   MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
4534    [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DIFF; IN_UNIV; IN_SING] THEN
4535     ASM_MESON_TAC[COMPLEX_POW_EQ_0; EXISTS_COMPLEX_ROOT; LE_1];
4536     DISCH_THEN(fun th -> GEN_REWRITE_TAC
4537         (BINDER_CONV o LAND_CONV o RAND_CONV) [GSYM th])] THEN
4538   REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; IN_DIFF; IN_SING] THEN
4539   SIMP_TAC[SUBSET_UNIV; SET_RULE `s SUBSET UNIV DIFF {a} <=> ~(a IN s)`] THEN
4540   X_GEN_TAC `z:complex` THEN DISCH_TAC THEN
4541   MP_TAC(SPEC `n:num` lemma) THEN ASM_REWRITE_TAC[] THEN
4542   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
4543   ABBREV_TAC `d = (min (&1 / &2) (e / &4)) * norm(z:complex)` THEN
4544   SUBGOAL_THEN `&0 < d` ASSUME_TAC THENL
4545    [EXPAND_TAC "d" THEN MATCH_MP_TAC REAL_LT_MUL THEN
4546     ASM_REWRITE_TAC[COMPLEX_NORM_NZ] THEN ASM_REAL_ARITH_TAC;
4547     ALL_TAC] THEN
4548   SUBGOAL_THEN
4549    `!w x y. w pow n = z pow n /\ x IN ball(w,d) /\ y IN ball(w,d)
4550             ==> (x pow n = y pow n <=> x = y)`
4551   ASSUME_TAC THENL
4552    [REWRITE_TAC[IN_BALL] THEN REPEAT STRIP_TAC THEN
4553     FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
4554     SUBGOAL_THEN `norm(z pow n) = norm(w pow n)` MP_TAC THENL
4555      [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]] THEN
4556     DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
4557      (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN
4558     ASM_SIMP_TAC[LE_1; NORM_POS_LE] THEN
4559     ASM_CASES_TAC `w = Cx(&0)` THENL
4560      [ASM_MESON_TAC[COMPLEX_NORM_ZERO]; DISCH_THEN SUBST_ALL_TAC] THEN
4561     MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&2 * d` THEN CONJ_TAC THENL
4562      [MAP_EVERY UNDISCH_TAC
4563        [`dist(w:complex,x) < d`; `dist(w:complex,y) < d`] THEN
4564       CONV_TAC NORM_ARITH;
4565       ALL_TAC] THEN
4566     EXPAND_TAC "d" THEN MATCH_MP_TAC REAL_LE_TRANS THEN
4567     EXISTS_TAC `&2 * e / &4 * norm(w:complex)` THEN CONJ_TAC THENL
4568      [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN
4569       MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN
4570       REAL_ARITH_TAC;
4571       ALL_TAC] THEN
4572     ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_ARITH
4573      `&2 * e / &4 * x <= e * y <=> e * x <= e * &2 * y`] THEN
4574     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH
4575      `dist(z,y) < d ==> d <= &1 / &2 * norm(z)
4576                         ==> norm(z) <= &2 * norm y`)) THEN
4577     EXPAND_TAC "d" THEN MATCH_MP_TAC REAL_LE_RMUL THEN
4578     REWRITE_TAC[NORM_POS_LE] THEN REAL_ARITH_TAC;
4579     ALL_TAC] THEN
4580   EXISTS_TAC `IMAGE (\w. w pow n) (ball(z,d))` THEN REPEAT CONJ_TAC THENL
4581    [REWRITE_TAC[IN_IMAGE] THEN ASM_MESON_TAC[CENTRE_IN_BALL];
4582     MATCH_MP_TAC INVARIANCE_OF_DOMAIN THEN
4583     SIMP_TAC[OPEN_BALL; CONTINUOUS_ON_COMPLEX_POW; CONTINUOUS_ON_ID] THEN
4584     ASM_MESON_TAC[];
4585     REWRITE_TAC[SET_RULE
4586      `~(z IN IMAGE f s) <=> (!x. x IN s ==> ~(f x = z))`] THEN
4587     X_GEN_TAC `w:complex` THEN
4588     ASM_SIMP_TAC[IN_BALL; COMPLEX_POW_EQ_0; LE_1] THEN
4589     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
4590     SIMP_TAC[GSYM COMPLEX_VEC_0; DIST_0] THEN DISCH_TAC THEN
4591     EXPAND_TAC "d" THEN
4592     REWRITE_TAC[REAL_ARITH `~(z < e * z) <=> &0 <= z * (&1 - e)`] THEN
4593     MATCH_MP_TAC REAL_LE_MUL THEN CONV_TAC NORM_ARITH;
4594     ALL_TAC] THEN
4595   SUBGOAL_THEN
4596    `!z'. z' pow n = z pow n
4597          ==> IMAGE (\w. w pow n) (ball(z',d)) =
4598              IMAGE (\w. w pow n) (ball(z,d))`
4599   ASSUME_TAC THENL
4600    [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_BALL] THEN
4601     X_GEN_TAC `w:complex` THEN DISCH_TAC THEN
4602     ASM_CASES_TAC `w = Cx(&0)` THENL
4603      [ASM_MESON_TAC[COMPLEX_POW_EQ_0; LE_1]; ALL_TAC] THEN
4604     X_GEN_TAC `x:complex` THEN  EQ_TAC THEN
4605     DISCH_THEN(X_CHOOSE_THEN `y:complex` STRIP_ASSUME_TAC) THENL
4606      [EXISTS_TAC `z / w * y:complex`;
4607       EXISTS_TAC `w / z * y:complex`] THEN
4608     ASM_SIMP_TAC[COMPLEX_POW_MUL; COMPLEX_POW_DIV; COMPLEX_DIV_REFL;
4609                  COMPLEX_POW_EQ_0; LE_1; COMPLEX_MUL_LID; dist] THEN
4610     ASM_SIMP_TAC[COMPLEX_FIELD
4611      `~(w = Cx(&0)) ==> z - z / w * y = z / w * (w - y)`] THEN
4612     REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV] THEN
4613     (SUBGOAL_THEN `norm(z pow n) = norm(w pow n)` MP_TAC THENL
4614      [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]]) THEN
4615     DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
4616      (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN
4617     ASM_SIMP_TAC[LE_1; NORM_POS_LE; REAL_DIV_REFL; COMPLEX_NORM_ZERO] THEN
4618     ASM_REWRITE_TAC[REAL_MUL_LID; GSYM dist];
4619     ALL_TAC] THEN
4620   EXISTS_TAC `{ ball(z',d) | z' pow n = z pow n}` THEN
4621   REWRITE_TAC[FORALL_IN_GSPEC] THEN REPEAT CONJ_TAC THENL
4622    [REWRITE_TAC[UNIONS_GSPEC; EXTENSION; IN_ELIM_THM] THEN
4623     X_GEN_TAC `x:complex` THEN EQ_TAC THENL
4624      [DISCH_THEN(X_CHOOSE_THEN `w:complex` STRIP_ASSUME_TAC) THEN
4625       CONJ_TAC THENL
4626        [DISCH_TAC THEN UNDISCH_TAC `x IN ball(w:complex,d)` THEN
4627         ASM_REWRITE_TAC[IN_BALL; GSYM COMPLEX_VEC_0; DIST_0] THEN
4628         SUBGOAL_THEN `norm(w pow n) = norm(z pow n)` MP_TAC THENL
4629          [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]] THEN
4630         DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
4631          (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN
4632         ASM_SIMP_TAC[LE_1; NORM_POS_LE; REAL_NOT_LT] THEN DISCH_TAC THEN
4633         EXPAND_TAC "d" THEN REWRITE_TAC[REAL_ARITH
4634          `e * z <= z <=> &0 <= z * (&1 - e)`] THEN
4635         MATCH_MP_TAC REAL_LE_MUL THEN CONV_TAC NORM_ARITH;
4636         SUBGOAL_THEN `IMAGE (\w. w pow n) (ball(z,d)) =
4637                   IMAGE (\w. w pow n) (ball(w,d))`
4638         SUBST1_TAC THENL [ASM_MESON_TAC[]; ASM SET_TAC[]]];
4639       STRIP_TAC THEN
4640       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_IMAGE]) THEN
4641       REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:complex` THEN
4642       REWRITE_TAC[IN_BALL] THEN STRIP_TAC THEN
4643       ASM_CASES_TAC `y = Cx(&0)` THENL
4644        [ASM_MESON_TAC[COMPLEX_POW_EQ_0; LE_1]; ALL_TAC] THEN
4645       EXISTS_TAC `x / y * z:complex` THEN
4646       REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV] THEN
4647       ASM_SIMP_TAC[COMPLEX_POW_MUL; COMPLEX_POW_DIV; COMPLEX_DIV_REFL;
4648                    COMPLEX_POW_EQ_0; LE_1; COMPLEX_MUL_LID; dist] THEN
4649       ASM_SIMP_TAC[COMPLEX_FIELD
4650        `~(y = Cx(&0)) ==> x / y * z - x = x / y * (z - y)`] THEN
4651       REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV] THEN
4652       SUBGOAL_THEN `norm(y pow n) = norm(x pow n)` MP_TAC THENL
4653        [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]] THEN
4654       REWRITE_TAC[COMPLEX_POW_MUL; COMPLEX_POW_DIV] THEN
4655       DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
4656        (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN
4657       ASM_SIMP_TAC[LE_1; NORM_POS_LE; REAL_DIV_REFL; COMPLEX_NORM_ZERO] THEN
4658       ASM_REWRITE_TAC[REAL_MUL_LID; GSYM dist]];
4659     X_GEN_TAC `w:complex` THEN DISCH_TAC THEN
4660     REWRITE_TAC[OPEN_BALL; IN_BALL; REAL_NOT_LT; dist; COMPLEX_SUB_RZERO] THEN
4661     SUBGOAL_THEN `norm(w pow n) = norm(z pow n)` MP_TAC THENL
4662      [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]] THEN
4663     DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
4664      (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN
4665     ASM_SIMP_TAC[LE_1; NORM_POS_LE] THEN DISCH_THEN SUBST1_TAC THEN
4666     EXPAND_TAC "d" THEN
4667     REWRITE_TAC[REAL_ARITH `e * z <= z <=> &0 <= z * (&1 - e)`] THEN
4668     MATCH_MP_TAC REAL_LE_MUL THEN CONV_TAC NORM_ARITH;
4669     REWRITE_TAC[pairwise; IMP_CONJ; FORALL_IN_GSPEC; RIGHT_FORALL_IMP_THM] THEN
4670     X_GEN_TAC `u:complex` THEN DISCH_TAC THEN
4671     X_GEN_TAC `v:complex` THEN DISCH_TAC THEN
4672     ASM_CASES_TAC `v:complex = u` THEN ASM_REWRITE_TAC[] THEN
4673     DISCH_THEN(K ALL_TAC) THEN
4674     REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s /\ x IN t ==> F`] THEN
4675     X_GEN_TAC `x:complex` THEN REWRITE_TAC[IN_BALL] THEN
4676     DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH
4677      `dist(u,x) < d /\ dist(v,x) < d ==> dist(u,v) < &2 * d`)) THEN
4678     REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
4679     EXISTS_TAC `e * norm(z:complex)` THEN CONJ_TAC THENL
4680      [EXPAND_TAC "d" THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN
4681       MATCH_MP_TAC REAL_LE_RMUL THEN
4682       REWRITE_TAC[NORM_POS_LE] THEN ASM_REAL_ARITH_TAC;
4683       ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN REWRITE_TAC[dist]] THEN
4684     SUBGOAL_THEN `norm(z pow n) = norm(v pow n)` MP_TAC THENL
4685      [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]] THEN
4686     DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
4687      (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN
4688     ASM_SIMP_TAC[LE_1; NORM_POS_LE] THEN ASM_MESON_TAC[];
4689     X_GEN_TAC `w:complex` THEN DISCH_TAC THEN
4690     SUBGOAL_THEN `IMAGE (\w. w pow n) (ball(z,d)) =
4691                   IMAGE (\w. w pow n) (ball(w,d))`
4692     SUBST1_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
4693     MATCH_MP_TAC INVARIANCE_OF_DOMAIN_HOMEOMORPHISM THEN
4694     SIMP_TAC[LE_REFL; OPEN_BALL; CONTINUOUS_ON_COMPLEX_POW;
4695              CONTINUOUS_ON_ID] THEN
4696     ASM_MESON_TAC[]]);;
4697
4698 let COVERING_SPACE_SQUARE_PUNCTURED_PLANE = prove
4699  (`covering_space ((:complex) DIFF {Cx(&0)},(\z. z pow 2))
4700                   ((:complex) DIFF {Cx (&0)})`,
4701   SIMP_TAC[COVERING_SPACE_POW_PUNCTURED_PLANE; ARITH]);;
4702
4703 let COVERING_SPACE_CEXP_PUNCTURED_PLANE = prove
4704  (`covering_space((:complex),cexp) ((:complex) DIFF {Cx(&0)})`,
4705   SIMP_TAC[covering_space; IN_UNIV; CONTINUOUS_ON_CEXP; IN_DIFF; IN_SING] THEN
4706   CONJ_TAC THENL [SET_TAC[CEXP_CLOG; CEXP_NZ]; ALL_TAC] THEN
4707   SIMP_TAC[OPEN_IN_OPEN_EQ; OPEN_DIFF; OPEN_UNIV; CLOSED_SING] THEN
4708   SIMP_TAC[SUBSET_UNIV; SET_RULE `s SUBSET UNIV DIFF {a} <=> ~(a IN s)`] THEN
4709   X_GEN_TAC `z:complex` THEN DISCH_TAC THEN
4710   EXISTS_TAC `IMAGE cexp (ball(clog z,&1))` THEN
4711   REWRITE_TAC[SET_RULE `~(z IN IMAGE f s) <=> !x. x IN s ==> ~(f x = z)`] THEN
4712   REWRITE_TAC[CEXP_NZ] THEN CONJ_TAC THENL
4713    [REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `clog z` THEN
4714     ASM_SIMP_TAC[CEXP_CLOG; CENTRE_IN_BALL; REAL_LT_01];
4715     ALL_TAC] THEN
4716   SUBGOAL_THEN
4717    `!x y. x IN cball(clog z,&1) /\ y IN cball(clog z,&1) /\ cexp x = cexp y
4718           ==> x = y`
4719   ASSUME_TAC THENL
4720    [REWRITE_TAC[IN_CBALL] THEN REPEAT STRIP_TAC THEN
4721     MATCH_MP_TAC COMPLEX_EQ_CEXP THEN ASM_REWRITE_TAC[] THEN
4722     MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `norm(x - y:complex)` THEN
4723     REWRITE_TAC[GSYM IM_SUB; COMPLEX_NORM_GE_RE_IM] THEN
4724     MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&2` THEN CONJ_TAC THENL
4725      [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC NORM_ARITH;
4726       MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC];
4727     ALL_TAC] THEN
4728   CONJ_TAC THENL
4729    [MATCH_MP_TAC INVARIANCE_OF_DOMAIN THEN
4730     REWRITE_TAC[OPEN_BALL; CONTINUOUS_ON_CEXP] THEN
4731     ASM_MESON_TAC[SUBSET; BALL_SUBSET_CBALL];
4732     ALL_TAC] THEN
4733   MP_TAC(ISPECL [`cball(clog z,&1)`; `cexp`;
4734                  `IMAGE cexp (cball(clog z,&1))`] HOMEOMORPHISM_COMPACT) THEN
4735   ASM_REWRITE_TAC[COMPACT_CBALL; CONTINUOUS_ON_CEXP] THEN
4736   REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE] THEN
4737   X_GEN_TAC `l:complex->complex` THEN STRIP_TAC THEN
4738   EXISTS_TAC `{ IMAGE (\x. x + Cx (&2 * n * pi) * ii)
4739                       (ball(clog z,&1))
4740                 | integer n}` THEN
4741   SIMP_TAC[FORALL_IN_GSPEC; OPEN_BALL;
4742            ONCE_REWRITE_RULE[VECTOR_ADD_SYM] OPEN_TRANSLATION] THEN
4743   REPEAT CONJ_TAC THENL
4744    [REWRITE_TAC[UNIONS_GSPEC; IN_IMAGE; CEXP_EQ] THEN SET_TAC[];
4745     REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
4746     REWRITE_TAC[FORALL_IN_GSPEC] THEN
4747     X_GEN_TAC `m:real` THEN DISCH_TAC THEN
4748     X_GEN_TAC `n:real` THEN DISCH_TAC THEN
4749     ASM_CASES_TAC `m:real = n` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
4750     REWRITE_TAC[IN_BALL; dist; SET_RULE
4751      `DISJOINT (IMAGE f s) (IMAGE g s) <=>
4752       !x y. x IN s /\ y IN s ==> ~(f x = g y)`] THEN
4753     REPEAT GEN_TAC THEN MATCH_MP_TAC(NORM_ARITH
4754      `&2 <= norm(m - n)
4755       ==> norm(c - x) < &1 /\ norm(c - y) < &1 ==> ~(x + m = y + n)`) THEN
4756     REWRITE_TAC[GSYM COMPLEX_SUB_RDISTRIB; COMPLEX_NORM_MUL] THEN
4757     REWRITE_TAC[COMPLEX_NORM_II; GSYM CX_SUB; COMPLEX_NORM_CX] THEN
4758     REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN
4759     REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM; REAL_ABS_PI; REAL_MUL_RID] THEN
4760     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 * &1 * pi` THEN
4761     CONJ_TAC THENL [MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; ALL_TAC] THEN
4762     MATCH_MP_TAC REAL_LE_LMUL THEN
4763     SIMP_TAC[REAL_LE_RMUL_EQ; PI_POS; REAL_POS] THEN
4764     MATCH_MP_TAC REAL_ABS_INTEGER_LEMMA THEN
4765     ASM_SIMP_TAC[REAL_SUB_0; INTEGER_CLOSED];
4766     X_GEN_TAC `n:real` THEN DISCH_TAC THEN
4767     EXISTS_TAC `(\x. x + Cx(&2 * n * pi) * ii) o (l:complex->complex)` THEN
4768     ASM_REWRITE_TAC[CONTINUOUS_ON_CEXP; o_THM; IMAGE_o; FORALL_IN_IMAGE] THEN
4769     RULE_ASSUM_TAC(REWRITE_RULE[INJECTIVE_ON_ALT]) THEN
4770     ASM_SIMP_TAC[CEXP_ADD; CEXP_INTEGER_2PI; COMPLEX_MUL_RID;
4771                  REWRITE_RULE[SUBSET] BALL_SUBSET_CBALL] THEN
4772     REPEAT CONJ_TAC THENL
4773      [MATCH_MP_TAC(SET_RULE
4774        `(!x. e(f x) = e x) ==> IMAGE e (IMAGE f s) = IMAGE e s`) THEN
4775       ASM_SIMP_TAC[CEXP_ADD; CEXP_INTEGER_2PI; COMPLEX_MUL_RID];
4776       MATCH_MP_TAC(SET_RULE
4777        `(!x. x IN s ==> l(e x) = x)
4778         ==> IMAGE t (IMAGE l (IMAGE e s)) = IMAGE t s`) THEN
4779       ASM_SIMP_TAC[REWRITE_RULE[SUBSET] BALL_SUBSET_CBALL];
4780       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
4781       SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID;
4782                CONTINUOUS_ON_CONST] THEN
4783       ASM_MESON_TAC[BALL_SUBSET_CBALL; IMAGE_SUBSET;
4784                     CONTINUOUS_ON_SUBSET]]]);;
4785
4786 (* ------------------------------------------------------------------------- *)
4787 (* Hence the Borsukian results about mappings into circle.                   *)
4788 (* ------------------------------------------------------------------------- *)
4789
4790 let INESSENTIAL_EQ_CONTINUOUS_LOGARITHM = prove
4791  (`!f:real^N->complex s.
4792       (?a. homotopic_with (\h. T) (s,(:complex) DIFF {Cx(&0)}) f (\t. a)) <=>
4793       (?g. g continuous_on s /\ (!x. x IN s ==> f x = cexp(g x)))`,
4794   REPEAT GEN_TAC THEN EQ_TAC THENL
4795    [DISCH_THEN(CHOOSE_THEN
4796      (MP_TAC o CONJ COVERING_SPACE_CEXP_PUNCTURED_PLANE)) THEN
4797     DISCH_THEN(MP_TAC o MATCH_MP COVERING_SPACE_LIFT_INESSENTIAL_FUNCTION) THEN
4798     REWRITE_TAC[SUBSET_UNIV] THEN MESON_TAC[];
4799     DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN
4800     SUBGOAL_THEN
4801      `?a. homotopic_with (\h. T) (s,(:complex) DIFF {Cx(&0)})
4802               (cexp o g) (\x:real^N. a)`
4803     MP_TAC THENL
4804      [MATCH_MP_TAC NULLHOMOTOPIC_THROUGH_CONTRACTIBLE THEN
4805       EXISTS_TAC `(:complex)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN
4806       ASM_SIMP_TAC[STARLIKE_IMP_CONTRACTIBLE; STARLIKE_UNIV] THEN
4807       REWRITE_TAC[CONTINUOUS_ON_CEXP; SUBSET; FORALL_IN_IMAGE] THEN
4808       REWRITE_TAC[IN_UNIV; IN_DIFF; IN_SING; CEXP_NZ];
4809       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:complex` THEN
4810       MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN
4811       ASM_SIMP_TAC[o_THM]]]);;
4812
4813 let INESSENTIAL_IMP_CONTINUOUS_LOGARITHM_CIRCLE = prove
4814  (`!f:real^N->complex s.
4815         (?a. homotopic_with (\h. T) (s,sphere(vec 0,&1)) f (\t. a))
4816         ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = cexp(g x)`,
4817   REPEAT GEN_TAC THEN
4818   SIMP_TAC[sphere; GSYM INESSENTIAL_EQ_CONTINUOUS_LOGARITHM] THEN
4819   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:complex` THEN
4820   REWRITE_TAC[homotopic_with] THEN MATCH_MP_TAC MONO_EXISTS THEN
4821   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
4822   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
4823     (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN
4824   SIMP_TAC[SUBSET; DIST_0; FORALL_IN_GSPEC; IN_UNIV; IN_DIFF; IN_SING] THEN
4825   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
4826   SIMP_TAC[COMPLEX_NORM_CX] THEN REAL_ARITH_TAC);;
4827
4828 let INESSENTIAL_EQ_CONTINUOUS_LOGARITHM_CIRCLE = prove
4829  (`!f:real^N->complex s.
4830         (?a. homotopic_with (\h. T) (s,sphere(vec 0,&1)) f (\t. a)) <=>
4831         (?g. (Cx o g) continuous_on s /\
4832              !x. x IN s ==> f x = cexp(ii * Cx(g x)))`,
4833   REPEAT GEN_TAC THEN EQ_TAC THENL
4834    [DISCH_TAC THEN FIRST_ASSUM(MP_TAC o
4835       MATCH_MP INESSENTIAL_IMP_CONTINUOUS_LOGARITHM_CIRCLE) THEN
4836     DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN
4837     EXISTS_TAC `Im o (g:real^N->complex)` THEN CONJ_TAC THENL
4838      [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
4839       ASM_REWRITE_TAC[CONTINUOUS_ON_CX_IM];
4840       FIRST_X_ASSUM(CHOOSE_THEN (MP_TAC o CONJUNCT1 o
4841         MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET)) THEN
4842       ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; NORM_CEXP] THEN
4843       REWRITE_TAC[EULER; o_THM; RE_MUL_II; IM_MUL_II] THEN
4844       SIMP_TAC[RE_CX; IM_CX; REAL_NEG_0; REAL_EXP_0]];
4845     DISCH_THEN(X_CHOOSE_THEN `g:real^N->real` STRIP_ASSUME_TAC) THEN
4846     SUBGOAL_THEN
4847      `?a. homotopic_with (\h. T) (s,sphere(vec 0,&1))
4848               ((cexp o (\z. ii * z)) o (Cx o g)) (\x:real^N. a)`
4849     MP_TAC THENL
4850      [MATCH_MP_TAC NULLHOMOTOPIC_THROUGH_CONTRACTIBLE THEN
4851       EXISTS_TAC `{z | Im z = &0}` THEN ASM_REWRITE_TAC[] THEN
4852       ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; CONTINUOUS_ON_CEXP; CONJ_ASSOC;
4853                    CONTINUOUS_ON_COMPLEX_LMUL; CONTINUOUS_ON_ID] THEN
4854       CONJ_TAC THENL
4855        [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_SPHERE_0;
4856                     o_THM; IM_CX] THEN
4857         SIMP_TAC[NORM_CEXP; RE_MUL_II; REAL_EXP_0; REAL_NEG_0];
4858         MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN
4859         MATCH_MP_TAC CONVEX_IMP_STARLIKE THEN CONJ_TAC THENL
4860          [REWRITE_TAC[IM_DEF; CONVEX_STANDARD_HYPERPLANE];
4861           REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN
4862           MESON_TAC[IM_CX]]];
4863       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:complex` THEN
4864       MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN
4865       ASM_SIMP_TAC[o_THM]]]);;
4866
4867 let HOMOTOPIC_CIRCLEMAPS_DIV,HOMOTOPIC_CIRCLEMAPS_DIV_1 = (CONJ_PAIR o prove)
4868  (`(!f g:real^N->real^2 s.
4869     homotopic_with (\x. T) (s,sphere(vec 0,&1)) f g <=>
4870     f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0,&1) /\
4871     g continuous_on s /\ IMAGE g s SUBSET sphere(vec 0,&1) /\
4872     ?c. homotopic_with (\x. T) (s,sphere(vec 0,&1)) (\x. f x / g x) (\x. c)) /\
4873    (!f g:real^N->real^2 s.
4874     homotopic_with (\x. T) (s,sphere(vec 0,&1)) f g <=>
4875     f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0,&1) /\
4876     g continuous_on s /\ IMAGE g s SUBSET sphere(vec 0,&1) /\
4877     homotopic_with (\x. T) (s,sphere(vec 0,&1)) (\x. f x / g x) (\x. Cx(&1)))`,
4878   let lemma = prove
4879    (`!f g h:real^N->real^2 s.
4880           homotopic_with (\x. T) (s,sphere(vec 0,&1)) f g
4881           ==> h continuous_on s /\ (!x. x IN s ==> h(x) IN sphere(vec 0,&1))
4882                ==> homotopic_with (\x. T) (s,sphere(vec 0,&1))
4883                                           (\x. f x * h x) (\x. g x * h x)`,
4884     REWRITE_TAC[IN_SPHERE_0] THEN REPEAT STRIP_TAC THEN
4885     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN
4886     ASM_SIMP_TAC[HOMOTOPIC_WITH; LEFT_IMP_EXISTS_THM] THEN
4887     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; FORALL_IN_PCROSS] THEN
4888     X_GEN_TAC `k:real^((1,N)finite_sum)->real^2` THEN STRIP_TAC THEN
4889     EXISTS_TAC `\z. (k:real^(1,N)finite_sum->real^2) z * h(sndcart z)` THEN
4890     ASM_SIMP_TAC[COMPLEX_NORM_MUL; SNDCART_PASTECART; REAL_MUL_LID] THEN
4891     ASM_REWRITE_TAC[SNDCART_PASTECART] THEN
4892     MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN
4893     ASM_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
4894     SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; IMAGE_SNDCART_PCROSS] THEN
4895     ASM_REWRITE_TAC[UNIT_INTERVAL_NONEMPTY]) in
4896   REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC
4897    (TAUT `(q <=> r) /\ (p <=> r) ==> (p <=> q) /\ (p <=> r)`) THEN
4898   CONJ_TAC THENL
4899    [REPEAT(MATCH_MP_TAC(TAUT `(p ==> (q <=> r)) ==> (p /\ q <=> p /\ r)`) THEN
4900            DISCH_TAC) THEN
4901     EQ_TAC THENL
4902      [ALL_TAC; DISCH_TAC THEN EXISTS_TAC `Cx(&1)` THEN ASM_MESON_TAC[]] THEN
4903     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:complex` THEN
4904     DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET th) THEN
4905         MP_TAC th) THEN
4906     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN
4907     REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN
4908     ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN
4909     MP_TAC(ISPECL [`vec 0:real^2`; `&1`] PATH_CONNECTED_SPHERE) THEN
4910     REWRITE_TAC[DIMINDEX_2; LE_REFL; PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
4911     DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL
4912      [ASM SET_TAC[]; REWRITE_TAC[IN_SPHERE_0; COMPLEX_NORM_CX; REAL_ABS_NUM]];
4913     EQ_TAC THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP lemma) THENL
4914      [FIRST_ASSUM(STRIP_ASSUME_TAC o
4915          MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN
4916       FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
4917       DISCH_THEN(MP_TAC o SPEC `\x. inv((g:real^N->complex) x)`);
4918       DISCH_THEN(MP_TAC o SPEC `g:real^N->complex`)] THEN
4919     RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0]) THEN
4920     ASM_SIMP_TAC[IN_SPHERE_0; COMPLEX_NORM_INV; REAL_INV_1] THEN
4921     ASM_SIMP_TAC[GSYM COMPLEX_NORM_ZERO; REAL_OF_NUM_EQ; ARITH_EQ;
4922                  CONTINUOUS_ON_COMPLEX_INV] THEN
4923     ASM_REWRITE_TAC[SUBSET; IN_SPHERE_0; FORALL_IN_IMAGE] THEN
4924     MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT]
4925      HOMOTOPIC_WITH_EQ) THEN
4926     ASM_SIMP_TAC[COMPLEX_DIV_RMUL; COMPLEX_MUL_LID; COMPLEX_MUL_RINV;
4927                  GSYM complex_div; COMPLEX_DIV_REFL;
4928                  GSYM COMPLEX_NORM_ZERO; REAL_OF_NUM_EQ; ARITH_EQ]]);;
4929
4930 (* ------------------------------------------------------------------------- *)
4931 (* In particular, complex logs exist on various "well-behaved" sets.         *)
4932 (* ------------------------------------------------------------------------- *)
4933
4934 let CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE = prove
4935  (`!f:real^N->complex s.
4936         f continuous_on s /\ contractible s /\
4937         (!x. x IN s ==> ~(f x = Cx(&0)))
4938         ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = cexp(g x)`,
4939   REPEAT STRIP_TAC THEN
4940   REWRITE_TAC[GSYM INESSENTIAL_EQ_CONTINUOUS_LOGARITHM] THEN
4941   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NULLHOMOTOPIC_FROM_CONTRACTIBLE THEN
4942   ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);;
4943
4944 let CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED = prove
4945  (`!f:real^N->complex s.
4946         f continuous_on s /\ simply_connected s /\ locally path_connected s /\
4947         (!x. x IN s ==> ~(f x = Cx(&0)))
4948         ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = cexp(g x)`,
4949   REPEAT STRIP_TAC THEN MP_TAC
4950   (ISPECL [`f:real^N->complex`; `s:real^N->bool`]
4951     (MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT)
4952         COVERING_SPACE_CEXP_PUNCTURED_PLANE)) THEN
4953   ASM_REWRITE_TAC[IN_UNIV] THEN ASM SET_TAC[]);;
4954
4955 let CONTINUOUS_LOGARITHM_ON_CBALL = prove
4956  (`!f:real^N->complex a r.
4957         f continuous_on cball(a,r) /\
4958         (!z. z IN cball(a,r) ==> ~(f z = Cx(&0)))
4959         ==> ?h. h continuous_on cball(a,r) /\
4960                 !z. z IN cball(a,r) ==> f z = cexp(h z)`,
4961   REPEAT STRIP_TAC THEN
4962   ASM_CASES_TAC `cball(a:real^N,r) = {}` THEN
4963   ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY; NOT_IN_EMPTY] THEN
4964   MATCH_MP_TAC CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE THEN
4965   ASM_REWRITE_TAC[] THEN
4966   MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN
4967   MATCH_MP_TAC CONVEX_IMP_STARLIKE THEN
4968   ASM_REWRITE_TAC[CONVEX_CBALL]);;
4969
4970 let CONTINUOUS_LOGARITHM_ON_BALL = prove
4971  (`!f:real^N->complex a r.
4972         f continuous_on ball(a,r) /\
4973         (!x. x IN ball(a,r) ==> ~(f x = Cx(&0)))
4974         ==> ?h. h continuous_on ball(a,r) /\
4975                 !x. x IN ball(a,r) ==> f x = cexp(h x)`,
4976   REPEAT STRIP_TAC THEN
4977   ASM_CASES_TAC `ball(a:real^N,r) = {}` THEN
4978   ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY; NOT_IN_EMPTY] THEN
4979   MATCH_MP_TAC CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE THEN
4980   ASM_REWRITE_TAC[] THEN
4981   MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN
4982   MATCH_MP_TAC CONVEX_IMP_STARLIKE THEN
4983   ASM_REWRITE_TAC[CONVEX_BALL]);;
4984
4985 let CONTINUOUS_SQRT_ON_CONTRACTIBLE = prove
4986  (`!f:real^N->complex s.
4987         f continuous_on s /\ contractible s /\
4988         (!x. x IN s ==> ~(f x = Cx(&0)))
4989         ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = (g x) pow 2`,
4990   REPEAT GEN_TAC THEN DISCH_TAC THEN
4991   FIRST_ASSUM(MP_TAC o MATCH_MP CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE) THEN
4992   DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN
4993   EXISTS_TAC `\z:real^N. cexp(g z / Cx(&2))` THEN
4994   ASM_SIMP_TAC[GSYM CEXP_N; COMPLEX_RING `Cx(&2) * z / Cx(&2) = z`] THEN
4995   GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
4996   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
4997   REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN
4998   MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN
4999   ASM_SIMP_TAC[CONTINUOUS_ON_CONST] THEN
5000   CONV_TAC COMPLEX_RING);;
5001
5002 let CONTINUOUS_SQRT_ON_SIMPLY_CONNECTED = prove
5003  (`!f:real^N->complex s.
5004         f continuous_on s /\ simply_connected s /\ locally path_connected s /\
5005         (!x. x IN s ==> ~(f x = Cx(&0)))
5006         ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = (g x) pow 2`,
5007   REPEAT GEN_TAC THEN DISCH_TAC THEN
5008   FIRST_ASSUM(MP_TAC o MATCH_MP CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED) THEN
5009   DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN
5010   EXISTS_TAC `\z:real^N. cexp(g z / Cx(&2))` THEN
5011   ASM_SIMP_TAC[GSYM CEXP_N; COMPLEX_RING `Cx(&2) * z / Cx(&2) = z`] THEN
5012   GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
5013   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
5014   REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN
5015   MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN
5016   ASM_SIMP_TAC[CONTINUOUS_ON_CONST] THEN
5017   CONV_TAC COMPLEX_RING);;
5018
5019 (* ------------------------------------------------------------------------- *)
5020 (* Analogously, holomorphic logarithms and square roots.                     *)
5021 (* ------------------------------------------------------------------------- *)
5022
5023 let CONTRACTIBLE_IMP_HOLOMORPHIC_LOG,SIMPLY_CONNECTED_IMP_HOLOMORPHIC_LOG =
5024  (CONJ_PAIR o prove)
5025  (`(!s:complex->bool.
5026       contractible s
5027       ==> !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0)))
5028               ==> ?g. g holomorphic_on s /\ !z. z IN s ==> f z = cexp(g z)) /\
5029    (!s:complex->bool.
5030       simply_connected s /\ locally path_connected s
5031       ==> !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0)))
5032               ==> ?g. g holomorphic_on s /\ !z. z IN s ==> f z = cexp(g z))`,
5033   REPEAT STRIP_TAC THENL
5034    [MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`]
5035         CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE);
5036     MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`]
5037         CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED)] THEN
5038   ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN
5039  (MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN
5040   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5041   UNDISCH_TAC `f holomorphic_on s` THEN
5042   REWRITE_TAC[holomorphic_on] THEN MATCH_MP_TAC MONO_FORALL THEN
5043   X_GEN_TAC `z:complex` THEN ASM_CASES_TAC `(z:complex) IN s` THEN
5044   ASM_REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN] THEN
5045   DISCH_THEN(X_CHOOSE_THEN `f':complex` MP_TAC) THEN
5046   DISCH_THEN(MP_TAC o
5047    ISPECL [`\x. (cexp(g x) - cexp(g z)) / (x - z)`; `&1`] o
5048    MATCH_MP (REWRITE_RULE [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`]
5049     LIM_TRANSFORM_WITHIN)) THEN
5050   ASM_SIMP_TAC[REAL_LT_01] THEN
5051   DISCH_THEN(MP_TAC o
5052     SPECL [`\x:complex. if g x = g z then cexp(g z)
5053                         else (cexp(g x) - cexp(g z)) / (g x - g z)`;
5054            `cexp(g(z:complex))`] o
5055     MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_COMPLEX_DIV)) THEN
5056   REWRITE_TAC[CEXP_NZ] THEN ANTS_TAC THENL
5057    [SUBGOAL_THEN
5058      `(\x. if g x = g z then cexp(g z)
5059            else (cexp(g x) - cexp(g(z:complex))) / (g x - g z)) =
5060       (\y. if y = g z then cexp(g z) else (cexp y - cexp(g z)) / (y - g z)) o g`
5061     SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN
5062     MATCH_MP_TAC LIM_COMPOSE_AT THEN
5063     EXISTS_TAC `(g:complex->complex) z` THEN REPEAT CONJ_TAC THENL
5064      [ASM_MESON_TAC[CONTINUOUS_ON];
5065       REWRITE_TAC[EVENTUALLY_TRUE];
5066       ONCE_REWRITE_TAC[LIM_AT_ZERO] THEN
5067       SIMP_TAC[COMPLEX_VEC_0; COMPLEX_ADD_SUB; COMPLEX_EQ_ADD_LCANCEL_0] THEN
5068       MP_TAC(SPEC `cexp(g(z:complex))` (MATCH_MP LIM_COMPLEX_LMUL
5069        LIM_CEXP_MINUS_1)) THEN REWRITE_TAC[COMPLEX_MUL_RID] THEN
5070       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN
5071       SIMP_TAC[EVENTUALLY_AT; GSYM DIST_NZ; CEXP_ADD] THEN
5072       EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN
5073       SIMPLE_COMPLEX_ARITH_TAC];
5074     DISCH_THEN(fun th ->
5075         EXISTS_TAC `f' / cexp(g(z:complex))` THEN MP_TAC th) THEN
5076     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ]
5077         LIM_TRANSFORM_EVENTUALLY) THEN
5078     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
5079      [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN
5080     DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN
5081     REWRITE_TAC[CONTINUOUS_WITHIN; tendsto] THEN
5082     DISCH_THEN(MP_TAC o SPEC `&2 * pi`) THEN
5083     REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN
5084     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
5085     X_GEN_TAC `w:complex` THEN REWRITE_TAC[dist] THEN DISCH_TAC THEN
5086     COND_CASES_TAC THENL
5087      [ASM_REWRITE_TAC[COMPLEX_SUB_REFL; complex_div; COMPLEX_MUL_LZERO];
5088       ASM_CASES_TAC `w:complex = z` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
5089       SUBGOAL_THEN `~(cexp(g(w:complex)) = cexp(g z))` MP_TAC THENL
5090        [UNDISCH_TAC `~((g:complex->complex) w = g z)` THEN
5091         REWRITE_TAC[CONTRAPOS_THM] THEN
5092         MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] COMPLEX_EQ_CEXP) THEN
5093         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
5094          REAL_LET_TRANS)) THEN
5095         REWRITE_TAC[GSYM IM_SUB; COMPLEX_NORM_GE_RE_IM];
5096         REPEAT(FIRST_X_ASSUM(MP_TAC o check(is_neg o concl))) THEN
5097         CONV_TAC COMPLEX_FIELD]]]));;
5098
5099 let CONTRACTIBLE_IMP_HOLOMORPHIC_SQRT,SIMPLY_CONNECTED_IMP_HOLOMORPHIC_SQRT =
5100  (CONJ_PAIR o prove)
5101  (`(!s:complex->bool.
5102       contractible s
5103       ==> !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0)))
5104               ==> ?g. g holomorphic_on s /\  !z. z IN s ==> f z = g z pow 2) /\
5105    (!s:complex->bool.
5106       simply_connected s /\ locally path_connected s
5107       ==> !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0)))
5108               ==> ?g. g holomorphic_on s /\  !z. z IN s ==> f z = g z pow 2)`,
5109   CONJ_TAC THEN GEN_TAC THENL
5110    [DISCH_THEN(ASSUME_TAC o MATCH_MP CONTRACTIBLE_IMP_HOLOMORPHIC_LOG);
5111     DISCH_THEN(ASSUME_TAC o
5112       MATCH_MP SIMPLY_CONNECTED_IMP_HOLOMORPHIC_LOG)] THEN
5113   REPEAT STRIP_TAC THEN
5114   FIRST_X_ASSUM(MP_TAC o SPEC `f:complex->complex`) THEN ASM_SIMP_TAC[] THEN
5115   DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN
5116   EXISTS_TAC `\z:complex. cexp(g z / Cx(&2))` THEN
5117   ASM_SIMP_TAC[GSYM CEXP_N; COMPLEX_RING `Cx(&2) * z / Cx(&2) = z`] THEN
5118   GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
5119   MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN
5120   REWRITE_TAC[HOLOMORPHIC_ON_CEXP] THEN
5121   MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN
5122   ASM_SIMP_TAC[HOLOMORPHIC_ON_CONST] THEN
5123   CONV_TAC COMPLEX_RING);;
5124
5125 (* ------------------------------------------------------------------------- *)
5126 (* Related theorems about holomorphic inverse cosines.                       *)
5127 (* ------------------------------------------------------------------------- *)
5128
5129 let CONTRACTIBLE_IMP_HOLOMORPHIC_ACS = prove
5130  (`!f s. f holomorphic_on s /\ contractible s /\
5131          (!z. z IN s ==> ~(f z = Cx(&1)) /\ ~(f z = --Cx(&1)))
5132          ==> ?g. g holomorphic_on s /\ !z. z IN s ==> f z = ccos(g z)`,
5133    REPEAT STRIP_TAC THEN
5134    FIRST_ASSUM(MP_TAC o SPEC `\z:complex. Cx(&1) - f(z) pow 2` o
5135      MATCH_MP CONTRACTIBLE_IMP_HOLOMORPHIC_SQRT) THEN
5136    ASM_SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_POW;
5137                 COMPLEX_RING `~(Cx(&1) - z pow 2 = Cx(&0)) <=>
5138                               ~(z = Cx(&1)) /\ ~(z = --Cx(&1))`] THEN
5139    REWRITE_TAC[COMPLEX_RING
5140     `Cx(&1) - w pow 2 = z pow 2 <=>
5141      (w + ii * z) * (w - ii * z) = Cx(&1)`] THEN
5142    DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN
5143    FIRST_ASSUM(MP_TAC o SPEC `\z:complex. f(z) + ii * g(z)` o
5144        MATCH_MP CONTRACTIBLE_IMP_HOLOMORPHIC_LOG) THEN
5145    ASM_SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_CONST;
5146      COMPLEX_RING `(a + b) * (a - b) = Cx(&1) ==> ~(a + b = Cx(&0))`] THEN
5147    DISCH_THEN(X_CHOOSE_THEN `h:complex->complex` STRIP_ASSUME_TAC) THEN
5148    EXISTS_TAC `\z:complex. --ii * h(z)` THEN
5149    ASM_SIMP_TAC[HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_CONST; ccos] THEN
5150    X_GEN_TAC `z:complex` THEN
5151    DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`)) THEN
5152    ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
5153    FIRST_X_ASSUM(MP_TAC o MATCH_MP (COMPLEX_FIELD
5154     `a * b = Cx(&1) ==> b = inv a`)) THEN
5155    ASM_SIMP_TAC[GSYM CEXP_NEG] THEN
5156    FIRST_X_ASSUM(ASSUME_TAC o SYM) THEN DISCH_THEN(ASSUME_TAC o SYM) THEN
5157    ASM_REWRITE_TAC[COMPLEX_RING `ii * --ii * z = z`;
5158                    COMPLEX_RING `--ii * --ii * z = --z`] THEN
5159    CONV_TAC COMPLEX_RING);;
5160
5161 let CONTRACTIBLE_IMP_HOLOMORPHIC_ACS_BOUNDED = prove
5162  (`!f s a.
5163         f holomorphic_on s /\ contractible s /\ a IN s /\
5164         (!z. z IN s ==> ~(f z = Cx(&1)) /\ ~(f z = --Cx(&1)))
5165         ==> ?g. g holomorphic_on s /\ norm(g a) <= pi + norm(f a) /\
5166                 !z. z IN s ==> f z = ccos(g z)`,
5167   let lemma = prove
5168     (`!w. ?v. ccos(v) = w /\ norm(v) <= pi + norm(w)`,
5169      GEN_TAC THEN EXISTS_TAC `cacs w` THEN ABBREV_TAC `v = cacs w` THEN
5170      MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
5171       [ASM_MESON_TAC[CCOS_CACS]; DISCH_THEN(SUBST1_TAC o SYM)] THEN
5172      SIMP_TAC[NORM_LE_SQUARE; PI_POS_LE; NORM_POS_LE; REAL_LE_ADD] THEN
5173      MATCH_MP_TAC(REAL_ARITH
5174       `&0 <= b * c /\ a <= b pow 2 + c pow 2 ==> a <= (b + c) pow 2`) THEN
5175      SIMP_TAC[REAL_LE_MUL; PI_POS_LE; NORM_POS_LE] THEN
5176      REWRITE_TAC[COMPLEX_SQNORM; GSYM NORM_POW_2; NORM_CCOS_POW_2] THEN
5177      MATCH_MP_TAC REAL_LE_ADD2 THEN REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN
5178      EXPAND_TAC "v" THEN REWRITE_TAC[REAL_ABS_PI; RE_CACS_BOUND] THEN
5179      MATCH_MP_TAC(REAL_ARITH
5180       `&0 <= c /\ x <= (d / &2) pow 2 ==> x <= c + d pow 2 / &4`) THEN
5181      REWRITE_TAC[REAL_LE_POW_2; GSYM REAL_LE_SQUARE_ABS; REAL_LE_ABS_SINH]) in
5182   REPEAT STRIP_TAC THEN
5183   MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`]
5184         CONTRACTIBLE_IMP_HOLOMORPHIC_ACS) THEN
5185   ASM_REWRITE_TAC[] THEN
5186   DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN
5187   MP_TAC(SPEC `(f:complex->complex) a` lemma) THEN
5188   DISCH_THEN(X_CHOOSE_THEN `b:complex` STRIP_ASSUME_TAC) THEN
5189   SUBGOAL_THEN `ccos b = ccos(g(a:complex))` MP_TAC THENL
5190    [ASM_MESON_TAC[]; REWRITE_TAC[CCOS_EQ]] THEN
5191   DISCH_THEN(X_CHOOSE_THEN `n:real` (STRIP_ASSUME_TAC o GSYM)) THENL
5192    [EXISTS_TAC `\z:complex. g z + Cx(&2 * n * pi)`;
5193     EXISTS_TAC `\z:complex. --(g z) + Cx(&2 * n * pi)`] THEN
5194   ASM_SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_NEG;
5195                HOLOMORPHIC_ON_CONST] THEN
5196   CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[CCOS_EQ] THEN
5197   ASM_MESON_TAC[]);;
5198
5199 (* ------------------------------------------------------------------------- *)
5200 (* Extension property for inessential maps. This almost follows from         *)
5201 (* INESSENTIAL_NEIGHBOURHOOD_EXTENSION except that here we don't need to     *)
5202 (* assume that t is closed in s.                                             *)
5203 (* ------------------------------------------------------------------------- *)
5204
5205 let INESSENTIAL_NEIGHBOURHOOD_EXTENSION_LOGARITHM = prove
5206  (`!f:real^N->complex s t.
5207         f continuous_on s /\ t SUBSET s /\
5208         (?g. g continuous_on t /\ !x. x IN t ==> f x = cexp(g x))
5209         ==> ?u. t SUBSET u /\ open_in (subtopology euclidean s) u /\
5210                 (?g. g continuous_on u /\ !x. x IN u ==> f x = cexp(g x))`,
5211   REPEAT GEN_TAC THEN
5212   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5213   DISCH_THEN(X_CHOOSE_THEN `h:real^N->complex` (STRIP_ASSUME_TAC o GSYM)) THEN
5214   SUBGOAL_THEN
5215    `!x. x IN t
5216         ==> ?d. &0 < d /\
5217                 (!y. y IN s /\ dist(x,y) < d
5218                      ==> norm(f y / f x - Cx(&1)) < &1 / &7) /\
5219                 (!z:real^N. z IN t /\ dist(x,z) < &2 * d
5220                             ==> norm(h z - h x) < &1 / &5)`
5221   MP_TAC THENL
5222    [REPEAT STRIP_TAC THEN
5223     UNDISCH_TAC `(h:real^N->complex) continuous_on t` THEN
5224     GEN_REWRITE_TAC LAND_CONV [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
5225     DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
5226     ASM_REWRITE_TAC[continuous_within] THEN
5227     DISCH_THEN(MP_TAC o SPEC `&1 / &5`) THEN
5228     CONV_TAC REAL_RAT_REDUCE_CONV THEN
5229     GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [dist] THEN
5230     DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
5231     SUBGOAL_THEN `~((f:real^N->complex) x = Cx(&0))` ASSUME_TAC THENL
5232      [ASM_MESON_TAC[CEXP_NZ]; ALL_TAC] THEN
5233     SUBGOAL_THEN
5234      `(\y:real^N. f y / f x) continuous (at x within s)`
5235     MP_TAC THENL
5236      [REWRITE_TAC[complex_div] THEN MATCH_MP_TAC CONTINUOUS_COMPLEX_MUL THEN
5237       REWRITE_TAC[CONTINUOUS_CONST] THEN
5238       ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; SUBSET];
5239       REWRITE_TAC[continuous_within] THEN
5240       DISCH_THEN(MP_TAC o SPEC `&1 / &7`) THEN
5241       CONV_TAC REAL_RAT_REDUCE_CONV THEN
5242       ASM_SIMP_TAC[COMPLEX_DIV_REFL; dist] THEN
5243       DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC)] THEN
5244     EXISTS_TAC `min d (e / &2)` THEN
5245     ASM_REWRITE_TAC[REAL_LT_MIN; REAL_HALF] THEN CONJ_TAC THENL
5246      [ASM_MESON_TAC[NORM_SUB];
5247       REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
5248       ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_REWRITE_TAC[] THEN
5249       ASM_REAL_ARITH_TAC];
5250     GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
5251     REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
5252     X_GEN_TAC `d:real^N->real` THEN DISCH_THEN(LABEL_TAC "*")] THEN
5253   ABBREV_TAC `u = \x. s INTER ball(x:real^N,d x)` THEN
5254   ABBREV_TAC `g = \x y. h(x:real^N) + clog(f y / f x)` THEN
5255   SUBGOAL_THEN
5256    `(!x:real^N. x IN t ==> x IN u x) /\
5257     (!x. x IN t ==> open_in (subtopology euclidean s) (u x))`
5258   STRIP_ASSUME_TAC THENL
5259    [EXPAND_TAC "u" THEN
5260     ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL; OPEN_IN_OPEN_INTER; OPEN_BALL] THEN
5261     ASM SET_TAC[];
5262     ALL_TAC] THEN
5263   SUBGOAL_THEN `!x:real^N y:real^N. x IN t /\ y IN u x ==> cexp(g x y) = f y`
5264   ASSUME_TAC THENL
5265    [REPEAT STRIP_TAC THEN
5266     EXPAND_TAC "g" THEN REWRITE_TAC[CEXP_ADD] THEN ASM_SIMP_TAC[] THEN
5267     REMOVE_THEN "*" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
5268     DISCH_THEN(MP_TAC o SPEC `y:real^N` o el 1 o CONJUNCTS) THEN
5269     MP_TAC(ASSUME `y IN (u:real^N->real^N->bool) x`) THEN
5270     EXPAND_TAC "u" THEN REWRITE_TAC[IN_INTER; IN_BALL] THEN
5271     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5272     DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH
5273      `norm(x - y) < &1 / &7 ==> norm(y) = &1 ==> ~(x = vec 0)`)) THEN
5274     SIMP_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM; CEXP_CLOG; COMPLEX_VEC_0] THEN
5275     SIMP_TAC[COMPLEX_DIV_LMUL; COMPLEX_DIV_EQ_0; DE_MORGAN_THM];
5276     ALL_TAC] THEN
5277   MP_TAC(ISPECL
5278    [`g:real^N->real^N->complex`;
5279     `u:real^N->real^N->bool`;
5280     `UNIONS {(u:real^N->real^N->bool) x | x IN t}`;
5281     `t:real^N->bool`]
5282     PASTING_LEMMA_EXISTS) THEN
5283   REWRITE_TAC[SUBSET_REFL] THEN ANTS_TAC THENL
5284    [CONJ_TAC THENL
5285      [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN CONJ_TAC THENL
5286        [MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN
5287         ASM_SIMP_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5288         REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN
5289         ASM_MESON_TAC[OPEN_IN_IMP_SUBSET];
5290         EXPAND_TAC "g" THEN REWRITE_TAC[] THEN
5291         MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
5292         REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
5293         GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
5294         MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
5295          [REWRITE_TAC[complex_div] THEN
5296           MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_RMUL THEN
5297           ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET];
5298           MATCH_MP_TAC CONTINUOUS_ON_CLOG THEN
5299           REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; IN_INTER] THEN
5300           X_GEN_TAC `y:real^N` THEN REPEAT STRIP_TAC THEN
5301           ONCE_REWRITE_TAC[COMPLEX_RING `z = (z - Cx(&1)) + Cx(&1)`] THEN
5302           REWRITE_TAC[RE_ADD; RE_CX] THEN MATCH_MP_TAC(REAL_ARITH
5303            `abs x < &1 ==> &0 < x + &1`) THEN
5304           MATCH_MP_TAC(MESON[COMPLEX_NORM_GE_RE_IM; REAL_LET_TRANS]
5305            `norm z < &1 ==> abs(Re z) < &1`) THEN
5306           MATCH_MP_TAC(REAL_ARITH `x < &1 / &7 ==> x < &1`) THEN
5307           REMOVE_THEN "*" (MP_TAC o SPEC `x:real^N`) THEN ASM_SIMP_TAC[] THEN
5308           DISCH_THEN(MP_TAC o SPEC `y:real^N` o el 1 o CONJUNCTS) THEN
5309           MP_TAC(ASSUME `y IN (u:real^N->real^N->bool) x`) THEN
5310           EXPAND_TAC "u" THEN REWRITE_TAC[IN_INTER; IN_BALL] THEN
5311           STRIP_TAC THEN ASM_REWRITE_TAC[]]];
5312       MAP_EVERY X_GEN_TAC  [`a:real^N`; `b:real^N`; `x:real^N`] THEN
5313       REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN
5314       MATCH_MP_TAC COMPLEX_EQ_CEXP THEN
5315       CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
5316       EXPAND_TAC "g" THEN REWRITE_TAC[IM_ADD] THEN
5317       MATCH_MP_TAC(REAL_ARITH
5318        `&5 < a /\ abs(ha - hb) < &1 / &5 /\ abs(fa) < &2 /\ abs(fb) < &2
5319         ==> abs((ha + fa) - (hb + fb)) < a`) THEN
5320       CONJ_TAC THENL [MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; ALL_TAC] THEN
5321       CONJ_TAC THENL
5322        [REWRITE_TAC[GSYM IM_SUB] THEN
5323         MATCH_MP_TAC(MESON[COMPLEX_NORM_GE_RE_IM; REAL_LET_TRANS]
5324          `norm z < a ==> abs(Im z) < a`) THEN
5325         MP_TAC(ASSUME `x IN (u:real^N->real^N->bool) b`) THEN
5326         MP_TAC(ASSUME `x IN (u:real^N->real^N->bool) a`) THEN
5327         EXPAND_TAC "u" THEN REWRITE_TAC[IMP_IMP; IN_INTER; IN_BALL] THEN
5328         DISCH_THEN(MP_TAC o MATCH_MP (TAUT
5329          `(p /\ q) /\ (p /\ r) ==> q /\ r`)) THEN
5330         DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH
5331          `dist(a,x) < d /\ dist(b,x) < e
5332           ==> dist(a,b) < &2 * d \/ dist(a,b) < &2 * e`)) THEN
5333         STRIP_TAC THENL
5334          [REMOVE_THEN "*" (MP_TAC o SPEC `a:real^N`);
5335           REMOVE_THEN "*" (MP_TAC o SPEC `b:real^N`)] THEN
5336         ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN
5337         ASM_MESON_TAC[NORM_SUB; DIST_SYM];
5338         CONJ_TAC THEN TRANS_TAC REAL_LT_TRANS `pi / &2` THEN
5339         (CONJ_TAC THENL
5340           [ALL_TAC; MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC]) THEN
5341         MATCH_MP_TAC RE_CLOG_POS_LT_IMP THEN
5342         ONCE_REWRITE_TAC[COMPLEX_RING `z = (z - Cx(&1)) + Cx(&1)`] THEN
5343         REWRITE_TAC[RE_ADD; RE_CX] THEN MATCH_MP_TAC(REAL_ARITH
5344          `abs x < &1 ==> &0 < x + &1`) THEN
5345         MATCH_MP_TAC(MESON[COMPLEX_NORM_GE_RE_IM; REAL_LET_TRANS]
5346          `norm z < &1 ==> abs(Re z) < &1`) THEN
5347         MATCH_MP_TAC(REAL_ARITH `x < &1 / &7 ==> x < &1`) THENL
5348          [REMOVE_THEN "*" (MP_TAC o SPEC `a:real^N`);
5349           REMOVE_THEN "*" (MP_TAC o SPEC `b:real^N`)] THEN
5350         ASM_REWRITE_TAC[] THEN
5351         DISCH_THEN(MP_TAC o SPEC `x:real^N` o el 1 o CONJUNCTS) THEN
5352         DISCH_THEN MATCH_MP_TAC THENL
5353          [MP_TAC(ASSUME `x IN (u:real^N->real^N->bool) a`);
5354           MP_TAC(ASSUME `x IN (u:real^N->real^N->bool) b`)] THEN
5355         EXPAND_TAC "u" THEN REWRITE_TAC[IN_INTER; IN_BALL] THEN
5356         STRIP_TAC THEN ASM_REWRITE_TAC[]]];
5357     DISCH_THEN(X_CHOOSE_THEN `h':real^N->complex` STRIP_ASSUME_TAC) THEN
5358     EXISTS_TAC `UNIONS {(u:real^N->real^N->bool) x | x IN t}` THEN
5359     CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5360     ASM_SIMP_TAC[OPEN_IN_UNIONS; FORALL_IN_GSPEC] THEN
5361     EXISTS_TAC `h':real^N->complex` THEN ASM_REWRITE_TAC[] THEN
5362     REWRITE_TAC[FORALL_IN_UNIONS; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
5363     REWRITE_TAC[FORALL_IN_GSPEC] THEN
5364     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
5365     X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
5366     FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^N`; `x:real^N`]) THEN
5367     ASM_REWRITE_TAC[] THEN
5368     ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN
5369     ASM_MESON_TAC[]]);;
5370
5371 (* ------------------------------------------------------------------------- *)
5372 (* The "borsukian" property of sets. This doesn't seem to have a standard    *)
5373 (* name. Kuratowski uses "contractible with respect to [S^1]" while          *)
5374 (* Whyburn uses "property b". It's closely related to unicoherence.          *)
5375 (* ------------------------------------------------------------------------- *)
5376
5377 let borsukian = new_definition
5378  `borsukian(s:real^N->bool) <=>
5379         !f. f continuous_on s /\ IMAGE f s SUBSET ((:real^2) DIFF {Cx(&0)})
5380             ==> ?a. homotopic_with (\h. T) (s,(:real^2) DIFF {Cx(&0)})
5381                                    f (\x. a)`;;
5382
5383 let BORSUKIAN_RETRACTION_GEN = prove
5384  (`!s:real^M->bool t:real^N->bool h k.
5385         h continuous_on s /\ IMAGE h s = t /\
5386         k continuous_on t /\ IMAGE k t SUBSET s /\
5387         (!y. y IN t ==> h(k y) = y) /\
5388         borsukian s
5389         ==> borsukian t`,
5390   REPEAT GEN_TAC THEN REWRITE_TAC[borsukian] THEN STRIP_TAC THEN
5391   FIRST_X_ASSUM(MP_TAC o check (is_forall o concl)) THEN
5392   PURE_ONCE_REWRITE_TAC[TAUT `p /\ q <=> p /\ q /\ T`] THEN
5393   MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
5394     COHOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN) THEN
5395   REWRITE_TAC[] THEN ASM_MESON_TAC[]);;
5396
5397 let RETRACT_OF_BORSUKIAN = prove
5398  (`!s t:real^N->bool. borsukian t /\ s retract_of t ==> borsukian s`,
5399   REPEAT GEN_TAC THEN
5400   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
5401   MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC]
5402         BORSUKIAN_RETRACTION_GEN)) THEN
5403   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN
5404   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^N->real^N` THEN
5405   REWRITE_TAC[RETRACTION] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5406   EXISTS_TAC `\x:real^N. x` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID]);;
5407
5408 let HOMEOMORPHIC_BORSUKIAN = prove
5409  (`!s:real^M->bool t:real^N->bool.
5410         s homeomorphic t /\ borsukian s ==> borsukian t`,
5411   REWRITE_TAC[homeomorphic; homeomorphism] THEN
5412   MESON_TAC[BORSUKIAN_RETRACTION_GEN; SUBSET_REFL]);;
5413
5414 let HOMEOMORPHIC_BORSUKIAN_EQ = prove
5415  (`!s:real^M->bool t:real^N->bool.
5416      s homeomorphic t ==> (borsukian s <=> borsukian t)`,
5417   REPEAT STRIP_TAC THEN EQ_TAC THEN
5418   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_BORSUKIAN) THEN
5419   ASM_MESON_TAC[HOMEOMORPHIC_SYM]);;
5420
5421 let BORSUKIAN_TRANSLATION = prove
5422  (`!a:real^N s. borsukian (IMAGE (\x. a + x) s) <=> borsukian s`,
5423   REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_BORSUKIAN_EQ THEN
5424   REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);;
5425
5426 add_translation_invariants [BORSUKIAN_TRANSLATION];;
5427
5428 let BORSUKIAN_INJECTIVE_LINEAR_IMAGE = prove
5429  (`!f:real^M->real^N s.
5430         linear f /\ (!x y. f x = f y ==> x = y)
5431         ==> (borsukian(IMAGE f s) <=> borsukian s)`,
5432   REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_BORSUKIAN_EQ THEN
5433   ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF;
5434                 HOMEOMORPHIC_REFL]);;
5435
5436 add_linear_invariants [BORSUKIAN_INJECTIVE_LINEAR_IMAGE];;
5437
5438 let HOMOTOPY_EQUIVALENT_BORSUKIANNESS = prove
5439  (`!s:real^M->bool t:real^N->bool.
5440         s homotopy_equivalent t
5441         ==> (borsukian s <=> borsukian t)`,
5442   REPEAT STRIP_TAC THEN REWRITE_TAC[borsukian] THEN
5443   MATCH_MP_TAC HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL THEN
5444   ASM_REWRITE_TAC[]);;
5445
5446 let BORSUKIAN_ALT = prove
5447  (`!s:real^N->bool.
5448         borsukian s <=>
5449         !f g:real^N->real^2.
5450            f continuous_on s /\ IMAGE f s SUBSET ((:real^2) DIFF {Cx(&0)}) /\
5451            g continuous_on s /\ IMAGE g s SUBSET ((:real^2) DIFF {Cx(&0)})
5452            ==> homotopic_with (\h. T) (s,(:real^2) DIFF {Cx (&0)}) f g`,
5453   REWRITE_TAC[borsukian; HOMOTOPIC_TRIVIALITY] THEN
5454   SIMP_TAC[PATH_CONNECTED_PUNCTURED_UNIVERSE; DIMINDEX_2; LE_REFL]);;
5455
5456 let BORSUKIAN_CONTINUOUS_LOGARITHM = prove
5457  (`!s:real^N->bool.
5458         borsukian s <=>
5459         !f. f continuous_on s /\ IMAGE f s SUBSET ((:real^2) DIFF {Cx(&0)})
5460             ==> ?g. g continuous_on s /\ (!x. x IN s ==> f(x) = cexp(g x))`,
5461   REWRITE_TAC[borsukian; INESSENTIAL_EQ_CONTINUOUS_LOGARITHM]);;
5462
5463 let BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE = prove
5464  (`!s:real^N->bool.
5465         borsukian s <=>
5466            !f. f continuous_on s /\ IMAGE f s SUBSET sphere(Cx(&0),&1)
5467                ==> ?g. g continuous_on s /\ (!x. x IN s ==> f(x) = cexp(g x))`,
5468   GEN_TAC THEN REWRITE_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM] THEN
5469   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_SPHERE_0; SET_RULE
5470    `IMAGE f s SUBSET UNIV DIFF {a} <=> !z. z IN s ==> ~(f z = a)`] THEN
5471   EQ_TAC THEN DISCH_TAC THEN
5472   X_GEN_TAC `f:real^N->complex` THEN STRIP_TAC THENL
5473    [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
5474     X_GEN_TAC `x:real^N` THEN REPEAT STRIP_TAC THEN
5475     FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
5476     ASM_REWRITE_TAC[COMPLEX_NORM_0] THEN REAL_ARITH_TAC;
5477     FIRST_X_ASSUM(MP_TAC o SPEC `\x:real^N. f(x) / Cx(norm(f x))`) THEN
5478     ASM_SIMP_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NORM;
5479                  REAL_DIV_REFL; NORM_EQ_0; COMPLEX_NORM_ZERO] THEN
5480     ANTS_TAC THENL
5481      [MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN
5482       ASM_REWRITE_TAC[CX_INJ; COMPLEX_NORM_ZERO; CONTINUOUS_ON_CX_LIFT] THEN
5483       ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_NORM_COMPOSE];
5484       ASM_SIMP_TAC[CX_INJ; COMPLEX_NORM_ZERO; COMPLEX_FIELD
5485        `~(z = Cx(&0)) ==> (w / z = u <=> w = z * u)`] THEN
5486       DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN
5487       EXISTS_TAC
5488        `\x. clog(Cx(norm(f x:complex))) + (g:real^N->complex)(x)` THEN
5489       ASM_SIMP_TAC[CEXP_ADD; CEXP_CLOG; CX_INJ; COMPLEX_NORM_ZERO] THEN
5490       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
5491       ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
5492       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
5493       ASM_SIMP_TAC[CONTINUOUS_ON_CX_LIFT; CONTINUOUS_ON_LIFT_NORM_COMPOSE] THEN
5494       MATCH_MP_TAC CONTINUOUS_ON_CLOG THEN
5495       ASM_SIMP_TAC[IMP_CONJ; FORALL_IN_IMAGE; RE_CX; COMPLEX_NORM_NZ]]]);;
5496
5497 let BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE_CX = prove
5498  (`!s:real^N->bool.
5499         borsukian s <=>
5500             !f. f continuous_on s /\ IMAGE f s SUBSET sphere(Cx(&0),&1)
5501             ==> ?g. (Cx o g) continuous_on s /\
5502                     (!x. x IN s ==> f x = cexp(ii * Cx(g x)))`,
5503   GEN_TAC THEN REWRITE_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE] THEN
5504   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_SPHERE_0] THEN EQ_TAC THEN
5505   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `f:real^N->complex` THEN
5506   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
5507   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL
5508    [X_GEN_TAC `g:real^N->complex` THEN STRIP_TAC THEN
5509     EXISTS_TAC `Im o (g:real^N->complex)` THEN
5510     ASM_SIMP_TAC[CONTINUOUS_ON_CX_IM; CONTINUOUS_ON_COMPOSE; o_ASSOC] THEN
5511     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
5512     REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`)) THEN ASM_REWRITE_TAC[] THEN
5513     ASM_CASES_TAC `(f:real^N->complex) x = cexp(g x)` THEN
5514     ASM_REWRITE_TAC[NORM_CEXP; o_DEF; REAL_EXP_EQ_1] THEN
5515     DISCH_TAC THEN AP_TERM_TAC THEN
5516     ASM_REWRITE_TAC[COMPLEX_EQ; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX] THEN
5517     REWRITE_TAC[REAL_NEG_0];
5518     X_GEN_TAC `g:real^N->real` THEN STRIP_TAC THEN
5519     EXISTS_TAC `\x:real^N. ii * Cx(g x)` THEN
5520     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN
5521     ASM_REWRITE_TAC[GSYM o_DEF]]);;
5522
5523 let BORSUKIAN_CIRCLE = prove
5524  (`!s:real^N->bool.
5525         borsukian s <=>
5526             !f. f continuous_on s /\ IMAGE f s SUBSET sphere(Cx(&0),&1)
5527                 ==> ?a. homotopic_with (\h. T) (s,sphere(Cx(&0),&1))
5528                                                f (\x. a)`,
5529   REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN
5530   REWRITE_TAC[INESSENTIAL_EQ_CONTINUOUS_LOGARITHM_CIRCLE] THEN
5531   REWRITE_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE_CX] THEN
5532   REWRITE_TAC[COMPLEX_VEC_0]);;
5533
5534 let BORSUKIAN_CIRCLE_ALT = prove
5535  (`!s:real^N->bool.
5536         borsukian s <=>
5537         !f g:real^N->real^2.
5538            f continuous_on s /\ IMAGE f s SUBSET sphere(Cx(&0),&1) /\
5539            g continuous_on s /\ IMAGE g s SUBSET sphere(Cx(&0),&1)
5540            ==> homotopic_with (\h. T) (s,sphere(Cx(&0),&1)) f g`,
5541   REWRITE_TAC[BORSUKIAN_CIRCLE; HOMOTOPIC_TRIVIALITY] THEN
5542   SIMP_TAC[PATH_CONNECTED_SPHERE; DIMINDEX_2; LE_REFL]);;
5543
5544 let CONTRACTIBLE_IMP_BORSUKIAN = prove
5545  (`!s:real^N->bool. contractible s ==> borsukian s`,
5546   SIMP_TAC[borsukian; CONTRACTIBLE_IMP_PATH_CONNECTED] THEN
5547   MESON_TAC[NULLHOMOTOPIC_FROM_CONTRACTIBLE]);;
5548
5549 let SIMPLY_CONNECTED_IMP_BORSUKIAN = prove
5550  (`!s:real^N->bool.
5551         simply_connected s /\ locally path_connected s ==> borsukian s`,
5552   SIMP_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM] THEN REPEAT STRIP_TAC THEN
5553   MATCH_MP_TAC CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED THEN
5554   ASM SET_TAC[]);;
5555
5556 let STARLIKE_IMP_BORSUKIAN = prove
5557  (`!s:real^N->bool. starlike s ==> borsukian s`,
5558   SIMP_TAC[CONTRACTIBLE_IMP_BORSUKIAN; STARLIKE_IMP_CONTRACTIBLE]);;
5559
5560 let BORSUKIAN_EMPTY = prove
5561  (`borsukian({}:real^N->bool)`,
5562   SIMP_TAC[CONTRACTIBLE_IMP_BORSUKIAN; CONTRACTIBLE_EMPTY]);;
5563
5564 let BORSUKIAN_UNIV = prove
5565  (`borsukian(:real^N)`,
5566   SIMP_TAC[CONTRACTIBLE_IMP_BORSUKIAN; CONTRACTIBLE_UNIV]);;
5567
5568 let CONVEX_IMP_BORSUKIAN = prove
5569  (`!s:real^N->bool. convex s ==> borsukian s`,
5570   MESON_TAC[STARLIKE_IMP_BORSUKIAN; CONVEX_IMP_STARLIKE; BORSUKIAN_EMPTY]);;
5571
5572 let BORSUKIAN_SPHERE = prove
5573  (`!a:real^N r. 3 <= dimindex(:N) ==> borsukian (sphere(a,r))`,
5574   REPEAT STRIP_TAC THEN MATCH_MP_TAC SIMPLY_CONNECTED_IMP_BORSUKIAN THEN
5575   ASM_SIMP_TAC[SIMPLY_CONNECTED_SPHERE] THEN
5576   REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN
5577   ASM_SIMP_TAC[LOCALLY_PATH_CONNECTED_SPHERE; SIMPLY_CONNECTED_SPHERE]);;
5578
5579 let BORSUKIAN_OPEN_UNION = prove
5580  (`!s t:real^N->bool.
5581         open_in (subtopology euclidean (s UNION t)) s /\
5582         open_in (subtopology euclidean (s UNION t)) t /\
5583         borsukian s /\ borsukian t /\ connected(s INTER t)
5584         ==> borsukian(s UNION t)`,
5585   REPEAT GEN_TAC THEN SIMP_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM] THEN
5586   STRIP_TAC THEN X_GEN_TAC `f:real^N->complex` THEN STRIP_TAC THEN
5587   REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `f:real^N->complex`)) THEN
5588   ANTS_TAC THENL
5589    [CONJ_TAC THENL
5590      [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; ASM SET_TAC[]];
5591     DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC)] THEN
5592   ANTS_TAC THENL
5593    [CONJ_TAC THENL
5594      [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; ASM SET_TAC[]];
5595     DISCH_THEN(X_CHOOSE_THEN `h:real^N->complex` STRIP_ASSUME_TAC)] THEN
5596   ASM_CASES_TAC `s INTER t:real^N->bool = {}` THENL
5597    [EXISTS_TAC `(\x. if x IN s then g x else h x):real^N->complex` THEN
5598     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5599     MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL_OPEN THEN
5600     ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
5601     ALL_TAC] THEN
5602   MP_TAC(ISPECL
5603    [`(\x. g x - h x):real^N->complex`; `s INTER t:real^N->bool`]
5604    CONTINUOUS_DISCRETE_RANGE_CONSTANT) THEN
5605   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
5606    [CONJ_TAC THENL
5607      [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
5608       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET];
5609       X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN
5610       EXISTS_TAC `&2 * pi` THEN
5611       REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN
5612       X_GEN_TAC `y:real^N` THEN
5613       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
5614       ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN
5615       ONCE_REWRITE_TAC[COMPLEX_RING
5616        `a - b:complex = c - d <=> a - c = b - d`] THEN
5617       DISCH_TAC THEN MATCH_MP_TAC COMPLEX_EQ_CEXP THEN
5618       REWRITE_TAC[CEXP_SUB] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
5619       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
5620        REAL_LET_TRANS)) THEN
5621       GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [COMPLEX_RING
5622        `(a - b) - (c - d):complex = (a - c) - (b - d)`] THEN
5623       REWRITE_TAC[GSYM IM_SUB; COMPLEX_NORM_GE_RE_IM]];
5624
5625     REWRITE_TAC[IN_INTER; COMPLEX_EQ_SUB_RADD] THEN
5626     DISCH_THEN(X_CHOOSE_TAC `a:complex`) THEN
5627     EXISTS_TAC `(\x. if x IN s then g x else a + h x):real^N->complex` THEN
5628     CONJ_TAC THENL
5629      [MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL_OPEN THEN
5630       ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST] THEN
5631       ASM SET_TAC[];
5632       GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[] THEN
5633       COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
5634        [ASM_MESON_TAC[]; REWRITE_TAC[CEXP_ADD]] THEN
5635       SUBGOAL_THEN `?y:real^N. y IN s /\ y IN t` STRIP_ASSUME_TAC THENL
5636        [ASM SET_TAC[]; ALL_TAC] THEN
5637       SUBGOAL_THEN `cexp(a + h(y:real^N)) = cexp(h y)` MP_TAC THENL
5638        [ASM_MESON_TAC[]; REWRITE_TAC[CEXP_ADD]] THEN
5639       SIMP_TAC[COMPLEX_RING `a * z = z <=> a = Cx(&1) \/ z = Cx(&0)`;
5640                CEXP_NZ; COMPLEX_MUL_LID] THEN
5641       ASM SET_TAC[]]]);;
5642
5643 let BORSUKIAN_CLOSED_UNION = prove
5644  (`!s t:real^N->bool.
5645         closed_in (subtopology euclidean (s UNION t)) s /\
5646         closed_in (subtopology euclidean (s UNION t)) t /\
5647         borsukian s /\ borsukian t /\ connected(s INTER t)
5648         ==> borsukian(s UNION t)`,
5649   REPEAT GEN_TAC THEN SIMP_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM] THEN
5650   STRIP_TAC THEN X_GEN_TAC `f:real^N->complex` THEN STRIP_TAC THEN
5651   REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `f:real^N->complex`)) THEN
5652   ANTS_TAC THENL
5653    [CONJ_TAC THENL
5654      [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; ASM SET_TAC[]];
5655     DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC)] THEN
5656   ANTS_TAC THENL
5657    [CONJ_TAC THENL
5658      [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; ASM SET_TAC[]];
5659     DISCH_THEN(X_CHOOSE_THEN `h:real^N->complex` STRIP_ASSUME_TAC)] THEN
5660   ASM_CASES_TAC `s INTER t:real^N->bool = {}` THENL
5661    [EXISTS_TAC `(\x. if x IN s then g x else h x):real^N->complex` THEN
5662     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5663     MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
5664     ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
5665     ALL_TAC] THEN
5666   MP_TAC(ISPECL
5667    [`(\x. g x - h x):real^N->complex`; `s INTER t:real^N->bool`]
5668    CONTINUOUS_DISCRETE_RANGE_CONSTANT) THEN
5669   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
5670    [CONJ_TAC THENL
5671      [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
5672       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET];
5673       X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN
5674       EXISTS_TAC `&2 * pi` THEN
5675       REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN
5676       X_GEN_TAC `y:real^N` THEN
5677       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
5678       ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN
5679       ONCE_REWRITE_TAC[COMPLEX_RING
5680        `a - b:complex = c - d <=> a - c = b - d`] THEN
5681       DISCH_TAC THEN MATCH_MP_TAC COMPLEX_EQ_CEXP THEN
5682       REWRITE_TAC[CEXP_SUB] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
5683       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
5684        REAL_LET_TRANS)) THEN
5685       GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [COMPLEX_RING
5686        `(a - b) - (c - d):complex = (a - c) - (b - d)`] THEN
5687       REWRITE_TAC[GSYM IM_SUB; COMPLEX_NORM_GE_RE_IM]];
5688
5689     REWRITE_TAC[IN_INTER; COMPLEX_EQ_SUB_RADD] THEN
5690     DISCH_THEN(X_CHOOSE_TAC `a:complex`) THEN
5691     EXISTS_TAC `(\x. if x IN s then g x else a + h x):real^N->complex` THEN
5692     CONJ_TAC THENL
5693      [MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
5694       ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST] THEN
5695       ASM SET_TAC[];
5696       GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[] THEN
5697       COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
5698        [ASM_MESON_TAC[]; REWRITE_TAC[CEXP_ADD]] THEN
5699       SUBGOAL_THEN `?y:real^N. y IN s /\ y IN t` STRIP_ASSUME_TAC THENL
5700        [ASM SET_TAC[]; ALL_TAC] THEN
5701       SUBGOAL_THEN `cexp(a + h(y:real^N)) = cexp(h y)` MP_TAC THENL
5702        [ASM_MESON_TAC[]; REWRITE_TAC[CEXP_ADD]] THEN
5703       SIMP_TAC[COMPLEX_RING `a * z = z <=> a = Cx(&1) \/ z = Cx(&0)`;
5704                CEXP_NZ; COMPLEX_MUL_LID] THEN
5705       ASM SET_TAC[]]]);;
5706
5707 let BORSUKIAN_SEPARATION_COMPACT = prove
5708  (`!s:real^2->bool.
5709         compact s ==> (borsukian s <=> connected((:real^2) DIFF s))`,
5710   SIMP_TAC[BORSUKIAN_CIRCLE; BORSUK_SEPARATION_THEOREM; DIMINDEX_2; LE_REFL;
5711            COMPLEX_VEC_0]);;
5712
5713 let BORSUKIAN_COMPONENTWISE_EQ = prove
5714  (`!s:real^N->bool.
5715         locally connected s \/ compact s
5716         ==> (borsukian s <=> !c. c IN components s ==> borsukian c)`,
5717   GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[BORSUKIAN_ALT] THEN
5718   MATCH_MP_TAC COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS THEN
5719   ASM_SIMP_TAC[OPEN_IMP_ANR; OPEN_DIFF; OPEN_UNIV; CLOSED_SING]);;
5720
5721 let BORSUKIAN_COMPONENTWISE = prove
5722  (`!s:real^N->bool.
5723         (locally connected s \/ compact s) /\
5724         (!c. c IN components s ==> borsukian c)
5725         ==> borsukian s`,
5726   MESON_TAC[BORSUKIAN_COMPONENTWISE_EQ]);;
5727
5728 let BORSUKIAN_MONOTONE_IMAGE_COMPACT = prove
5729  (`!f:real^M->real^N s t.
5730         f continuous_on s /\ IMAGE f s = t /\ compact s /\
5731         (!y. y IN t ==> connected {x | x IN s /\ f x = y}) /\
5732         borsukian s
5733         ==> borsukian t`,
5734   REPEAT STRIP_TAC THEN REWRITE_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM] THEN
5735   X_GEN_TAC `g:real^N->complex` THEN STRIP_TAC THEN FIRST_X_ASSUM
5736    (MP_TAC o GEN_REWRITE_RULE I [BORSUKIAN_CONTINUOUS_LOGARITHM]) THEN
5737   DISCH_THEN(MP_TAC o SPEC `(g:real^N->complex) o (f:real^M->real^N)`) THEN
5738   ASM_SIMP_TAC[IMAGE_o; CONTINUOUS_ON_COMPOSE; o_THM] THEN
5739   DISCH_THEN(X_CHOOSE_THEN `h:real^M->complex` STRIP_ASSUME_TAC) THEN
5740   SUBGOAL_THEN
5741    `!y. ?x. y IN t ==> x IN s /\ (f:real^M->real^N) x = y`
5742   MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5743   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
5744   X_GEN_TAC `f':real^N->real^M` THEN STRIP_TAC THEN
5745   EXISTS_TAC `(h:real^M->complex) o (f':real^N->real^M)` THEN
5746   REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5747   MATCH_MP_TAC CONTINUOUS_FROM_CLOSED_GRAPH THEN
5748   EXISTS_TAC `IMAGE (h:real^M->complex) s` THEN
5749   ASM_SIMP_TAC[COMPACT_CONTINUOUS_IMAGE; IMAGE_o] THEN
5750   CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[o_THM]] THEN
5751   SUBGOAL_THEN
5752    `{pastecart x ((h:real^M->complex) ((f':real^N->real^M) x)) | x IN t} =
5753     {p | ?x. x IN s /\ pastecart x p IN
5754                        {z | z IN s PCROSS UNIV /\
5755                             (sndcart z - pastecart (f(fstcart z))
5756                                                    (h(fstcart z))) IN {vec 0}}}`
5757   SUBST1_TAC THENL
5758    [ALL_TAC;
5759     MATCH_MP_TAC CLOSED_COMPACT_PROJECTION THEN ASM_REWRITE_TAC[] THEN
5760     MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
5761     ASM_SIMP_TAC[CLOSED_UNIV; CLOSED_PCROSS; COMPACT_IMP_CLOSED] THEN
5762     REWRITE_TAC[CLOSED_SING] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
5763     SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
5764     MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN REWRITE_TAC[GSYM o_DEF] THEN
5765     CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
5766     SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; IMAGE_FSTCART_PCROSS] THEN
5767     ASM_REWRITE_TAC[UNIV_NOT_EMPTY]] THEN
5768   REWRITE_TAC[IN_ELIM_THM; PASTECART_IN_PCROSS; FSTCART_PASTECART;
5769               SNDCART_PASTECART; IN_UNIV; IN_SING; VECTOR_SUB_EQ] THEN
5770   REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM] THEN
5771   REWRITE_TAC[CONJ_ASSOC; PASTECART_INJ] THEN
5772   MAP_EVERY X_GEN_TAC [`y:real^N`; `z:complex`] THEN
5773   ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ r <=> q /\ p /\ r`] THEN
5774   REWRITE_TAC[UNWIND_THM1] THEN EQ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5775   DISCH_THEN(X_CHOOSE_THEN `w:real^M` STRIP_ASSUME_TAC) THEN
5776   CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5777   SUBGOAL_THEN
5778    `?a. !x. x IN {x | x IN s /\ (f:real^M->real^N) x = y}
5779             ==> h x - h(f' y):complex = a`
5780   MP_TAC THENL
5781    [ALL_TAC;
5782     REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
5783     X_GEN_TAC `a:complex` THEN
5784     DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
5785     DISCH_THEN(MP_TAC o SPEC `(f':real^N->real^M) y`) THEN
5786     ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[VECTOR_SUB_REFL]] THEN
5787     DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
5788     RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_SUB_EQ]) THEN ASM SET_TAC[]] THEN
5789   MATCH_MP_TAC CONTINUOUS_DISCRETE_RANGE_CONSTANT THEN
5790   REWRITE_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL
5791    [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[];
5792     MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
5793     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
5794       CONTINUOUS_ON_SUBSET)) THEN SET_TAC[];
5795     ALL_TAC] THEN
5796   X_GEN_TAC `v:real^M` THEN STRIP_TAC THEN
5797   EXISTS_TAC `&2 * pi` THEN
5798   REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN
5799   X_GEN_TAC `u:real^M` THEN
5800   REWRITE_TAC[COMPLEX_RING `a - x:complex = b - x <=> a = b`] THEN
5801   DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
5802   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN
5803   REWRITE_TAC[COMPLEX_RING `(a - x) - (b - x):complex = a - b`] THEN
5804   DISCH_TAC THEN MATCH_MP_TAC COMPLEX_EQ_CEXP THEN
5805   CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[GSYM IM_SUB] THEN
5806   ASM_MESON_TAC[REAL_LET_TRANS; COMPLEX_NORM_GE_RE_IM]);;
5807
5808 let BORSUKIAN_OPEN_MAP_IMAGE_COMPACT = prove
5809  (`!f:real^M->real^N s t.
5810         f continuous_on s /\ IMAGE f s = t /\ compact s /\
5811         (!u. open_in (subtopology euclidean s) u
5812              ==> open_in (subtopology euclidean t) (IMAGE f u)) /\
5813         borsukian s
5814         ==> borsukian t`,
5815   REPEAT GEN_TAC THEN
5816   REWRITE_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE_CX] THEN STRIP_TAC THEN
5817   X_GEN_TAC `g:real^N->complex` THEN STRIP_TAC THEN
5818   FIRST_X_ASSUM(MP_TAC o SPEC `(g:real^N->complex) o (f:real^M->real^N)`) THEN
5819   ASM_SIMP_TAC[IMAGE_o; CONTINUOUS_ON_COMPOSE; o_THM] THEN
5820   DISCH_THEN(X_CHOOSE_THEN `h:real^M->real` STRIP_ASSUME_TAC) THEN
5821   SUBGOAL_THEN
5822    `!y. ?x. y IN t ==> x IN s /\ (f:real^M->real^N) x = y /\
5823                        (!x'. x' IN s /\ f x' = y ==> h x <= h x')`
5824   MP_TAC THENL
5825    [REWRITE_TAC[RIGHT_EXISTS_IMP_THM] THEN REPEAT STRIP_TAC THEN
5826     MP_TAC(ISPEC `{ h x:real | x IN s /\ (f:real^M->real^N) x = y}`
5827          COMPACT_ATTAINS_INF) THEN
5828     REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC; GSYM CONJ_ASSOC] THEN
5829     DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5830     ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[GSYM IMAGE_o] THEN
5831     MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN CONJ_TAC THENL
5832      [REWRITE_TAC[o_DEF; GSYM CONTINUOUS_ON_CX_LIFT] THEN
5833       GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
5834       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
5835         CONTINUOUS_ON_SUBSET)) THEN SET_TAC[];
5836       ONCE_REWRITE_TAC[SET_RULE `x = y <=> x IN {y}`] THEN
5837       MATCH_MP_TAC PROPER_MAP_FROM_COMPACT THEN
5838       ASM_REWRITE_TAC[CLOSED_IN_SING; SUBSET_REFL]];
5839     REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN
5840   X_GEN_TAC `k:real^N->real^M` THEN DISCH_TAC THEN
5841   EXISTS_TAC `(h:real^M->real) o (k:real^N->real^M)` THEN
5842   REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
5843   REWRITE_TAC[continuous_on] THEN X_GEN_TAC `y:real^N` THEN
5844   DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5845   MP_TAC(ISPECL [`Cx o (h:real^M->real)`; `s:real^M->bool`]
5846         COMPACT_UNIFORMLY_CONTINUOUS) THEN
5847   ASM_REWRITE_TAC[uniformly_continuous_on] THEN
5848   DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[o_THM; DIST_CX] THEN
5849   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
5850   MP_TAC(ISPECL
5851    [`\y. {x | x IN s /\ (f:real^M->real^N) x = y}`;
5852     `s:real^M->bool`; `t:real^N->bool`]
5853     UPPER_LOWER_HEMICONTINUOUS_EXPLICIT) THEN
5854   ASM_SIMP_TAC[GSYM CLOSED_MAP_IFF_UPPER_HEMICONTINUOUS_PREIMAGE;
5855                GSYM OPEN_MAP_IFF_LOWER_HEMICONTINUOUS_PREIMAGE;
5856                SUBSET_REFL; SUBSET_RESTRICT] THEN
5857   ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_IMP_CLOSED_MAP]; ALL_TAC] THEN
5858   DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `d:real`]) THEN
5859   ASM_REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN ANTS_TAC THENL
5860    [CONJ_TAC THENL [MATCH_MP_TAC COMPACT_IMP_BOUNDED; ASM SET_TAC[]] THEN
5861     MATCH_MP_TAC CLOSED_IN_COMPACT THEN EXISTS_TAC `s:real^M->bool` THEN
5862     ASM_REWRITE_TAC[SET_RULE `x IN s /\ f x = y <=> x IN s /\ f x IN {y}`] THEN
5863     MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN
5864     EXISTS_TAC `t:real^N->bool` THEN
5865     ASM_REWRITE_TAC[CLOSED_IN_SING; SUBSET_REFL];
5866     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real` THEN
5867     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))] THEN
5868   ASM_REWRITE_TAC[] THEN X_GEN_TAC `y':real^N` THEN STRIP_TAC THEN
5869   REMOVE_THEN "*" (MP_TAC o SPEC `y':real^N`) THEN
5870   ANTS_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN
5871   DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `(k:real^N->real^M) y`)
5872                              (MP_TAC o SPEC `(k:real^N->real^M) y'`)) THEN
5873   ASM_SIMP_TAC[] THEN
5874   DISCH_THEN(X_CHOOSE_THEN `w:real^M` STRIP_ASSUME_TAC) THEN
5875   DISCH_THEN(X_CHOOSE_THEN `w':real^M` STRIP_ASSUME_TAC) THEN
5876   FIRST_ASSUM(MP_TAC o SPEC `y':real^N`) THEN
5877   FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN
5878   ASM_SIMP_TAC[] THEN
5879   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5880   DISCH_THEN(MP_TAC o SPEC `w:real^M`) THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN
5881   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5882   DISCH_THEN(MP_TAC o SPEC `w':real^M`) THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN
5883   FIRST_ASSUM(MP_TAC o SPECL [`w:real^M`; `(k:real^N->real^M) y'`]) THEN
5884   FIRST_X_ASSUM(MP_TAC o SPECL [`w':real^M`; `(k:real^N->real^M) y`]) THEN
5885   ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);;
5886
5887 (* ------------------------------------------------------------------------- *)
5888 (* Unicoherence (closed).                                                    *)
5889 (* ------------------------------------------------------------------------- *)
5890
5891 let unicoherent = new_definition
5892  `unicoherent(u:real^N->bool) <=>
5893   !s t. connected s /\ connected t /\ s UNION t = u /\
5894         closed_in (subtopology euclidean u) s /\
5895         closed_in (subtopology euclidean u) t
5896         ==> connected (s INTER t)`;;
5897
5898 let HOMEOMORPHIC_UNICOHERENT = prove
5899  (`!s:real^M->bool t:real^N->bool.
5900         s homeomorphic t /\ unicoherent s ==> unicoherent t`,
5901   REPEAT STRIP_TAC THEN
5902   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
5903   REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN
5904   MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
5905   STRIP_TAC THEN REWRITE_TAC[unicoherent] THEN
5906   MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
5907   STRIP_TAC THEN
5908   SUBGOAL_THEN
5909    `u INTER v = IMAGE (f:real^M->real^N)
5910                 (IMAGE (g:real^N->real^M) u INTER IMAGE g v)`
5911   SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5912   MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN CONJ_TAC THENL
5913    [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
5914       CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[];
5915     ALL_TAC] THEN
5916   FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [unicoherent]) THEN
5917   ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> r /\ (p /\ q) /\ s`] THEN
5918   CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5919   CONJ_TAC THENL
5920    [CONJ_TAC THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
5921     ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
5922      (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[];
5923     CONJ_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_CLOSED_MAP THEN
5924     MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `t:real^N->bool`] THEN
5925     ASM_REWRITE_TAC[homeomorphism]]);;
5926
5927 let HOMEOMORPHIC_UNICOHERENT_EQ = prove
5928  (`!s:real^M->bool t:real^N->bool.
5929      s homeomorphic t ==> (unicoherent s <=> unicoherent t)`,
5930   REPEAT STRIP_TAC THEN EQ_TAC THEN
5931   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_UNICOHERENT) THEN
5932   ASM_MESON_TAC[HOMEOMORPHIC_SYM]);;
5933
5934 let UNICOHERENT_TRANSLATION = prove
5935  (`!a:real^N s. unicoherent (IMAGE (\x. a + x) s) <=> unicoherent s`,
5936   REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_UNICOHERENT_EQ THEN
5937   REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);;
5938
5939 add_translation_invariants [UNICOHERENT_TRANSLATION];;
5940
5941 let UNICOHERENT_INJECTIVE_LINEAR_IMAGE = prove
5942  (`!f:real^M->real^N s.
5943         linear f /\ (!x y. f x = f y ==> x = y)
5944         ==> (unicoherent(IMAGE f s) <=> unicoherent s)`,
5945   REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_UNICOHERENT_EQ THEN
5946   ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF;
5947                 HOMEOMORPHIC_REFL]);;
5948
5949 add_linear_invariants [UNICOHERENT_INJECTIVE_LINEAR_IMAGE];;
5950
5951 let BORSUKIAN_IMP_UNICOHERENT = prove
5952  (`!u:real^N->bool. borsukian u ==> unicoherent u`,
5953   GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[unicoherent] THEN
5954   SUBGOAL_THEN
5955    `!f. f continuous_on u /\ IMAGE f u SUBSET sphere(vec 0,&1)
5956              ==> ?a. homotopic_with (\h. T)
5957                      (u,(:complex) DIFF {Cx (&0)}) (f:real^N->complex) (\t. a)`
5958   MP_TAC THENL
5959    [FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I
5960      [BORSUKIAN_CIRCLE]) THEN
5961     X_GEN_TAC `f:real^N->complex` THEN STRIP_TAC THEN
5962     FIRST_X_ASSUM(MP_TAC o SPEC `f:real^N->complex`) THEN
5963     ASM_REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN
5964     MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
5965     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_SUBSET_RIGHT) THEN
5966     REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF {a} <=> ~(a IN s)`] THEN
5967     REWRITE_TAC[IN_SPHERE; DIST_REFL] THEN REAL_ARITH_TAC;
5968     POP_ASSUM(K ALL_TAC)] THEN
5969   REWRITE_TAC[sphere; DIST_0; INESSENTIAL_EQ_CONTINUOUS_LOGARITHM] THEN
5970   REPEAT STRIP_TAC THEN SIMP_TAC[CONNECTED_CLOSED_IN_EQ; NOT_EXISTS_THM] THEN
5971   MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `w:real^N->bool`] THEN STRIP_TAC THEN
5972   SUBGOAL_THEN
5973    `closed_in (subtopology euclidean u) (v:real^N->bool) /\
5974     closed_in (subtopology euclidean u) (w:real^N->bool)`
5975   STRIP_ASSUME_TAC THENL
5976    [ASM_MESON_TAC[CLOSED_IN_INTER; CLOSED_IN_TRANS]; ALL_TAC] THEN
5977   MP_TAC(ISPECL
5978    [`v:real^N->bool`; `w:real^N->bool`; `u:real^N->bool`;
5979     `vec 0:real^1`; `vec 1:real^1`] URYSOHN_LOCAL) THEN
5980   ASM_REWRITE_TAC[] THEN
5981   DISCH_THEN(X_CHOOSE_THEN `q:real^N->real^1` STRIP_ASSUME_TAC) THEN
5982   SUBGOAL_THEN
5983    `?g:real^N->real^2.
5984         g continuous_on u /\ IMAGE g u SUBSET {x | norm x = &1} /\
5985         (!x. x IN s ==> g(x) = cexp(Cx pi * ii * Cx(drop(q x)))) /\
5986         (!x. x IN t ==> g(x) = inv(cexp(Cx pi * ii * Cx(drop(q x)))))`
5987   (DESTRUCT_TAC "@g. cont circle s t") THENL
5988    [EXISTS_TAC
5989      `\x. if (x:real^N) IN s then cexp(Cx pi * ii * Cx(drop(q x)))
5990           else inv(cexp(Cx pi * ii * Cx(drop(q x))))` THEN
5991     SUBGOAL_THEN
5992      `!x:real^N.
5993         x IN s INTER t
5994         ==> cexp(Cx pi * ii * Cx(drop(q x))) =
5995             inv(cexp(Cx pi * ii * Cx(drop (q x))))`
5996     ASSUME_TAC THENL
5997      [SUBST1_TAC(SYM(ASSUME `v UNION w:real^N->bool = s INTER t`)) THEN
5998       REWRITE_TAC[IN_UNION] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN
5999       REWRITE_TAC[DROP_VEC; COMPLEX_MUL_RZERO; CEXP_0; COMPLEX_INV_1] THEN
6000       REWRITE_TAC[COMPLEX_MUL_RID; EULER] THEN
6001       REWRITE_TAC[RE_MUL_CX; IM_MUL_CX; RE_MUL_II; IM_MUL_II] THEN
6002       REWRITE_TAC[RE_II; IM_II; REAL_MUL_RZERO; REAL_MUL_RID] THEN
6003       REWRITE_TAC[REAL_EXP_0; COMPLEX_MUL_LID; COS_PI; SIN_PI] THEN
6004       REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN
6005       CONV_TAC COMPLEX_RING;
6006       ALL_TAC] THEN
6007     SIMP_TAC[] THEN REPEAT CONJ_TAC THENL
6008      [EXPAND_TAC "u" THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
6009       ASM_REWRITE_TAC[SET_RULE
6010        `P /\ ~P \/ x IN t /\ x IN s <=> x IN s INTER t`] THEN
6011       CONJ_TAC THENL
6012        [ALL_TAC;
6013         MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_INV THEN REWRITE_TAC[CEXP_NZ]] THEN
6014       GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
6015       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
6016       REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN
6017       REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN
6018       MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN
6019       REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
6020       MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN
6021       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION];
6022       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
6023       REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
6024       REWRITE_TAC[COMPLEX_NORM_INV; NORM_CEXP] THEN
6025       REWRITE_TAC[RE_MUL_CX; RE_MUL_II; IM_CX] THEN
6026       REWRITE_TAC[REAL_MUL_RZERO; REAL_NEG_0; REAL_EXP_0; REAL_INV_1];
6027       GEN_TAC THEN DISCH_TAC THEN COND_CASES_TAC THEN
6028       ASM_REWRITE_TAC[] THEN ASM SET_TAC[]];
6029      FIRST_X_ASSUM(MP_TAC o SPEC `g:real^N->complex`) THEN
6030      ASM_REWRITE_TAC[] THEN
6031      DISCH_THEN(X_CHOOSE_THEN `h:real^N->complex` STRIP_ASSUME_TAC)] THEN
6032   SUBGOAL_THEN
6033    `(?n. integer n /\
6034          !x:real^N. x IN s
6035                     ==> h(x) - Cx pi * ii * Cx (drop (q x)) =
6036                         Cx(&2 * n * pi) * ii) /\
6037     (?n. integer n /\
6038          !x:real^N. x IN t
6039                     ==> h(x) + Cx pi * ii * Cx (drop (q x)) =
6040                         Cx(&2 * n * pi) * ii)`
6041   (CONJUNCTS_THEN2
6042     (X_CHOOSE_THEN `m:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))
6043     (X_CHOOSE_THEN `n:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)))
6044   THENL
6045    [CONJ_TAC THEN MATCH_MP_TAC(MESON[]
6046      `(?x. x IN s) /\
6047       (!x. x IN s ==> ?n. P n /\ f x = k n) /\
6048       (?a. !x. x IN s ==> f x = a)
6049       ==> (?n. P n /\ !x. x IN s ==> f x = k n)`) THEN
6050     (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
6051     MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN
6052    (CONJ_TAC THENL
6053      [REWRITE_TAC[COMPLEX_RING `a + b:complex = c <=> a = --b + c`;
6054                   COMPLEX_RING `a - b:complex = c <=> a = b + c`] THEN
6055       REWRITE_TAC[GSYM CEXP_EQ; CEXP_NEG] THEN ASM SET_TAC[];
6056       ALL_TAC] THEN
6057     DISCH_THEN(LABEL_TAC "*") THEN
6058     MATCH_MP_TAC CONTINUOUS_DISCRETE_RANGE_CONSTANT THEN
6059     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6060      [(MATCH_MP_TAC CONTINUOUS_ON_ADD ORELSE
6061        MATCH_MP_TAC CONTINUOUS_ON_SUB) THEN
6062       CONJ_TAC THENL
6063        [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; ALL_TAC] THEN
6064       REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN
6065       MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN
6066       REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
6067       MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN
6068       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION];
6069       X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `&2 * pi` THEN
6070       REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN
6071       X_GEN_TAC `y:real^N` THEN
6072       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
6073       REMOVE_THEN "*" (fun th ->
6074        MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN
6075       ASM_REWRITE_TAC[] THEN STRIP_TAC THEN STRIP_TAC THEN
6076       ASM_REWRITE_TAC[] THEN
6077       REWRITE_TAC[COMPLEX_EQ_MUL_RCANCEL; II_NZ; GSYM COMPLEX_SUB_RDISTRIB;
6078             COMPLEX_NORM_MUL; CX_INJ; COMPLEX_NORM_II; REAL_MUL_RID] THEN
6079       REWRITE_TAC[GSYM CX_SUB; COMPLEX_NORM_CX] THEN
6080       REWRITE_TAC[REAL_EQ_MUL_LCANCEL; GSYM REAL_SUB_LDISTRIB] THEN
6081       REWRITE_TAC[GSYM REAL_SUB_RDISTRIB; REAL_ABS_MUL] THEN
6082       REWRITE_TAC[REAL_EQ_MUL_RCANCEL; PI_NZ; REAL_ABS_PI] THEN
6083       REWRITE_TAC[REAL_ABS_NUM; REAL_OF_NUM_EQ; ARITH_EQ] THEN
6084       DISCH_TAC THEN REWRITE_TAC[REAL_ARITH
6085        `&2 * p <= &2 * a * p <=> &0 <= &2 * p * (a - &1)`] THEN
6086       MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN
6087       MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[PI_POS_LE; REAL_SUB_LE] THEN
6088       MATCH_MP_TAC REAL_ABS_INTEGER_LEMMA THEN
6089       ASM_SIMP_TAC[INTEGER_CLOSED; REAL_SUB_0]]);
6090       ALL_TAC] THEN
6091   GEN_REWRITE_TAC I [TAUT `p ==> q ==> F <=> ~(p /\ q)`] THEN
6092   DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
6093    `(!x. x IN s ==> P x) /\ (!x. x IN t ==> Q x)
6094     ==> ~(v = {}) /\ ~(w = {}) /\ v UNION w SUBSET s INTER t
6095          ==> ~(!y z. y IN v /\ z IN w ==> ~(P y /\ Q y /\ P z /\ Q z))`)) THEN
6096   ANTS_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[]] THEN
6097   REPEAT GEN_TAC THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (COMPLEX_RING
6098    `y + p = n /\ y - p = m /\ z + q = n /\ z - q = m ==> q:complex = p`)) THEN
6099   REWRITE_TAC[DROP_VEC; COMPLEX_MUL_RZERO; COMPLEX_ENTIRE; CX_INJ] THEN
6100   REWRITE_TAC[PI_NZ; II_NZ; REAL_OF_NUM_EQ; ARITH_EQ]);;
6101
6102 let CONTRACTIBLE_IMP_UNICOHERENT = prove
6103  (`!u:real^N->bool. contractible u ==> unicoherent u`,
6104   SIMP_TAC[BORSUKIAN_IMP_UNICOHERENT; CONTRACTIBLE_IMP_BORSUKIAN]);;
6105
6106 let CONVEX_IMP_UNICOHERENT = prove
6107  (`!u:real^N->bool. convex u ==> unicoherent u`,
6108   SIMP_TAC[BORSUKIAN_IMP_UNICOHERENT; CONVEX_IMP_BORSUKIAN]);;
6109
6110 let UNICOHERENT_UNIV = prove
6111  (`unicoherent(:real^N)`,
6112   SIMP_TAC[CONVEX_IMP_UNICOHERENT; CONVEX_UNIV]);;
6113
6114 let UNICOHERENT_MONOTONE_IMAGE_COMPACT = prove
6115  (`!f:real^M->real^N s t.
6116         f continuous_on s /\ IMAGE f s = t /\ compact s /\
6117         (!y. y IN t ==> connected {x | x IN s /\ f x = y}) /\
6118         unicoherent s
6119         ==> unicoherent t`,
6120   REPEAT STRIP_TAC THEN
6121   SUBGOAL_THEN `compact(t:real^N->bool)` ASSUME_TAC THENL
6122    [ASM_MESON_TAC[COMPACT_CONTINUOUS_IMAGE]; REWRITE_TAC[unicoherent]] THEN
6123   MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN
6124   ASM_SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED] THEN
6125   STRIP_TAC THEN
6126   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [unicoherent]) THEN
6127   DISCH_THEN(MP_TAC o SPECL
6128    [`{x | x IN s /\ (f:real^M->real^N) x IN u}`;
6129     `{x | x IN s /\ (f:real^M->real^N) x IN v}`]) THEN
6130   ASM_SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED; SUBSET_RESTRICT;
6131                CONTINUOUS_CLOSED_PREIMAGE; CONJ_ASSOC] THEN
6132   REWRITE_TAC[IMP_CONJ_ALT] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
6133
6134   MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^N->bool`]
6135     CONNECTED_CLOSED_MONOTONE_PREIMAGE) THEN
6136
6137   ASM_REWRITE_TAC[] THEN
6138   ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_IMP_CLOSED_MAP]; ALL_TAC] THEN
6139   DISCH_TAC THEN ASM_SIMP_TAC[] THEN
6140   DISCH_THEN(MP_TAC o ISPEC `f:real^M->real^N` o MATCH_MP
6141    (REWRITE_RULE[IMP_CONJ_ALT] CONNECTED_CONTINUOUS_IMAGE)) THEN
6142   ANTS_TAC THENL
6143    [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
6144         CONTINUOUS_ON_SUBSET)) THEN SET_TAC[];
6145     MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]);;
6146
6147 (* ------------------------------------------------------------------------- *)
6148 (* Several common variants of unicoherence for R^n.                          *)
6149 (* ------------------------------------------------------------------------- *)
6150
6151 let CONNECTED_FRONTIER_SIMPLE = prove
6152  (`!s. connected(s) /\ connected((:real^N) DIFF s) ==> connected(frontier s)`,
6153   REPEAT STRIP_TAC THEN REWRITE_TAC[FRONTIER_CLOSURES] THEN
6154   MATCH_MP_TAC(REWRITE_RULE[unicoherent] UNICOHERENT_UNIV) THEN
6155   REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN
6156   ASM_SIMP_TAC[CLOSED_CLOSURE; CONNECTED_CLOSURE] THEN
6157   MATCH_MP_TAC(SET_RULE
6158    `s SUBSET closure s /\ t SUBSET closure t /\ s UNION t = UNIV
6159     ==> closure s UNION closure t = UNIV`) THEN
6160   REWRITE_TAC[CLOSURE_SUBSET] THEN SET_TAC[]);;
6161
6162 let CONNECTED_FRONTIER_COMPONENT_COMPLEMENT = prove
6163  (`!s c:real^N->bool.
6164         connected s /\ c IN components((:real^N) DIFF s)
6165         ==> connected(frontier c)`,
6166   REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_FRONTIER_SIMPLE THEN
6167   CONJ_TAC THENL
6168    [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED];
6169     MATCH_MP_TAC COMPONENT_COMPLEMENT_CONNECTED THEN
6170     EXISTS_TAC `s:real^N->bool` THEN
6171     ASM_REWRITE_TAC[SUBSET_UNIV; CONNECTED_UNIV]]);;
6172
6173 let CONNECTED_FRONTIER_DISJOINT = prove
6174  (`!s t:real^N->bool.
6175      connected s /\ connected t /\ DISJOINT s t /\ frontier s SUBSET frontier t
6176      ==> connected(frontier s)`,
6177   REPEAT STRIP_TAC THEN ASM_CASES_TAC `s = (:real^N)` THEN
6178   ASM_REWRITE_TAC[FRONTIER_UNIV; CONNECTED_EMPTY] THEN
6179   SUBGOAL_THEN `?c. c IN components((:real^N) DIFF s) /\ t SUBSET c`
6180   STRIP_ASSUME_TAC THENL
6181    [MATCH_MP_TAC EXISTS_COMPONENT_SUPERSET THEN ASM SET_TAC[]; ALL_TAC] THEN
6182   SUBGOAL_THEN `frontier s:real^N->bool = frontier c` SUBST1_TAC THENL
6183    [ALL_TAC; ASM_MESON_TAC[CONNECTED_FRONTIER_COMPONENT_COMPLEMENT]] THEN
6184   MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
6185    [REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
6186     REWRITE_TAC[frontier; IN_DIFF] THEN CONJ_TAC THENL
6187      [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET] o
6188        MATCH_MP SUBSET_CLOSURE) THEN
6189       ASM_MESON_TAC[SUBSET; frontier; IN_DIFF];
6190       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV
6191         [GSYM FRONTIER_COMPLEMENT]) THEN
6192       REWRITE_TAC[frontier] THEN
6193       MATCH_MP_TAC(SET_RULE `u SUBSET t ==> x IN s DIFF t ==> ~(x IN u)`) THEN
6194       MATCH_MP_TAC SUBSET_INTERIOR THEN
6195       ASM_MESON_TAC[IN_COMPONENTS_SUBSET]];
6196     GEN_REWRITE_TAC RAND_CONV [GSYM FRONTIER_COMPLEMENT] THEN
6197     ASM_MESON_TAC[FRONTIER_OF_COMPONENTS_SUBSET]]);;
6198
6199 let SEPARATION_BY_COMPONENT_CLOSED_POINTWISE = prove
6200  (`!s a b. closed s /\ ~connected_component ((:real^N) DIFF s) a b
6201            ==> ?c. c IN components s /\
6202                    ~connected_component((:real^N) DIFF c) a b`,
6203   REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THENL
6204    [EXISTS_TAC `connected_component s (a:real^N)` THEN
6205     ASM_REWRITE_TAC[IN_COMPONENTS] THEN
6206     CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
6207     DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN
6208     REWRITE_TAC[IN_UNIV; IN_DIFF] THEN REWRITE_TAC[IN] THEN
6209     ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ];
6210     ALL_TAC] THEN
6211   ASM_CASES_TAC `(b:real^N) IN s` THENL
6212    [EXISTS_TAC `connected_component s (b:real^N)` THEN
6213     ASM_REWRITE_TAC[IN_COMPONENTS] THEN
6214     CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
6215     DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN
6216     REWRITE_TAC[IN_UNIV; IN_DIFF] THEN REWRITE_TAC[IN] THEN
6217     ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ];
6218     ALL_TAC] THEN
6219   FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IRREDUCIBLE_SEPARATOR) THEN
6220   DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
6221   SUBGOAL_THEN `?c:real^N->bool. c IN components s /\ t SUBSET c` MP_TAC THENL
6222    [MATCH_MP_TAC EXISTS_COMPONENT_SUPERSET THEN ASM_REWRITE_TAC[];
6223     MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN
6224     ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
6225      `~(t b) ==> s SUBSET t ==> ~(s b)`)) THEN
6226     REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN
6227     ASM SET_TAC[]] THEN
6228   CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
6229   MP_TAC(ISPECL [`connected_component ((:real^N) DIFF t) a`;
6230                  `connected_component ((:real^N) DIFF t) b`]
6231         CONNECTED_FRONTIER_DISJOINT) THEN
6232   REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; CONNECTED_COMPONENT_DISJOINT] THEN
6233   ASM_REWRITE_TAC[IN] THEN ONCE_REWRITE_TAC[CONNECTED_COMPONENT_SYM_EQ] THEN
6234   SUBGOAL_THEN
6235    `frontier(connected_component ((:real^N) DIFF t) a) = t /\
6236     frontier(connected_component ((:real^N) DIFF t) b) = t`
6237    (fun th -> ASM_REWRITE_TAC[th; SUBSET_REFL]) THEN
6238   CONJ_TAC THEN MATCH_MP_TAC FRONTIER_MINIMAL_SEPARATING_CLOSED_POINTWISE THENL
6239    [EXISTS_TAC `b:real^N`; EXISTS_TAC `a:real^N`] THEN
6240   ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[CONNECTED_COMPONENT_SYM_EQ] THEN
6241   ASM_SIMP_TAC[] THEN ASM SET_TAC[]);;
6242
6243 let SEPARATION_BY_COMPONENT_CLOSED = prove
6244  (`!s. closed s /\ ~connected((:real^N) DIFF s)
6245        ==> ?c. c IN components s /\ ~connected((:real^N) DIFF c)`,
6246   REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT; IN_DIFF; IN_UNIV] THEN
6247   MP_TAC SEPARATION_BY_COMPONENT_CLOSED_POINTWISE THEN
6248   MATCH_MP_TAC MONO_FORALL THEN
6249   MESON_TAC[REWRITE_RULE[SUBSET] IN_COMPONENTS_SUBSET]);;
6250
6251 let SEPARATION_BY_UNION_CLOSED_POINTWISE = prove
6252  (`!s t a b. closed s /\ closed t /\ DISJOINT s t /\
6253              connected_component ((:real^N) DIFF s) a b /\
6254              connected_component ((:real^N) DIFF t) a b
6255              ==> connected_component ((:real^N) DIFF (s UNION t)) a b`,
6256   REPEAT GEN_TAC THEN
6257   REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
6258   DISCH_THEN(CONJUNCTS_THEN (fun th ->
6259     ASSUME_TAC th THEN MP_TAC(MATCH_MP CONNECTED_COMPONENT_IN th))) THEN
6260   REWRITE_TAC[IN_DIFF; IN_UNIV] THEN REPEAT STRIP_TAC THEN
6261   GEN_REWRITE_TAC I [TAUT `p <=> ~ ~ p`] THEN DISCH_THEN(MP_TAC o MATCH_MP
6262    (REWRITE_RULE[IMP_CONJ_ALT] SEPARATION_BY_COMPONENT_CLOSED_POINTWISE)) THEN
6263   ASM_SIMP_TAC[CLOSED_UNION; NOT_EXISTS_THM] THEN
6264   X_GEN_TAC `c:real^N->bool` THEN
6265   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
6266   REWRITE_TAC[] THEN
6267   SUBGOAL_THEN `(c:real^N->bool) SUBSET s \/ c SUBSET t` STRIP_ASSUME_TAC THENL
6268    [FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
6269     FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN
6270     REWRITE_TAC[CONNECTED_CLOSED; NOT_EXISTS_THM] THEN
6271     DISCH_THEN(MP_TAC o SPECL [`s:real^N->bool`; `t:real^N->bool`]) THEN
6272     ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
6273     UNDISCH_TAC `connected_component ((:real^N) DIFF s) a b`;
6274     UNDISCH_TAC `connected_component ((:real^N) DIFF t) a b`] THEN
6275   MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s b ==> t b`) THEN
6276   REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN
6277   ASM SET_TAC[]);;
6278
6279 let SEPARATION_BY_UNION_CLOSED = prove
6280  (`!s t:real^N->bool.
6281         closed s /\ closed t /\ DISJOINT s t /\
6282         connected((:real^N) DIFF s) /\
6283         connected((:real^N) DIFF t)
6284         ==> connected((:real^N) DIFF (s UNION t))`,
6285   SIMP_TAC[CONNECTED_IFF_CONNECTED_COMPONENT; IN_DIFF; IN_UNION; IN_UNIV] THEN
6286   MESON_TAC[SEPARATION_BY_UNION_CLOSED_POINTWISE]);;
6287
6288 let OPEN_UNICOHERENT_UNIV = prove
6289  (`!s t. open s /\ open t /\ connected s /\ connected t /\
6290          s UNION t = (:real^N)
6291          ==> connected(s INTER t)`,
6292   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE
6293    `s INTER t = UNIV DIFF ((UNIV DIFF s) UNION (UNIV DIFF t))`] THEN
6294   MATCH_MP_TAC SEPARATION_BY_UNION_CLOSED THEN
6295   ASM_SIMP_TAC[GSYM OPEN_CLOSED; SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN
6296   ASM SET_TAC[]);;
6297
6298 let SEPARATION_BY_COMPONENT_OPEN = prove
6299  (`!s. open s /\ ~connected((:real^N) DIFF s)
6300        ==> ?c. c IN components s /\ ~connected((:real^N) DIFF c)`,
6301   let lemma = prove
6302    (`!s t u. closed s /\ closed t /\ s INTER t = {} /\
6303              connected u /\ ~(u INTER s = {}) /\ ~(u INTER t = {})
6304              ==> ?c. c IN components((:real^N) DIFF (s UNION t)) /\
6305                      ~(c INTER u = {}) /\
6306                      ~(frontier c INTER s = {}) /\
6307                      ~(frontier c INTER t = {})`,
6308     REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[MESON[]
6309      `(?x. P x /\ Q x /\ R x) <=> ~(!x. P x /\ Q x ==> ~R x)`] THEN
6310     DISCH_TAC THEN
6311     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_CLOSED]) THEN
6312     REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC
6313      [`s UNION
6314        UNIONS {c | c IN components((:real^N) DIFF (s UNION t)) /\
6315                    frontier c SUBSET s}`;
6316       `t UNION
6317         UNIONS {c | c IN components((:real^N) DIFF (s UNION t)) /\
6318                     frontier c SUBSET t}`] THEN
6319     REPLICATE_TAC 2 (CONJ_TAC THENL
6320      [REWRITE_TAC[GSYM FRONTIER_SUBSET_EQ] THEN
6321       MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s SUBSET t UNION u`) THEN
6322       MATCH_MP_TAC(MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)
6323           (SPEC_ALL FRONTIER_UNION_SUBSET)) THEN
6324       ASM_REWRITE_TAC[UNION_SUBSET; FRONTIER_SUBSET_EQ] THEN
6325       MATCH_MP_TAC(MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)
6326           (SPEC_ALL FRONTIER_UNIONS_SUBSET_CLOSURE)) THEN
6327       MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_REWRITE_TAC[UNIONS_SUBSET] THEN
6328       SIMP_TAC[FORALL_IN_GSPEC];
6329       ALL_TAC]) THEN
6330     REPEAT CONJ_TAC THENL
6331      [MATCH_MP_TAC SUBSET_TRANS THEN
6332       EXISTS_TAC `(s UNION t) UNION
6333                    UNIONS {c | c IN components((:real^N) DIFF (s UNION t)) /\
6334                    ~(c INTER u = {})}` THEN
6335       CONJ_TAC THENL
6336        [MP_TAC(ISPEC `(:real^N) DIFF (s UNION t)` UNIONS_COMPONENTS) THEN
6337         SET_TAC[];
6338         MATCH_MP_TAC(SET_RULE
6339          `c SUBSET d UNION e
6340           ==> (s UNION t) UNION c SUBSET (s UNION d) UNION (t UNION e)`) THEN
6341         REWRITE_TAC[GSYM UNIONS_UNION] THEN MATCH_MP_TAC SUBSET_UNIONS THEN
6342         ONCE_REWRITE_TAC[SUBSET] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNION] THEN
6343         X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN
6344         FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN
6345         ASM_REWRITE_TAC[DE_MORGAN_THM] THEN
6346         MATCH_MP_TAC(SET_RULE
6347          `c SUBSET s UNION t
6348           ==> c INTER s = {} \/ c INTER t = {}
6349               ==> c SUBSET s \/ c SUBSET t`) THEN
6350         FIRST_ASSUM(MP_TAC o MATCH_MP FRONTIER_OF_COMPONENTS_SUBSET) THEN
6351         REWRITE_TAC[FRONTIER_COMPLEMENT] THEN
6352         MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN
6353         ASM_SIMP_TAC[FRONTIER_SUBSET_EQ; CLOSED_UNION]];
6354       MATCH_MP_TAC(SET_RULE
6355        `c UNION d SUBSET UNIV DIFF (s UNION t) /\ s INTER t = {} /\ DISJOINT c d
6356         ==> (s UNION c) INTER (t UNION d) INTER u = {}`) THEN
6357       ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6358        [REWRITE_TAC[GSYM UNIONS_UNION] THEN
6359         GEN_REWRITE_TAC RAND_CONV [UNIONS_COMPONENTS] THEN
6360         MATCH_MP_TAC SUBSET_UNIONS THEN SET_TAC[];
6361         MATCH_MP_TAC(SET_RULE
6362          `(!s. s IN c ==> !t. t IN c' ==> s INTER t = {})
6363           ==> DISJOINT (UNIONS c) (UNIONS c')`) THEN
6364         REWRITE_TAC[FORALL_IN_GSPEC] THEN
6365         MP_TAC(ISPEC `(:real^N) DIFF (s UNION t)` COMPONENTS_NONOVERLAP) THEN
6366         SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN
6367         X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN
6368         X_GEN_TAC `c':real^N->bool` THEN
6369         ASM_CASES_TAC `c':real^N->bool = c` THEN ASM_REWRITE_TAC[] THEN
6370         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
6371          `c SUBSET s ==> s INTER t = {} /\ ~(c = {}) ==> ~(c SUBSET t)`)) THEN
6372         ASM_REWRITE_TAC[FRONTIER_EQ_EMPTY] THEN
6373         FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN
6374         FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
6375         ASM SET_TAC[]];
6376       ASM SET_TAC[];
6377       ASM SET_TAC[]]) in
6378   GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
6379   ASM_SIMP_TAC[CONNECTED_CLOSED_SET; GSYM OPEN_CLOSED;
6380                LEFT_IMP_EXISTS_THM] THEN
6381   MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->bool`] THEN STRIP_TAC THEN
6382   MP_TAC(ISPECL [`t:real^N->bool`; `u:real^N->bool`; `(:real^N)`]
6383           lemma) THEN
6384   ASM_REWRITE_TAC[CONNECTED_UNIV; SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN
6385   ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN
6386   X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6387   DISCH_TAC THEN MP_TAC(ISPEC `c:real^N->bool` CONNECTED_FRONTIER_SIMPLE) THEN
6388   FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN
6389   ASM_REWRITE_TAC[] THEN REWRITE_TAC[CONNECTED_CLOSED] THEN
6390   MAP_EVERY EXISTS_TAC [`t:real^N->bool`; `u:real^N->bool`] THEN
6391   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
6392   FIRST_ASSUM(MP_TAC o MATCH_MP FRONTIER_OF_COMPONENTS_SUBSET) THEN
6393   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN
6394   ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN
6395   ASM_REWRITE_TAC[FRONTIER_SUBSET_EQ; GSYM OPEN_CLOSED]);;
6396
6397 let SEPARATION_BY_UNION_OPEN = prove
6398  (`!s t:real^N->bool.
6399         open s /\ open t /\ DISJOINT s t /\
6400         connected((:real^N) DIFF s) /\
6401         connected((:real^N) DIFF t)
6402         ==> connected((:real^N) DIFF (s UNION t))`,
6403   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE
6404    `UNIV DIFF (s UNION t) = (UNIV DIFF s) INTER (UNIV DIFF t)`] THEN
6405   MATCH_MP_TAC(REWRITE_RULE[unicoherent] UNICOHERENT_UNIV) THEN
6406   REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN
6407   ASM_REWRITE_TAC[GSYM OPEN_CLOSED] THEN ASM SET_TAC[]);;
6408
6409 let CONNECTED_INTER_DISJOINT_OPEN_FRONTIERS = prove
6410  (`!s t:real^N->bool.
6411         open s /\ connected s /\ open t /\ connected t /\
6412         DISJOINT (frontier s) (frontier t)
6413         ==> connected(s INTER t)`,
6414   let lemma = prove
6415    (`~(f = {}) ==> s UNION UNIONS f = UNIONS {s UNION c | c IN f}`,
6416     REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in
6417   REPEAT STRIP_TAC THEN
6418   MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN
6419   ASM_REWRITE_TAC[INTER_EMPTY; CONNECTED_EMPTY] THEN
6420   MAP_EVERY ASM_CASES_TAC [`s = (:real^N)`; `t = (:real^N)`] THEN
6421   ASM_REWRITE_TAC[INTER_UNIV; CONNECTED_UNIV] THEN
6422   ASM_CASES_TAC `s INTER t:real^N->bool = {}` THEN
6423   ASM_REWRITE_TAC[CONNECTED_EMPTY] THEN
6424   MP_TAC(ISPECL
6425    [`s UNION UNIONS {c | c IN components((:real^N) DIFF closure t) /\
6426                          ~(c INTER s = {})}`;
6427     `t UNION UNIONS {c | c IN components((:real^N) DIFF closure s) /\
6428                          ~(c INTER t = {})}`]
6429    OPEN_UNICOHERENT_UNIV) THEN
6430   ANTS_TAC THENL
6431    [REPEAT CONJ_TAC THENL
6432      [MATCH_MP_TAC OPEN_UNION THEN ASM_REWRITE_TAC[] THEN
6433       MATCH_MP_TAC OPEN_UNIONS THEN REWRITE_TAC[IN_ELIM_THM] THEN
6434       MESON_TAC[OPEN_COMPONENTS; closed; CLOSED_CLOSURE];
6435       MATCH_MP_TAC OPEN_UNION THEN ASM_REWRITE_TAC[] THEN
6436       MATCH_MP_TAC OPEN_UNIONS THEN REWRITE_TAC[IN_ELIM_THM] THEN
6437       MESON_TAC[OPEN_COMPONENTS; closed; CLOSED_CLOSURE];
6438       MATCH_MP_TAC(MESON[]
6439        `(s = {} \/ ~(s = {}) ==> connected(u UNION UNIONS s))
6440         ==> connected(u UNION UNIONS s)`) THEN
6441       STRIP_TAC THEN ASM_REWRITE_TAC[UNION_EMPTY; UNIONS_0] THEN
6442       ASM_SIMP_TAC[lemma] THEN MATCH_MP_TAC CONNECTED_UNIONS THEN
6443       REWRITE_TAC[FORALL_IN_GSPEC] THEN
6444       CONJ_TAC THENL
6445        [ASM_MESON_TAC[CONNECTED_UNION; IN_COMPONENTS_CONNECTED; UNION_COMM];
6446         ALL_TAC] THEN
6447       MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ ~(s = {}) ==> ~(t = {})`) THEN
6448       EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_INTERS] THEN
6449       REWRITE_TAC[FORALL_IN_GSPEC; SUBSET_UNION];
6450       MATCH_MP_TAC(MESON[]
6451        `(s = {} \/ ~(s = {}) ==> connected(u UNION UNIONS s))
6452         ==> connected(u UNION UNIONS s)`) THEN
6453       STRIP_TAC THEN ASM_REWRITE_TAC[UNION_EMPTY; UNIONS_0] THEN
6454       ASM_SIMP_TAC[lemma] THEN MATCH_MP_TAC CONNECTED_UNIONS THEN
6455       REWRITE_TAC[FORALL_IN_GSPEC] THEN
6456       CONJ_TAC THENL
6457        [ASM_MESON_TAC[CONNECTED_UNION; IN_COMPONENTS_CONNECTED; UNION_COMM];
6458         ALL_TAC] THEN
6459       MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ ~(s = {}) ==> ~(t = {})`) THEN
6460       EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_INTERS] THEN
6461       REWRITE_TAC[FORALL_IN_GSPEC; SUBSET_UNION];
6462       GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN
6463       REWRITE_TAC[IN_UNION; UNIONS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN
6464       ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN
6465       ASM_CASES_TAC `(x:real^N) IN t` THEN ASM_REWRITE_TAC[] THEN
6466       FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o MATCH_MP (SET_RULE
6467        `DISJOINT s t ==> !x. ~(x IN s) \/ ~(x IN t)`)) THEN
6468       ASM_SIMP_TAC[frontier; INTERIOR_OPEN; IN_DIFF] THEN STRIP_TAC THENL
6469        [SUBGOAL_THEN `x IN UNIONS(components((:real^N) DIFF closure s))`
6470         MP_TAC THENL
6471          [ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; IN_DIFF; IN_UNIV];
6472           ALL_TAC] THEN
6473         REWRITE_TAC[IN_UNIONS] THEN
6474         DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
6475         ASM_CASES_TAC `c INTER t:real^N->bool = {}` THENL
6476          [ALL_TAC; ASM_MESON_TAC[]] THEN
6477         SUBGOAL_THEN `c INTER closure(t:real^N->bool) = {}` ASSUME_TAC THENL
6478          [ASM_MESON_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_COMPONENTS;
6479                         closed; CLOSED_CLOSURE];
6480           ALL_TAC] THEN
6481         SUBGOAL_THEN `x IN UNIONS(components((:real^N) DIFF closure t))`
6482         MP_TAC THENL
6483          [ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; IN_DIFF; IN_UNIV] THEN
6484           ASM SET_TAC[];
6485           ALL_TAC] THEN
6486         REWRITE_TAC[IN_UNIONS] THEN
6487         DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN
6488         ASM_CASES_TAC `d INTER s:real^N->bool = {}` THENL
6489          [ALL_TAC; ASM_MESON_TAC[]] THEN
6490         SUBGOAL_THEN `d INTER closure(s:real^N->bool) = {}` ASSUME_TAC THENL
6491          [ASM_MESON_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_COMPONENTS;
6492                         closed; CLOSED_CLOSURE];
6493           ALL_TAC];
6494         SUBGOAL_THEN `x IN UNIONS(components((:real^N) DIFF closure t))`
6495         MP_TAC THENL
6496          [ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; IN_DIFF; IN_UNIV];
6497           ALL_TAC] THEN
6498         REWRITE_TAC[IN_UNIONS] THEN
6499         DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN
6500         ASM_CASES_TAC `d INTER s:real^N->bool = {}` THENL
6501          [ALL_TAC; ASM_MESON_TAC[]] THEN
6502         SUBGOAL_THEN `d INTER closure(s:real^N->bool) = {}` ASSUME_TAC THENL
6503          [ASM_MESON_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_COMPONENTS;
6504                         closed; CLOSED_CLOSURE];
6505           ALL_TAC] THEN
6506         SUBGOAL_THEN `x IN UNIONS(components((:real^N) DIFF closure s))`
6507         MP_TAC THENL
6508          [ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; IN_DIFF; IN_UNIV] THEN
6509           ASM SET_TAC[];
6510           ALL_TAC] THEN
6511         REWRITE_TAC[IN_UNIONS] THEN
6512         DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
6513         ASM_CASES_TAC `c INTER t:real^N->bool = {}` THENL
6514          [ALL_TAC; ASM_MESON_TAC[]] THEN
6515         SUBGOAL_THEN `c INTER closure(t:real^N->bool) = {}` ASSUME_TAC THENL
6516          [ASM_MESON_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_COMPONENTS;
6517                         closed; CLOSED_CLOSURE];
6518           ALL_TAC]] THEN
6519      (FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
6520        `DISJOINT s t ==> !c d. ~(c = {}) /\ c SUBSET s /\ d SUBSET t /\ c = d
6521                                ==> p`)) THEN
6522       MAP_EVERY EXISTS_TAC
6523        [`frontier c:real^N->bool`; `frontier d:real^N->bool`] THEN
6524       REPEAT CONJ_TAC THENL
6525        [REWRITE_TAC[FRONTIER_EQ_EMPTY; DE_MORGAN_THM] THEN
6526         ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY; IN_COMPONENTS_SUBSET;
6527                       SET_RULE `s SUBSET UNIV DIFF t /\ s = UNIV ==> t = {}`;
6528                       CLOSURE_EQ_EMPTY];
6529         ASM_MESON_TAC[FRONTIER_OF_COMPONENTS_SUBSET;FRONTIER_COMPLEMENT;
6530                       FRONTIER_CLOSURE_SUBSET; SUBSET_TRANS];
6531         ASM_MESON_TAC[FRONTIER_OF_COMPONENTS_SUBSET;FRONTIER_COMPLEMENT;
6532                       FRONTIER_CLOSURE_SUBSET; SUBSET_TRANS];
6533         AP_TERM_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN
6534         MATCH_MP_TAC COMPONENTS_MAXIMAL THENL
6535          [EXISTS_TAC `(:real^N) DIFF closure t`;
6536           EXISTS_TAC `(:real^N) DIFF closure s`] THEN
6537         ASM_REWRITE_TAC[] THEN
6538         (CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED];
6539          ASM SET_TAC[]])])];
6540       ALL_TAC] THEN
6541     MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
6542     MATCH_MP_TAC(SET_RULE
6543      `s INTER t' = {} /\ t INTER s' = {} /\ s' INTER t' = {}
6544       ==> (s UNION s') INTER (t UNION t') = s INTER t`) THEN
6545     REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC;
6546                 UNIONS_SUBSET] THEN
6547     REPEAT CONJ_TAC THEN X_GEN_TAC `d:real^N->bool` THENL
6548      [MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN
6549       MP_TAC(ISPECL [`(:real^N) DIFF closure s`; `d:real^N->bool`]
6550         IN_COMPONENTS_SUBSET) THEN
6551       SET_TAC[];
6552       MP_TAC(ISPEC `t:real^N->bool` CLOSURE_SUBSET) THEN
6553       MP_TAC(ISPECL [`(:real^N) DIFF closure t`; `d:real^N->bool`]
6554         IN_COMPONENTS_SUBSET) THEN
6555       SET_TAC[];
6556       STRIP_TAC THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC] THEN
6557     MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
6558     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
6559      `DISJOINT s t
6560       ==> !c d. c SUBSET s /\ d SUBSET t /\ ~(c INTER d = {}) ==> F`)) THEN
6561     MAP_EVERY EXISTS_TAC
6562      [`frontier c:real^N->bool`; `frontier d:real^N->bool`] THEN
6563     REPEAT(CONJ_TAC THENL
6564      [ASM_MESON_TAC[FRONTIER_OF_COMPONENTS_SUBSET;FRONTIER_COMPLEMENT;
6565                       FRONTIER_CLOSURE_SUBSET; SUBSET_TRANS]; ALL_TAC]) THEN
6566     MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN CONJ_TAC THENL
6567      [MATCH_MP_TAC CONNECTED_FRONTIER_COMPONENT_COMPLEMENT THEN
6568       EXISTS_TAC `closure s:real^N->bool` THEN
6569       ASM_MESON_TAC[CONNECTED_CLOSURE];
6570       ALL_TAC] THEN
6571     ONCE_REWRITE_TAC[SET_RULE `c DIFF d = c INTER (UNIV DIFF d)`] THEN
6572     ONCE_REWRITE_TAC[INTER_COMM] THEN CONJ_TAC THEN
6573     MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN
6574     ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
6575      [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED];
6576       ALL_TAC;
6577       MATCH_MP_TAC COMPONENT_COMPLEMENT_CONNECTED THEN
6578       EXISTS_TAC `closure t:real^N->bool` THEN
6579       ASM_SIMP_TAC[CONNECTED_UNIV; SUBSET_UNIV; CONNECTED_CLOSURE];
6580       ALL_TAC;
6581       ALL_TAC] THEN
6582     REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN
6583     MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN
6584     MP_TAC(ISPEC `t:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]);;
6585
6586 let NONSEPARATION_BY_COMPONENT_EQ = prove
6587  (`!s. (open s \/ closed s)
6588        ==> ((!c. c IN components s ==> connected((:real^N) DIFF c)) <=>
6589             connected((:real^N) DIFF s))`,
6590   REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
6591    [ASM_MESON_TAC[SEPARATION_BY_COMPONENT_OPEN];
6592     ALL_TAC;
6593     ASM_MESON_TAC[SEPARATION_BY_COMPONENT_CLOSED];
6594     ALL_TAC] THEN
6595   MATCH_MP_TAC COMPONENT_COMPLEMENT_CONNECTED THEN
6596   EXISTS_TAC `(:real^N) DIFF s` THEN
6597   ASM_REWRITE_TAC[CONNECTED_UNIV; SUBSET_UNIV;
6598                   SET_RULE `UNIV DIFF (UNIV DIFF s) = s`]);;
6599
6600 (* ------------------------------------------------------------------------- *)
6601 (* Another interesting equivalent of an inessential mapping into C-{0}       *)
6602 (* ------------------------------------------------------------------------- *)
6603
6604 let INESSENTIAL_EQ_EXTENSIBLE = prove
6605  (`!f s.
6606    closed s
6607    ==> ((?a. homotopic_with (\h. T) (s,(:complex) DIFF {Cx(&0)}) f (\t. a)) <=>
6608         (?g. g continuous_on (:real^N) /\
6609              (!x. x IN s ==> g x = f x) /\ (!x. ~(g x = Cx(&0)))))`,
6610   REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL
6611    [DISCH_THEN(X_CHOOSE_TAC `a:complex`) THEN
6612     ASM_CASES_TAC `s:real^N->bool = {}` THENL
6613      [EXISTS_TAC `\x:real^N. Cx(&1)` THEN
6614       ASM_REWRITE_TAC[CONTINUOUS_ON_CONST; NOT_IN_EMPTY] THEN
6615       CONV_TAC COMPLEX_RING;
6616       ALL_TAC] THEN
6617     FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN
6618     FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
6619     FIRST_ASSUM(MP_TAC o
6620       SPEC `(:real^N)` o
6621       MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ_ALT]
6622         (REWRITE_RULE[CONJ_ASSOC] BORSUK_HOMOTOPY_EXTENSION)) o
6623       GEN_REWRITE_RULE I [HOMOTOPIC_WITH_SYM]) THEN
6624     ASM_REWRITE_TAC[GSYM CLOSED_IN; SUBTOPOLOGY_UNIV] THEN
6625     SIMP_TAC[OPEN_IMP_ANR; OPEN_DIFF; OPEN_UNIV; CLOSED_SING] THEN
6626     ASM_SIMP_TAC[CLOSED_UNIV; CONTINUOUS_ON_CONST] THEN
6627     ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN
6628     ASM SET_TAC[];
6629     DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN
6630     REWRITE_TAC[INESSENTIAL_EQ_CONTINUOUS_LOGARITHM] THEN
6631     MP_TAC(ISPECL [`vec 0:real^N`; `&1`] HOMEOMORPHIC_BALL_UNIV) THEN
6632     REWRITE_TAC[REAL_LT_01; homeomorphic; LEFT_IMP_EXISTS_THM] THEN
6633     MAP_EVERY X_GEN_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN
6634     REWRITE_TAC[homeomorphism; IN_UNIV] THEN STRIP_TAC THEN
6635     MP_TAC(ISPECL [`(g:real^N->complex) o (h:real^N->real^N)`;
6636                    `vec 0:real^N`; `&1`] CONTINUOUS_LOGARITHM_ON_BALL) THEN
6637     ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; o_THM] THEN
6638     DISCH_THEN(X_CHOOSE_THEN `j:real^N->complex` STRIP_ASSUME_TAC) THEN
6639     EXISTS_TAC `(j:real^N->complex) o (k:real^N->real^N)` THEN
6640     ASM_SIMP_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
6641     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
6642     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
6643       CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]]);;
6644
6645 (* ------------------------------------------------------------------------- *)
6646 (* Another simple case where sphere maps are nullhomotopic.                  *)
6647 (* ------------------------------------------------------------------------- *)
6648
6649 let INESSENTIAL_SPHEREMAP_2 = prove
6650  (`!f:real^M->real^N a r b s.
6651         2 < dimindex(:M) /\ dimindex(:N) = 2 /\
6652         f continuous_on sphere(a,r) /\
6653         IMAGE f (sphere(a,r)) SUBSET (sphere(b,s))
6654         ==> ?c. homotopic_with (\z. T) (sphere(a,r),sphere(b,s)) f (\x. c)`,
6655   let lemma = prove
6656    (`!f:real^N->real^2 a r.
6657           2 < dimindex(:N) /\
6658           f continuous_on sphere(a,r) /\
6659           IMAGE f (sphere(a,r)) SUBSET (sphere(vec 0,&1))
6660           ==> ?c. homotopic_with (\z. T) (sphere(a,r),sphere(vec 0,&1))
6661                                  f (\x. c)`,
6662     REPEAT STRIP_TAC THEN
6663     REWRITE_TAC[INESSENTIAL_EQ_CONTINUOUS_LOGARITHM_CIRCLE] THEN
6664     MP_TAC(ISPECL [`f:real^N->real^2`; `sphere(a:real^N,r)`]
6665           CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED) THEN
6666     ASM_SIMP_TAC[SIMPLY_CONNECTED_SPHERE_EQ; LOCALLY_PATH_CONNECTED_SPHERE] THEN
6667     ANTS_TAC THENL
6668      [ASM_REWRITE_TAC[ARITH_RULE `3 <= n <=> 2 < n`] THEN FIRST_X_ASSUM
6669        (MATCH_MP_TAC o MATCH_MP (SET_RULE
6670           `IMAGE f s SUBSET t ==> (!x. P x ==> ~(x IN t))
6671           ==> !x. x IN s ==> ~P(f x)`)) THEN
6672       SIMP_TAC[COMPLEX_NORM_0; IN_SPHERE_0] THEN REAL_ARITH_TAC;
6673       DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^2` STRIP_ASSUME_TAC) THEN
6674       EXISTS_TAC `Im o (g:real^N->real^2)` THEN CONJ_TAC THENL
6675        [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
6676         ASM_REWRITE_TAC[CONTINUOUS_ON_CX_IM];
6677         X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
6678         ASM_SIMP_TAC[] THEN AP_TERM_TAC THEN
6679         REWRITE_TAC[o_DEF; COMPLEX_EQ; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX] THEN
6680         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
6681         REWRITE_TAC[FORALL_IN_IMAGE] THEN
6682         DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
6683         ASM_SIMP_TAC[IN_SPHERE_0; NORM_CEXP; REAL_EXP_EQ_1] THEN
6684         REAL_ARITH_TAC]])
6685   and hslemma = prove
6686    (`!a:real^M r b:real^N s.
6687         dimindex(:M) = dimindex(:N) /\ &0 < r /\ &0 < s
6688         ==> (sphere(a,r) homeomorphic sphere(b,s))`,
6689     REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th ->
6690       let t = `?a:real^M b:real^N. ~(sphere(a,r) homeomorphic sphere(b,s))` in
6691       MP_TAC(DISCH t (GEOM_EQUAL_DIMENSION_RULE th (ASSUME t)))) THEN
6692     ASM_SIMP_TAC[HOMEOMORPHIC_SPHERES] THEN MESON_TAC[]) in
6693   REPEAT STRIP_TAC THEN ASM_CASES_TAC `s <= &0` THEN
6694   ASM_SIMP_TAC[NULLHOMOTOPIC_INTO_CONTRACTIBLE; CONTRACTIBLE_SPHERE] THEN
6695   RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN
6696   SUBGOAL_THEN
6697    `(sphere(b:real^N,s)) homeomorphic (sphere(vec 0:real^2,&1))`
6698   MP_TAC THENL
6699    [ASM_SIMP_TAC[hslemma; REAL_LT_01; DIMINDEX_2];
6700     REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM]] THEN
6701   MAP_EVERY X_GEN_TAC [`h:real^N->real^2`; `k:real^2->real^N`] THEN
6702   REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN
6703   MP_TAC(ISPECL
6704    [`(h:real^N->real^2) o (f:real^M->real^N)`;
6705     `a:real^M`; `r:real`] lemma) THEN
6706   ASM_REWRITE_TAC[IMAGE_o] THEN ANTS_TAC THENL
6707    [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE; ASM SET_TAC[]] THEN
6708     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
6709     DISCH_THEN(X_CHOOSE_THEN `c:real^2` (fun th ->
6710       EXISTS_TAC `(k:real^2->real^N) c` THEN MP_TAC th)) THEN
6711     DISCH_THEN(MP_TAC o ISPEC `k:real^2->real^N` o MATCH_MP
6712      (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN
6713     DISCH_THEN(MP_TAC o SPEC `sphere(b:real^N,s)`) THEN
6714     ASM_REWRITE_TAC[SUBSET_REFL] THEN
6715     MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN
6716     REWRITE_TAC[o_DEF] THEN ASM SET_TAC[]]);;
6717
6718 (* ------------------------------------------------------------------------- *)
6719 (* Janiszewski's theorem.                                                    *)
6720 (* ------------------------------------------------------------------------- *)
6721
6722 let JANISZEWSKI = prove
6723  (`!s t a b:real^2.
6724         compact s /\ closed t /\ connected(s INTER t) /\
6725         connected_component ((:real^2) DIFF s) a b /\
6726         connected_component ((:real^2) DIFF t) a b
6727         ==> connected_component ((:real^2) DIFF (s UNION t)) a b`,
6728   let lemma = prove
6729    (`!s t a b:real^2.
6730           compact s /\ compact t /\ connected(s INTER t) /\
6731           connected_component ((:real^2) DIFF s) a b /\
6732           connected_component ((:real^2) DIFF t) a b
6733           ==> connected_component ((:real^2) DIFF (s UNION t)) a b`,
6734     REPEAT GEN_TAC THEN
6735     REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
6736     DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
6737     FIRST_X_ASSUM(CONJUNCTS_THEN(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN)) THEN
6738     REWRITE_TAC[IN_DIFF; IN_UNIV] THEN STRIP_TAC THEN STRIP_TAC THEN
6739     ASM_SIMP_TAC[GSYM BORSUK_MAPS_HOMOTOPIC_IN_CONNECTED_COMPONENT_EQ;
6740                  DIMINDEX_2; LE_REFL; COMPACT_UNION; IN_UNION] THEN
6741     ONCE_REWRITE_TAC[HOMOTOPIC_CIRCLEMAPS_DIV] THEN
6742     REWRITE_TAC[INESSENTIAL_EQ_CONTINUOUS_LOGARITHM_CIRCLE] THEN
6743     ASM_SIMP_TAC[BORSUK_MAP_INTO_SPHERE; CONTINUOUS_ON_BORSUK_MAP;
6744                  IN_UNION] THEN
6745     DISCH_THEN(CONJUNCTS_THEN2
6746      (X_CHOOSE_THEN `g:real^2->real` STRIP_ASSUME_TAC)
6747      (X_CHOOSE_THEN `h:real^2->real` STRIP_ASSUME_TAC)) THEN
6748     SUBGOAL_THEN
6749      `closed_in (subtopology euclidean (s UNION t)) s /\
6750       closed_in (subtopology euclidean (s UNION t)) (t:real^2->bool)`
6751     STRIP_ASSUME_TAC THENL
6752      [REWRITE_TAC[CLOSED_IN_CLOSED] THEN CONJ_TAC THENL
6753        [EXISTS_TAC `s:real^2->bool`; EXISTS_TAC `t:real^2->bool`] THEN
6754       ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM SET_TAC[];
6755       ALL_TAC] THEN
6756     ASM_CASES_TAC `s INTER t:real^2->bool = {}` THENL
6757      [EXISTS_TAC `(\x. if x IN s then g x else h x):real^2->real` THEN
6758       CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
6759       REWRITE_TAC[o_DEF; COND_RAND] THEN
6760       MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
6761       ASM_REWRITE_TAC[GSYM o_DEF] THEN ASM SET_TAC[];
6762       ALL_TAC] THEN
6763     MP_TAC(ISPECL
6764      [`\x:real^2. lift(g x) - lift(h x)`; `s INTER t:real^2->bool`]
6765      CONTINUOUS_DISCRETE_RANGE_CONSTANT) THEN
6766     ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
6767      [CONJ_TAC THENL
6768        [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
6769         REWRITE_TAC[GSYM CONTINUOUS_ON_CX_LIFT] THEN
6770         REWRITE_TAC[GSYM o_DEF] THEN
6771         ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET];
6772         REWRITE_TAC[o_DEF]] THEN
6773       X_GEN_TAC `x:real^2` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN
6774       EXISTS_TAC `&2 * pi` THEN
6775       REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN
6776       X_GEN_TAC `y:real^2` THEN
6777       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
6778       ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN
6779       REWRITE_TAC[GSYM LIFT_SUB; LIFT_EQ; NORM_LIFT] THEN DISCH_TAC THEN
6780       ONCE_REWRITE_TAC[REAL_RING `a - b:real = c - d <=> a - c = b - d`] THEN
6781       REWRITE_TAC[GSYM CX_INJ] THEN
6782       MATCH_MP_TAC(COMPLEX_RING `ii * w = ii * z ==> w = z`) THEN
6783       MATCH_MP_TAC COMPLEX_EQ_CEXP THEN CONJ_TAC THENL
6784        [REWRITE_TAC[IM_MUL_II; RE_CX] THEN ASM_REAL_ARITH_TAC;
6785         REWRITE_TAC[CX_SUB; COMPLEX_SUB_LDISTRIB; CEXP_SUB] THEN
6786         ASM_MESON_TAC[]];
6787       REWRITE_TAC[EXISTS_LIFT; GSYM LIFT_SUB; LIFT_EQ; IN_INTER] THEN
6788       REWRITE_TAC[REAL_EQ_SUB_RADD; LEFT_IMP_EXISTS_THM] THEN
6789       X_GEN_TAC `z:real` THEN DISCH_TAC THEN
6790       EXISTS_TAC `(\x. if x IN s then g x else z + h x):real^2->real` THEN
6791       CONJ_TAC THENL
6792        [REWRITE_TAC[o_DEF; COND_RAND] THEN
6793         MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
6794         ASM_SIMP_TAC[TAUT `~(p /\ ~p)`; CX_ADD; GSYM o_DEF] THEN
6795         REWRITE_TAC[o_DEF; CX_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
6796         ASM_REWRITE_TAC[CONTINUOUS_ON_CONST; GSYM o_DEF];
6797         X_GEN_TAC `x:real^2` THEN REWRITE_TAC[] THEN
6798         COND_CASES_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
6799         ASM_SIMP_TAC[] THEN DISCH_TAC THEN
6800         SUBGOAL_THEN
6801          `?w:real^2. cexp(ii * Cx(h w)) = cexp (ii * Cx(z + h w))`
6802          (CHOOSE_THEN MP_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN
6803         REWRITE_TAC[CX_ADD; COMPLEX_ADD_LDISTRIB; CEXP_ADD] THEN
6804         REWRITE_TAC[COMPLEX_FIELD `a = b * a <=> a = Cx(&0) \/ b = Cx(&1)`;
6805                     CEXP_NZ]]]) in
6806   REPEAT STRIP_TAC THEN
6807   SUBGOAL_THEN
6808    `?c:real^2->bool.
6809        compact c /\ connected c /\ a IN c /\ b IN c /\ c INTER t = {}`
6810   STRIP_ASSUME_TAC THENL
6811    [SUBGOAL_THEN `path_component((:real^2) DIFF t) a b` MP_TAC THENL
6812      [ASM_MESON_TAC[OPEN_PATH_CONNECTED_COMPONENT; closed; COMPACT_IMP_CLOSED];
6813       REWRITE_TAC[path_component; SET_RULE
6814         `s SUBSET UNIV DIFF t <=> s INTER t = {}`]] THEN
6815     DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^2` STRIP_ASSUME_TAC) THEN
6816     EXISTS_TAC `path_image(g:real^1->real^2)` THEN
6817     ASM_SIMP_TAC[CONNECTED_PATH_IMAGE; COMPACT_PATH_IMAGE] THEN
6818     ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE];
6819     ALL_TAC] THEN
6820   MP_TAC(ISPECL [`c UNION s:real^2->bool`; `vec 0:real^2`]
6821         BOUNDED_SUBSET_BALL) THEN
6822   ASM_SIMP_TAC[BOUNDED_UNION; COMPACT_IMP_BOUNDED; LEFT_IMP_EXISTS_THM] THEN
6823   X_GEN_TAC `r:real` THEN STRIP_TAC THEN
6824   MP_TAC(ISPECL [`s:real^2->bool`;
6825                  `(t INTER cball(vec 0,r)) UNION sphere(vec 0:real^2,r)`;
6826                  `a:real^2`; `b:real^2`] lemma) THEN
6827   ASM_SIMP_TAC[COMPACT_UNION; CLOSED_INTER_COMPACT;
6828                COMPACT_SPHERE; COMPACT_CBALL] THEN
6829   ANTS_TAC THENL
6830    [CONJ_TAC THENL
6831      [UNDISCH_TAC `connected(s INTER t:real^2->bool)` THEN
6832       MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC;
6833       REWRITE_TAC[connected_component] THEN EXISTS_TAC `c:real^2->bool`] THEN
6834     MP_TAC(ISPECL [`vec 0:real^2`; `r:real`] CBALL_DIFF_SPHERE) THEN
6835     ASM SET_TAC[];
6836     REWRITE_TAC[connected_component] THEN MATCH_MP_TAC MONO_EXISTS THEN
6837     X_GEN_TAC `u:real^2->bool` THEN
6838     SIMP_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN
6839     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
6840     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
6841     MP_TAC(ISPECL
6842      [`u:real^2->bool`; `cball(vec 0:real^2,r)`] CONNECTED_INTER_FRONTIER) THEN
6843     ASM_REWRITE_TAC[FRONTIER_CBALL] THEN
6844     MP_TAC(ISPECL [`vec 0:real^2`; `r:real`] BALL_SUBSET_CBALL) THEN
6845     ASM SET_TAC[]]);;
6846
6847 let JANISZEWSKI_GEN = prove
6848  (`!s t a b:real^N.
6849         dimindex(:N) <= 2 /\
6850         compact s /\ closed t /\ connected(s INTER t) /\
6851         connected_component ((:real^N) DIFF s) a b /\
6852         connected_component ((:real^N) DIFF t) a b
6853         ==> connected_component ((:real^N) DIFF (s UNION t)) a b`,
6854   REPEAT GEN_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL
6855    [ASM_SIMP_TAC[CONNECTED_COMPONENT_1_GEN] THEN SET_TAC[];
6856     ASM_SIMP_TAC[ARITH_RULE `1 <= n /\ ~(n = 1) ==> (n <= 2 <=> n = 2)`;
6857                  DIMINDEX_GE_1] THEN
6858     ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[GSYM DIMINDEX_2] THEN
6859     DISCH_THEN(fun th ->
6860      MATCH_ACCEPT_TAC(GEOM_EQUAL_DIMENSION_RULE th JANISZEWSKI))]);;
6861
6862 let JANISZEWSKI_CONNECTED = prove
6863  (`!s t:real^2->bool.
6864        compact s /\ closed t /\ connected(s INTER t) /\
6865        connected ((:real^2) DIFF s) /\ connected ((:real^2) DIFF t)
6866        ==> connected((:real^2) DIFF (s UNION t))`,
6867   REPEAT GEN_TAC THEN
6868   REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
6869   REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN
6870   REWRITE_TAC[IN_DIFF; IN_UNIV; IN_UNION] THEN
6871   ASM_MESON_TAC[JANISZEWSKI]);;
6872
6873 let JANISZEWSKI_DUAL = prove
6874  (`!s t:real^2->bool.
6875         compact s /\ compact t /\ connected s /\ connected t /\
6876         connected((:real^2) DIFF (s UNION t))
6877          ==> connected(s INTER t)`,
6878   REPEAT STRIP_TAC THEN
6879   MP_TAC(ISPEC `s UNION t:real^2->bool` BORSUKIAN_IMP_UNICOHERENT) THEN
6880   ASM_SIMP_TAC[BORSUKIAN_SEPARATION_COMPACT; COMPACT_UNION; unicoherent] THEN
6881   DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
6882   CONJ_TAC THEN MATCH_MP_TAC CLOSED_SUBSET THEN
6883   ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN SET_TAC[]);;
6884
6885 (* ------------------------------------------------------------------------- *)
6886 (* The Jordan Curve theorem.                                                 *)
6887 (* ------------------------------------------------------------------------- *)
6888
6889 let JORDAN_CURVE_THEOREM = prove
6890  (`!c:real^1->real^2.
6891         simple_path c /\ pathfinish c = pathstart c
6892         ==> ?ins out.
6893                  ~(ins = {}) /\ open ins /\ connected ins /\
6894                  ~(out = {}) /\ open out /\ connected out /\
6895                  bounded ins /\ ~bounded out /\
6896                  ins INTER out = {} /\
6897                  ins UNION out = (:real^2) DIFF path_image c /\
6898                  frontier ins = path_image c /\
6899                  frontier out = path_image c`,
6900   REPEAT STRIP_TAC THEN
6901   SUBGOAL_THEN
6902    `path_image(c:real^1->real^2) homeomorphic sphere(vec 0:real^2,&1)`
6903   ASSUME_TAC THENL
6904    [ASM_SIMP_TAC[HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE; REAL_LT_01];
6905     FIRST_ASSUM(ASSUME_TAC o MATCH_MP SIMPLE_PATH_IMP_PATH) THEN
6906     FIRST_ASSUM(ASSUME_TAC o MATCH_MP COMPACT_PATH_IMAGE) THEN
6907     ABBREV_TAC `s:real^2->bool = path_image c`] THEN
6908   FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
6909         JORDAN_BROUWER_SEPARATION)) THEN
6910   REWRITE_TAC[REAL_LT_01] THEN DISCH_TAC THEN
6911   MP_TAC(ISPEC `(:real^2) DIFF s` COBOUNDED_UNBOUNDED_COMPONENTS) THEN
6912   MP_TAC(ISPEC `(:real^2) DIFF s` COBOUNDED_HAS_BOUNDED_COMPONENT) THEN
6913   ASM_SIMP_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`; COMPACT_IMP_BOUNDED;
6914                DIMINDEX_2; LE_REFL; IMP_IMP] THEN
6915   REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
6916   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `ins:real^2->bool` THEN
6917   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `out:real^2->bool` THEN
6918   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6919   REPLICATE_TAC 5 (GEN_REWRITE_TAC I [CONJ_ASSOC]) THEN
6920   MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
6921    [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY; IN_COMPONENTS_CONNECTED;
6922                   OPEN_COMPONENTS; closed; COMPACT_IMP_CLOSED];
6923     STRIP_TAC] THEN
6924   MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
6925    [ASM_MESON_TAC[COMPONENTS_EQ]; DISCH_TAC] THEN
6926   MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL
6927    [CONJ_TAC THEN MATCH_MP_TAC JORDAN_BROUWER_FRONTIER THEN
6928     REWRITE_TAC[DIMINDEX_2; LE_REFL] THEN ASM_MESON_TAC[];
6929     STRIP_TAC] THEN
6930   GEN_REWRITE_TAC RAND_CONV [UNIONS_COMPONENTS] THEN
6931   REWRITE_TAC[GSYM UNIONS_2] THEN AP_TERM_TAC THEN
6932   MATCH_MP_TAC(SET_RULE
6933    `a IN s /\ b IN s /\ (!c. c IN s /\ ~(c = a) /\ ~(c = b) ==> F)
6934     ==> {a,b} = s`) THEN
6935   ASM_REWRITE_TAC[] THEN X_GEN_TAC `mid:real^2->bool` THEN STRIP_TAC THEN
6936   SUBGOAL_THEN `frontier mid:real^2->bool = s` ASSUME_TAC THENL
6937    [MATCH_MP_TAC JORDAN_BROUWER_FRONTIER THEN
6938     REWRITE_TAC[DIMINDEX_2; LE_REFL] THEN ASM_MESON_TAC[];
6939     ALL_TAC] THEN
6940   SUBGOAL_THEN `open(mid:real^2->bool) /\ connected mid /\ ~(mid = {})`
6941   STRIP_ASSUME_TAC THENL
6942    [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY; IN_COMPONENTS_CONNECTED;
6943                   OPEN_COMPONENTS; closed; COMPACT_IMP_CLOSED];
6944     ALL_TAC] THEN
6945   SUBGOAL_THEN
6946    `?a b:real^2.
6947         a IN s /\ b IN s  /\ ~(a = b) /\
6948         ?g. arc g /\ pathstart g = a /\ pathfinish g = b /\
6949             path_image g DIFF {a,b} SUBSET mid`
6950   STRIP_ASSUME_TAC THENL
6951    [SUBGOAL_THEN `?a b:real^2. a IN s /\ b IN s /\ ~(a = b)`
6952     STRIP_ASSUME_TAC THENL
6953      [MATCH_MP_TAC(SET_RULE
6954        `(!c. s SUBSET {c} ==> F) ==> ?a b. a IN s /\ b IN s /\ ~(a = b)`) THEN
6955       ASM_MESON_TAC[INFINITE_SIMPLE_PATH_IMAGE; INFINITE; FINITE_SING;
6956                     FINITE_SUBSET];
6957       ALL_TAC] THEN
6958     MP_TAC(ISPECL
6959      [`mid:real^2->bool`; `s INTER ball(a:real^2,dist(a,b))`;
6960       `s INTER ball(b:real^2,dist(a,b))`]
6961      DENSE_ACCESSIBLE_FRONTIER_POINT_PAIRS) THEN
6962     ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN ANTS_TAC THENL
6963      [SUBGOAL_THEN
6964        `a IN ball(a:real^2,dist(a,b)) /\ b IN ball(b,dist(a,b)) /\
6965         ~(a IN ball(b,dist(a,b))) /\ ~(b IN ball(a,dist(a,b)))`
6966       MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
6967       ASM_REWRITE_TAC[IN_BALL; DIST_REFL; GSYM DIST_NZ] THEN
6968       REWRITE_TAC[DIST_SYM] THEN REAL_ARITH_TAC;
6969       REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM]] THEN
6970     X_GEN_TAC `g:real^1->real^2` THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC
6971      [`pathstart g:real^2`; `pathfinish g:real^2`] THEN
6972     ASM_SIMP_TAC[ARC_DISTINCT_ENDS] THEN EXISTS_TAC `g:real^1->real^2` THEN
6973     ASM_REWRITE_TAC[] THEN
6974     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
6975         SUBSET_TRANS)) THEN
6976     REWRITE_TAC[OPEN_CLOSED_INTERVAL_1; path_image; pathstart; pathfinish] THEN
6977     SET_TAC[];
6978     ALL_TAC] THEN
6979   MP_TAC(ISPECL [`c:real^1->real^2`; `a:real^2`; `b:real^2`]
6980      EXISTS_DOUBLE_ARC) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN
6981   MAP_EVERY X_GEN_TAC [`u:real^1->real^2`; `d:real^1->real^2`] THEN
6982   STRIP_TAC THEN
6983   SUBGOAL_THEN `?x:real^2 y:real^2. x IN ins /\ y IN out`
6984   STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
6985   MP_TAC(ISPECL
6986    [`(path_image u UNION path_image g):real^2->bool`;
6987     `(path_image d UNION path_image g):real^2->bool`;
6988     `x:real^2`; `y:real^2`] JANISZEWSKI) THEN
6989   ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5)
6990       [COMPACT_UNION; COMPACT_IMP_CLOSED; COMPACT_PATH_IMAGE;
6991        ARC_IMP_PATH; NOT_IMP] THEN
6992   REPEAT CONJ_TAC THENL
6993    [SUBGOAL_THEN
6994      `(path_image u UNION path_image g) INTER
6995       (path_image d UNION path_image g) = path_image(g:real^1->real^2)`
6996      (fun th -> ASM_SIMP_TAC[CONNECTED_ARC_IMAGE; th]) THEN
6997     MATCH_MP_TAC(SET_RULE
6998      `u INTER d SUBSET s ==> (u UNION s) INTER (d UNION s) = s`) THEN
6999     ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN
7000     ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE;
7001                   ARC_IMP_PATH];
7002     REWRITE_TAC[connected_component] THEN
7003     EXISTS_TAC `ins UNION out UNION (s DIFF path_image u):real^2->bool` THEN
7004     ASM_REWRITE_TAC[IN_UNION] THEN CONJ_TAC THENL
7005      [ONCE_REWRITE_TAC[SET_RULE `s UNION t UNION u =
7006                                 (s UNION u) UNION (t UNION u)`] THEN
7007       MATCH_MP_TAC CONNECTED_UNION THEN REPEAT CONJ_TAC THENL
7008        [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
7009         EXISTS_TAC `ins:real^2->bool` THEN
7010         ASM_SIMP_TAC[UNION_SUBSET; CLOSURE_UNION_FRONTIER; SUBSET_UNION] THEN
7011         ASM SET_TAC[];
7012         MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
7013         EXISTS_TAC `out:real^2->bool` THEN
7014         ASM_SIMP_TAC[UNION_SUBSET; CLOSURE_UNION_FRONTIER; SUBSET_UNION] THEN
7015         ASM SET_TAC[];
7016         MATCH_MP_TAC(SET_RULE
7017          `~(u = {}) ==> ~((s UNION u) INTER (t UNION u) = {})`) THEN
7018         SUBGOAL_THEN `~(path_image d SUBSET {a:real^2,b})`
7019         MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
7020         DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
7021           FINITE_SUBSET)) THEN
7022         REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN
7023         ASM_SIMP_TAC[INFINITE_ARC_IMAGE; GSYM INFINITE]];
7024       SUBGOAL_THEN `ins INTER out = {} /\ ins INTER mid = {} /\
7025                     (mid:real^2->bool) INTER out = {}`
7026       MP_TAC THENL [ASM_MESON_TAC[COMPONENTS_NONOVERLAP]; ALL_TAC] THEN
7027       REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN
7028       ASM SET_TAC[]];
7029     REWRITE_TAC[connected_component] THEN
7030     EXISTS_TAC `ins UNION out UNION (s DIFF path_image d):real^2->bool` THEN
7031     ASM_REWRITE_TAC[IN_UNION] THEN CONJ_TAC THENL
7032      [ONCE_REWRITE_TAC[SET_RULE `s UNION t UNION u =
7033                                 (s UNION u) UNION (t UNION u)`] THEN
7034       MATCH_MP_TAC CONNECTED_UNION THEN REPEAT CONJ_TAC THENL
7035        [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
7036         EXISTS_TAC `ins:real^2->bool` THEN
7037         ASM_SIMP_TAC[UNION_SUBSET; CLOSURE_UNION_FRONTIER; SUBSET_UNION] THEN
7038         ASM SET_TAC[];
7039         MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
7040         EXISTS_TAC `out:real^2->bool` THEN
7041         ASM_SIMP_TAC[UNION_SUBSET; CLOSURE_UNION_FRONTIER; SUBSET_UNION] THEN
7042         ASM SET_TAC[];
7043         MATCH_MP_TAC(SET_RULE
7044          `~(u = {}) ==> ~((s UNION u) INTER (t UNION u) = {})`) THEN
7045         SUBGOAL_THEN `~(path_image u SUBSET {a:real^2,b})`
7046         MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
7047         DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
7048           FINITE_SUBSET)) THEN
7049         REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN
7050         ASM_SIMP_TAC[INFINITE_ARC_IMAGE; GSYM INFINITE]];
7051       SUBGOAL_THEN `ins INTER out = {} /\ ins INTER mid = {} /\
7052                     (mid:real^2->bool) INTER out = {}`
7053       MP_TAC THENL [ASM_MESON_TAC[COMPONENTS_NONOVERLAP]; ALL_TAC] THEN
7054       REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN
7055       ASM SET_TAC[]];
7056     SUBGOAL_THEN `~(connected_component ((:real^2) DIFF s) x y)` MP_TAC THENL
7057      [REWRITE_TAC[connected_component] THEN
7058       DISCH_THEN(X_CHOOSE_THEN `t:real^2->bool` STRIP_ASSUME_TAC) THEN
7059       MP_TAC(ISPECL [`(:real^2) DIFF s`; `t:real^2->bool`]
7060         COMPONENTS_MAXIMAL) THEN
7061       DISCH_THEN(fun th ->
7062         MP_TAC(SPEC `ins:real^2->bool` th) THEN
7063         MP_TAC(SPEC `out:real^2->bool` th)) THEN ASM SET_TAC[];
7064       REWRITE_TAC[CONTRAPOS_THM] THEN
7065       MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s y ==> t y`) THEN
7066       REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN
7067       ASM SET_TAC[]]]);;
7068
7069 let JORDAN_DISCONNECTED = prove
7070  (`!c. simple_path c /\ pathfinish c = pathstart c
7071        ==> ~connected((:real^2) DIFF path_image c)`,
7072   GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[connected] THEN
7073   FIRST_ASSUM(MP_TAC o MATCH_MP JORDAN_CURVE_THEOREM) THEN
7074   REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
7075   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);;
7076
7077 let JORDAN_INSIDE_OUTSIDE = prove
7078  (`!c:real^1->real^2.
7079         simple_path c /\ pathfinish c = pathstart c
7080         ==> ~(inside(path_image c) = {}) /\
7081             open(inside(path_image c)) /\
7082             connected(inside(path_image c)) /\
7083             ~(outside(path_image c) = {}) /\
7084             open(outside(path_image c)) /\
7085             connected(outside(path_image c)) /\
7086             bounded(inside(path_image c)) /\
7087             ~bounded(outside(path_image c)) /\
7088             inside(path_image c) INTER outside(path_image c) = {} /\
7089             inside(path_image c) UNION outside(path_image c) =
7090             (:real^2) DIFF path_image c /\
7091             frontier(inside(path_image c)) = path_image c /\
7092             frontier(outside(path_image c)) = path_image c`,
7093   GEN_TAC THEN DISCH_TAC THEN
7094   FIRST_ASSUM(MP_TAC o MATCH_MP JORDAN_CURVE_THEOREM) THEN
7095   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
7096   MAP_EVERY X_GEN_TAC [`ins:real^2->bool`; `out:real^2->bool`] THEN
7097   STRIP_TAC THEN
7098   SUBGOAL_THEN `inside(path_image c) :real^2->bool = ins /\
7099                 outside(path_image c):real^2->bool = out `
7100    (fun th -> ASM_REWRITE_TAC[th]) THEN
7101   MATCH_MP_TAC INSIDE_OUTSIDE_UNIQUE THEN ASM_SIMP_TAC[JORDAN_DISCONNECTED]);;
7102
7103 (* ------------------------------------------------------------------------- *)
7104 (* Triple-curve or "theta-curve" theorem. Proof that there is no fourth      *)
7105 (* component taken from Kuratowski's Topology vol 2, para 61, II.            *)
7106 (* ------------------------------------------------------------------------- *)
7107
7108 let SPLIT_INSIDE_SIMPLE_CLOSED_CURVE = prove
7109  (`!c1 c2 c a b:real^2.
7110         ~(a = b) /\
7111         simple_path c1 /\ pathstart c1 = a /\ pathfinish c1 = b /\
7112         simple_path c2 /\ pathstart c2 = a /\ pathfinish c2 = b /\
7113         simple_path c /\ pathstart c = a /\ pathfinish c = b /\
7114         path_image c1 INTER path_image c2 = {a,b} /\
7115         path_image c1 INTER path_image c = {a,b} /\
7116         path_image c2 INTER path_image c = {a,b} /\
7117         ~(path_image c INTER inside(path_image c1 UNION path_image c2) = {})
7118         ==> inside(path_image c1 UNION path_image c) INTER
7119             inside(path_image c2 UNION path_image c) = {} /\
7120             inside(path_image c1 UNION path_image c) UNION
7121             inside(path_image c2 UNION path_image c) UNION
7122             (path_image c DIFF {a,b}) =
7123             inside(path_image c1 UNION path_image c2)`,
7124   REPEAT GEN_TAC THEN STRIP_TAC THEN
7125   MAP_EVERY (MP_TAC o C ISPEC JORDAN_INSIDE_OUTSIDE)
7126    [`(c1 ++ reversepath c2):real^1->real^2`;
7127     `(c1 ++ reversepath c):real^1->real^2`;
7128     `(c2 ++ reversepath c):real^1->real^2`] THEN
7129   ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN;
7130                PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH;
7131                SIMPLE_PATH_JOIN_LOOP; SIMPLE_PATH_IMP_ARC;
7132                PATH_IMAGE_JOIN; SIMPLE_PATH_IMP_PATH; PATH_IMAGE_REVERSEPATH;
7133                SIMPLE_PATH_REVERSEPATH; ARC_REVERSEPATH;
7134                SUBSET_REFL] THEN
7135   REPLICATE_TAC 3 STRIP_TAC THEN
7136   SUBGOAL_THEN
7137    `path_image(c:real^1->real^2) INTER
7138     outside(path_image c1 UNION path_image c2) = {}`
7139   ASSUME_TAC THENL
7140    [MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
7141     SUBGOAL_THEN
7142      `connected(path_image(c:real^1->real^2) DIFF
7143                 {pathstart c,pathfinish c})`
7144     MP_TAC THENL [ASM_SIMP_TAC[CONNECTED_SIMPLE_PATH_ENDLESS]; ALL_TAC] THEN
7145     ASM_REWRITE_TAC[connected] THEN
7146     MAP_EVERY EXISTS_TAC
7147      [`inside(path_image c1 UNION path_image c2):real^2->bool`;
7148       `outside(path_image c1 UNION path_image c2):real^2->bool`] THEN
7149     ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
7150     ALL_TAC] THEN
7151   SUBGOAL_THEN
7152    `outside(path_image c1 UNION path_image c2) SUBSET
7153     outside(path_image c1 UNION path_image (c:real^1->real^2)) /\
7154     outside(path_image c1 UNION path_image c2) SUBSET
7155     outside(path_image c2 UNION path_image c)`
7156   STRIP_ASSUME_TAC THENL
7157    [CONJ_TAC THENL
7158      [ALL_TAC; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [UNION_COMM]] THEN
7159     MATCH_MP_TAC OUTSIDE_UNION_OUTSIDE_UNION THEN ASM_REWRITE_TAC[] THEN
7160     ONCE_REWRITE_TAC[UNION_COMM] THEN ASM_REWRITE_TAC[];
7161     ALL_TAC] THEN
7162   SUBGOAL_THEN
7163    `path_image(c1:real^1->real^2) INTER
7164     inside(path_image c2 UNION path_image c) = {}`
7165   ASSUME_TAC THENL
7166    [MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
7167     SUBGOAL_THEN
7168      `frontier(outside(path_image c1 UNION path_image c2)):real^2->bool =
7169       frontier(outside(path_image c2 UNION path_image c))`
7170     MP_TAC THENL
7171      [AP_TERM_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN
7172       GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [UNION_COMM] THEN
7173       MATCH_MP_TAC OUTSIDE_UNION_OUTSIDE_UNION THEN
7174       MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
7175       SUBGOAL_THEN
7176        `connected(path_image(c1:real^1->real^2) DIFF
7177                   {pathstart c1,pathfinish c1})`
7178       MP_TAC THENL [ASM_SIMP_TAC[CONNECTED_SIMPLE_PATH_ENDLESS]; ALL_TAC] THEN
7179       ASM_REWRITE_TAC[connected] THEN
7180       MAP_EVERY EXISTS_TAC
7181        [`inside(path_image c2 UNION path_image c):real^2->bool`;
7182         `outside(path_image c2 UNION path_image c):real^2->bool`] THEN
7183       ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
7184       MP_TAC(ISPEC `c:real^1->real^2` NONEMPTY_SIMPLE_PATH_ENDLESS) THEN
7185       ASM_REWRITE_TAC[] THEN ASM SET_TAC[]];
7186     ALL_TAC] THEN
7187   SUBGOAL_THEN
7188    `path_image(c2:real^1->real^2) INTER
7189     inside(path_image c1 UNION path_image c) = {}`
7190   ASSUME_TAC THENL
7191    [MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
7192     SUBGOAL_THEN
7193      `frontier(outside(path_image c1 UNION path_image c2)):real^2->bool =
7194       frontier(outside(path_image c1 UNION path_image c))`
7195     MP_TAC THENL
7196      [AP_TERM_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN
7197       MATCH_MP_TAC OUTSIDE_UNION_OUTSIDE_UNION THEN
7198       MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
7199       SUBGOAL_THEN
7200        `connected(path_image(c2:real^1->real^2) DIFF
7201                   {pathstart c2,pathfinish c2})`
7202       MP_TAC THENL [ASM_SIMP_TAC[CONNECTED_SIMPLE_PATH_ENDLESS]; ALL_TAC] THEN
7203       ASM_REWRITE_TAC[connected] THEN
7204       MAP_EVERY EXISTS_TAC
7205        [`inside(path_image c1 UNION path_image c):real^2->bool`;
7206         `outside(path_image c1 UNION path_image c):real^2->bool`] THEN
7207       ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
7208       MP_TAC(ISPEC `c:real^1->real^2` NONEMPTY_SIMPLE_PATH_ENDLESS) THEN
7209       ASM_REWRITE_TAC[] THEN ASM SET_TAC[]];
7210     ALL_TAC] THEN
7211   SUBGOAL_THEN
7212    `inside(path_image c1 UNION path_image (c:real^1->real^2)) SUBSET
7213     inside(path_image c1 UNION path_image c2) /\
7214     inside(path_image c2 UNION path_image (c:real^1->real^2)) SUBSET
7215     inside(path_image c1 UNION path_image c2)`
7216   STRIP_ASSUME_TAC THENL
7217    [CONJ_TAC THEN REWRITE_TAC[INSIDE_OUTSIDE] THEN
7218     REWRITE_TAC[SET_RULE `UNIV DIFF t SUBSET UNIV DIFF s <=> s SUBSET t`] THENL
7219      [ALL_TAC; GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [UNION_COMM]] THEN
7220     MATCH_MP_TAC(SET_RULE
7221      `out1 SUBSET out2 /\ c2 DIFF (c1 UNION c) SUBSET out2
7222       ==> (c1 UNION c2) UNION out1 SUBSET (c1 UNION c) UNION out2`) THEN
7223     ASM_REWRITE_TAC[] THEN
7224     REWRITE_TAC[OUTSIDE_INSIDE] THEN ASM SET_TAC[];
7225     ALL_TAC] THEN
7226   SUBGOAL_THEN
7227    `inside(path_image c1 UNION path_image c :real^2->bool) SUBSET
7228     outside(path_image c2 UNION path_image c) /\
7229     inside(path_image c2 UNION path_image c) SUBSET
7230     outside(path_image c1 UNION path_image c)`
7231   STRIP_ASSUME_TAC THENL
7232    [REWRITE_TAC[SUBSET] THEN CONJ_TAC THEN
7233     X_GEN_TAC `x:real^2` THEN DISCH_TAC THENL
7234      [SUBGOAL_THEN `?z:real^2. z IN path_image c1 /\
7235                                z IN outside(path_image c2 UNION path_image c)`
7236       (CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THENL
7237        [REWRITE_TAC[OUTSIDE_INSIDE; IN_DIFF; IN_UNION; IN_UNIV] THEN
7238         MP_TAC(ISPEC `c1:real^1->real^2` NONEMPTY_SIMPLE_PATH_ENDLESS) THEN
7239         ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
7240         ALL_TAC] THEN
7241       DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
7242       REWRITE_TAC[OUTSIDE; IN_ELIM_THM; CONTRAPOS_THM] THEN
7243       MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
7244       MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN REWRITE_TAC[IN] THEN
7245       MP_TAC(ASSUME
7246        `open(outside(path_image c2 UNION path_image c):real^2->bool)`) THEN
7247       REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
7248       DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN ASM_REWRITE_TAC[] THEN
7249       DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
7250       MP_TAC(ASSUME
7251        `frontier(inside(path_image c1 UNION path_image c):real^2->bool) =
7252         path_image c1 UNION path_image c`) THEN
7253       GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN
7254       DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN REWRITE_TAC[frontier] THEN
7255       ASM_SIMP_TAC[IN_UNION; IN_DIFF; CLOSURE_APPROACHABLE; IN_ELIM_THM] THEN
7256       DISCH_THEN(MP_TAC o SPEC `e:real` o CONJUNCT1) THEN
7257       ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
7258       X_GEN_TAC `w:real^2` THEN STRIP_TAC THEN
7259       MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `w:real^2` THEN
7260       REWRITE_TAC[connected_component] THEN CONJ_TAC THENL
7261        [EXISTS_TAC
7262          `outside(path_image c2 UNION path_image c:real^2->bool)` THEN
7263         ASM_REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`;
7264                         OUTSIDE_NO_OVERLAP] THEN
7265         FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
7266         ASM_REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] IN_BALL];
7267         EXISTS_TAC `inside(path_image c1 UNION path_image c:real^2->bool)` THEN
7268         ASM_REWRITE_TAC[] THEN
7269         MATCH_MP_TAC(SET_RULE
7270          `inside(c1 UNION c) INTER (c1 UNION c) = {} /\
7271           c2 INTER inside(c1 UNION c) = {}
7272           ==> inside(c1 UNION c) SUBSET UNIV DIFF (c2 UNION c)`) THEN
7273         ASM_REWRITE_TAC[INSIDE_NO_OVERLAP]];
7274       SUBGOAL_THEN `?z:real^2. z IN path_image c2 /\
7275                                z IN outside(path_image c1 UNION path_image c)`
7276       (CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THENL
7277        [REWRITE_TAC[OUTSIDE_INSIDE; IN_DIFF; IN_UNION; IN_UNIV] THEN
7278         MP_TAC(ISPEC `c2:real^1->real^2` NONEMPTY_SIMPLE_PATH_ENDLESS) THEN
7279         ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
7280         ALL_TAC] THEN
7281       DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
7282       REWRITE_TAC[OUTSIDE; IN_ELIM_THM; CONTRAPOS_THM] THEN
7283       MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
7284       MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN REWRITE_TAC[IN] THEN
7285       MP_TAC(ASSUME
7286        `open(outside(path_image c1 UNION path_image c):real^2->bool)`) THEN
7287       REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
7288       DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN ASM_REWRITE_TAC[] THEN
7289       DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
7290       MP_TAC(ASSUME
7291        `frontier(inside(path_image c2 UNION path_image c):real^2->bool) =
7292         path_image c2 UNION path_image c`) THEN
7293       GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN
7294       DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN REWRITE_TAC[frontier] THEN
7295       ASM_SIMP_TAC[IN_UNION; IN_DIFF; CLOSURE_APPROACHABLE; IN_ELIM_THM] THEN
7296       DISCH_THEN(MP_TAC o SPEC `e:real` o CONJUNCT1) THEN
7297       ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
7298       X_GEN_TAC `w:real^2` THEN STRIP_TAC THEN
7299       MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `w:real^2` THEN
7300       REWRITE_TAC[connected_component] THEN CONJ_TAC THENL
7301        [EXISTS_TAC
7302          `outside(path_image c1 UNION path_image c:real^2->bool)` THEN
7303         ASM_REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`;
7304                         OUTSIDE_NO_OVERLAP] THEN
7305         FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
7306         ASM_REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] IN_BALL];
7307         EXISTS_TAC `inside(path_image c2 UNION path_image c:real^2->bool)` THEN
7308         ASM_REWRITE_TAC[] THEN
7309         MATCH_MP_TAC(SET_RULE
7310          `inside(c2 UNION c) INTER (c2 UNION c) = {} /\
7311           c1 INTER inside(c2 UNION c) = {}
7312           ==> inside(c2 UNION c) SUBSET UNIV DIFF (c1 UNION c)`) THEN
7313         ASM_REWRITE_TAC[INSIDE_NO_OVERLAP]]];
7314     ALL_TAC] THEN
7315   CONJ_TAC THENL
7316    [MATCH_MP_TAC(SET_RULE
7317      `!u. s SUBSET u /\ t INTER u = {} ==> s INTER t = {}`) THEN
7318     EXISTS_TAC `outside(path_image c2 UNION path_image c):real^2->bool` THEN
7319     ASM_REWRITE_TAC[INSIDE_INTER_OUTSIDE];
7320     ALL_TAC] THEN
7321   SUBGOAL_THEN
7322    `outside (path_image c1 UNION path_image c) INTER
7323     outside (path_image c2 UNION path_image c):real^2->bool
7324     SUBSET outside (path_image c1 UNION path_image c2)`
7325   MP_TAC THENL
7326    [ALL_TAC;
7327     ONCE_REWRITE_TAC[SET_RULE `s INTER t = u <=>
7328                         (UNIV DIFF s) UNION (UNIV DIFF t) = UNIV DIFF u`] THEN
7329     REWRITE_TAC[GSYM UNION_WITH_INSIDE] THEN ASM SET_TAC[]] THEN
7330   MATCH_MP_TAC COMPONENTS_MAXIMAL THEN
7331   EXISTS_TAC `(:real^2) DIFF (path_image c1 UNION path_image c2)` THEN
7332   MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
7333    [ASM_REWRITE_TAC[OUTSIDE_IN_COMPONENTS]; DISCH_TAC] THEN
7334   CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
7335   MP_TAC(ISPECL
7336    [`closure(inside(path_image c1 UNION path_image c)):real^2->bool`;
7337     `closure(inside(path_image c2 UNION path_image c)):real^2->bool`]
7338    JANISZEWSKI_CONNECTED) THEN
7339   ASM_REWRITE_TAC[COMPACT_CLOSURE; CLOSED_CLOSURE] THEN
7340   ASM_REWRITE_TAC[CLOSURE_UNION_FRONTIER;
7341                   SET_RULE `UNIV DIFF (UNIV DIFF s) = s`;
7342                   ONCE_REWRITE_RULE[UNION_COMM] UNION_WITH_INSIDE] THEN
7343   REWRITE_TAC[SET_RULE
7344    `UNIV DIFF ((UNIV DIFF s) UNION (UNIV DIFF t)) = s INTER t`] THEN
7345   DISCH_THEN MATCH_MP_TAC THEN
7346   SUBGOAL_THEN `connected(path_image c:real^2->bool)` MP_TAC THENL
7347    [ASM_SIMP_TAC[CONNECTED_SIMPLE_PATH_IMAGE]; ALL_TAC] THEN
7348   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
7349   REWRITE_TAC[GSYM UNION_WITH_INSIDE] THEN ASM SET_TAC[]);;