Multivariate/dimension.ml

   1 (* ========================================================================= *)
   2 (* Results connected with topological dimension.                             *)
   3 (*                                                                           *)
   4 (* At the moment this is just Brouwer's fixpoint theorem. The proof is from  *)
   5 (* Kuhn: "some combinatorial lemmas in topology", IBM J. v4. (1960) p. 518   *)
   6 (* See "http://www.research.ibm.com/journal/rd/045/ibmrd0405K.pdf".          *)
   7 (*                                                                           *)
   8 (* The script below is quite messy, but at least we avoid formalizing any    *)
   9 (* topological machinery; we don't even use barycentric subdivision; this is *)
  10 (* the big advantage of Kuhn's proof over the usual Sperner's lemma one.     *)
  11 (*                                                                           *)
  12 (*              (c) Copyright, John Harrison 1998-2008                       *)
  13 (* ========================================================================= *)
  14
  15 needs "Multivariate/polytope.ml";;
  16
  17 let BROUWER_COMPACTNESS_LEMMA = prove
  18  (`!f:real^M->real^N s.
  19         compact s /\ f continuous_on s /\ ~(?x. x IN s /\ (f x = vec 0))
  20         ==> ?d. &0 < d /\ !x. x IN s ==> d <= norm(f x)`,
  21   REPEAT STRIP_TAC THEN
  22   MP_TAC(ISPECL [`norm o (f:real^M->real^N)`; `s:real^M->bool`]
  23                 CONTINUOUS_ATTAINS_INF) THEN
  24   ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THENL
  25    [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN
  26   ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; o_ASSOC; CONTINUOUS_ON_LIFT_NORM] THEN
  27   REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[NORM_POS_LT]);;
  28
  29 let KUHN_LABELLING_LEMMA = prove
  30  (`!f:real^N->real^N P Q.
  31         (!x. P x ==> P (f x))
  32         ==> (!x. P x ==> (!i. Q i ==> &0 <= x$i /\ x$i <= &1))
  33             ==> ?l. (!x i. l x i <= 1) /\
  34                     (!x i. P x /\ Q i /\ (x$i = &0) ==> (l x i = 0)) /\
  35                     (!x i. P x /\ Q i /\ (x$i = &1) ==> (l x i = 1)) /\
  36                     (!x i. P x /\ Q i /\ (l x i = 0) ==> x$i <= f(x)$i) /\
  37                     (!x i. P x /\ Q i /\ (l x i = 1) ==> f(x)$i <= x$i)`,
  38   REPEAT GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM;  GSYM SKOLEM_THM] THEN
  39   REWRITE_TAC[ARITH_RULE `n <= 1 <=> (n = 0) \/ (n = 1)`;
  40               RIGHT_OR_DISTRIB; EXISTS_OR_THM; UNWIND_THM2; ARITH_EQ] THEN
  41   MESON_TAC[REAL_ARITH
  42    `!x y. &0 <= x /\ x <= &1 /\ &0 <= y /\ y <= &1
  43           ==> ~(x = &1) /\ x <= y \/ ~(x = &0) /\ y <= x`]);;
  44
  45 (* ------------------------------------------------------------------------- *)
  46 (* The key "counting" observation, somewhat abstracted.                      *)
  47 (* ------------------------------------------------------------------------- *)
  48
  49 let KUHN_COUNTING_LEMMA = prove
  50  (`!face:F->S->bool faces simplices comp comp' bnd.
  51         FINITE faces /\ FINITE simplices /\
  52         (!f. f IN faces /\ bnd f
  53              ==> (CARD {s | s IN simplices /\ face f s} = 1)) /\
  54         (!f. f IN faces /\ ~bnd f
  55              ==> (CARD {s | s IN simplices /\ face f s} = 2)) /\
  56         (!s. s IN simplices /\ comp s
  57              ==> (CARD {f | f IN faces /\ face f s /\ comp' f} = 1)) /\
  58         (!s. s IN simplices /\ ~comp s
  59              ==> (CARD {f | f IN faces /\ face f s /\ comp' f} = 0) \/
  60                  (CARD {f | f IN faces /\ face f s /\ comp' f} = 2))
  61         ==> ODD(CARD {f | f IN faces /\ comp' f /\ bnd f})
  62             ==> ODD(CARD {s | s IN simplices /\ comp s})`,
  63   REPEAT STRIP_TAC THEN
  64   SUBGOAL_THEN
  65    `sum simplices
  66      (\s:S. &(CARD {f:F | f IN faces /\ face f s /\ comp' f})) =
  67     sum simplices
  68      (\s. &(CARD {f | f IN {f | f IN faces /\ comp' f /\ bnd f} /\
  69                       face f s})) +
  70     sum simplices
  71      (\s. &(CARD {f | f IN {f | f IN faces /\ comp' f /\ ~(bnd f)} /\
  72                       face f s}))`
  73   MP_TAC THENL
  74    [ASM_SIMP_TAC[GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_EQ THEN
  75     ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
  76     REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN
  77     MATCH_MP_TAC CARD_UNION_EQ THEN ASM_SIMP_TAC[FINITE_RESTRICT] THEN
  78     REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; IN_UNION; NOT_IN_EMPTY] THEN
  79     CONJ_TAC THEN GEN_TAC THEN CONV_TAC TAUT;
  80     ALL_TAC] THEN
  81   MP_TAC(ISPECL
  82    [`\s f. (face:F->S->bool) f s`; `simplices:S->bool`;
  83     `{f:F | f IN faces /\ comp' f /\ bnd f}`; `1`] SUM_MULTICOUNT) THEN
  84   MP_TAC(ISPECL
  85    [`\s f. (face:F->S->bool) f s`; `simplices:S->bool`;
  86     `{f:F | f IN faces /\ comp' f /\ ~(bnd f)}`; `2`] SUM_MULTICOUNT) THEN
  87   REWRITE_TAC[] THEN
  88   REPEAT(ANTS_TAC THENL
  89    [ASM_SIMP_TAC[FINITE_RESTRICT] THEN GEN_TAC THEN
  90     DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN
  91     SIMP_TAC[IN_ELIM_THM];
  92     DISCH_THEN SUBST1_TAC]) THEN
  93   SUBGOAL_THEN
  94    `sum simplices
  95      (\s:S. &(CARD {f:F | f IN faces /\ face f s /\ comp' f})) =
  96     sum {s | s IN simplices /\ comp s}
  97         (\s:S. &(CARD {f:F | f IN faces /\ face f s /\ comp' f})) +
  98     sum {s | s IN simplices /\ ~(comp s)}
  99         (\s:S. &(CARD {f:F | f IN faces /\ face f s /\ comp' f}))`
 100   SUBST1_TAC THENL
 101    [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNION_EQ THEN
 102     ASM_REWRITE_TAC[] THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN
 103     REWRITE_TAC[IN_ELIM_THM; IN_INTER; IN_UNION] THEN
 104     CONJ_TAC THEN GEN_TAC THEN CONV_TAC TAUT;
 105     ALL_TAC] THEN
 106   SUBGOAL_THEN
 107    `sum {s | s IN simplices /\ comp s}
 108         (\s:S. &(CARD {f:F | f IN faces /\ face f s /\ comp' f})) =
 109     sum {s | s IN simplices /\ comp s} (\s. &1)`
 110   SUBST1_TAC THENL
 111    [MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[FINITE_RESTRICT] THEN
 112     GEN_TAC THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN
 113     DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN
 114     SIMP_TAC[IN_ELIM_THM];
 115     ALL_TAC] THEN
 116   SUBGOAL_THEN
 117    `sum {s | s IN simplices /\ ~(comp s)}
 118         (\s:S. &(CARD {f:F | f IN faces /\ face f s /\ comp' f})) =
 119     sum {s | s IN simplices /\ ~(comp s) /\
 120              (CARD {f | f IN faces /\ face f s /\ comp' f} = 0)}
 121         (\s:S. &(CARD {f:F | f IN faces /\ face f s /\ comp' f})) +
 122     sum {s | s IN simplices /\ ~(comp s) /\
 123              (CARD {f | f IN faces /\ face f s /\ comp' f} = 2)}
 124         (\s:S. &(CARD {f:F | f IN faces /\ face f s /\ comp' f}))`
 125   SUBST1_TAC THENL
 126    [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNION_EQ THEN
 127     ASM_SIMP_TAC[FINITE_RESTRICT] THEN
 128     REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_UNION] THEN
 129     CONJ_TAC THENL
 130      [REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[ARITH_RULE `~(2 = 0)`];
 131       ALL_TAC] THEN
 132     X_GEN_TAC `s:S` THEN UNDISCH_TAC
 133      `!s:S. s IN simplices /\ ~comp s
 134             ==> (CARD {f:F | f IN faces /\ face f s /\ comp' f} = 0) \/
 135                 (CARD {f | f IN faces /\ face f s /\ comp' f} = 2)` THEN
 136     DISCH_THEN(MP_TAC o SPEC `s:S`) THEN
 137     REWRITE_TAC[IN_ELIM_THM] THEN CONV_TAC TAUT;
 138     ALL_TAC] THEN
 139   SUBGOAL_THEN
 140    `!n. sum {s | s IN simplices /\ ~(comp s) /\
 141              (CARD {f | f IN faces /\ face f s /\ comp' f} = n)}
 142             (\s:S. &(CARD {f:F | f IN faces /\ face f s /\ comp' f})) =
 143         sum {s | s IN simplices /\ ~(comp s) /\
 144              (CARD {f | f IN faces /\ face f s /\ comp' f} = n)}
 145             (\s:S. &n)`
 146    (fun th -> REWRITE_TAC[th])
 147   THENL
 148    [GEN_TAC THEN MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[FINITE_RESTRICT] THEN
 149     SIMP_TAC[IN_ELIM_THM];
 150     ALL_TAC] THEN
 151   REWRITE_TAC[SUM_0] THEN ASM_SIMP_TAC[SUM_CONST; FINITE_RESTRICT] THEN
 152   REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN
 153   REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN
 154   FIRST_X_ASSUM(CHOOSE_THEN SUBST1_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN
 155   DISCH_THEN(MP_TAC o AP_TERM `ODD`) THEN
 156   REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH_ODD; ODD]);;
 157
 158 (* ------------------------------------------------------------------------- *)
 159 (* The odd/even result for faces of complete vertices, generalized.          *)
 160 (* ------------------------------------------------------------------------- *)
 161
 162 let HAS_SIZE_1_EXISTS = prove
 163  (`!s. s HAS_SIZE 1 <=> ?!x. x IN s`,
 164   REPEAT GEN_TAC THEN CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN
 165   REWRITE_TAC[EXTENSION; IN_SING] THEN MESON_TAC[]);;
 166
 167 let HAS_SIZE_2_EXISTS = prove
 168  (`!s. s HAS_SIZE 2 <=> ?x y. ~(x = y) /\ !z. z IN s <=> (z = x) \/ (z = y)`,
 169   REPEAT GEN_TAC THEN CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN
 170   REWRITE_TAC[EXTENSION; IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[]);;
 171
 172 let IMAGE_LEMMA_0 = prove
 173  (`!f:A->B s n.
 174       {a | a IN s /\ (IMAGE f (s DELETE a) = t DELETE b)} HAS_SIZE n
 175       ==> {s' | ?a. a IN s /\ (s' = s DELETE a) /\ (IMAGE f s' = t DELETE b)}
 176           HAS_SIZE n`,
 177   REPEAT STRIP_TAC THEN
 178   SUBGOAL_THEN
 179    `{s' | ?a. a IN s /\ (s' = s DELETE a) /\ (IMAGE f s' = t DELETE b)} =
 180     IMAGE (\a. s DELETE a)
 181           {a | a IN s /\ (IMAGE (f:A->B) (s DELETE a) = t DELETE b)}`
 182   SUBST1_TAC THENL
 183    [GEN_REWRITE_TAC I [EXTENSION] THEN
 184     REWRITE_TAC[IN_ELIM_THM; IN_IMAGE] THEN MESON_TAC[];
 185     MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN ASM_REWRITE_TAC[] THEN
 186     REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_DELETE] THEN MESON_TAC[]]);;
 187
 188 let IMAGE_LEMMA_1 = prove
 189  (`!f:A->B s t b.
 190         FINITE s /\ FINITE t /\ (CARD s = CARD t) /\
 191         (IMAGE f s = t) /\ b IN t
 192         ==> (CARD {s' | ?a. a IN s /\ (s' = s DELETE a) /\
 193                             (IMAGE f s' = t DELETE b)} = 1)`,
 194   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_SIZE_CARD THEN
 195   MATCH_MP_TAC IMAGE_LEMMA_0 THEN REWRITE_TAC[HAS_SIZE_1_EXISTS] THEN
 196   SUBGOAL_THEN `!x y. x IN s /\ y IN s /\ ((f:A->B) x = f y) ==> (x = y)`
 197   ASSUME_TAC THENL [ASM_MESON_TAC[IMAGE_IMP_INJECTIVE_GEN]; ALL_TAC] THEN
 198   REWRITE_TAC[EXISTS_UNIQUE_THM; IN_ELIM_THM] THEN CONJ_TAC THEN
 199   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN
 200   REWRITE_TAC[IN_IMAGE] THENL
 201    [DISCH_THEN(fun th -> MP_TAC(SPEC `b:B` th) THEN MP_TAC th) THEN
 202     ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN
 203     REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DELETE] THEN
 204     REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[];
 205     REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DELETE] THEN ASM_MESON_TAC[]]);;
 206
 207 let IMAGE_LEMMA_2 = prove
 208  (`!f:A->B s t b.
 209         FINITE s /\ FINITE t /\ (CARD s = CARD t) /\
 210         (IMAGE f s) SUBSET t /\ ~(IMAGE f s = t) /\ b IN t
 211         ==> (CARD {s' | ?a. a IN s /\ (s' = s DELETE a) /\
 212                             (IMAGE f s' = t DELETE b)} = 0) \/
 213             (CARD {s' | ?a. a IN s /\ (s' = s DELETE a) /\
 214                             (IMAGE f s' = t DELETE b)} = 2)`,
 215   REPEAT STRIP_TAC THEN ASM_CASES_TAC
 216    `{a | a IN s /\ (IMAGE (f:A->B) (s DELETE a) = t DELETE b)} = {}`
 217   THENL [DISJ1_TAC; DISJ2_TAC] THEN MATCH_MP_TAC HAS_SIZE_CARD THEN
 218   MATCH_MP_TAC IMAGE_LEMMA_0 THEN
 219   ASM_REWRITE_TAC[HAS_SIZE_0; HAS_SIZE_2_EXISTS] THEN
 220   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
 221   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a1:A` THEN
 222   REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
 223   SUBGOAL_THEN `(f:A->B) a1 IN (t DELETE b)` ASSUME_TAC THENL
 224    [REWRITE_TAC[IN_DELETE] THEN
 225     ASM_MESON_TAC[SUBSET; IN_IMAGE; INSERT_DELETE; IMAGE_CLAUSES];
 226     ALL_TAC] THEN
 227   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN
 228   DISCH_THEN(MP_TAC o SPEC `(f:A->B) a1`) THEN ASM_REWRITE_TAC[IN_IMAGE] THEN
 229   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a2:A` THEN
 230   REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
 231   SUBGOAL_THEN
 232    `!x y. x IN (s DELETE a1) /\ y IN (s DELETE a1) /\ ((f:A->B) x = f y)
 233           ==> (x = y)`
 234   MP_TAC THENL
 235    [MATCH_MP_TAC IMAGE_IMP_INJECTIVE_GEN THEN EXISTS_TAC `t DELETE (b:B)` THEN
 236     ASM_SIMP_TAC[CARD_DELETE; FINITE_DELETE];
 237     REWRITE_TAC[IN_DELETE] THEN DISCH_TAC] THEN
 238   X_GEN_TAC `a:A` THEN ASM_CASES_TAC `a:A = a1` THEN ASM_REWRITE_TAC[] THEN
 239   ASM_CASES_TAC `(a:A) IN s` THEN ASM_REWRITE_TAC[] THENL
 240    [ALL_TAC; ASM_MESON_TAC[]] THEN
 241   MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(f:A->B) a = f a1` THEN CONJ_TAC THENL
 242    [ALL_TAC; ASM_MESON_TAC[IN_DELETE]] THEN
 243   FIRST_X_ASSUM(fun t -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SYM t]) THEN
 244   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DELETE] THEN EQ_TAC THENL
 245    [DISCH_THEN(MP_TAC o SPEC `(f:A->B) a`); ALL_TAC] THEN
 246   ASM_MESON_TAC[]);;
 247
 248 (* ------------------------------------------------------------------------- *)
 249 (* Combine this with the basic counting lemma.                               *)
 250 (* ------------------------------------------------------------------------- *)
 251
 252 let KUHN_COMPLETE_LEMMA = prove
 253  (`!face:(A->bool)->(A->bool)->bool simplices rl bnd n.
 254         FINITE simplices /\
 255         (!f s. face f s <=> ?a. a IN s /\ (f = s DELETE a)) /\
 256         (!s. s IN simplices ==> s HAS_SIZE (n + 2) /\
 257                                 (IMAGE rl s) SUBSET 0..n+1) /\
 258         (!f. f IN {f | ?s. s IN simplices /\ face f s} /\ bnd f
 259              ==> (CARD {s | s IN simplices /\ face f s} = 1)) /\
 260         (!f. f IN {f | ?s. s IN simplices /\ face f s} /\ ~bnd f
 261              ==> (CARD {s | s IN simplices /\ face f s} = 2))
 262         ==> ODD(CARD {f | f IN {f | ?s. s IN simplices /\ face f s} /\
 263                           (IMAGE rl f = 0..n) /\ bnd f})
 264             ==> ODD(CARD {s | s IN simplices /\ (IMAGE rl s = 0..n+1)})`,
 265   REPEAT GEN_TAC THEN STRIP_TAC THEN
 266   SUBGOAL_THEN
 267    `!P f:A->bool s.
 268        s IN simplices
 269        ==> (f IN {f | ?s. s IN simplices /\ (?a. a IN s /\ (f = s DELETE a))} /\
 270             (?a. a IN s /\ (f = s DELETE a)) /\ P f <=>
 271            (?a. a IN s /\ (f = s DELETE a) /\ P f))`
 272   ASSUME_TAC THENL
 273    [ASM_REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[]; ALL_TAC] THEN
 274   SUBGOAL_THEN `0..n = (0..n+1) DELETE (n+1)` SUBST1_TAC THENL
 275    [REWRITE_TAC[EXTENSION; IN_NUMSEG; IN_DELETE] THEN ARITH_TAC;
 276     ALL_TAC] THEN
 277   MATCH_MP_TAC KUHN_COUNTING_LEMMA THEN
 278   EXISTS_TAC `face:(A->bool)->(A->bool)->bool` THEN
 279   REPEAT CONJ_TAC THEN TRY(FIRST_ASSUM ACCEPT_TAC) THEN
 280   ASM_SIMP_TAC[] THENL
 281    [SUBGOAL_THEN
 282      `{f:A->bool | ?s. s IN simplices /\ (?a. a IN s /\ (f = s DELETE a))} =
 283       UNIONS (IMAGE (\s. {f | ?a. a IN s /\ (f = s DELETE a)}) simplices)`
 284     SUBST1_TAC THENL
 285      [REWRITE_TAC[EXTENSION; UNIONS_IMAGE; IN_ELIM_THM]; ALL_TAC] THEN
 286     ASM_SIMP_TAC[FINITE_UNIONS; FINITE_IMAGE] THEN
 287     REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `s:A->bool` THEN
 288     DISCH_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN
 289     EXISTS_TAC `{t:A->bool | t SUBSET s}` THEN CONJ_TAC THENL
 290      [MATCH_MP_TAC FINITE_POWERSET THEN ASM_MESON_TAC[HAS_SIZE];
 291       SIMP_TAC[SUBSET; IN_ELIM_THM; LEFT_IMP_EXISTS_THM; IN_DELETE]];
 292     REPEAT STRIP_TAC THEN MATCH_MP_TAC IMAGE_LEMMA_1;
 293     REPEAT STRIP_TAC THEN MATCH_MP_TAC IMAGE_LEMMA_2] THEN
 294   ASM_REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; LE_0; LE_REFL] THEN
 295   REWRITE_TAC[CARD_NUMSEG; ARITH_RULE `((n + 1) + 1) - 0 = n + 2`] THEN
 296   ASM_MESON_TAC[HAS_SIZE]);;
 297
 298 (* ------------------------------------------------------------------------- *)
 299 (* We use the following notion of ordering rather than pointwise indexing.   *)
 300 (* ------------------------------------------------------------------------- *)
 301
 302 let kle = new_definition
 303   `kle n x y <=> ?k. k SUBSET 1..n /\
 304                      (!j. y(j) = x(j) + (if j IN k then 1 else 0))`;;
 305
 306 let KLE_REFL = prove
 307  (`!n x. kle n x x`,
 308   REPEAT GEN_TAC THEN REWRITE_TAC[kle] THEN EXISTS_TAC `{}:num->bool` THEN
 309   REWRITE_TAC[ADD_CLAUSES; NOT_IN_EMPTY; EMPTY_SUBSET]);;
 310
 311 let KLE_ANTISYM = prove
 312  (`!n x y. kle n x y /\ kle n y x <=> (x = y)`,
 313   REPEAT GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[kle]; MESON_TAC[KLE_REFL]] THEN
 314   DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
 315   ASM_REWRITE_TAC[FUN_EQ_THM] THEN
 316   MESON_TAC[ARITH_RULE `(x = (x + a) + b) ==> (x = x + a:num)`]);;
 317
 318 let POINTWISE_MINIMAL,POINTWISE_MAXIMAL = (CONJ_PAIR o prove)
 319  (`(!s:(num->num)->bool.
 320         FINITE s
 321         ==> ~(s = {}) /\
 322             (!x y. x IN s /\ y IN s
 323                    ==> (!j. x(j) <= y(j)) \/ (!j. y(j) <= x(j)))
 324             ==> ?a. a IN s /\ !x. x IN s ==> !j. a(j) <= x(j)) /\
 325    (!s:(num->num)->bool.
 326         FINITE s
 327         ==> ~(s = {}) /\
 328             (!x y. x IN s /\ y IN s
 329                    ==> (!j. x(j) <= y(j)) \/ (!j. y(j) <= x(j)))
 330             ==> ?a. a IN s /\ !x. x IN s ==> !j. x(j) <= a(j))`,
 331   CONJ_TAC THEN
 332   (MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[NOT_INSERT_EMPTY] THEN
 333    MAP_EVERY X_GEN_TAC [`a:num->num`; `s:(num->num)->bool`] THEN
 334    ASM_CASES_TAC `s:(num->num)->bool = {}` THEN ASM_REWRITE_TAC[] THENL
 335     [REWRITE_TAC[IN_SING] THEN MESON_TAC[LE_REFL]; ALL_TAC] THEN
 336    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
 337    DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
 338    ANTS_TAC THENL [ASM_MESON_TAC[IN_INSERT]; ALL_TAC] THEN
 339    DISCH_THEN(X_CHOOSE_THEN `b:num->num` STRIP_ASSUME_TAC) THEN
 340    FIRST_X_ASSUM(MP_TAC o SPECL [`a:num->num`; `b:num->num`]) THEN
 341    ASM_REWRITE_TAC[IN_INSERT] THEN ASM_MESON_TAC[LE_CASES; LE_TRANS]));;
 342
 343 let KLE_IMP_POINTWISE = prove
 344  (`!n x y. kle n x y ==> !j. x(j) <= y(j)`,
 345   REWRITE_TAC[kle] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[LE_ADD]);;
 346
 347 let POINTWISE_ANTISYM = prove
 348  (`!x y:num->num. (!j. x(j) <= y(j)) /\ (!j. y(j) <= x(j)) <=> (x = y)`,
 349   REWRITE_TAC[AND_FORALL_THM; FUN_EQ_THM; LE_ANTISYM]);;
 350
 351 let KLE_TRANS = prove
 352  (`!x y z n. kle n x y /\ kle n y z /\ (kle n x z \/ kle n z x)
 353              ==> kle n x z`,
 354   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
 355   SUBGOAL_THEN `x:num->num = z` (fun th -> REWRITE_TAC[KLE_REFL; th]) THEN
 356   REWRITE_TAC[FUN_EQ_THM; GSYM LE_ANTISYM; FORALL_AND_THM] THEN
 357   ASM_MESON_TAC[KLE_IMP_POINTWISE; LE_TRANS]);;
 358
 359 let KLE_STRICT = prove
 360  (`!n x y. kle n x y /\ ~(x = y)
 361            ==> (!j. x(j) <= y(j)) /\ (?k. 1 <= k /\ k <= n /\ x(k) < y(k))`,
 362   REPEAT GEN_TAC THEN REWRITE_TAC[kle] THEN
 363   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
 364   DISCH_THEN(X_CHOOSE_THEN `k:num->bool` MP_TAC) THEN
 365   ASM_CASES_TAC `k:num->bool = {}` THENL
 366    [ASM_REWRITE_TAC[NOT_IN_EMPTY; ADD_CLAUSES; GSYM FUN_EQ_THM; ETA_AX];
 367     STRIP_TAC THEN ASM_REWRITE_TAC[LE_ADD] THEN
 368     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
 369     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:num` THEN
 370     STRIP_TAC THEN ASM_REWRITE_TAC[ARITH_RULE `n < n + 1`] THEN
 371     ASM_MESON_TAC[SUBSET; IN_NUMSEG]]);;
 372
 373 let KLE_MINIMAL = prove
 374  (`!s n. FINITE s /\ ~(s = {}) /\
 375          (!x y. x IN s /\ y IN s ==> kle n x y \/ kle n y x)
 376          ==> ?a. a IN s /\ !x. x IN s ==> kle n a x`,
 377   REPEAT STRIP_TAC THEN
 378   SUBGOAL_THEN `?a:num->num. a IN s /\ !x. x IN s ==> !j. a(j) <= x(j)`
 379   MP_TAC THENL
 380    [MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] POINTWISE_MINIMAL); ALL_TAC] THEN
 381   ASM_MESON_TAC[POINTWISE_ANTISYM; KLE_IMP_POINTWISE]);;
 382
 383 let KLE_MAXIMAL = prove
 384  (`!s n. FINITE s /\ ~(s = {}) /\
 385          (!x y. x IN s /\ y IN s ==> kle n x y \/ kle n y x)
 386          ==> ?a. a IN s /\ !x. x IN s ==> kle n x a`,
 387   REPEAT STRIP_TAC THEN
 388   SUBGOAL_THEN `?a:num->num. a IN s /\ !x. x IN s ==> !j. x(j) <= a(j)`
 389   MP_TAC THENL
 390    [MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] POINTWISE_MAXIMAL); ALL_TAC] THEN
 391   ASM_MESON_TAC[POINTWISE_ANTISYM; KLE_IMP_POINTWISE]);;
 392
 393 let KLE_STRICT_SET = prove
 394  (`!n x y. kle n x y /\ ~(x = y) ==> 1 <= CARD {k | k IN 1..n /\ x(k) < y(k)}`,
 395   REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP KLE_STRICT) THEN
 396   DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC o CONJUNCT2) THEN
 397   MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD {i:num}` THEN CONJ_TAC THENL
 398    [SIMP_TAC[CARD_CLAUSES; FINITE_RULES; ARITH; NOT_IN_EMPTY];
 399     MATCH_MP_TAC CARD_SUBSET THEN SIMP_TAC[FINITE_RESTRICT; FINITE_NUMSEG] THEN
 400     SIMP_TAC[IN_ELIM_THM; IN_NUMSEG; SUBSET; IN_SING] THEN ASM_MESON_TAC[]]);;
 401
 402 let KLE_RANGE_COMBINE = prove
 403  (`!n x y m1 m2.
 404         kle n x y /\ kle n y z /\ (kle n x z \/ kle n z x) /\
 405         m1 <= CARD {k | k IN 1..n /\ x(k) < y(k)} /\
 406         m2 <= CARD {k | k IN 1..n /\ y(k) < z(k)}
 407         ==> kle n x z /\ m1 + m2 <= CARD {k | k IN 1..n /\ x(k) < z(k)}`,
 408   REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
 409   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
 410    [ASM_MESON_TAC[KLE_TRANS]; DISCH_TAC] THEN
 411   MATCH_MP_TAC LE_TRANS THEN
 412   EXISTS_TAC `CARD {k | k IN 1..n /\ x(k):num < y(k)} +
 413               CARD {k | k IN 1..n /\ y(k) < z(k)}` THEN
 414   ASM_SIMP_TAC[LE_ADD2] THEN MATCH_MP_TAC EQ_IMP_LE THEN
 415   MATCH_MP_TAC CARD_UNION_EQ THEN
 416   SIMP_TAC[FINITE_RESTRICT; FINITE_NUMSEG] THEN
 417   REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; IN_UNION; NOT_IN_EMPTY] THEN
 418   CONJ_TAC THENL
 419    [ALL_TAC;
 420     ASM_MESON_TAC[KLE_IMP_POINTWISE; ARITH_RULE
 421      `x <= y:num /\ y <= z ==> (x < y \/ y < z <=> x < z)`]] THEN
 422   X_GEN_TAC `i:num` THEN UNDISCH_TAC `kle n x z` THEN
 423   REWRITE_TAC[kle] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
 424   ASM_CASES_TAC `i IN 1..n` THEN ASM_REWRITE_TAC[] THEN
 425   MATCH_MP_TAC(ARITH_RULE `d <= 1 ==> ~(a < x /\ x < a + d)`) THEN
 426   COND_CASES_TAC THEN REWRITE_TAC[ARITH]);;
 427
 428 let KLE_RANGE_COMBINE_L = prove
 429  (`!n x y m.
 430         kle n x y /\ kle n y z /\ (kle n x z \/ kle n z x) /\
 431         m <= CARD {k | k IN 1..n /\ y(k) < z(k)}
 432         ==> kle n x z /\ m <= CARD {k | k IN 1..n /\ x(k) < z(k)}`,
 433   REPEAT GEN_TAC THEN ASM_CASES_TAC `x:num->num = y` THEN ASM_SIMP_TAC[] THEN
 434   DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
 435   SUBGOAL_THEN `kle n x z /\ 1 + m <= CARD {k | k IN 1 .. n /\ x k < z k}`
 436    (fun th -> MESON_TAC[th; ARITH_RULE `1 + m <= x ==> m <= x`]) THEN
 437   MATCH_MP_TAC KLE_RANGE_COMBINE THEN EXISTS_TAC `y:num->num` THEN
 438   ASM_SIMP_TAC[KLE_STRICT_SET]);;
 439
 440 let KLE_RANGE_COMBINE_R = prove
 441  (`!n x y m.
 442         kle n x y /\ kle n y z /\ (kle n x z \/ kle n z x) /\
 443         m <= CARD {k | k IN 1..n /\ x(k) < y(k)}
 444         ==> kle n x z /\ m <= CARD {k | k IN 1..n /\ x(k) < z(k)}`,
 445   REPEAT GEN_TAC THEN ASM_CASES_TAC `y:num->num = z` THEN ASM_SIMP_TAC[] THEN
 446   DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
 447   SUBGOAL_THEN `kle n x z /\ m + 1 <= CARD {k | k IN 1 .. n /\ x k < z k}`
 448    (fun th -> MESON_TAC[th; ARITH_RULE `m + 1 <= x ==> m <= x`]) THEN
 449   MATCH_MP_TAC KLE_RANGE_COMBINE THEN EXISTS_TAC `y:num->num` THEN
 450   ASM_SIMP_TAC[KLE_STRICT_SET]);;
 451
 452 let KLE_RANGE_INDUCT = prove
 453  (`!n m s. s HAS_SIZE (SUC m)
 454            ==> (!x y. x IN s /\ y IN s ==> kle n x y \/ kle n y x)
 455                ==> ?x y. x IN s /\ y IN s /\ kle n x y /\
 456                          m <= CARD {k | k IN 1..n /\ x(k) < y(k)}`,
 457   GEN_TAC THEN INDUCT_TAC THENL
 458    [GEN_TAC THEN REWRITE_TAC[ARITH; LE_0] THEN
 459     CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN MESON_TAC[IN_SING; KLE_REFL];
 460     ALL_TAC] THEN
 461   X_GEN_TAC `s:(num->num)->bool` THEN
 462   ONCE_REWRITE_TAC[HAS_SIZE_SUC] THEN REPEAT STRIP_TAC THEN
 463   MP_TAC(SPECL [`s:(num->num)->bool`; `n:num`] KLE_MINIMAL) THEN
 464   ANTS_TAC THENL [ASM_MESON_TAC[HAS_SIZE_SUC; HAS_SIZE]; ALL_TAC] THEN
 465   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:num->num` THEN
 466   STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s DELETE (a:num->num)`) THEN
 467   REPEAT(ANTS_TAC THENL [ASM_MESON_TAC[IN_DELETE]; ALL_TAC]) THEN
 468   DISCH_THEN(X_CHOOSE_THEN `x:num->num` MP_TAC) THEN
 469   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:num->num` THEN
 470   REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
 471   REWRITE_TAC[ARITH_RULE `SUC m = 1 + m`] THEN
 472   MATCH_MP_TAC KLE_RANGE_COMBINE THEN EXISTS_TAC `x:num->num` THEN
 473   ASM_SIMP_TAC[KLE_STRICT_SET]);;
 474
 475 let KLE_SUC = prove
 476  (`!n x y. kle n x y ==> kle (n + 1) x y`,
 477   REPEAT GEN_TAC THEN REWRITE_TAC[kle] THEN MATCH_MP_TAC MONO_EXISTS THEN
 478   REWRITE_TAC[SUBSET; IN_NUMSEG] THEN
 479   MESON_TAC[ARITH_RULE `k <= n ==> k <= n + 1`]);;
 480
 481 let KLE_TRANS_1 = prove
 482  (`!n x y. kle n x y ==> !j. x j <= y j /\ y j <= x j + 1`,
 483   SIMP_TAC[kle; LEFT_IMP_EXISTS_THM] THEN
 484   REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ARITH_TAC);;
 485
 486 let KLE_TRANS_2 = prove
 487  (`!a b c. kle n a b /\ kle n b c /\ (!j. c j <= a j + 1)
 488            ==> kle n a c`,
 489   REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
 490   REWRITE_TAC[kle] THEN
 491   DISCH_THEN(X_CHOOSE_THEN `kk1:num->bool` STRIP_ASSUME_TAC) THEN
 492   DISCH_THEN(X_CHOOSE_THEN `kk2:num->bool` STRIP_ASSUME_TAC) THEN
 493   ASM_REWRITE_TAC[] THEN
 494   DISCH_THEN(fun th ->
 495     EXISTS_TAC `(kk1:num->bool) UNION kk2` THEN MP_TAC th) THEN
 496   ASM_REWRITE_TAC[UNION_SUBSET; IN_UNION] THEN
 497   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
 498   ASM_CASES_TAC `(i:num) IN kk1` THEN ASM_CASES_TAC `(i:num) IN kk2` THEN
 499   ASM_REWRITE_TAC[] THEN ARITH_TAC);;
 500
 501 let KLE_BETWEEN_R = prove
 502  (`!a b c x. kle n a b /\ kle n b c /\ kle n a x /\ kle n c x
 503              ==> kle n b x`,
 504   REPEAT STRIP_TAC THEN MATCH_MP_TAC KLE_TRANS_2 THEN
 505   EXISTS_TAC `c:num->num` THEN ASM_REWRITE_TAC[] THEN
 506   ASM_MESON_TAC[KLE_TRANS_1; ARITH_RULE
 507    `x <= c + 1 /\ c <= b ==> x <= b + 1`]);;
 508
 509 let KLE_BETWEEN_L = prove
 510  (`!a b c x. kle n a b /\ kle n b c /\ kle n x a /\ kle n x c
 511              ==> kle n x b`,
 512   REPEAT STRIP_TAC THEN MATCH_MP_TAC KLE_TRANS_2 THEN
 513   EXISTS_TAC `a:num->num` THEN ASM_REWRITE_TAC[] THEN
 514   ASM_MESON_TAC[KLE_TRANS_1; ARITH_RULE
 515    `c <= x + 1 /\ b <= c ==> b <= x + 1`]);;
 516
 517 let KLE_ADJACENT = prove
 518  (`!a b x k.
 519         1 <= k /\ k <= n /\ (!j. b(j) = if j = k then a(j) + 1 else a(j)) /\
 520         kle n a x /\ kle n x b
 521         ==> (x = a) \/ (x = b)`,
 522   REPEAT STRIP_TAC THEN
 523   REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP KLE_IMP_POINTWISE)) THEN
 524   ASM_REWRITE_TAC[FUN_EQ_THM; IMP_IMP; AND_FORALL_THM] THEN
 525   ASM_CASES_TAC `(x:num->num) k = a k` THENL
 526    [DISCH_THEN(fun th -> DISJ1_TAC THEN MP_TAC th);
 527     DISCH_THEN(fun th -> DISJ2_TAC THEN MP_TAC th)] THEN
 528   MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
 529   COND_CASES_TAC THEN ASM_REWRITE_TAC[LE_ANTISYM] THEN
 530   ASM_MESON_TAC[ARITH_RULE
 531    `a <= x /\ x <= a + 1 /\ ~(x = a) ==> (x = a + 1)`]);;
 532
 533 (* ------------------------------------------------------------------------- *)
 534 (* Kuhn's notion of a simplex (my reformulation to avoid so much indexing).  *)
 535 (* ------------------------------------------------------------------------- *)
 536
 537 let ksimplex = new_definition
 538  `ksimplex p n s <=>
 539         s HAS_SIZE (n + 1) /\
 540         (!x j. x IN s ==> x(j) <= p) /\
 541         (!x j. x IN s /\ ~(1 <= j /\ j <= n) ==> (x j = p)) /\
 542         (!x y. x IN s /\ y IN s ==> kle n x y \/ kle n y x)`;;
 543
 544 let KSIMPLEX_EXTREMA = prove
 545  (`!p n s.
 546         ksimplex p n s
 547         ==> ?a b. a IN s /\ b IN s /\
 548                   (!x. x IN s ==> kle n a x /\ kle n x b) /\
 549                   (!i. b(i) = if 1 <= i /\ i <= n then a(i) + 1 else a(i))`,
 550   REPEAT GEN_TAC THEN REWRITE_TAC[ksimplex] THEN ASM_CASES_TAC `n = 0` THENL
 551    [ASM_REWRITE_TAC[ARITH_RULE `1 <= i /\ i <= 0 <=> F`; GSYM FUN_EQ_THM] THEN
 552     REWRITE_TAC[ADD_CLAUSES; ETA_AX] THEN
 553     CONV_TAC(LAND_CONV(LAND_CONV HAS_SIZE_CONV)) THEN
 554     DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
 555     ASM_REWRITE_TAC[IN_SING] THEN MESON_TAC[KLE_REFL];
 556     ALL_TAC] THEN
 557   REPEAT STRIP_TAC THEN
 558   MP_TAC(SPECL [`s:(num->num)->bool`; `n:num`] KLE_MINIMAL) THEN
 559   ANTS_TAC THENL [ASM_MESON_TAC[HAS_SIZE; HAS_SIZE_SUC; ADD1]; ALL_TAC] THEN
 560   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:num->num` THEN STRIP_TAC THEN
 561   MP_TAC(SPECL [`s:(num->num)->bool`; `n:num`] KLE_MAXIMAL) THEN
 562   ANTS_TAC THENL [ASM_MESON_TAC[HAS_SIZE; HAS_SIZE_SUC; ADD1]; ALL_TAC] THEN
 563   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:num->num` THEN STRIP_TAC THEN
 564   ASM_SIMP_TAC[] THEN
 565   MP_TAC(SPECL [`n:num`; `n:num`; `s:(num->num)->bool`] KLE_RANGE_INDUCT) THEN
 566   ASM_REWRITE_TAC[ADD1] THEN
 567   DISCH_THEN(X_CHOOSE_THEN `c:num->num` (X_CHOOSE_THEN `d:num->num`
 568     STRIP_ASSUME_TAC)) THEN
 569   SUBGOAL_THEN `{k | k IN 1 .. n /\ a k :num < b k} = 1..n` MP_TAC THENL
 570    [MATCH_MP_TAC CARD_SUBSET_LE THEN
 571     ASM_REWRITE_TAC[CARD_NUMSEG; ADD_SUB; FINITE_NUMSEG; SUBSET_RESTRICT] THEN
 572     SUBGOAL_THEN `kle n a b /\ n <= CARD {k | k IN 1..n /\ a(k) < b(k)}`
 573      (fun th -> REWRITE_TAC[th]) THEN
 574     MATCH_MP_TAC KLE_RANGE_COMBINE_L THEN EXISTS_TAC `c:num->num` THEN
 575     ASM_SIMP_TAC[] THEN
 576     SUBGOAL_THEN `kle n c b /\ n <= CARD {k | k IN 1 .. n /\ c k < b k}`
 577      (fun th -> REWRITE_TAC[th]) THEN
 578     MATCH_MP_TAC KLE_RANGE_COMBINE_R THEN EXISTS_TAC `d:num->num` THEN
 579     ASM_SIMP_TAC[];
 580     ALL_TAC] THEN
 581   SUBGOAL_THEN `kle n a b` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
 582   DISCH_THEN(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [kle]) THEN
 583   ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN
 584   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
 585   COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; LT_REFL] THEN
 586   ASM_MESON_TAC[SUBSET; IN_NUMSEG]);;
 587
 588 let KSIMPLEX_EXTREMA_STRONG = prove
 589  (`!p n s.
 590         ksimplex p n s /\ ~(n = 0)
 591         ==> ?a b. a IN s /\ b IN s /\ ~(a = b) /\
 592                   (!x. x IN s ==> kle n a x /\ kle n x b) /\
 593                   (!i. b(i) = if 1 <= i /\ i <= n then a(i) + 1 else a(i))`,
 594   REPEAT STRIP_TAC THEN
 595   FIRST_X_ASSUM(MP_TAC o MATCH_MP KSIMPLEX_EXTREMA) THEN
 596   REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
 597   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST_ALL_TAC THEN
 598   FIRST_X_ASSUM(MP_TAC o SPEC `1`) THEN
 599   ASM_REWRITE_TAC[LE_REFL; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN ARITH_TAC);;
 600
 601 let KSIMPLEX_SUCCESSOR = prove
 602  (`!a p n s.
 603         ksimplex p n s /\ a IN s
 604         ==> (!x. x IN s ==> kle n x a) \/
 605             (?y. y IN s /\ ?k. 1 <= k /\ k <= n /\
 606                                !j. y(j) = if j = k then a(j) + 1 else a(j))`,
 607   REWRITE_TAC[ksimplex] THEN REPEAT STRIP_TAC THEN
 608   REWRITE_TAC[TAUT `a \/ b <=> ~a ==> b`] THEN
 609   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN DISCH_TAC THEN
 610   MP_TAC(SPECL [`{x | x IN s /\ ~kle n x a}`; `n:num`] KLE_MINIMAL) THEN
 611   RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN
 612   ASM_SIMP_TAC[FINITE_RESTRICT] THEN
 613   ASM_SIMP_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN
 614   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:num->num` THEN
 615   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
 616   SUBGOAL_THEN `1 <= CARD {k | k IN 1..n /\ a(k):num < b(k)}` MP_TAC THENL
 617    [MATCH_MP_TAC KLE_STRICT_SET THEN ASM_MESON_TAC[]; ALL_TAC] THEN
 618   DISCH_THEN(DISJ_CASES_THEN MP_TAC o MATCH_MP (ARITH_RULE
 619    `1 <= n ==> (n = 1) \/ 2 <= n`))
 620   THENL
 621    [DISCH_TAC THEN
 622     MP_TAC(HAS_SIZE_CONV `{k | k IN 1 .. n /\ a k :num < b k} HAS_SIZE 1`) THEN
 623     ASM_SIMP_TAC[HAS_SIZE; FINITE_RESTRICT; FINITE_NUMSEG] THEN
 624     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN
 625     REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING; IN_NUMSEG] THEN
 626     DISCH_THEN(fun th -> CONJ_TAC THENL [MESON_TAC[th]; MP_TAC th]) THEN
 627     DISCH_THEN(fun th -> CONJ_TAC THENL [MESON_TAC[th]; MP_TAC th]) THEN
 628     MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
 629     SUBGOAL_THEN `kle n a b` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
 630     DISCH_THEN(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [kle]) THEN
 631     ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN
 632     COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; LT_REFL] THEN
 633     COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; LT_REFL] THEN
 634     ASM_MESON_TAC[SUBSET; IN_NUMSEG; ARITH_RULE `~(a + 1 = a)`;
 635                   ARITH_RULE `a < a + 1`];
 636     ALL_TAC] THEN
 637   DISCH_TAC THEN
 638   MP_TAC(SPECL [`n:num`; `PRE(CARD {x | x IN s /\ ~(kle n x a)})`;
 639                 `{x | x IN s /\ ~(kle n x a)}`] KLE_RANGE_INDUCT) THEN
 640   ASM_SIMP_TAC[HAS_SIZE; FINITE_RESTRICT; CARD_EQ_0; GSYM MEMBER_NOT_EMPTY;
 641     ARITH_RULE `(n = SUC(PRE n)) <=> ~(n = 0)`] THEN
 642   REPEAT(ANTS_TAC THENL
 643    [REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC]) THEN
 644   DISCH_THEN(X_CHOOSE_THEN `c:num->num`
 645    (X_CHOOSE_THEN `d:num->num` MP_TAC)) THEN
 646   REPEAT(DISCH_THEN(CONJUNCTS_THEN2
 647    (STRIP_ASSUME_TAC o REWRITE_RULE[IN_ELIM_THM]) MP_TAC)) THEN
 648   DISCH_TAC THEN
 649   MP_TAC(SPECL [`n:num`; `PRE(CARD {x | x IN s /\ kle n x a})`;
 650                 `{x | x IN s /\ kle n x a}`] KLE_RANGE_INDUCT) THEN
 651   ASM_SIMP_TAC[HAS_SIZE; FINITE_RESTRICT; CARD_EQ_0; GSYM MEMBER_NOT_EMPTY;
 652     ARITH_RULE `(n = SUC(PRE n)) <=> ~(n = 0)`] THEN
 653   REPEAT(ANTS_TAC THENL
 654    [REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[KLE_REFL]; ALL_TAC]) THEN
 655   DISCH_THEN(X_CHOOSE_THEN `e:num->num`
 656     (X_CHOOSE_THEN `f:num->num` MP_TAC)) THEN
 657   REPEAT(DISCH_THEN(CONJUNCTS_THEN2
 658    (STRIP_ASSUME_TAC o REWRITE_RULE[IN_ELIM_THM]) MP_TAC)) THEN
 659   DISCH_TAC THEN
 660   SUBGOAL_THEN `kle n e d /\ n + 1 <= CARD {k | k IN 1..n /\ e(k) < d(k)}`
 661   MP_TAC THENL
 662    [ALL_TAC;
 663     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN
 664     DISCH_THEN(MP_TAC o CONJUNCT2) THEN
 665     REWRITE_TAC[ARITH_RULE `~(n + 1 <= x) <=> x <= n`] THEN
 666     MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD(1..n)` THEN
 667     SIMP_TAC[CARD_SUBSET; SUBSET_RESTRICT; FINITE_RESTRICT; FINITE_NUMSEG] THEN
 668     REWRITE_TAC[CARD_NUMSEG; ADD_SUB; LE_REFL]] THEN
 669   SUBGOAL_THEN
 670    `(CARD {x | x IN s /\ kle n x a} - 1) +
 671     2 + (CARD {x | x IN s /\ ~kle n x a} - 1) = n + 1`
 672    (SUBST1_TAC o SYM)
 673   THENL
 674    [MATCH_MP_TAC(ARITH_RULE
 675      `~(a = 0) /\ ~(b = 0) /\ (a + b = n + 1)
 676        ==> ((a - 1) + 2 + (b - 1) = n + 1)`) THEN
 677     ASM_SIMP_TAC[CARD_EQ_0; FINITE_RESTRICT; GSYM MEMBER_NOT_EMPTY] THEN
 678     REPEAT (CONJ_TAC THENL
 679      [REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC]) THEN
 680     FIRST_ASSUM(SUBST1_TAC o SYM o CONJUNCT2) THEN
 681     MATCH_MP_TAC CARD_UNION_EQ THEN ASM_REWRITE_TAC[] THEN
 682     REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_UNION; IN_ELIM_THM] THEN
 683     ASM_MESON_TAC[];
 684     ALL_TAC] THEN
 685   MATCH_MP_TAC KLE_RANGE_COMBINE THEN EXISTS_TAC `a:num->num` THEN
 686   CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN
 687   CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN
 688   CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN CONJ_TAC THENL
 689    [W(fun(asl,w) -> SUBGOAL_THEN(mk_conj(`kle n e a`,w))
 690      (fun th -> REWRITE_TAC[th])) THEN
 691     MATCH_MP_TAC KLE_RANGE_COMBINE_R THEN EXISTS_TAC `f:num->num` THEN
 692     ASM_REWRITE_TAC[ARITH_RULE `k - 1 = PRE k`];
 693     ALL_TAC] THEN
 694   W(fun(asl,w) -> SUBGOAL_THEN(mk_conj(`kle n a d`,w))
 695      (fun th -> REWRITE_TAC[th])) THEN
 696   MATCH_MP_TAC KLE_RANGE_COMBINE THEN EXISTS_TAC `b:num->num` THEN
 697   ASM_REWRITE_TAC[ARITH_RULE `k - 1 = PRE k`] THEN
 698   CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN
 699   CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN
 700   CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN
 701   W(fun(asl,w) -> SUBGOAL_THEN(mk_conj(`kle n b d`,w))
 702      (fun th -> REWRITE_TAC[th])) THEN
 703   MATCH_MP_TAC KLE_RANGE_COMBINE_L THEN EXISTS_TAC `c:num->num` THEN
 704   ASM_REWRITE_TAC[ARITH_RULE `k - 1 = PRE k`] THEN ASM_MESON_TAC[KLE_TRANS]);;
 705
 706 let KSIMPLEX_PREDECESSOR = prove
 707  (`!a p n s.
 708         ksimplex p n s /\ a IN s
 709         ==> (!x. x IN s ==> kle n a x) \/
 710             (?y. y IN s /\ ?k. 1 <= k /\ k <= n /\
 711                                !j. a(j) = if j = k then y(j) + 1 else y(j))`,
 712   REWRITE_TAC[ksimplex] THEN REPEAT STRIP_TAC THEN
 713   REWRITE_TAC[TAUT `a \/ b <=> ~a ==> b`] THEN
 714   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN DISCH_TAC THEN
 715   MP_TAC(SPECL [`{x | x IN s /\ ~kle n a x}`; `n:num`] KLE_MAXIMAL) THEN
 716   RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN
 717   ASM_SIMP_TAC[FINITE_RESTRICT] THEN
 718   ASM_SIMP_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN
 719   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:num->num` THEN
 720   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
 721   SUBGOAL_THEN `1 <= CARD {k | k IN 1..n /\ b(k):num < a(k)}` MP_TAC THENL
 722    [MATCH_MP_TAC KLE_STRICT_SET THEN ASM_MESON_TAC[]; ALL_TAC] THEN
 723   DISCH_THEN(DISJ_CASES_THEN MP_TAC o MATCH_MP (ARITH_RULE
 724    `1 <= n ==> (n = 1) \/ 2 <= n`))
 725   THENL
 726    [DISCH_TAC THEN
 727     MP_TAC(HAS_SIZE_CONV `{k | k IN 1 .. n /\ b k :num < a k} HAS_SIZE 1`) THEN
 728     ASM_SIMP_TAC[HAS_SIZE; FINITE_RESTRICT; FINITE_NUMSEG] THEN
 729     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN
 730     REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING; IN_NUMSEG] THEN
 731     DISCH_THEN(fun th -> CONJ_TAC THENL [MESON_TAC[th]; MP_TAC th]) THEN
 732     DISCH_THEN(fun th -> CONJ_TAC THENL [MESON_TAC[th]; MP_TAC th]) THEN
 733     MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
 734     SUBGOAL_THEN `kle n b a` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
 735     DISCH_THEN(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [kle]) THEN
 736     ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN
 737     COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; LT_REFL] THEN
 738     COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; LT_REFL] THEN
 739     ASM_MESON_TAC[SUBSET; IN_NUMSEG; ARITH_RULE `~(a + 1 = a)`;
 740                   ARITH_RULE `a < a + 1`];
 741     ALL_TAC] THEN
 742   DISCH_TAC THEN
 743   MP_TAC(SPECL [`n:num`; `PRE(CARD {x | x IN s /\ ~(kle n a x)})`;
 744                 `{x | x IN s /\ ~(kle n a x)}`] KLE_RANGE_INDUCT) THEN
 745   ASM_SIMP_TAC[HAS_SIZE; FINITE_RESTRICT; CARD_EQ_0; GSYM MEMBER_NOT_EMPTY;
 746     ARITH_RULE `(n = SUC(PRE n)) <=> ~(n = 0)`] THEN
 747   REPEAT(ANTS_TAC THENL
 748    [REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC]) THEN
 749   DISCH_THEN(X_CHOOSE_THEN `d:num->num`
 750    (X_CHOOSE_THEN `c:num->num` MP_TAC)) THEN
 751   REPEAT(DISCH_THEN(CONJUNCTS_THEN2
 752    (STRIP_ASSUME_TAC o REWRITE_RULE[IN_ELIM_THM]) MP_TAC)) THEN
 753   DISCH_TAC THEN
 754   MP_TAC(SPECL [`n:num`; `PRE(CARD {x | x IN s /\ kle n a x})`;
 755                 `{x | x IN s /\ kle n a x}`] KLE_RANGE_INDUCT) THEN
 756   ASM_SIMP_TAC[HAS_SIZE; FINITE_RESTRICT; CARD_EQ_0; GSYM MEMBER_NOT_EMPTY;
 757     ARITH_RULE `(n = SUC(PRE n)) <=> ~(n = 0)`] THEN
 758   REPEAT(ANTS_TAC THENL
 759    [REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[KLE_REFL]; ALL_TAC]) THEN
 760   DISCH_THEN(X_CHOOSE_THEN `f:num->num`
 761     (X_CHOOSE_THEN `e:num->num` MP_TAC)) THEN
 762   REPEAT(DISCH_THEN(CONJUNCTS_THEN2
 763    (STRIP_ASSUME_TAC o REWRITE_RULE[IN_ELIM_THM]) MP_TAC)) THEN
 764   DISCH_TAC THEN
 765   SUBGOAL_THEN `kle n d e /\ n + 1 <= CARD {k | k IN 1..n /\ d(k) < e(k)}`
 766   MP_TAC THENL
 767    [ALL_TAC;
 768     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN
 769     DISCH_THEN(MP_TAC o CONJUNCT2) THEN
 770     REWRITE_TAC[ARITH_RULE `~(n + 1 <= x) <=> x <= n`] THEN
 771     MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD(1..n)` THEN
 772     SIMP_TAC[CARD_SUBSET; SUBSET_RESTRICT; FINITE_RESTRICT; FINITE_NUMSEG] THEN
 773     REWRITE_TAC[CARD_NUMSEG; ADD_SUB; LE_REFL]] THEN
 774   SUBGOAL_THEN
 775    `((CARD {x | x IN s /\ ~kle n a x} - 1) + 2) +
 776     (CARD {x | x IN s /\ kle n a x} - 1) = n + 1`
 777    (SUBST1_TAC o SYM)
 778   THENL
 779    [MATCH_MP_TAC(ARITH_RULE
 780      `~(a = 0) /\ ~(b = 0) /\ (a + b = n + 1)
 781        ==> (((b - 1) + 2) + (a - 1) = n + 1)`) THEN
 782     ASM_SIMP_TAC[CARD_EQ_0; FINITE_RESTRICT; GSYM MEMBER_NOT_EMPTY] THEN
 783     REPEAT (CONJ_TAC THENL
 784      [REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC]) THEN
 785     FIRST_ASSUM(SUBST1_TAC o SYM o CONJUNCT2) THEN
 786     MATCH_MP_TAC CARD_UNION_EQ THEN ASM_REWRITE_TAC[] THEN
 787     REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_UNION; IN_ELIM_THM] THEN
 788     ASM_MESON_TAC[];
 789     ALL_TAC] THEN
 790   MATCH_MP_TAC KLE_RANGE_COMBINE THEN EXISTS_TAC `a:num->num` THEN
 791   CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN
 792   CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN
 793   CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN CONJ_TAC THENL
 794    [ALL_TAC;
 795     W(fun(asl,w) -> SUBGOAL_THEN(mk_conj(`kle n a e`,w))
 796      (fun th -> REWRITE_TAC[th])) THEN
 797     MATCH_MP_TAC KLE_RANGE_COMBINE_L THEN EXISTS_TAC `f:num->num` THEN
 798     ASM_REWRITE_TAC[ARITH_RULE `k - 1 = PRE k`]] THEN
 799   W(fun(asl,w) -> SUBGOAL_THEN(mk_conj(`kle n d a`,w))
 800      (fun th -> REWRITE_TAC[th])) THEN
 801   MATCH_MP_TAC KLE_RANGE_COMBINE THEN EXISTS_TAC `b:num->num` THEN
 802   ASM_REWRITE_TAC[ARITH_RULE `k - 1 = PRE k`] THEN
 803   CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN
 804   CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN
 805   CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN
 806   W(fun(asl,w) -> SUBGOAL_THEN(mk_conj(`kle n d b`,w))
 807      (fun th -> REWRITE_TAC[th])) THEN
 808   MATCH_MP_TAC KLE_RANGE_COMBINE_R THEN EXISTS_TAC `c:num->num` THEN
 809   ASM_REWRITE_TAC[ARITH_RULE `k - 1 = PRE k`] THEN ASM_MESON_TAC[KLE_TRANS]);;
 810
 811 (* ------------------------------------------------------------------------- *)
 812 (* The lemmas about simplices that we need.                                  *)
 813 (* ------------------------------------------------------------------------- *)
 814
 815 let FINITE_SIMPLICES = prove
 816  (`!p n. FINITE {s | ksimplex p n s}`,
 817   REPEAT STRIP_TAC THEN
 818   MATCH_MP_TAC FINITE_SUBSET THEN
 819   EXISTS_TAC `{s | s SUBSET {f | (!i. i IN 1..n ==> f(i) IN 0..p) /\
 820                                  (!i. ~(i IN 1..n) ==> (f(i) = p))}}` THEN
 821   ASM_SIMP_TAC[FINITE_POWERSET; FINITE_FUNSPACE; FINITE_NUMSEG] THEN
 822   REWRITE_TAC[SUBSET; IN_ELIM_THM; ksimplex] THEN
 823   ASM_SIMP_TAC[IN_NUMSEG; LE_0]);;
 824
 825 let SIMPLEX_TOP_FACE = prove
 826  (`0 < p /\
 827    (!x. x IN f ==> (x(n + 1) = p))
 828    ==> ((?s a. ksimplex p (n + 1) s /\ a IN s /\ (f = s DELETE a)) <=>
 829         ksimplex p n f)`,
 830   REPEAT STRIP_TAC THEN EQ_TAC THENL
 831    [REWRITE_TAC[ksimplex; LEFT_IMP_EXISTS_THM] THEN
 832     REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_DELETE] THEN
 833     REPEAT CONJ_TAC THENL
 834      [UNDISCH_TAC `(s:(num->num)->bool) HAS_SIZE ((n + 1) + 1)` THEN
 835       SIMP_TAC[HAS_SIZE; CARD_DELETE; FINITE_DELETE] THEN
 836       ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ARITH_TAC;
 837       REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[];
 838       GEN_TAC THEN X_GEN_TAC `j:num` THEN
 839       ONCE_REWRITE_TAC[ARITH_RULE
 840        `(1 <= j /\ j <= n) <=> (1 <= j /\ j <= n + 1) /\ ~(j = (n + 1))`] THEN
 841       ASM_MESON_TAC[IN_DELETE];
 842       REPEAT STRIP_TAC THEN
 843       SUBGOAL_THEN `kle (n + 1) x y \/ kle (n + 1) y x` MP_TAC THENL
 844        [ASM_MESON_TAC[]; ALL_TAC] THEN
 845       MATCH_MP_TAC MONO_OR THEN CONJ_TAC THEN
 846       (REWRITE_TAC[kle] THEN
 847        MATCH_MP_TAC MONO_EXISTS THEN
 848        REWRITE_TAC[GSYM ADD1; NUMSEG_CLAUSES; ARITH_RULE `1 <= SUC n`] THEN
 849        X_GEN_TAC `k:num->bool` THEN SIMP_TAC[] THEN
 850        REWRITE_TAC[SUBSET; IN_INSERT] THEN
 851        ASM_CASES_TAC `(SUC n) IN k` THENL
 852         [ALL_TAC; ASM_MESON_TAC[]] THEN
 853        DISCH_THEN(MP_TAC o SPEC `n + 1` o CONJUNCT2) THEN
 854        ASM_REWRITE_TAC[GSYM ADD1] THEN
 855        ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN
 856        MATCH_MP_TAC(ARITH_RULE `(x = p) /\ (y = p) ==> ~(x = SUC y)`) THEN
 857        CONJ_TAC THEN ASM_MESON_TAC[ADD1; IN_DELETE])];
 858     ALL_TAC] THEN
 859   DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP KSIMPLEX_EXTREMA) THEN
 860   DISCH_THEN(X_CHOOSE_THEN `a:num->num` (X_CHOOSE_THEN `b:num->num`
 861     STRIP_ASSUME_TAC)) THEN
 862   ABBREV_TAC `c = \i. if i = (n + 1) then p - 1 else a(i)` THEN
 863   MAP_EVERY EXISTS_TAC [`(c:num->num) INSERT f`; `c:num->num`] THEN
 864   REWRITE_TAC[IN_INSERT; DELETE_INSERT] THEN
 865   SUBGOAL_THEN `~((c:num->num) IN f)` ASSUME_TAC THENL
 866    [DISCH_TAC THEN UNDISCH_TAC `!x:num->num. x IN f ==> (x (n + 1) = p)` THEN
 867     DISCH_THEN(MP_TAC o SPEC `c:num->num`) THEN ASM_REWRITE_TAC[] THEN
 868     EXPAND_TAC "c" THEN REWRITE_TAC[] THEN UNDISCH_TAC `0 < p` THEN ARITH_TAC;
 869     ALL_TAC] THEN
 870   CONJ_TAC THENL
 871    [ALL_TAC; UNDISCH_TAC `~((c:num->num) IN f)` THEN SET_TAC[]] THEN
 872   UNDISCH_TAC `ksimplex p n f` THEN REWRITE_TAC[ksimplex] THEN
 873   REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL
 874    [SIMP_TAC[HAS_SIZE; FINITE_RULES; CARD_CLAUSES] THEN ASM_REWRITE_TAC[ADD1];
 875     EXPAND_TAC "c" THEN REWRITE_TAC[IN_INSERT] THEN
 876     SIMP_TAC[TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`] THEN
 877     ASM_MESON_TAC[ARITH_RULE `p - 1 <= p`];
 878     EXPAND_TAC "c" THEN REWRITE_TAC[IN_INSERT; TAUT
 879       `(a \/ b) /\ c ==> d <=> (a /\ c ==> d) /\ (b /\ c ==> d)`] THEN
 880     DISCH_TAC THEN REPEAT GEN_TAC THEN CONJ_TAC THENL
 881      [DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC MP_TAC); ALL_TAC] THEN
 882     ASM_MESON_TAC[LE_REFL; ARITH_RULE `1 <= n + 1`;
 883                   ARITH_RULE `j <= n ==> j <= n + 1`];
 884     ALL_TAC] THEN
 885   DISCH_TAC THEN REWRITE_TAC[IN_INSERT] THEN
 886   SUBGOAL_THEN `!x. x IN f ==> kle (n + 1) c x`
 887     (fun th -> ASM_MESON_TAC[th; KLE_SUC; KLE_REFL]) THEN
 888   X_GEN_TAC `x:num->num` THEN DISCH_TAC THEN
 889   SUBGOAL_THEN `kle (n + 1) a x` MP_TAC THENL
 890    [ASM_MESON_TAC[KLE_SUC]; ALL_TAC] THEN
 891   EXPAND_TAC "c" THEN REWRITE_TAC[kle] THEN
 892   DISCH_THEN(X_CHOOSE_THEN `k:num->bool` STRIP_ASSUME_TAC) THEN
 893   EXISTS_TAC `(n + 1) INSERT k` THEN
 894   ASM_REWRITE_TAC[INSERT_SUBSET; IN_NUMSEG] THEN
 895   ASM_REWRITE_TAC[LE_REFL; ARITH_RULE `1 <= n + 1`] THEN
 896   X_GEN_TAC `j:num` THEN REWRITE_TAC[IN_INSERT] THEN
 897   ASM_CASES_TAC `j = n + 1` THEN ASM_REWRITE_TAC[] THEN
 898   SUBGOAL_THEN `~(n + 1 IN k)`
 899    (fun th -> ASM_MESON_TAC[th; ARITH_RULE `0 < p ==> (p = (p - 1) + 1)`]) THEN
 900   DISCH_TAC THEN UNDISCH_TAC `!x:num->num. x IN f ==> (x (n + 1) = p)` THEN
 901   DISCH_THEN(fun th -> MP_TAC(SPEC `x:num->num` th) THEN
 902                        MP_TAC(SPEC `a:num->num` th)) THEN
 903   ASM_REWRITE_TAC[] THEN MESON_TAC[ARITH_RULE `~(p + 1 = p)`]);;
 904
 905 let KSIMPLEX_FIX_PLANE = prove
 906  (`!p q n j s a a0 a1.
 907         ksimplex p n s /\ a IN s /\
 908         1 <= j /\ j <= n /\ (!x. x IN (s DELETE a) ==> (x j = q)) /\
 909         a0 IN s /\ a1 IN s /\
 910         (!i. a1 i = (if 1 <= i /\ i <= n then a0 i + 1 else a0 i))
 911         ==> (a = a0) \/ (a = a1)`,
 912   REPEAT STRIP_TAC THEN
 913   MATCH_MP_TAC(TAUT `(~a /\ ~b ==> F) ==> a \/ b`) THEN STRIP_TAC THEN
 914   UNDISCH_TAC `!x:num->num. x IN s DELETE a ==> (x j = q)` THEN
 915   DISCH_THEN(fun th ->
 916    MP_TAC(SPEC `a0:num->num` th) THEN MP_TAC(SPEC `a1:num->num` th)) THEN
 917   ASM_REWRITE_TAC[IN_DELETE] THEN ARITH_TAC);;
 918
 919 let KSIMPLEX_FIX_PLANE_0 = prove
 920  (`!p n j s a a0 a1.
 921         ksimplex p n s /\ a IN s /\
 922         1 <= j /\ j <= n /\ (!x. x IN (s DELETE a) ==> (x j = 0)) /\
 923         a0 IN s /\ a1 IN s /\
 924         (!i. a1 i = (if 1 <= i /\ i <= n then a0 i + 1 else a0 i))
 925         ==> (a = a1)`,
 926   REPEAT STRIP_TAC THEN
 927   SUBGOAL_THEN `(a = a0) \/ (a = a1:num->num)` MP_TAC THENL
 928    [MATCH_MP_TAC KSIMPLEX_FIX_PLANE THEN
 929     MAP_EVERY EXISTS_TAC
 930      [`p:num`; `0`; `n:num`; `j:num`; `s:(num->num)->bool`] THEN
 931     ASM_REWRITE_TAC[];
 932     ALL_TAC] THEN
 933   ASM_CASES_TAC `a0:num->num = a1` THEN ASM_REWRITE_TAC[] THEN
 934   MATCH_MP_TAC(TAUT `~a ==> (a \/ b ==> b)`) THEN
 935   DISCH_THEN SUBST_ALL_TAC THEN
 936   FIRST_X_ASSUM(MP_TAC o SPEC `a1:num->num`) THEN
 937   ASM_REWRITE_TAC[IN_DELETE] THEN ARITH_TAC);;
 938
 939 let KSIMPLEX_FIX_PLANE_P = prove
 940  (`!p n j s a a0 a1.
 941         ksimplex p n s /\ a IN s /\
 942         1 <= j /\ j <= n /\ (!x. x IN (s DELETE a) ==> (x j = p)) /\
 943         a0 IN s /\ a1 IN s /\
 944         (!i. a1 i = (if 1 <= i /\ i <= n then a0 i + 1 else a0 i))
 945         ==> (a = a0)`,
 946   REPEAT STRIP_TAC THEN
 947   SUBGOAL_THEN `(a = a0) \/ (a = a1:num->num)` MP_TAC THENL
 948    [MATCH_MP_TAC KSIMPLEX_FIX_PLANE THEN
 949     MAP_EVERY EXISTS_TAC
 950      [`p:num`; `p:num`; `n:num`; `j:num`; `s:(num->num)->bool`] THEN
 951     ASM_REWRITE_TAC[];
 952     ALL_TAC] THEN
 953   ASM_CASES_TAC `a0:num->num = a1` THEN ASM_REWRITE_TAC[] THEN
 954   MATCH_MP_TAC(TAUT `~b ==> (a \/ b ==> a)`) THEN
 955   DISCH_THEN SUBST_ALL_TAC THEN
 956   FIRST_X_ASSUM(MP_TAC o SPEC `a0:num->num`) THEN
 957   ASM_REWRITE_TAC[IN_DELETE] THEN DISCH_TAC THEN
 958   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ksimplex]) THEN
 959   DISCH_THEN(MP_TAC o SPEC `a1:num->num` o CONJUNCT1 o CONJUNCT2) THEN
 960   DISCH_THEN(MP_TAC o SPEC `j:num`) THEN ASM_REWRITE_TAC[] THEN ARITH_TAC);;
 961
 962 let KSIMPLEX_REPLACE_0 = prove
 963  (`ksimplex p n s /\ a IN s /\ ~(n = 0) /\
 964    (?j. 1 <= j /\ j <= n /\ !x. x IN (s DELETE a) ==> (x j = 0))
 965    ==> (CARD
 966          {s' | ksimplex p n s' /\ ?b. b IN s' /\ (s' DELETE b = s DELETE a)} =
 967         1)`,
 968   let lemma = prove
 969    (`!a a'. (s' DELETE a' = s DELETE a) /\ (a' = a) /\ a' IN s' /\ a IN s
 970             ==> (s' = s)`,
 971     SET_TAC[]) in
 972   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_SIZE_CARD THEN
 973   REWRITE_TAC[HAS_SIZE_1_EXISTS] THEN REWRITE_TAC[IN_ELIM_THM] THEN
 974   SUBGOAL_THEN
 975    `!s' a'. ksimplex p n s' /\ a' IN s' /\ (s' DELETE a' = s DELETE a)
 976             ==> (s' = s)`
 977    (fun th -> ASM_MESON_TAC[th]) THEN
 978   REPEAT STRIP_TAC THEN
 979   MP_TAC(SPECL [`p:num`; `n:num`; `s:(num->num)->bool`]
 980        KSIMPLEX_EXTREMA_STRONG) THEN
 981   ASM_REWRITE_TAC[] THEN
 982   DISCH_THEN(X_CHOOSE_THEN `a0:num->num` (X_CHOOSE_THEN `a1:num->num`
 983     STRIP_ASSUME_TAC)) THEN
 984   MP_TAC(SPECL [`p:num`; `n:num`; `s':(num->num)->bool`]
 985        KSIMPLEX_EXTREMA_STRONG) THEN
 986   ASM_REWRITE_TAC[] THEN
 987   DISCH_THEN(X_CHOOSE_THEN `b0:num->num` (X_CHOOSE_THEN `b1:num->num`
 988     STRIP_ASSUME_TAC)) THEN
 989   SUBGOAL_THEN `a:num->num = a1` SUBST_ALL_TAC THENL
 990    [MATCH_MP_TAC KSIMPLEX_FIX_PLANE_0 THEN MAP_EVERY EXISTS_TAC
 991      [`p:num`; `n:num`; `j:num`; `s:(num->num)->bool`; `a0:num->num`] THEN
 992     ASM_REWRITE_TAC[];
 993     ALL_TAC] THEN
 994   SUBGOAL_THEN `a':num->num = b1` SUBST_ALL_TAC THENL
 995    [MATCH_MP_TAC KSIMPLEX_FIX_PLANE_0 THEN MAP_EVERY EXISTS_TAC
 996      [`p:num`; `n:num`; `j:num`; `s':(num->num)->bool`; `b0:num->num`] THEN
 997     ASM_REWRITE_TAC[];
 998     ALL_TAC] THEN
 999   MATCH_MP_TAC lemma THEN
1000   MAP_EVERY EXISTS_TAC [`a1:num->num`; `b1:num->num`] THEN
1001   ASM_REWRITE_TAC[] THEN
1002   SUBGOAL_THEN `b0:num->num = a0` MP_TAC THENL
1003    [ONCE_REWRITE_TAC[GSYM KLE_ANTISYM] THEN ASM_MESON_TAC[IN_DELETE];
1004     ASM_REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[]]);;
1005
1006 let KSIMPLEX_REPLACE_1 = prove
1007  (`ksimplex p n s /\ a IN s /\ ~(n = 0) /\
1008    (?j. 1 <= j /\ j <= n /\ !x. x IN (s DELETE a) ==> (x j = p))
1009    ==> (CARD
1010          {s' | ksimplex p n s' /\ ?b. b IN s' /\ (s' DELETE b = s DELETE a)} =
1011         1)`,
1012   let lemma = prove
1013    (`!a a'. (s' DELETE a' = s DELETE a) /\ (a' = a) /\ a' IN s' /\ a IN s
1014             ==> (s' = s)`,
1015     SET_TAC[]) in
1016   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_SIZE_CARD THEN
1017   REWRITE_TAC[HAS_SIZE_1_EXISTS] THEN REWRITE_TAC[IN_ELIM_THM] THEN
1018   SUBGOAL_THEN
1019    `!s' a'. ksimplex p n s' /\ a' IN s' /\ (s' DELETE a' = s DELETE a)
1020             ==> (s' = s)`
1021    (fun th -> ASM_MESON_TAC[th]) THEN
1022   REPEAT STRIP_TAC THEN
1023   MP_TAC(SPECL [`p:num`; `n:num`; `s:(num->num)->bool`]
1024        KSIMPLEX_EXTREMA_STRONG) THEN
1025   ASM_REWRITE_TAC[] THEN
1026   DISCH_THEN(X_CHOOSE_THEN `a0:num->num` (X_CHOOSE_THEN `a1:num->num`
1027     STRIP_ASSUME_TAC)) THEN
1028   MP_TAC(SPECL [`p:num`; `n:num`; `s':(num->num)->bool`]
1029        KSIMPLEX_EXTREMA_STRONG) THEN
1030   ASM_REWRITE_TAC[] THEN
1031   DISCH_THEN(X_CHOOSE_THEN `b0:num->num` (X_CHOOSE_THEN `b1:num->num`
1032     STRIP_ASSUME_TAC)) THEN
1033   SUBGOAL_THEN `a:num->num = a0` SUBST_ALL_TAC THENL
1034    [MATCH_MP_TAC KSIMPLEX_FIX_PLANE_P THEN MAP_EVERY EXISTS_TAC
1035      [`p:num`; `n:num`; `j:num`; `s:(num->num)->bool`; `a1:num->num`] THEN
1036     ASM_REWRITE_TAC[];
1037     ALL_TAC] THEN
1038   SUBGOAL_THEN `a':num->num = b0` SUBST_ALL_TAC THENL
1039    [MATCH_MP_TAC KSIMPLEX_FIX_PLANE_P THEN MAP_EVERY EXISTS_TAC
1040      [`p:num`; `n:num`; `j:num`; `s':(num->num)->bool`; `b1:num->num`] THEN
1041     ASM_REWRITE_TAC[];
1042     ALL_TAC] THEN
1043   MATCH_MP_TAC lemma THEN
1044   MAP_EVERY EXISTS_TAC [`a0:num->num`; `b0:num->num`] THEN
1045   ASM_REWRITE_TAC[] THEN
1046   SUBGOAL_THEN `b1:num->num = a1` MP_TAC THENL
1047    [ONCE_REWRITE_TAC[GSYM KLE_ANTISYM] THEN ASM_MESON_TAC[IN_DELETE];
1048     ASM_REWRITE_TAC[FUN_EQ_THM] THEN MATCH_MP_TAC MONO_FORALL THEN
1049     MESON_TAC[EQ_ADD_RCANCEL]]);;
1050
1051 let KSIMPLEX_REPLACE_2 = prove
1052  (`ksimplex p n s /\ a IN s /\ ~(n = 0) /\
1053    ~(?j. 1 <= j /\ j <= n /\ !x. x IN (s DELETE a) ==> (x j = 0)) /\
1054    ~(?j. 1 <= j /\ j <= n /\ !x. x IN (s DELETE a) ==> (x j = p))
1055    ==> (CARD
1056          {s' | ksimplex p n s' /\ ?b. b IN s' /\ (s' DELETE b = s DELETE a)} =
1057         2)`,
1058   let lemma = prove
1059    (`!a a'. (s' DELETE a' = s DELETE a) /\ (a' = a) /\ a' IN s' /\ a IN s
1060             ==> (s' = s)`,
1061     SET_TAC[])
1062   and lemma_1 = prove
1063    (`a IN s /\ ~(b = a) ==> ~(s = b INSERT (s DELETE a))`,
1064     SET_TAC[]) in
1065   REPEAT STRIP_TAC THEN
1066   MP_TAC(SPECL [`p:num`; `n:num`; `s:(num->num)->bool`]
1067        KSIMPLEX_EXTREMA_STRONG) THEN
1068   ASM_REWRITE_TAC[] THEN
1069   DISCH_THEN(X_CHOOSE_THEN `a0:num->num` (X_CHOOSE_THEN `a1:num->num`
1070    STRIP_ASSUME_TAC)) THEN
1071   ASM_CASES_TAC `a:num->num = a0` THENL
1072    [FIRST_X_ASSUM SUBST_ALL_TAC THEN
1073     MP_TAC(SPECL [`a0:num->num`; `p:num`; `n:num`; `s:(num->num)->bool`]
1074                  KSIMPLEX_SUCCESSOR) THEN
1075     ASM_REWRITE_TAC[] THEN
1076     MATCH_MP_TAC(TAUT `~a /\ (b ==> c) ==> a \/ b ==> c`) THEN CONJ_TAC THENL
1077      [DISCH_THEN(MP_TAC o SPEC `a1:num->num`) THEN ASM_REWRITE_TAC[] THEN
1078       DISCH_THEN(MP_TAC o SPEC `1` o MATCH_MP KLE_IMP_POINTWISE) THEN
1079       ASM_REWRITE_TAC[ARITH_RULE `1 <= n <=> ~(n = 0)`; ARITH] THEN ARITH_TAC;
1080       ALL_TAC] THEN
1081     DISCH_THEN(X_CHOOSE_THEN `a2:num->num`
1082      (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
1083     DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN
1084     ABBREV_TAC `a3 = \j:num. if j = k then a1 j + 1 else a1 j` THEN
1085     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN
1086     REWRITE_TAC[] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN
1087     MATCH_MP_TAC HAS_SIZE_CARD THEN CONV_TAC HAS_SIZE_CONV THEN
1088     MAP_EVERY EXISTS_TAC
1089      [`s:(num->num)->bool`; `a3 INSERT (s DELETE (a0:num->num))`] THEN
1090     SUBGOAL_THEN `~((a3:num->num) IN s)` ASSUME_TAC THENL
1091      [DISCH_TAC THEN SUBGOAL_THEN `kle n a3 a1` MP_TAC THENL
1092        [ASM_MESON_TAC[]; ALL_TAC] THEN
1093       DISCH_THEN(MP_TAC o SPEC `k:num` o MATCH_MP KLE_IMP_POINTWISE) THEN
1094       ASM_REWRITE_TAC[LE_REFL] THEN ARITH_TAC;
1095       ALL_TAC] THEN
1096     SUBGOAL_THEN `~(a3:num->num = a0) /\ ~(a3 = a1)` STRIP_ASSUME_TAC THENL
1097      [ASM_MESON_TAC[]; ALL_TAC] THEN
1098     SUBGOAL_THEN `~(a2:num->num = a0)` ASSUME_TAC THENL
1099      [ASM_REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[ARITH_RULE `~(x + 1 = x)`];
1100       ALL_TAC] THEN
1101     CONJ_TAC THENL [MATCH_MP_TAC lemma_1 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
1102     SUBGOAL_THEN `!x. x IN (s DELETE a0) ==> kle n a2 x` ASSUME_TAC THENL
1103      [GEN_TAC THEN REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN
1104       SUBGOAL_THEN `kle n a2 x \/ kle n x a2` MP_TAC THENL
1105        [ASM_MESON_TAC[ksimplex]; ALL_TAC] THEN
1106       MATCH_MP_TAC(TAUT `(~b ==> ~a) ==> b \/ a ==> b`) THEN
1107       DISCH_TAC THEN SUBGOAL_THEN `kle n a0 x` MP_TAC THENL
1108        [ASM_MESON_TAC[]; ALL_TAC] THEN REPEAT STRIP_TAC THEN
1109       SUBGOAL_THEN `(x:num->num = a0) \/ (x = a2)`
1110        (fun th -> ASM_MESON_TAC[KLE_REFL; th]) THEN
1111       MATCH_MP_TAC KLE_ADJACENT THEN
1112       EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[];
1113       ALL_TAC] THEN
1114     SUBGOAL_THEN `ksimplex p n (a3 INSERT (s DELETE a0))` ASSUME_TAC THENL
1115      [MP_TAC(ASSUME `ksimplex p n s`) THEN REWRITE_TAC[ksimplex] THEN
1116       MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
1117        [SIMP_TAC[HAS_SIZE; FINITE_INSERT; FINITE_DELETE; CARD_CLAUSES;
1118                  CARD_DELETE] THEN
1119         ASM_REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN ARITH_TAC;
1120         ALL_TAC] THEN
1121       MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
1122        [DISCH_TAC THEN REWRITE_TAC[IN_INSERT; IN_DELETE] THEN
1123         SUBGOAL_THEN `!j. (a3:num->num) j <= p`
1124          (fun th -> ASM_MESON_TAC[th]) THEN
1125         X_GEN_TAC `j:num` THEN ONCE_ASM_REWRITE_TAC[] THEN COND_CASES_TAC THENL
1126          [ALL_TAC; ASM_MESON_TAC[]] THEN
1127         FIRST_X_ASSUM SUBST_ALL_TAC THEN
1128         UNDISCH_TAC
1129          `~(?j. 1 <= j /\ j <= n /\
1130                 (!x. x IN s DELETE a0 ==> (x j = (p:num))))` THEN
1131         REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN
1132         REWRITE_TAC[ASSUME `1 <= k`; ASSUME `k:num <= n`; NOT_FORALL_THM] THEN
1133         DISCH_THEN(X_CHOOSE_THEN `a4:num->num` MP_TAC) THEN
1134         REWRITE_TAC[IN_DELETE; NOT_IMP] THEN STRIP_TAC THEN
1135         UNDISCH_TAC `!x. x IN s DELETE a0 ==> kle n a2 x` THEN
1136         DISCH_THEN(MP_TAC o SPEC `a4:num->num`) THEN
1137         ASM_REWRITE_TAC[IN_DELETE] THEN
1138         DISCH_THEN(MP_TAC o MATCH_MP KLE_IMP_POINTWISE) THEN
1139         ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN
1140         ASM_REWRITE_TAC[] THEN
1141         UNDISCH_TAC `~((a4:num->num) k = p)` THEN
1142         SUBGOAL_THEN `(a4:num->num) k <= p` MP_TAC THENL
1143          [ASM_MESON_TAC[ksimplex]; ARITH_TAC];
1144         ALL_TAC] THEN
1145       MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
1146        [REWRITE_TAC[IN_INSERT; IN_DELETE] THEN REPEAT STRIP_TAC THENL
1147          [ALL_TAC; ASM_MESON_TAC[]] THEN
1148         FIRST_X_ASSUM SUBST_ALL_TAC THEN
1149         ONCE_ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[];
1150         ALL_TAC] THEN
1151       DISCH_TAC THEN REWRITE_TAC[IN_INSERT; IN_DELETE] THEN
1152       SUBGOAL_THEN `!x. x IN s /\ ~(x = a0) ==> kle n x a3`
1153        (fun th -> ASM_MESON_TAC[th; KLE_REFL]) THEN
1154       X_GEN_TAC `x:num->num` THEN STRIP_TAC THEN
1155       SUBGOAL_THEN `kle n a2 x /\ kle n x a1` MP_TAC THENL
1156        [ASM_MESON_TAC[IN_DELETE]; ALL_TAC] THEN
1157       REWRITE_TAC[IMP_CONJ] THEN
1158       DISCH_THEN(MP_TAC o SPEC `k:num` o MATCH_MP KLE_IMP_POINTWISE) THEN
1159       DISCH_TAC THEN REWRITE_TAC[kle] THEN
1160       DISCH_THEN(X_CHOOSE_THEN `kk:num->bool` STRIP_ASSUME_TAC) THEN
1161       EXISTS_TAC `(k:num) INSERT kk` THEN
1162       REWRITE_TAC[INSERT_SUBSET; IN_NUMSEG] THEN
1163       CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN
1164       X_GEN_TAC `j:num` THEN
1165       FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN
1166       REWRITE_TAC[IN_INSERT] THEN ASM_CASES_TAC `j:num = k` THENL
1167        [ALL_TAC; ASM_MESON_TAC[]] THEN
1168       FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[] THEN
1169       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE
1170        `a2 <= x ==> !a0. x <= a1 /\ (a1 = a0 + 1) /\ (a2 = a0 + 1)
1171              ==> (a1 + 1 = x + 1)`)) THEN
1172       EXISTS_TAC `(a0:num->num) k` THEN
1173       ASM_MESON_TAC[KLE_IMP_POINTWISE];
1174       ALL_TAC] THEN
1175     GEN_REWRITE_TAC I [EXTENSION] THEN
1176     REWRITE_TAC[IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN
1177     X_GEN_TAC `s':(num->num)->bool` THEN EQ_TAC THENL
1178      [ALL_TAC;
1179       DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THENL
1180        [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN
1181       ASM_REWRITE_TAC[] THEN EXISTS_TAC `a3:num->num` THEN
1182       REWRITE_TAC[IN_INSERT; DELETE_INSERT] THEN
1183       UNDISCH_TAC `~((a3:num->num) IN s)` THEN SET_TAC[]] THEN
1184     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1185     DISCH_THEN(X_CHOOSE_THEN `a':num->num` STRIP_ASSUME_TAC) THEN
1186     MP_TAC(SPECL [`p:num`; `n:num`; `s':(num->num)->bool`]
1187                  KSIMPLEX_EXTREMA_STRONG) THEN ASM_REWRITE_TAC[] THEN
1188     DISCH_THEN(X_CHOOSE_THEN `a_min:num->num` (X_CHOOSE_THEN `a_max:num->num`
1189       STRIP_ASSUME_TAC)) THEN
1190     SUBGOAL_THEN `(a':num->num = a_min) \/ (a' = a_max)` MP_TAC THENL
1191      [MATCH_MP_TAC KSIMPLEX_FIX_PLANE THEN MAP_EVERY EXISTS_TAC
1192        [`p:num`; `(a2:num->num) k`; `n:num`;
1193         `k:num`; `s':(num->num)->bool`] THEN
1194       REPEAT CONJ_TAC THEN TRY(FIRST_ASSUM MATCH_ACCEPT_TAC) THEN
1195       X_GEN_TAC `x:num->num` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
1196       SUBGOAL_THEN `kle n a2 x /\ kle n x a1` MP_TAC THENL
1197        [ASM_MESON_TAC[IN_DELETE]; ALL_TAC] THEN
1198       DISCH_THEN(CONJUNCTS_THEN (MP_TAC o SPEC `k:num` o MATCH_MP
1199         KLE_IMP_POINTWISE)) THEN
1200       ASM_REWRITE_TAC[] THEN ARITH_TAC;
1201       ALL_TAC] THEN
1202     DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THENL
1203      [DISJ1_TAC THEN MATCH_MP_TAC lemma THEN
1204       MAP_EVERY EXISTS_TAC [`a0:num->num`; `a_min:num->num`] THEN
1205       ASM_REWRITE_TAC[] THEN
1206       SUBGOAL_THEN `a_max:num->num = a1` MP_TAC THENL
1207        [SUBGOAL_THEN `a1:num->num IN (s' DELETE a_min) /\
1208                       a_max:num->num IN (s DELETE a0)`
1209         MP_TAC THENL
1210          [ASM_MESON_TAC[IN_DELETE]; ASM_MESON_TAC[KLE_ANTISYM; IN_DELETE]];
1211         ALL_TAC] THEN
1212       ASM_REWRITE_TAC[FUN_EQ_THM] THEN MATCH_MP_TAC MONO_FORALL THEN
1213       MESON_TAC[EQ_ADD_RCANCEL];
1214       DISJ2_TAC THEN MATCH_MP_TAC lemma THEN
1215       MAP_EVERY EXISTS_TAC [`a3:num->num`; `a_max:num->num`] THEN
1216       ASM_REWRITE_TAC[IN_INSERT] THEN CONJ_TAC THENL
1217        [UNDISCH_TAC `~(a3:num->num IN s)` THEN SET_TAC[]; ALL_TAC] THEN
1218       SUBGOAL_THEN `a_min:num->num = a2` MP_TAC THENL
1219        [SUBGOAL_THEN `a2:num->num IN (s' DELETE a_max) /\
1220                       a_min:num->num IN (s DELETE a0)`
1221         MP_TAC THENL
1222          [ASM_MESON_TAC[IN_DELETE]; ASM_MESON_TAC[KLE_ANTISYM; IN_DELETE]];
1223         ALL_TAC] THEN
1224       ASM_REWRITE_TAC[FUN_EQ_THM] THEN MATCH_MP_TAC MONO_FORALL THEN
1225       MESON_TAC[EQ_ADD_RCANCEL]];
1226     ALL_TAC] THEN
1227   ASM_CASES_TAC `a:num->num = a1` THENL
1228    [FIRST_X_ASSUM SUBST_ALL_TAC THEN
1229     MP_TAC(SPECL [`a1:num->num`; `p:num`; `n:num`; `s:(num->num)->bool`]
1230                  KSIMPLEX_PREDECESSOR) THEN
1231     ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN
1232     MATCH_MP_TAC(TAUT `~a /\ (b ==> c) ==> a \/ b ==> c`) THEN CONJ_TAC THENL
1233      [DISCH_THEN(MP_TAC o SPEC `a0:num->num`) THEN ASM_REWRITE_TAC[] THEN
1234       DISCH_THEN(MP_TAC o SPEC `1` o MATCH_MP KLE_IMP_POINTWISE) THEN
1235       ASM_REWRITE_TAC[ARITH_RULE `1 <= n <=> ~(n = 0)`; ARITH] THEN ARITH_TAC;
1236       ALL_TAC] THEN
1237     DISCH_THEN(X_CHOOSE_THEN `a2:num->num`
1238      (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
1239     DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN
1240     SUBGOAL_THEN `!x. x IN (s DELETE a1) ==> kle n x a2` ASSUME_TAC THENL
1241      [GEN_TAC THEN REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN
1242       SUBGOAL_THEN `kle n a2 x \/ kle n x a2` MP_TAC THENL
1243        [ASM_MESON_TAC[ksimplex]; ALL_TAC] THEN
1244       MATCH_MP_TAC(TAUT `(~b ==> ~a) ==> a \/ b ==> b`) THEN
1245       DISCH_TAC THEN SUBGOAL_THEN `kle n x a1` MP_TAC THENL
1246        [ASM_MESON_TAC[]; ALL_TAC] THEN REPEAT STRIP_TAC THEN
1247       SUBGOAL_THEN `(x:num->num = a2) \/ (x = a1)`
1248        (fun th -> ASM_MESON_TAC[KLE_REFL; th]) THEN
1249       MATCH_MP_TAC KLE_ADJACENT THEN EXISTS_TAC `k:num` THEN
1250       REPEAT CONJ_TAC THEN FIRST_X_ASSUM MATCH_ACCEPT_TAC;
1251       ALL_TAC] THEN
1252     SUBGOAL_THEN `~(a2:num->num = a1)` ASSUME_TAC THENL
1253      [REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[ARITH_RULE `~(x + 1 = x)`];
1254       ALL_TAC] THEN
1255     ABBREV_TAC `a3 = \j:num. if j = k then a0 j - 1 else a0 j` THEN
1256     SUBGOAL_THEN `!j:num. a0(j) = if j = k then a3(j) + 1 else a3 j`
1257     ASSUME_TAC THENL
1258      [X_GEN_TAC `j:num` THEN EXPAND_TAC "a3" THEN REWRITE_TAC[] THEN
1259       COND_CASES_TAC THEN
1260       REWRITE_TAC[ARITH_RULE `(a = a - 1 + 1) <=> ~(a = 0)`] THEN
1261       FIRST_X_ASSUM SUBST_ALL_TAC THEN DISCH_TAC THEN
1262       UNDISCH_TAC `!j:num. a1 j = (if j = k then a2 j + 1 else a2 j)` THEN
1263       DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_REWRITE_TAC[] THEN
1264       REWRITE_TAC[ARITH_RULE `(0 + 1 = x + 1) <=> (x = 0)`] THEN DISCH_TAC THEN
1265       UNDISCH_TAC
1266        `~(?j. 1 <= j /\ j <= n /\ (!x. x IN s DELETE a1 ==> (x j = 0)))` THEN
1267       REWRITE_TAC[NOT_EXISTS_THM] THEN EXISTS_TAC `k:num` THEN
1268       ASM_MESON_TAC[KLE_IMP_POINTWISE; LE];
1269       ALL_TAC] THEN
1270     SUBGOAL_THEN `~(kle n a0 a3)` ASSUME_TAC THENL
1271      [ASM_MESON_TAC[KLE_IMP_POINTWISE; ARITH_RULE `~(a + 1 <= a)`];
1272       ALL_TAC] THEN
1273     SUBGOAL_THEN `~(a3:num->num IN s)` ASSUME_TAC THENL
1274      [ASM_MESON_TAC[]; ALL_TAC] THEN
1275     SUBGOAL_THEN `kle n a3 a2` ASSUME_TAC THENL
1276      [SUBGOAL_THEN `kle n a0 a1` MP_TAC THENL
1277        [ASM_MESON_TAC[]; ALL_TAC] THEN
1278       REWRITE_TAC[kle] THEN MATCH_MP_TAC MONO_EXISTS THEN
1279       GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN
1280       MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
1281       ONCE_REWRITE_TAC[
1282         ASSUME `!j:num. a0 j = (if j = k then a3 j + 1 else a3 j)`;
1283         ASSUME `!j:num. a1 j = (if j = k then a2 j + 1 else a2 j)`] THEN
1284       REPEAT(COND_CASES_TAC THEN REWRITE_TAC[]) THEN ARITH_TAC;
1285       ALL_TAC] THEN
1286     SUBGOAL_THEN `kle n a3 a0` ASSUME_TAC THENL
1287      [REWRITE_TAC[kle] THEN EXISTS_TAC `{k:num}` THEN
1288       ASM_REWRITE_TAC[SUBSET; IN_SING; IN_NUMSEG] THEN
1289       ASM_MESON_TAC[ADD_CLAUSES];
1290       ALL_TAC] THEN
1291     MATCH_MP_TAC HAS_SIZE_CARD THEN CONV_TAC HAS_SIZE_CONV THEN
1292     MAP_EVERY EXISTS_TAC
1293      [`s:(num->num)->bool`; `a3 INSERT (s DELETE (a1:num->num))`] THEN
1294     SUBGOAL_THEN `~(a3:num->num = a1) /\ ~(a3 = a0)` STRIP_ASSUME_TAC THENL
1295      [ASM_MESON_TAC[]; ALL_TAC] THEN
1296     CONJ_TAC THENL [MATCH_MP_TAC lemma_1 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
1297     SUBGOAL_THEN `ksimplex p n (a3 INSERT (s DELETE a1))` ASSUME_TAC THENL
1298      [MP_TAC(ASSUME `ksimplex p n s`) THEN REWRITE_TAC[ksimplex] THEN
1299       MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
1300        [SIMP_TAC[HAS_SIZE; FINITE_INSERT; FINITE_DELETE; CARD_CLAUSES;
1301                  CARD_DELETE] THEN
1302         ASM_REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN ARITH_TAC;
1303         ALL_TAC] THEN
1304       MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
1305        [DISCH_TAC THEN REWRITE_TAC[IN_INSERT; IN_DELETE] THEN
1306         SUBGOAL_THEN `!j. (a3:num->num) j <= p`
1307          (fun th -> ASM_MESON_TAC[th]) THEN
1308         X_GEN_TAC `j:num` THEN
1309         FIRST_X_ASSUM(MP_TAC o SPECL [`a0:num->num`; `j:num`]) THEN
1310         ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ARITH_TAC;
1311         ALL_TAC] THEN
1312       MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
1313        [REWRITE_TAC[IN_INSERT; IN_DELETE] THEN REPEAT STRIP_TAC THENL
1314          [ALL_TAC; ASM_MESON_TAC[]] THEN
1315         FIRST_X_ASSUM SUBST_ALL_TAC THEN
1316         EXPAND_TAC "a3" THEN REWRITE_TAC[] THEN ASM_MESON_TAC[];
1317         ALL_TAC] THEN
1318       DISCH_TAC THEN REWRITE_TAC[IN_INSERT; IN_DELETE] THEN
1319       SUBGOAL_THEN `!x. x IN s /\ ~(x = a1) ==> kle n a3 x`
1320        (fun th -> ASM_MESON_TAC[th; KLE_REFL]) THEN
1321       X_GEN_TAC `x:num->num` THEN STRIP_TAC THEN
1322       MATCH_MP_TAC KLE_BETWEEN_L THEN
1323       MAP_EVERY EXISTS_TAC [`a0:num->num`; `a2:num->num`] THEN
1324       ASM_MESON_TAC[IN_DELETE];
1325       ALL_TAC] THEN
1326     GEN_REWRITE_TAC I [EXTENSION] THEN
1327     REWRITE_TAC[IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN
1328     X_GEN_TAC `s':(num->num)->bool` THEN EQ_TAC THENL
1329      [ALL_TAC;
1330       DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THENL
1331        [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN
1332       ASM_REWRITE_TAC[] THEN EXISTS_TAC `a3:num->num` THEN
1333       REWRITE_TAC[IN_INSERT; DELETE_INSERT] THEN
1334       UNDISCH_TAC `~((a3:num->num) IN s)` THEN SET_TAC[]] THEN
1335     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1336     DISCH_THEN(X_CHOOSE_THEN `a':num->num` STRIP_ASSUME_TAC) THEN
1337     MP_TAC(SPECL [`p:num`; `n:num`; `s':(num->num)->bool`]
1338                  KSIMPLEX_EXTREMA_STRONG) THEN ASM_REWRITE_TAC[] THEN
1339     DISCH_THEN(X_CHOOSE_THEN `a_min:num->num` (X_CHOOSE_THEN `a_max:num->num`
1340       STRIP_ASSUME_TAC)) THEN
1341     SUBGOAL_THEN `(a':num->num = a_min) \/ (a' = a_max)` MP_TAC THENL
1342      [MATCH_MP_TAC KSIMPLEX_FIX_PLANE THEN MAP_EVERY EXISTS_TAC
1343        [`p:num`; `(a2:num->num) k`; `n:num`;
1344         `k:num`; `s':(num->num)->bool`] THEN
1345       REPEAT CONJ_TAC THEN TRY(FIRST_ASSUM MATCH_ACCEPT_TAC) THEN
1346       X_GEN_TAC `x:num->num` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
1347       SUBGOAL_THEN `kle n a0 x /\ kle n x a2` MP_TAC THENL
1348        [ASM_MESON_TAC[IN_DELETE]; ALL_TAC] THEN
1349       DISCH_THEN(CONJUNCTS_THEN (MP_TAC o SPEC `k:num` o MATCH_MP
1350         KLE_IMP_POINTWISE)) THEN
1351       SUBGOAL_THEN `(a2:num->num) k <= a0 k`
1352         (fun th -> MP_TAC th THEN ARITH_TAC) THEN
1353       UNDISCH_TAC `!j:num. a1 j = (if j = k then a2 j + 1 else a2 j)` THEN
1354       DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_REWRITE_TAC[] THEN ARITH_TAC;
1355       ALL_TAC] THEN
1356     DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THENL
1357      [DISJ2_TAC THEN MATCH_MP_TAC lemma THEN
1358       MAP_EVERY EXISTS_TAC [`a3:num->num`; `a_min:num->num`] THEN
1359       ASM_REWRITE_TAC[IN_INSERT] THEN CONJ_TAC THENL
1360        [UNDISCH_TAC `~(a3:num->num IN s)` THEN SET_TAC[]; ALL_TAC] THEN
1361       SUBGOAL_THEN `a_max:num->num = a2` MP_TAC THENL
1362        [SUBGOAL_THEN `a2:num->num IN (s' DELETE a_min) /\
1363                       a_max:num->num IN (s DELETE a1)`
1364         MP_TAC THENL
1365          [ASM_MESON_TAC[IN_DELETE]; ASM_MESON_TAC[KLE_ANTISYM; IN_DELETE]];
1366         ALL_TAC] THEN
1367       SUBGOAL_THEN
1368        `!j. a2 j = if 1 <= j /\ j <= n then a3 j + 1 else a3 j`
1369        (fun th -> ASM_REWRITE_TAC[th; FUN_EQ_THM])
1370       THENL
1371        [ALL_TAC;
1372         MATCH_MP_TAC MONO_FORALL THEN MESON_TAC[EQ_ADD_RCANCEL]] THEN
1373       UNDISCH_TAC `!j:num. a1 j = (if j = k then a2 j + 1 else a2 j)` THEN
1374       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN
1375       MESON_TAC[EQ_ADD_RCANCEL];
1376       DISJ1_TAC THEN MATCH_MP_TAC lemma THEN
1377       MAP_EVERY EXISTS_TAC [`a1:num->num`; `a_max:num->num`] THEN
1378       REPEAT CONJ_TAC THEN TRY(FIRST_ASSUM ACCEPT_TAC) THEN
1379       SUBGOAL_THEN `a_min:num->num = a0` MP_TAC THENL
1380        [SUBGOAL_THEN `a0:num->num IN (s' DELETE a_max) /\
1381                       a_min:num->num IN (s DELETE a1)`
1382         MP_TAC THENL
1383          [ASM_MESON_TAC[IN_DELETE]; ASM_MESON_TAC[KLE_ANTISYM; IN_DELETE]];
1384         ALL_TAC] THEN
1385       UNDISCH_THEN `!j:num. a1 j = (if j = k then a2 j + 1 else a2 j)`
1386        (K ALL_TAC) THEN
1387       ASM_REWRITE_TAC[FUN_EQ_THM] THEN MATCH_MP_TAC MONO_FORALL THEN
1388       MESON_TAC[EQ_ADD_RCANCEL]];
1389     ALL_TAC] THEN
1390   MP_TAC(SPECL [`a:num->num`; `p:num`; `n:num`; `s:(num->num)->bool`]
1391         KSIMPLEX_PREDECESSOR) THEN ASM_REWRITE_TAC[] THEN
1392   MATCH_MP_TAC(TAUT `~a /\ (b ==> c) ==> a \/ b ==> c`) THEN CONJ_TAC THENL
1393    [ASM_MESON_TAC[KLE_ANTISYM]; ALL_TAC] THEN
1394   DISCH_THEN(X_CHOOSE_THEN `u:num->num`
1395    (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
1396   DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN
1397   MP_TAC(SPECL [`a:num->num`; `p:num`; `n:num`; `s:(num->num)->bool`]
1398         KSIMPLEX_SUCCESSOR) THEN
1399   REWRITE_TAC[ASSUME `ksimplex p n s`; ASSUME `a:num->num IN s`] THEN
1400   MATCH_MP_TAC(TAUT `~a /\ (b ==> c) ==> a \/ b ==> c`) THEN CONJ_TAC THENL
1401    [ASM_MESON_TAC[KLE_ANTISYM]; ALL_TAC] THEN
1402   DISCH_THEN(X_CHOOSE_THEN `v:num->num`
1403    (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
1404   DISCH_THEN(X_CHOOSE_THEN `l:num` STRIP_ASSUME_TAC) THEN
1405   ABBREV_TAC `a' = \j:num. if j = l then u(j) + 1 else u(j)` THEN
1406   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN
1407   REWRITE_TAC[] THEN DISCH_THEN(ASSUME_TAC o GSYM) THEN
1408   SUBGOAL_THEN `~(k:num = l)` ASSUME_TAC THENL
1409    [DISCH_TAC THEN
1410     UNDISCH_TAC `!j:num. v j = (if j = l then a j + 1 else a j)` THEN
1411     ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `l:num`) THEN
1412     REWRITE_TAC[] THEN DISCH_TAC THEN
1413     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ksimplex]) THEN
1414     DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN
1415     DISCH_THEN(MP_TAC o SPECL [`u:num->num`; `v:num->num`]) THEN
1416     ASM_REWRITE_TAC[] THEN
1417     ASM_REWRITE_TAC[kle] THEN
1418     DISCH_THEN(DISJ_CASES_THEN (CHOOSE_THEN (MP_TAC o SPEC `l:num` o
1419       CONJUNCT2))) THEN
1420     ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ARITH_TAC;
1421     ALL_TAC] THEN
1422   SUBGOAL_THEN `~(a':num->num = a)` ASSUME_TAC THENL
1423    [ASM_REWRITE_TAC[FUN_EQ_THM] THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN
1424     ASM_REWRITE_TAC[] THEN ARITH_TAC;
1425     ALL_TAC] THEN
1426   SUBGOAL_THEN `~((a':num->num) IN s)` ASSUME_TAC THENL
1427    [DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ksimplex]) THEN
1428     DISCH_THEN(MP_TAC o SPECL [`a:num->num`; `a':num->num`] o
1429       last o CONJUNCTS) THEN ASM_REWRITE_TAC[] THEN
1430     DISCH_THEN(DISJ_CASES_THEN (MP_TAC o MATCH_MP KLE_IMP_POINTWISE)) THENL
1431      [DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_REWRITE_TAC[] THEN ARITH_TAC;
1432       DISCH_THEN(MP_TAC o SPEC `l:num`) THEN ASM_REWRITE_TAC[] THEN
1433       ARITH_TAC];
1434     ALL_TAC] THEN
1435   SUBGOAL_THEN
1436    `kle n u a /\ kle n u a' /\ kle n a v /\ kle n a' v`
1437   STRIP_ASSUME_TAC THENL
1438    [REWRITE_TAC[kle] THEN REPEAT CONJ_TAC THENL
1439      [EXISTS_TAC `{k:num}`;
1440       EXISTS_TAC `{l:num}`;
1441       EXISTS_TAC `{l:num}`;
1442       EXISTS_TAC `{k:num}`] THEN
1443     ASM_REWRITE_TAC[IN_SING; SUBSET; IN_NUMSEG] THEN
1444     ASM_MESON_TAC[ADD_CLAUSES];
1445     ALL_TAC] THEN
1446   SUBGOAL_THEN `!x. kle n u x /\ kle n x v
1447                     ==> ((x = u) \/ (x = a) \/ (x = a') \/ (x = v))`
1448   ASSUME_TAC THENL
1449    [X_GEN_TAC `x:num->num` THEN
1450     DISCH_THEN(CONJUNCTS_THEN (MP_TAC o MATCH_MP KLE_IMP_POINTWISE)) THEN
1451     ASM_REWRITE_TAC[FUN_EQ_THM; IMP_IMP; AND_FORALL_THM] THEN
1452     ONCE_REWRITE_TAC[COND_RAND] THEN
1453     ASM_CASES_TAC `(x:num->num) k = u k` THEN
1454     ASM_CASES_TAC `(x:num->num) l = u l` THENL
1455      [DISCH_THEN(fun th -> DISJ1_TAC THEN MP_TAC th);
1456       DISCH_THEN(fun th -> DISJ2_TAC THEN DISJ2_TAC THEN DISJ1_TAC THEN
1457                            MP_TAC th);
1458       DISCH_THEN(fun th -> DISJ2_TAC THEN DISJ1_TAC THEN MP_TAC th);
1459       DISCH_THEN(fun th -> REPEAT DISJ2_TAC THEN MP_TAC th)] THEN
1460     MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `j:num` THEN
1461     REPEAT(COND_CASES_TAC THEN
1462            ASM_REWRITE_TAC[LE_ANTISYM;
1463        ARITH_RULE `x <= u + 1 /\ u <= x <=> (x = u) \/ (x = u + 1)`]);
1464     ALL_TAC] THEN
1465   SUBGOAL_THEN `kle n u v` ASSUME_TAC THENL
1466    [ASM_MESON_TAC[KLE_TRANS; ksimplex]; ALL_TAC] THEN
1467   SUBGOAL_THEN `ksimplex p n (a' INSERT (s DELETE a))` ASSUME_TAC THENL
1468    [MP_TAC(ASSUME `ksimplex p n s`) THEN REWRITE_TAC[ksimplex] THEN
1469     MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
1470      [SIMP_TAC[HAS_SIZE; FINITE_INSERT; FINITE_DELETE; CARD_CLAUSES;
1471                CARD_DELETE; IN_DELETE] THEN
1472       ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ARITH_TAC;
1473       ALL_TAC] THEN
1474     MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
1475      [REWRITE_TAC[IN_INSERT; IN_DELETE] THEN
1476       SIMP_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN
1477       REWRITE_TAC[RIGHT_FORALL_IMP_THM; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN
1478       ASM_REWRITE_TAC[] THEN
1479       DISCH_THEN(fun th -> X_GEN_TAC `j:num` THEN MP_TAC th) THEN
1480       COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN
1481       DISCH_THEN(MP_TAC o SPEC `v:num->num`) THEN ASM_REWRITE_TAC[] THEN
1482       DISCH_THEN(MP_TAC o SPEC `l:num`) THEN ASM_REWRITE_TAC[];
1483       ALL_TAC] THEN
1484     MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
1485      [REWRITE_TAC[IN_INSERT; IN_DELETE] THEN
1486       REWRITE_TAC[TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c`] THEN
1487       SIMP_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN
1488       REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
1489       REWRITE_TAC[EXISTS_REFL; LEFT_FORALL_IMP_THM] THEN
1490       ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[];
1491       ALL_TAC] THEN
1492     REWRITE_TAC[IN_INSERT; IN_DELETE] THEN
1493     SUBGOAL_THEN
1494      `!x. x IN s /\ kle n v x ==> kle n a' x`
1495     ASSUME_TAC THENL
1496      [X_GEN_TAC `x:num->num` THEN STRIP_TAC THEN
1497       MATCH_MP_TAC KLE_BETWEEN_R THEN
1498       MAP_EVERY EXISTS_TAC [`u:num->num`; `v:num->num`] THEN
1499       ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[ksimplex; KLE_TRANS];
1500       ALL_TAC] THEN
1501     SUBGOAL_THEN
1502      `!x. x IN s /\ kle n x u ==> kle n x a'`
1503     ASSUME_TAC THENL
1504      [X_GEN_TAC `x:num->num` THEN STRIP_TAC THEN
1505       MATCH_MP_TAC KLE_BETWEEN_L THEN
1506       MAP_EVERY EXISTS_TAC [`u:num->num`; `v:num->num`] THEN
1507       ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[ksimplex; KLE_TRANS];
1508       ALL_TAC] THEN
1509     SUBGOAL_THEN
1510      `!x. x IN s /\ ~(x = a) ==> kle n a' x \/ kle n x a'`
1511      (fun th -> MESON_TAC[th; KLE_REFL; ASSUME `(a:num->num) IN s`]) THEN
1512     X_GEN_TAC `x:num->num` THEN STRIP_TAC THEN
1513     ASM_CASES_TAC `kle n v x` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
1514     ASM_CASES_TAC `kle n x u` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
1515     SUBGOAL_THEN `(x:num->num = u) \/ (x = a) \/ (x = a') \/ (x = v)`
1516      (fun th -> ASM_MESON_TAC[th; KLE_REFL]) THEN
1517     FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[ksimplex];
1518     ALL_TAC] THEN
1519   MATCH_MP_TAC HAS_SIZE_CARD THEN CONV_TAC HAS_SIZE_CONV THEN
1520   MAP_EVERY EXISTS_TAC
1521    [`s:(num->num)->bool`; `a' INSERT (s DELETE (a:num->num))`] THEN
1522   CONJ_TAC THENL
1523    [REWRITE_TAC[EXTENSION; IN_DELETE; IN_INSERT] THEN ASM_MESON_TAC[];
1524     ALL_TAC] THEN
1525   GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM] THEN
1526   X_GEN_TAC `s':(num->num)->bool` THEN
1527   REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN EQ_TAC THENL
1528    [ALL_TAC;
1529     DISCH_THEN(DISJ_CASES_THEN SUBST1_TAC) THENL
1530      [ASM_MESON_TAC[]; ALL_TAC] THEN
1531     ASM_REWRITE_TAC[] THEN EXISTS_TAC `a':num->num` THEN
1532     REWRITE_TAC[EXTENSION; IN_INSERT; IN_DELETE] THEN ASM_MESON_TAC[]] THEN
1533   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1534   DISCH_THEN(X_CHOOSE_THEN `a'':num->num` STRIP_ASSUME_TAC) THEN
1535   SUBGOAL_THEN `(a:num->num) IN s' \/ a' IN s'` MP_TAC THENL
1536    [ALL_TAC;
1537     MATCH_MP_TAC MONO_OR THEN CONJ_TAC THEN DISCH_TAC THEN
1538     MP_TAC(ASSUME `s' DELETE a'' = s DELETE (a:num->num)`) THEN
1539     REWRITE_TAC[EXTENSION] THEN
1540     DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC th) THENL
1541      [DISCH_THEN(MP_TAC o SPEC `a:num->num`);
1542       DISCH_THEN(MP_TAC o SPEC `a':num->num`)] THEN
1543     REWRITE_TAC[IN_DELETE] THEN ASM_REWRITE_TAC[IN_INSERT; IN_DELETE] THEN
1544     DISCH_THEN(SUBST_ALL_TAC o SYM) THEN ASM_MESON_TAC[]] THEN
1545   SUBGOAL_THEN `~(u:num->num = v)` ASSUME_TAC THENL
1546    [ASM_REWRITE_TAC[FUN_EQ_THM] THEN DISCH_THEN(MP_TAC o SPEC `l:num`) THEN
1547     ASM_REWRITE_TAC[] THEN ARITH_TAC;
1548     ALL_TAC] THEN
1549   SUBGOAL_THEN `~(kle n v u)` ASSUME_TAC THENL
1550    [ASM_MESON_TAC[KLE_ANTISYM]; ALL_TAC] THEN
1551   SUBGOAL_THEN `~(u:num->num = a)` ASSUME_TAC THENL
1552    [ASM_REWRITE_TAC[FUN_EQ_THM] THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN
1553     ASM_REWRITE_TAC[] THEN ARITH_TAC;
1554     ALL_TAC] THEN
1555   SUBGOAL_THEN `~(v:num->num = a)` ASSUME_TAC THENL
1556    [ASM_REWRITE_TAC[FUN_EQ_THM] THEN DISCH_THEN(MP_TAC o SPEC `l:num`) THEN
1557     ASM_REWRITE_TAC[] THEN ARITH_TAC;
1558     ALL_TAC] THEN
1559   SUBGOAL_THEN `u:num->num IN s' /\ v IN s'` STRIP_ASSUME_TAC THENL
1560    [ASM_MESON_TAC[EXTENSION; IN_DELETE]; ALL_TAC] THEN
1561   ASM_CASES_TAC
1562    `!x. x IN s' ==> kle n x u \/ kle n v x`
1563   THENL
1564    [ALL_TAC;
1565     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN
1566     DISCH_THEN(X_CHOOSE_THEN `w:num->num` MP_TAC) THEN
1567     REWRITE_TAC[NOT_IMP; DE_MORGAN_THM] THEN STRIP_TAC THEN
1568     SUBGOAL_THEN `(w:num->num = u) \/ (w = a) \/ (w = a') \/ (w = v)`
1569      (fun th -> ASM_MESON_TAC[KLE_REFL; th]) THEN
1570     FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[ksimplex]] THEN
1571   MP_TAC(SPECL [`u:num->num`; `p:num`; `n:num`; `s':(num->num)->bool`]
1572                KSIMPLEX_SUCCESSOR) THEN
1573   ANTS_TAC THENL [ASM_MESON_TAC[EXTENSION; IN_DELETE]; ALL_TAC] THEN
1574   DISCH_THEN(DISJ_CASES_THEN2 (MP_TAC o SPEC `v:num->num`) MP_TAC) THENL
1575    [ASM_MESON_TAC[EXTENSION; IN_DELETE]; ALL_TAC] THEN
1576   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN
1577   UNDISCH_TAC `!x. x IN s' ==> kle n x u \/ kle n v x` THEN
1578   REWRITE_TAC[NOT_EXISTS_THM] THEN MATCH_MP_TAC MONO_FORALL THEN
1579   X_GEN_TAC `w:num->num` THEN
1580   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
1581   ASM_REWRITE_TAC[] THEN
1582   DISCH_THEN(DISJ_CASES_THEN(MP_TAC o MATCH_MP KLE_IMP_POINTWISE)) THEN
1583   ASM_REWRITE_TAC[] THENL
1584    [MESON_TAC[ARITH_RULE `~(i + 1 <= i)`]; ALL_TAC] THEN
1585   DISCH_THEN(fun th -> MP_TAC(SPEC `k:num` th) THEN
1586                        MP_TAC(SPEC `l:num` th)) THEN
1587   ASM_REWRITE_TAC[] THEN
1588   REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN TRY ARITH_TAC THEN
1589   UNDISCH_TAC `~(k:num = l)` THEN ASM_REWRITE_TAC[]);;
1590
1591 (* ------------------------------------------------------------------------- *)
1592 (* Hence another step towards concreteness.                                  *)
1593 (* ------------------------------------------------------------------------- *)
1594
1595 let KUHN_SIMPLEX_LEMMA = prove
1596  (`!p n. (!s. ksimplex p (n + 1) s ==> (IMAGE rl s SUBSET 0..n+1)) /\
1597          ODD(CARD{f | (?s a. ksimplex p (n + 1) s /\
1598                              a IN s /\
1599                              (f = s DELETE a)) /\
1600                       (IMAGE rl f = 0 .. n) /\
1601                       ((?j. 1 <= j /\ j <= n + 1 /\
1602                             !x. x IN f ==> (x j = 0)) \/
1603                        (?j. 1 <= j /\ j <= n + 1 /\
1604                             !x. x IN f ==> (x j = p)))})
1605          ==>  ODD(CARD {s | s IN {s | ksimplex p (n + 1) s} /\
1606                             (IMAGE rl s = 0..n+1)})`,
1607   REPEAT STRIP_TAC THEN SUBGOAL_THEN
1608    `ODD(CARD {f | f IN {f | ?s. s IN {s | ksimplex p (n + 1) s} /\
1609                              (?a. a IN s /\ (f = s DELETE a))} /\
1610                (IMAGE rl f = 0..n) /\
1611                ((?j. 1 <= j /\ j <= n + 1 /\ !x. x IN f ==> (x j = 0)) \/
1612                 (?j. 1 <= j /\ j <= n + 1 /\ !x. x IN f ==> (x j = p)))})`
1613   MP_TAC THENL
1614    [ASM_REWRITE_TAC[IN_ELIM_THM; RIGHT_AND_EXISTS_THM]; ALL_TAC] THEN
1615   MATCH_MP_TAC KUHN_COMPLETE_LEMMA THEN  REWRITE_TAC[FINITE_SIMPLICES] THEN
1616   ASM_REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
1617   CONV_TAC(LAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN ASM_REWRITE_TAC[] THENL
1618    [ASM_MESON_TAC[ksimplex; ARITH_RULE `(n + 1) + 1 = n + 2`];
1619     ASM_SIMP_TAC[];
1620     MATCH_MP_TAC KSIMPLEX_REPLACE_0;
1621     MATCH_MP_TAC KSIMPLEX_REPLACE_1;
1622     MATCH_MP_TAC KSIMPLEX_REPLACE_2] THEN
1623   ASM_MESON_TAC[ARITH_RULE `~(n + 1 = 0)`]);;
1624
1625 (* ------------------------------------------------------------------------- *)
1626 (* Reduced labelling.                                                        *)
1627 (* ------------------------------------------------------------------------- *)
1628
1629 let reduced = new_definition
1630  `reduced label n (x:num->num) =
1631      @k. k <= n /\
1632          (!i. 1 <= i /\ i < k + 1 ==> (label x i = 0)) /\
1633          ((k = n) \/ ~(label x (k + 1) = 0))`;;
1634
1635 let REDUCED_LABELLING = prove
1636  (`!label x n.
1637       reduced label n x <= n /\
1638       (!i. 1 <= i /\ i < reduced label n x + 1 ==> (label x i = 0)) /\
1639       ((reduced label n x = n) \/ ~(label x (reduced label n x + 1) = 0))`,
1640   REPEAT GEN_TAC THEN REWRITE_TAC[reduced] THEN CONV_TAC SELECT_CONV THEN
1641   MP_TAC(SPEC `\j. j <= n /\ ~(label (x:num->num) (j + 1) = 0) \/ (n = j)`
1642      num_WOP) THEN
1643   REWRITE_TAC[] THEN
1644   MATCH_MP_TAC(TAUT `a /\ (b ==> c) ==> (a <=> b) ==> c`) THEN
1645   CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
1646   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN
1647   ASM_CASES_TAC `k = n:num` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
1648   ASM_REWRITE_TAC[LE_REFL] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
1649   FIRST_X_ASSUM(MP_TAC o SPEC `i - 1`) THEN
1650   SIMP_TAC[LT_IMP_LE] THEN
1651   ASM_SIMP_TAC[ARITH_RULE `1 <= i /\ i < n + 1 ==> i - 1 < n`] THEN
1652   ASM_SIMP_TAC[ARITH_RULE `1 <= i /\ i < n + 1 ==> ~(n = i - 1)`] THEN
1653   ASM_SIMP_TAC[SUB_ADD] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
1654   ARITH_TAC);;
1655
1656 let REDUCED_LABELLING_UNIQUE = prove
1657  (`!label x n.
1658       r <= n /\
1659       (!i. 1 <= i /\ i < r + 1 ==> (label x i = 0)) /\
1660       ((r = n) \/ ~(label x (r + 1) = 0))
1661       ==> (reduced label n x = r)`,
1662   REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
1663   REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC(SPECL
1664         [`label:(num->num)->(num->num)`; `x:num->num`; `n:num`]
1665         REDUCED_LABELLING) THEN
1666   MATCH_MP_TAC(ARITH_RULE `~(a < b) /\ ~(b < a:num) ==> (a = b)`) THEN
1667   ASM_MESON_TAC[ARITH_RULE `s < r:num /\ r <= n ==> ~(s = n)`;
1668                 ARITH_RULE `s < r ==> 1 <= s + 1 /\ s + 1 < r + 1`]);;
1669
1670 let REDUCED_LABELLING_0 = prove
1671  (`!label n x j.
1672         1 <= j /\ j <= n /\ (label x j = 0)
1673         ==> ~(reduced label n x = j - 1)`,
1674   REPEAT STRIP_TAC THEN
1675   MP_TAC(SPECL [`label:(num->num)->num->num`; `x:num->num`; `n:num`]
1676                REDUCED_LABELLING) THEN
1677   ASM_SIMP_TAC[SUB_ADD; ARITH_RULE `1 <= j /\ j <= n ==> ~(j - 1 = n)`]);;
1678
1679 let REDUCED_LABELLING_1 = prove
1680  (`!label n x j.
1681         1 <= j /\ j <= n /\ ~(label x j = 0)
1682         ==> reduced label n x < j`,
1683   REWRITE_TAC[GSYM NOT_LE] THEN REPEAT STRIP_TAC THEN
1684   MP_TAC(SPECL [`label:(num->num)->num->num`; `x:num->num`; `n:num`]
1685                REDUCED_LABELLING) THEN
1686   DISCH_THEN(MP_TAC o SPEC `j:num` o CONJUNCT1 o CONJUNCT2) THEN
1687   ASM_REWRITE_TAC[ARITH_RULE `y < x + 1 <=> (y <= x)`]);;
1688
1689 let REDUCED_LABELLING_SUC = prove
1690  (`!lab n x.
1691         ~(reduced lab (n + 1) x = n + 1)
1692         ==> (reduced lab (n + 1) x = reduced lab n x)`,
1693   REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
1694   MATCH_MP_TAC REDUCED_LABELLING_UNIQUE THEN
1695   ASM_MESON_TAC[REDUCED_LABELLING; ARITH_RULE
1696    `x <= n + 1 /\ ~(x = n + 1) ==> x <= n`]);;
1697
1698 let COMPLETE_FACE_TOP = prove
1699  (`!lab f n.
1700          (!x j. x IN f /\ 1 <= j /\ j <= n + 1 /\ (x j = 0)
1701                 ==> (lab x j = 0)) /\
1702          (!x j. x IN f /\ 1 <= j /\ j <= n + 1 /\ (x j = p)
1703                 ==> (lab x j = 1))
1704          ==> ((IMAGE (reduced lab (n + 1)) f = 0..n) /\
1705               ((?j. 1 <= j /\ j <= n + 1 /\ !x. x IN f ==> (x j = 0)) \/
1706                (?j. 1 <= j /\ j <= n + 1 /\ !x. x IN f ==> (x j = p))) <=>
1707               (IMAGE (reduced lab (n + 1)) f = 0..n) /\
1708               (!x. x IN f ==> (x (n + 1) = p)))`,
1709   REPEAT STRIP_TAC THEN EQ_TAC THENL
1710    [ALL_TAC; MESON_TAC[ARITH_RULE `1 <= n + 1`; LE_REFL]] THEN
1711   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
1712   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THENL
1713    [DISCH_THEN(MP_TAC o SPEC `j - 1`) THEN
1714     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN
1715     ASM_SIMP_TAC[IN_IMAGE; IN_NUMSEG; LE_0; NOT_EXISTS_THM;
1716                  ARITH_RULE `j <= n + 1 ==> j - 1 <= n`] THEN
1717     ASM_MESON_TAC[REDUCED_LABELLING_0];
1718     DISCH_THEN(MP_TAC o SPEC `j:num`) THEN
1719     REWRITE_TAC[IN_IMAGE; IN_NUMSEG; LE_0; NOT_LE] THEN
1720     ASM_SIMP_TAC[ARITH_RULE `j <= n + 1 ==> ((j <= n) <=> ~(j = n + 1))`] THEN
1721     ASM_MESON_TAC[REDUCED_LABELLING_1; ARITH_RULE `~(1 = 0)`; LT_REFL]]);;
1722
1723 (* ------------------------------------------------------------------------- *)
1724 (* Hence we get just about the nice induction.                               *)
1725 (* ------------------------------------------------------------------------- *)
1726
1727 let KUHN_INDUCTION = prove
1728  (`!p n. 0 < p /\
1729          (!x j. (!j. x(j) <= p) /\ 1 <= j /\ j <= n + 1 /\ (x j = 0)
1730                 ==> (lab x j = 0)) /\
1731          (!x j. (!j. x(j) <= p) /\ 1 <= j /\ j <= n + 1 /\ (x j = p)
1732                 ==> (lab x j = 1))
1733          ==> ODD(CARD {f | ksimplex p n f /\
1734                            (IMAGE (reduced lab n) f = 0..n)})
1735              ==> ODD(CARD {s | ksimplex p (n + 1) s /\
1736                            (IMAGE (reduced lab (n + 1)) s = 0..n+1)})`,
1737   REPEAT STRIP_TAC THEN
1738   MATCH_MP_TAC(REWRITE_RULE[IN_ELIM_THM] KUHN_SIMPLEX_LEMMA) THEN
1739   CONJ_TAC THENL
1740    [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG; LE_0] THEN
1741     MESON_TAC[ARITH_RULE `x <= n ==> x <= n + 1`; REDUCED_LABELLING];
1742     ALL_TAC] THEN
1743   FIRST_ASSUM(fun th -> MP_TAC th THEN
1744     MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC) THEN
1745   AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN
1746   X_GEN_TAC `f:(num->num)->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN
1747   ASM_CASES_TAC
1748    `(!x j. x IN f /\ 1 <= j /\ j <= n + 1 /\ (x j = 0) ==> (lab x j = 0)) /\
1749     (!x j. x IN f /\ 1 <= j /\ j <= n + 1 /\ (x j = p) ==> (lab x j = 1))`
1750   THENL
1751    [ALL_TAC;
1752     MATCH_MP_TAC(TAUT `~a /\ ~b ==> (a /\ c <=> b /\ d)`) THEN
1753     CONJ_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN
1754     REWRITE_TAC[CONTRAPOS_THM] THEN REWRITE_TAC[ksimplex] THEN
1755     ASM_MESON_TAC[IN_DELETE]] THEN
1756   ASM_SIMP_TAC[COMPLETE_FACE_TOP] THEN
1757   ASM_CASES_TAC `!x. x IN f ==> (x(n + 1):num = p)` THENL
1758    [ALL_TAC;
1759     ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN
1760     REWRITE_TAC[ksimplex] THEN
1761     ASM_MESON_TAC[ARITH_RULE `~(n + 1 <= n)`]] THEN
1762   ASM_SIMP_TAC[SIMPLEX_TOP_FACE] THEN
1763   ASM_CASES_TAC `ksimplex p n f` THEN ASM_REWRITE_TAC[] THEN
1764   REWRITE_TAC[EXTENSION; IN_IMAGE] THEN
1765   AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN
1766   X_GEN_TAC `k:num` THEN REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
1767   AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN
1768   X_GEN_TAC `x:num->num` THEN REWRITE_TAC[] THEN
1769   ASM_CASES_TAC `(x:num->num) IN f` THEN ASM_REWRITE_TAC[] THEN
1770   AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN
1771   MATCH_MP_TAC REDUCED_LABELLING_SUC THEN
1772   MATCH_MP_TAC(ARITH_RULE `a:num < b ==> ~(a = b)`) THEN
1773   MATCH_MP_TAC REDUCED_LABELLING_1 THEN
1774   REWRITE_TAC[LE_REFL; ARITH_RULE `1 <= n + 1`] THEN
1775   MATCH_MP_TAC(ARITH_RULE `(n = 1) ==> ~(n = 0)`) THEN
1776   FIRST_X_ASSUM MATCH_MP_TAC THEN
1777   REWRITE_TAC[LE_REFL; ARITH_RULE `1 <= n + 1`] THEN
1778   ASM_MESON_TAC[ksimplex]);;
1779
1780 (* ------------------------------------------------------------------------- *)
1781 (* And so we get the final combinatorial result.                             *)
1782 (* ------------------------------------------------------------------------- *)
1783
1784 let KSIMPLEX_0 = prove
1785  (`ksimplex p 0 s <=> (s = {(\x. p)})`,
1786   REWRITE_TAC[ksimplex; ADD_CLAUSES] THEN
1787   CONV_TAC(LAND_CONV(LAND_CONV HAS_SIZE_CONV)) THEN
1788   REWRITE_TAC[ARITH_RULE `1 <= j /\ j <= 0 <=> F`] THEN
1789   ONCE_REWRITE_TAC[TAUT `a /\ b <=> ~(a ==> ~b)`] THEN
1790   SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[IN_SING] THEN
1791   SIMP_TAC[RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[KLE_REFL] THEN
1792   REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN
1793   REWRITE_TAC[AND_FORALL_THM; ARITH_RULE
1794    `x <= y:num /\ (x = y) <=> (x = y)`] THEN
1795   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN
1796   REWRITE_TAC[GSYM FUN_EQ_THM] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
1797   REWRITE_TAC[UNWIND_THM2]);;
1798
1799 let REDUCE_LABELLING_0 = prove
1800  (`!lab x. reduced lab 0 x = 0`,
1801   REPEAT GEN_TAC THEN MATCH_MP_TAC REDUCED_LABELLING_UNIQUE THEN
1802   REWRITE_TAC[LE_REFL] THEN ARITH_TAC);;
1803
1804 let KUHN_COMBINATORIAL = prove
1805  (`!lab p n.
1806          0 < p /\
1807          (!x j. (!j. x(j) <= p) /\ 1 <= j /\ j <= n /\ (x j = 0)
1808                 ==> (lab x j = 0)) /\
1809          (!x j. (!j. x(j) <= p) /\ 1 <= j /\ j <= n  /\ (x j = p)
1810                 ==> (lab x j = 1))
1811          ==> ODD(CARD {s | ksimplex p n s /\
1812                            (IMAGE (reduced lab n) s = 0..n)})`,
1813   GEN_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
1814   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN
1815   INDUCT_TAC THENL
1816    [DISCH_THEN(K ALL_TAC) THEN
1817     SUBGOAL_THEN `{s | ksimplex p 0 s /\ (IMAGE (reduced lab 0) s = 0 .. 0)} =
1818                   {{(\x. p)}}`
1819      (fun th -> SIMP_TAC[CARD_CLAUSES; NOT_IN_EMPTY;
1820                          FINITE_RULES; th; ARITH]) THEN
1821     GEN_REWRITE_TAC I [EXTENSION] THEN
1822     REWRITE_TAC[IN_ELIM_THM; KSIMPLEX_0; IN_SING] THEN
1823     GEN_TAC THEN MATCH_MP_TAC(TAUT `(a ==> b) ==> (a /\ b <=> a)`) THEN
1824     DISCH_THEN SUBST_ALL_TAC THEN
1825     REWRITE_TAC[NUMSEG_SING; EXTENSION; IN_SING; IN_IMAGE] THEN
1826     REWRITE_TAC[REDUCE_LABELLING_0] THEN MESON_TAC[];
1827     STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN
1828     ANTS_TAC THENL
1829      [ASM_MESON_TAC[ARITH_RULE `j <= n ==> j <= SUC n`];
1830       ALL_TAC] THEN
1831     REWRITE_TAC[ADD1] THEN MATCH_MP_TAC KUHN_INDUCTION THEN
1832     ASM_REWRITE_TAC[GSYM ADD1]]);;
1833
1834 let KUHN_LEMMA = prove
1835  (`!n p label.
1836         0 < p /\ 0 < n /\
1837         (!x. (!i. 1 <= i /\ i <= n ==> x(i) <= p)
1838              ==> !i. 1 <= i /\ i <= n ==> (label x i = 0) \/ (label x i = 1)) /\
1839         (!x. (!i. 1 <= i /\ i <= n ==> x(i) <= p)
1840              ==> !i. 1 <= i /\ i <= n /\ (x i = 0) ==> (label x i = 0)) /\
1841         (!x. (!i. 1 <= i /\ i <= n ==> x(i) <= p)
1842              ==> !i. 1 <= i /\ i <= n /\ (x i = p) ==> (label x i = 1))
1843         ==> ?q. (!i. 1 <= i /\ i <= n ==> q(i) < p) /\
1844                 (!i. 1 <= i /\ i <= n
1845                      ==> ?r s. (!j. 1 <= j /\ j <= n
1846                                     ==> q(j) <= r(j) /\ r(j) <= q(j) + 1) /\
1847                                (!j. 1 <= j /\ j <= n
1848                                     ==> q(j) <= s(j) /\ s(j) <= q(j) + 1) /\
1849                                ~(label r i = label s i))`,
1850   REPEAT STRIP_TAC THEN
1851   MP_TAC(SPECL [`label:(num->num)->num->num`; `p:num`; `n:num`]
1852                KUHN_COMBINATORIAL) THEN
1853   ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
1854   ASM_CASES_TAC
1855    `{s | ksimplex p n s /\ (IMAGE (reduced label n) s = 0 .. n)} = {}`
1856   THENL [ASM_REWRITE_TAC[CARD_CLAUSES; ARITH]; ALL_TAC] THEN
1857   DISCH_THEN(K ALL_TAC) THEN
1858   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
1859   REWRITE_TAC[IN_ELIM_THM] THEN
1860   DISCH_THEN(X_CHOOSE_THEN `s:(num->num)->bool` STRIP_ASSUME_TAC) THEN
1861   MP_TAC(SPECL [`p:num`; `n:num`; `s:(num->num)->bool`]
1862                KSIMPLEX_EXTREMA_STRONG) THEN
1863   ASM_REWRITE_TAC[GSYM LT_NZ] THEN
1864   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:num->num` THEN
1865   DISCH_THEN(X_CHOOSE_THEN `b:num->num` STRIP_ASSUME_TAC) THEN
1866   CONJ_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THENL
1867    [MATCH_MP_TAC(ARITH_RULE `x + 1 <= y ==> x < y`) THEN
1868     MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `(b:num->num) i` THEN
1869     CONJ_TAC THENL [ASM_REWRITE_TAC[LE_REFL]; ALL_TAC] THEN
1870     ASM_MESON_TAC[ksimplex];
1871     ALL_TAC] THEN
1872   UNDISCH_TAC `IMAGE (reduced label n) s = 0 .. n` THEN
1873   REWRITE_TAC[EXTENSION; IN_IMAGE] THEN
1874   DISCH_THEN(fun th ->
1875     MP_TAC(SPEC `i - 1` th) THEN MP_TAC(SPEC `i:num` th)) THEN
1876   ASM_REWRITE_TAC[IN_NUMSEG; LE_0] THEN
1877   DISCH_THEN(X_CHOOSE_THEN `u:num->num` (STRIP_ASSUME_TAC o GSYM)) THEN
1878   ASM_SIMP_TAC[ARITH_RULE `1 <= i /\ i <= n ==> i - 1 <= n`] THEN
1879   DISCH_THEN(X_CHOOSE_THEN `v:num->num` (STRIP_ASSUME_TAC o GSYM)) THEN
1880   MAP_EVERY EXISTS_TAC [`u:num->num`; `v:num->num`] THEN
1881   REWRITE_TAC[CONJ_ASSOC] THEN
1882   CONJ_TAC THENL [ASM_MESON_TAC[KLE_IMP_POINTWISE]; ALL_TAC] THEN
1883   MP_TAC(SPECL [`label:(num->num)->num->num`; `u:num->num`; `n:num`]
1884                 REDUCED_LABELLING) THEN
1885   MP_TAC(SPECL [`label:(num->num)->num->num`; `v:num->num`; `n:num`]
1886                 REDUCED_LABELLING) THEN
1887   ASM_REWRITE_TAC[] THEN
1888   ASM_SIMP_TAC[ARITH_RULE `1 <= i /\ i <= n ==> ~(i - 1 = n)`] THEN
1889   ASM_SIMP_TAC[SUB_ADD] THEN ASM_MESON_TAC[ARITH_RULE `i < i + 1`]);;
1890
1891 (* ------------------------------------------------------------------------- *)
1892 (* The main result for the unit cube.                                        *)
1893 (* ------------------------------------------------------------------------- *)
1894
1895 let BROUWER_CUBE = prove
1896  (`!f:real^N->real^N.
1897         f continuous_on (interval [vec 0,vec 1]) /\
1898         IMAGE f (interval [vec 0,vec 1]) SUBSET (interval [vec 0,vec 1])
1899         ==> ?x. x IN interval[vec 0,vec 1] /\ (f x = x)`,
1900   REPEAT STRIP_TAC THEN ABBREV_TAC `n = dimindex(:N)` THEN
1901   SUBGOAL_THEN `1 <= n /\ 0 < n /\ ~(n = 0)` STRIP_ASSUME_TAC THENL
1902    [EXPAND_TAC "n" THEN REWRITE_TAC[DIMINDEX_NONZERO; DIMINDEX_GE_1] THEN
1903     ASM_MESON_TAC[LT_NZ; DIMINDEX_NONZERO];
1904     ALL_TAC] THEN
1905   GEN_REWRITE_TAC I [TAUT `p <=> ~ ~ p`] THEN
1906   PURE_REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b) <=> a ==> ~b`] THEN
1907   DISCH_TAC THEN SUBGOAL_THEN
1908    `?d. &0 < d /\ !x:real^N. x IN interval[vec 0,vec 1] ==> d <= norm(f x - x)`
1909   STRIP_ASSUME_TAC THENL
1910    [MATCH_MP_TAC BROUWER_COMPACTNESS_LEMMA THEN
1911     ASM_SIMP_TAC[COMPACT_INTERVAL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST;
1912                  CONTINUOUS_ON_ID] THEN
1913     ASM_MESON_TAC[VECTOR_SUB_EQ];
1914     ALL_TAC] THEN
1915   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
1916   REWRITE_TAC[FORALL_IN_IMAGE] THEN
1917   FREEZE_THEN(fun th -> DISCH_THEN(MP_TAC o MATCH_MP th))
1918         (SPEC `f:real^N->real^N` KUHN_LABELLING_LEMMA) THEN
1919   DISCH_THEN(MP_TAC o SPEC `\i. 1 <= i /\ i <= n`) THEN
1920   ANTS_TAC THENL [ASM_SIMP_TAC[IN_INTERVAL; VEC_COMPONENT]; ALL_TAC] THEN
1921   REWRITE_TAC[] THEN
1922   DISCH_THEN(X_CHOOSE_THEN `label:real^N->num->num` STRIP_ASSUME_TAC) THEN
1923   SUBGOAL_THEN
1924    `!x y i. x IN interval[vec 0,vec 1] /\ y IN interval[vec 0,vec 1] /\
1925             1 <= i /\ i <= n /\ ~(label (x:real^N) i :num = label y i)
1926             ==> abs((f(x) - x)$i) <= norm(f(y) - f(x)) + norm(y - x)`
1927   ASSUME_TAC THENL
1928    [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
1929     EXISTS_TAC `abs(((f:real^N->real^N)(y) - f(x))$i) + abs((y - x)$i)` THEN
1930     ASM_SIMP_TAC[REAL_LE_ADD2; COMPONENT_LE_NORM] THEN
1931     ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN
1932     MATCH_MP_TAC(REAL_ARITH
1933      `!x y fx fy d. (x <= fx /\ fy <= y \/ fx <= x /\ y <= fy)
1934              ==> abs(fx - x) <= abs(fy - fx) + abs(y - x)`) THEN
1935     FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE
1936      `~(a = b)
1937       ==> a <= 1 /\ b <= 1 ==> (a = 0) /\ (b = 1) \/ (a = 1) /\ (b = 0)`)) THEN
1938     ASM_SIMP_TAC[] THEN STRIP_TAC THEN ASM_SIMP_TAC[];
1939     ALL_TAC] THEN
1940   SUBGOAL_THEN
1941    `?e. &0 < e /\
1942         !x y z i. x IN interval[vec 0,vec 1] /\
1943                   y IN interval[vec 0,vec 1] /\
1944                   z IN interval[vec 0,vec 1] /\
1945                   1 <= i /\ i <= n /\
1946                   norm(x - z) < e /\ norm(y - z) < e /\
1947                   ~(label (x:real^N) i :num = label y i)
1948                   ==> abs((f(z) - z)$i) < d / &n`
1949   MP_TAC THENL
1950    [SUBGOAL_THEN
1951      `(f:real^N->real^N) uniformly_continuous_on interval[vec 0,vec 1]`
1952     MP_TAC THENL
1953      [ASM_SIMP_TAC[COMPACT_UNIFORMLY_CONTINUOUS; COMPACT_INTERVAL];
1954       ALL_TAC] THEN
1955     REWRITE_TAC[uniformly_continuous_on] THEN
1956     DISCH_THEN(MP_TAC o SPEC `d / &n / &8`) THEN
1957     SUBGOAL_THEN `&0 < d / &n / &8` ASSUME_TAC THENL
1958      [ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LT_MULT; ARITH];
1959       ALL_TAC] THEN
1960     ASM_REWRITE_TAC[dist] THEN
1961     DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
1962     EXISTS_TAC `min (e / &2) (d / &n / &8)` THEN
1963     ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_LT_MIN; REAL_HALF] THEN
1964     MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `z:real^N`; `i:num`] THEN
1965     STRIP_TAC THEN
1966     ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN
1967     MATCH_MP_TAC(REAL_ARITH
1968      `!x fx n1 n2 n3 n4 d4.
1969         abs(fx - x) <= n1 + n2 /\
1970         abs(fx - fz) <= n3 /\ abs(x - z) <= n4 /\
1971         n1 < d4 /\ n2 < &2 * d4 /\ n3 < d4 /\ n4 < d4 /\ (&8 * d4 = d)
1972         ==> abs(fz - z) < d`) THEN
1973     MAP_EVERY EXISTS_TAC
1974      [`(x:real^N)$i`; `(f:real^N->real^N)(x)$i`;
1975       `norm((f:real^N->real^N) y - f x)`; `norm(y - x:real^N)`;
1976       `norm((f:real^N->real^N) x - f z)`;
1977       `norm(x - z:real^N)`; `d / &n / &8`] THEN
1978     ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; COMPONENT_LE_NORM] THEN
1979     SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH] THEN
1980     REPEAT CONJ_TAC THENL
1981      [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
1982       MATCH_MP_TAC REAL_LET_TRANS THEN
1983       EXISTS_TAC `norm(x - z:real^N) + norm(y - z)` THEN
1984       ASM_SIMP_TAC[REAL_ARITH `a < e / &2 /\ b < e / &2 /\
1985                                (&2 * (e / &2) = e) ==> a + b < e`;
1986                    REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ] THEN
1987       REWRITE_TAC[GSYM dist] THEN MESON_TAC[DIST_TRIANGLE; DIST_SYM];
1988       MATCH_MP_TAC REAL_LET_TRANS THEN
1989       EXISTS_TAC `norm(x - z:real^N) + norm(y - z)` THEN
1990       ASM_SIMP_TAC[REAL_ARITH `a < e /\ b < e ==> a + b < &2 * e`] THEN
1991       REWRITE_TAC[GSYM dist] THEN MESON_TAC[DIST_TRIANGLE; DIST_SYM];
1992       FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
1993       MATCH_MP_TAC(REAL_ARITH
1994         `a < e / &2 /\ &0 < e /\ (&2 * (e / &2) = e) ==> a < e`) THEN
1995       ASM_REWRITE_TAC[] THEN
1996       SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ]];
1997     ALL_TAC] THEN
1998   DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
1999   X_CHOOSE_THEN `p:num` MP_TAC (SPEC `&1 + &n / e` REAL_ARCH_SIMPLE) THEN
2000   DISJ_CASES_TAC(ARITH_RULE `(p = 0) \/ 0 < p`) THENL
2001    [DISCH_THEN(fun th -> DISCH_THEN(K ALL_TAC) THEN MP_TAC th) THEN
2002     ASM_REWRITE_TAC[LT_REFL; REAL_NOT_LE] THEN
2003     ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT;
2004                  REAL_ARITH `&0 < x ==> &0 < &1 + x`];
2005     ALL_TAC] THEN
2006   DISCH_TAC THEN ASM_REWRITE_TAC[NOT_FORALL_THM] THEN
2007   MP_TAC(SPECL [`n:num`; `p:num`;
2008             `\v:(num->num). label((lambda i. &(v i) / &p):real^N):num->num`]
2009                KUHN_LEMMA) THEN
2010   ASM_REWRITE_TAC[ARITH_RULE `(x = 0) \/ (x = 1) <=> x <= 1`] THEN
2011   ANTS_TAC THENL
2012    [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
2013     ASM_SIMP_TAC[LAMBDA_BETA; IN_INTERVAL; VEC_COMPONENT] THEN
2014     ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT] THEN
2015     ASM_SIMP_TAC[REAL_DIV_REFL; REAL_MUL_LZERO; REAL_MUL_LID;
2016                  REAL_LT_IMP_NZ; REAL_OF_NUM_LT] THEN
2017     ASM_REWRITE_TAC[LE_0; REAL_OF_NUM_LE] THEN
2018     REWRITE_TAC[real_div; REAL_MUL_LZERO];
2019     ALL_TAC] THEN
2020   DISCH_THEN(X_CHOOSE_THEN `q:num->num` STRIP_ASSUME_TAC) THEN
2021   GEN_REWRITE_TAC BINDER_CONV [SWAP_EXISTS_THM] THEN
2022   GEN_REWRITE_TAC I [SWAP_EXISTS_THM] THEN
2023   ABBREV_TAC `z:real^N = lambda i. &(q i) / &p` THEN EXISTS_TAC `z:real^N` THEN
2024   REWRITE_TAC[TAUT `~(a ==> b) <=> ~b /\ a`] THEN
2025   GEN_REWRITE_TAC BINDER_CONV [SWAP_EXISTS_THM] THEN
2026   ONCE_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
2027   GEN_REWRITE_TAC I [SWAP_EXISTS_THM] THEN
2028   ONCE_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
2029   SUBGOAL_THEN `z:real^N IN interval[vec 0,vec 1]` ASSUME_TAC THENL
2030    [EXPAND_TAC "z" THEN
2031     SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; VEC_COMPONENT] THEN
2032     ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT] THEN
2033     REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
2034     ASM_SIMP_TAC[LE_0; LT_IMP_LE];
2035     ALL_TAC] THEN
2036   SUBGOAL_THEN `?i. 1 <= i /\ i <= n /\ d / &n <= abs((f z - z:real^N)$i)`
2037   MP_TAC THENL
2038    [SUBGOAL_THEN `d <= norm(f z - z:real^N)` MP_TAC THENL
2039      [ASM_SIMP_TAC[]; ALL_TAC] THEN
2040     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
2041     REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN
2042     REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN
2043     MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC
2044      `sum(1..dimindex(:N)) (\i. abs((f z - z:real^N)$i))` THEN
2045     REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_LT_GEN THEN
2046     REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; NUMSEG_EMPTY; CARD_NUMSEG] THEN
2047     ASM_REWRITE_TAC[NOT_LT; ADD_SUB];
2048     ALL_TAC] THEN
2049   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:num` THEN
2050   STRIP_TAC THEN ASM_REWRITE_TAC[REAL_NOT_LT] THEN
2051   FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN
2052   DISCH_THEN(X_CHOOSE_THEN `r:num->num` (X_CHOOSE_THEN `s:num->num`
2053     STRIP_ASSUME_TAC)) THEN
2054   EXISTS_TAC `(lambda i. &(r i) / &p) :real^N` THEN
2055   EXISTS_TAC `(lambda i. &(s i) / &p) :real^N` THEN
2056   ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
2057    [SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; VEC_COMPONENT] THEN
2058     ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT] THEN
2059     REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
2060     ASM_MESON_TAC[LE_0; ARITH_RULE `r <= q + 1 /\ q < p ==> r <= p`];
2061     SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; VEC_COMPONENT] THEN
2062     ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT] THEN
2063     REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN
2064     ASM_MESON_TAC[LE_0; ARITH_RULE `r <= q + 1 /\ q < p ==> r <= p`];
2065     ALL_TAC;
2066     ALL_TAC] THEN
2067   MATCH_MP_TAC(MATCH_MP (REAL_ARITH `a <= b ==> b < e ==> a < e`)
2068                         (SPEC_ALL NORM_LE_L1)) THEN
2069   MATCH_MP_TAC SUM_BOUND_LT_GEN THEN
2070   REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; NUMSEG_EMPTY; CARD_NUMSEG] THEN
2071   ASM_REWRITE_TAC[NOT_LT; ADD_SUB] THEN EXPAND_TAC "z" THEN
2072   EXPAND_TAC "n" THEN SIMP_TAC[VECTOR_SUB_COMPONENT; LAMBDA_BETA] THEN
2073   ASM_REWRITE_TAC[real_div; GSYM REAL_SUB_RDISTRIB] THEN
2074   REWRITE_TAC[GSYM real_div; REAL_ABS_DIV; REAL_ABS_NUM] THEN
2075   ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT] THEN
2076   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN
2077   EXISTS_TAC `&1` THEN
2078   ASM_SIMP_TAC[REAL_ARITH `q <= r /\ r <= q + &1 ==> abs(r - q) <= &1`;
2079                REAL_OF_NUM_LE; REAL_OF_NUM_ADD] THEN
2080   GEN_REWRITE_TAC BINOP_CONV [GSYM REAL_INV_INV] THEN
2081   MATCH_MP_TAC REAL_LT_INV2 THEN
2082   REWRITE_TAC[REAL_INV_DIV; REAL_INV_MUL] THEN
2083   ASM_SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ;
2084                REAL_OF_NUM_LT; ARITH] THEN
2085   ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_OF_NUM_LT] THEN
2086   REWRITE_TAC[REAL_INV_1; REAL_MUL_LID] THEN
2087   ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_ARITH `&1 + x <= y ==> x < y`]);;
2088
2089 (* ------------------------------------------------------------------------- *)
2090 (* Retractions.                                                              *)
2091 (* ------------------------------------------------------------------------- *)
2092
2093 parse_as_infix("retract_of",(12,"right"));;
2094
2095 let retraction = new_definition
2096   `retraction (s,t) (r:real^N->real^N) <=>
2097         t SUBSET s /\ r continuous_on s /\ (IMAGE r s SUBSET t) /\
2098         (!x. x IN t ==> (r x = x))`;;
2099
2100 let retract_of = new_definition
2101   `t retract_of s <=> ?r. retraction (s,t) r`;;
2102
2103 let RETRACTION = prove
2104  (`!s t r. retraction (s,t) r <=>
2105            t SUBSET s /\
2106            r continuous_on s /\
2107            IMAGE r s = t /\
2108            (!x. x IN t ==> r x = x)`,
2109   REWRITE_TAC[retraction] THEN SET_TAC[]);;
2110
2111 let RETRACT_OF_IMP_EXTENSIBLE = prove
2112  (`!f:real^M->real^N u s t.
2113         s retract_of t /\ f continuous_on s /\ IMAGE f s SUBSET u
2114         ==> ?g. g continuous_on t /\ IMAGE g t SUBSET u /\
2115                 (!x. x IN s ==> g x = f x)`,
2116   REPEAT STRIP_TAC THEN
2117   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN
2118   REWRITE_TAC[RETRACTION; LEFT_IMP_EXISTS_THM] THEN
2119   X_GEN_TAC `r:real^M->real^M` THEN STRIP_TAC THEN
2120   EXISTS_TAC `(f:real^M->real^N) o (r:real^M->real^M)` THEN
2121   REWRITE_TAC[IMAGE_o; o_THM] THEN
2122   CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE; ASM SET_TAC[]] THEN
2123   ASM_MESON_TAC[]);;
2124
2125 let RETRACTION_IDEMPOTENT = prove
2126  (`!r s t. retraction (s,t) r ==> !x. x IN s ==> (r(r(x)) = r(x))`,
2127   REWRITE_TAC[retraction; SUBSET; FORALL_IN_IMAGE] THEN MESON_TAC[]);;
2128
2129 let IDEMPOTENT_IMP_RETRACTION = prove
2130  (`!f:real^N->real^N s.
2131         f continuous_on s /\ IMAGE f s SUBSET s /\
2132         (!x. x IN s ==> f(f x) = f x)
2133         ==> retraction (s,IMAGE f s) f`,
2134   REWRITE_TAC[retraction] THEN SET_TAC[]);;
2135
2136 let RETRACTION_SUBSET = prove
2137  (`!r s s' t. retraction (s,t) r /\ t SUBSET s' /\ s' SUBSET s
2138               ==> retraction (s',t) r`,
2139   SIMP_TAC[retraction] THEN
2140   MESON_TAC[IMAGE_SUBSET; SUBSET_TRANS; CONTINUOUS_ON_SUBSET]);;
2141
2142 let RETRACT_OF_SUBSET = prove
2143  (`!s s' t. t retract_of s /\ t SUBSET s' /\ s' SUBSET s
2144             ==> t retract_of s'`,
2145   REPEAT GEN_TAC THEN
2146   REWRITE_TAC[retract_of; LEFT_AND_EXISTS_THM] THEN
2147   MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[RETRACTION_SUBSET]);;
2148
2149 let RETRACT_OF_TRANSLATION = prove
2150  (`!a t s:real^N->bool.
2151         t retract_of s
2152         ==> (IMAGE (\x. a + x) t) retract_of (IMAGE (\x. a + x) s)`,
2153   REPEAT GEN_TAC THEN REWRITE_TAC[retract_of; retraction] THEN
2154   DISCH_THEN(X_CHOOSE_THEN `r:real^N->real^N` STRIP_ASSUME_TAC) THEN
2155   EXISTS_TAC `(\x:real^N. a + x) o r o (\x:real^N. --a + x)` THEN
2156   ASM_SIMP_TAC[IMAGE_SUBSET; FORALL_IN_IMAGE] THEN REPEAT CONJ_TAC THENL
2157    [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
2158      SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]) THEN
2159     ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ARITH `--a + a + x:real^N = x`;
2160                     IMAGE_ID];
2161     REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
2162     GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV)
2163      [GSYM IMAGE_o] THEN
2164     ASM_REWRITE_TAC[o_DEF; VECTOR_ARITH `--a + a + x:real^N = x`; IMAGE_ID];
2165     ASM_SIMP_TAC[o_DEF; VECTOR_ARITH `--a + a + x:real^N = x`]]);;
2166
2167 let RETRACT_OF_TRANSLATION_EQ = prove
2168  (`!a t s:real^N->bool.
2169         (IMAGE (\x. a + x) t) retract_of (IMAGE (\x. a + x) s) <=>
2170         t retract_of s`,
2171   REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[RETRACT_OF_TRANSLATION] THEN
2172   DISCH_THEN(MP_TAC o SPEC `--a:real^N` o MATCH_MP RETRACT_OF_TRANSLATION) THEN
2173   REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID;
2174               VECTOR_ARITH `--a + a + x:real^N = x`]);;
2175
2176 add_translation_invariants [RETRACT_OF_TRANSLATION_EQ];;
2177
2178 let RETRACT_OF_INJECTIVE_LINEAR_IMAGE = prove
2179  (`!f:real^M->real^N s t.
2180         linear f /\ (!x y. f x = f y ==> x = y) /\ t retract_of s
2181         ==> (IMAGE f t) retract_of (IMAGE f s)`,
2182   REPEAT GEN_TAC THEN
2183   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
2184   REWRITE_TAC[retract_of; retraction] THEN
2185   DISCH_THEN(X_CHOOSE_THEN `r:real^M->real^M` STRIP_ASSUME_TAC) THEN
2186   MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
2187   ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
2188   DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN
2189   EXISTS_TAC `(f:real^M->real^N) o r o (g:real^N->real^M)` THEN
2190   UNDISCH_THEN `!x y. (f:real^M->real^N) x = f y ==> x = y` (K ALL_TAC) THEN
2191   ASM_SIMP_TAC[IMAGE_SUBSET; FORALL_IN_IMAGE] THEN REPEAT CONJ_TAC THENL
2192    [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
2193            ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON]) THEN
2194     ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID];
2195     REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN
2196     GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV)
2197      [GSYM IMAGE_o] THEN
2198     ASM_REWRITE_TAC[o_DEF; IMAGE_ID];
2199     ASM_SIMP_TAC[o_DEF]]);;
2200
2201 let RETRACT_OF_LINEAR_IMAGE_EQ = prove
2202  (`!f:real^M->real^N s t.
2203         linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
2204         ==> ((IMAGE f t) retract_of (IMAGE f s) <=> t retract_of s)`,
2205   REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL
2206    [DISCH_TAC; ASM_MESON_TAC[RETRACT_OF_INJECTIVE_LINEAR_IMAGE]] THEN
2207   FIRST_ASSUM(X_CHOOSE_THEN `h:real^N->real^M` STRIP_ASSUME_TAC o
2208         MATCH_MP LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE) THEN
2209   SUBGOAL_THEN
2210    `!s. s = IMAGE (h:real^N->real^M) (IMAGE (f:real^M->real^N) s)`
2211    (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC] THEN
2212   MATCH_MP_TAC RETRACT_OF_INJECTIVE_LINEAR_IMAGE THEN
2213   ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);;
2214
2215 add_linear_invariants [RETRACT_OF_LINEAR_IMAGE_EQ];;
2216
2217 let RETRACTION_REFL = prove
2218  (`!s. retraction (s,s) (\x. x)`,
2219   REWRITE_TAC[retraction; IMAGE_ID; SUBSET_REFL; CONTINUOUS_ON_ID]);;
2220
2221 let RETRACT_OF_REFL = prove
2222  (`!s. s retract_of s`,
2223   REWRITE_TAC[retract_of] THEN MESON_TAC[RETRACTION_REFL]);;
2224
2225 let RETRACT_OF_IMP_SUBSET = prove
2226  (`!s t. s retract_of t ==> s SUBSET t`,
2227   SIMP_TAC[retract_of; retraction] THEN MESON_TAC[]);;
2228
2229 let RETRACT_OF_EMPTY = prove
2230  (`(!s:real^N->bool. {} retract_of s <=> s = {}) /\
2231    (!s:real^N->bool. s retract_of {} <=> s = {})`,
2232   REWRITE_TAC[retract_of; retraction; SUBSET_EMPTY; IMAGE_CLAUSES] THEN
2233   CONJ_TAC THEN X_GEN_TAC `s:real^N->bool` THEN
2234   ASM_CASES_TAC `s:real^N->bool = {}` THEN
2235   ASM_REWRITE_TAC[NOT_IN_EMPTY; IMAGE_EQ_EMPTY; CONTINUOUS_ON_EMPTY;
2236                   SUBSET_REFL]);;
2237
2238 let RETRACT_OF_SING = prove
2239  (`!s x:real^N. {x} retract_of s <=> x IN s`,
2240   REPEAT GEN_TAC THEN REWRITE_TAC[retract_of; RETRACTION] THEN EQ_TAC THENL
2241    [SET_TAC[]; ALL_TAC] THEN
2242   DISCH_TAC THEN EXISTS_TAC `(\y. x):real^N->real^N` THEN
2243   REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]);;
2244
2245 let RETRACTION_o = prove
2246  (`!f g s t u:real^N->bool.
2247         retraction (s,t) f /\ retraction (t,u) g
2248         ==> retraction (s,u) (g o f)`,
2249   REPEAT GEN_TAC THEN REWRITE_TAC[retraction] THEN REPEAT STRIP_TAC THENL
2250    [ASM SET_TAC[];
2251     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
2252     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
2253     REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
2254     REWRITE_TAC[o_THM] THEN ASM SET_TAC[]]);;
2255
2256 let RETRACT_OF_TRANS = prove
2257  (`!s t u:real^N->bool.
2258         s retract_of t /\ t retract_of u ==> s retract_of u`,
2259   REWRITE_TAC[retract_of] THEN MESON_TAC[RETRACTION_o]);;
2260
2261 let CLOSED_IN_RETRACT = prove
2262  (`!s t:real^N->bool.
2263         s retract_of t ==> closed_in (subtopology euclidean t) s`,
2264   REPEAT GEN_TAC THEN REWRITE_TAC[retract_of; retraction] THEN
2265   DISCH_THEN(X_CHOOSE_THEN `r:real^N->real^N` STRIP_ASSUME_TAC) THEN
2266   SUBGOAL_THEN
2267    `s = {x:real^N | x IN t /\ lift(norm(r x - x)) = vec 0}`
2268   SUBST1_TAC THENL
2269    [REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; LIFT_DROP; NORM_EQ_0] THEN
2270     REWRITE_TAC[VECTOR_SUB_EQ] THEN ASM SET_TAC[];
2271     MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT THEN
2272     MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN
2273     MATCH_MP_TAC CONTINUOUS_ON_SUB THEN ASM_SIMP_TAC[CONTINUOUS_ON_ID]]);;
2274
2275 let RETRACT_OF_CONTRACTIBLE = prove
2276  (`!s t:real^N->bool. contractible t /\ s retract_of t ==> contractible s`,
2277   REPEAT GEN_TAC THEN REWRITE_TAC[contractible; retract_of] THEN
2278   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC `r:real^N->real^N`)) THEN
2279   SIMP_TAC[HOMOTOPIC_WITH; PCROSS; LEFT_IMP_EXISTS_THM] THEN
2280   FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [retraction]) THEN
2281   MAP_EVERY X_GEN_TAC [`a:real^N`; `h:real^(1,N)finite_sum->real^N`] THEN
2282   RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN
2283   STRIP_TAC THEN MAP_EVERY EXISTS_TAC
2284    [`(r:real^N->real^N) a`;
2285     `(r:real^N->real^N) o (h:real^(1,N)finite_sum->real^N)`] THEN
2286   ASM_SIMP_TAC[o_THM; IMAGE_o; SUBSET] THEN CONJ_TAC THENL
2287    [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
2288     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ]
2289            CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[];
2290     ASM SET_TAC[]]);;
2291
2292 let RETRACT_OF_COMPACT = prove
2293  (`!s t:real^N->bool. compact t /\ s retract_of t ==> compact s`,
2294   REWRITE_TAC[retract_of; RETRACTION] THEN
2295   MESON_TAC[COMPACT_CONTINUOUS_IMAGE]);;
2296
2297 let RETRACT_OF_CLOSED = prove
2298  (`!s t. closed t /\ s retract_of t ==> closed s`,
2299   MESON_TAC[CLOSED_IN_CLOSED_EQ; CLOSED_IN_RETRACT]);;
2300
2301 let RETRACT_OF_CONNECTED = prove
2302  (`!s t:real^N->bool. connected t /\ s retract_of t ==> connected s`,
2303   REWRITE_TAC[retract_of; RETRACTION] THEN
2304   MESON_TAC[CONNECTED_CONTINUOUS_IMAGE]);;
2305
2306 let RETRACT_OF_PATH_CONNECTED = prove
2307  (`!s t:real^N->bool. path_connected t /\ s retract_of t ==> path_connected s`,
2308   REWRITE_TAC[retract_of; RETRACTION] THEN
2309   MESON_TAC[PATH_CONNECTED_CONTINUOUS_IMAGE]);;
2310
2311 let RETRACT_OF_SIMPLY_CONNECTED = prove
2312  (`!s t:real^N->bool.
2313        simply_connected t /\ s retract_of t ==> simply_connected s`,
2314   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
2315   MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
2316    (REWRITE_RULE[CONJ_ASSOC] SIMPLY_CONNECTED_RETRACTION_GEN)) THEN
2317   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN
2318   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^N->real^N` THEN
2319   REWRITE_TAC[RETRACTION] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. x` THEN
2320   ASM_REWRITE_TAC[IMAGE_ID; CONTINUOUS_ON_ID]);;
2321
2322 let RETRACT_OF_HOMOTOPICALLY_TRIVIAL = prove
2323  (`!s t:real^N->bool u:real^M->bool.
2324         t retract_of s /\
2325         (!f g. f continuous_on u /\ IMAGE f u SUBSET s /\
2326                g continuous_on u /\ IMAGE g u SUBSET s
2327                ==> homotopic_with (\x. T) (u,s)  f g)
2328         ==> (!f g. f continuous_on u /\ IMAGE f u SUBSET t /\
2329                    g continuous_on u /\ IMAGE g u SUBSET t
2330                    ==> homotopic_with (\x. T) (u,t) f g)`,
2331   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
2332   ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> p /\ q /\ T /\ r /\ s /\ T`] THEN
2333   MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
2334     HOMOTOPICALLY_TRIVIAL_RETRACTION_GEN) THEN
2335   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN
2336   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^N->real^N` THEN
2337   REWRITE_TAC[RETRACTION] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. x` THEN
2338   ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID]);;
2339
2340 let RETRACT_OF_HOMOTOPICALLY_TRIVIAL_NULL = prove
2341  (`!s t:real^N->bool u:real^M->bool.
2342         t retract_of s /\
2343         (!f. f continuous_on u /\ IMAGE f u SUBSET s
2344              ==> ?c. homotopic_with (\x. T) (u,s) f (\x. c))
2345         ==> (!f. f continuous_on u /\ IMAGE f u SUBSET t
2346                  ==> ?c. homotopic_with (\x. T) (u,t) f (\x. c))`,
2347   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
2348   ONCE_REWRITE_TAC[TAUT `p /\ q <=> p /\ q /\ T`] THEN
2349   MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
2350     HOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN) THEN
2351   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN
2352   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^N->real^N` THEN
2353   REWRITE_TAC[RETRACTION] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. x` THEN
2354   ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID]);;
2355
2356 let RETRACT_OF_COHOMOTOPICALLY_TRIVIAL = prove
2357  (`!s t:real^N->bool u:real^M->bool.
2358         t retract_of s /\
2359         (!f g. f continuous_on s /\ IMAGE f s SUBSET u /\
2360                g continuous_on s /\ IMAGE g s SUBSET u
2361                ==> homotopic_with (\x. T) (s,u)  f g)
2362         ==> (!f g. f continuous_on t /\ IMAGE f t SUBSET u /\
2363                    g continuous_on t /\ IMAGE g t SUBSET u
2364                    ==> homotopic_with (\x. T) (t,u) f g)`,
2365   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
2366   ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> p /\ q /\ T /\ r /\ s /\ T`] THEN
2367   MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
2368     COHOMOTOPICALLY_TRIVIAL_RETRACTION_GEN) THEN
2369   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN
2370   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^N->real^N` THEN
2371   REWRITE_TAC[RETRACTION] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. x` THEN
2372   ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID]);;
2373
2374 let RETRACT_OF_COHOMOTOPICALLY_TRIVIAL_NULL = prove
2375  (`!s t:real^N->bool u:real^M->bool.
2376         t retract_of s /\
2377         (!f. f continuous_on s /\ IMAGE f s SUBSET u
2378              ==> ?c. homotopic_with (\x. T) (s,u) f (\x. c))
2379         ==> (!f. f continuous_on t /\ IMAGE f t SUBSET u
2380                  ==> ?c. homotopic_with (\x. T) (t,u) f (\x. c))`,
2381   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
2382   ONCE_REWRITE_TAC[TAUT `p /\ q <=> p /\ q /\ T`] THEN
2383   MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
2384     COHOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN) THEN
2385   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN
2386   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^N->real^N` THEN
2387   REWRITE_TAC[RETRACTION] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. x` THEN
2388   ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID]);;
2389
2390 let RETRACTION_IMP_QUOTIENT_MAP = prove
2391  (`!r s t:real^N->bool.
2392     retraction (s,t) r
2393     ==> !u. u SUBSET t
2394             ==> (open_in (subtopology euclidean s) {x | x IN s /\ r x IN u} <=>
2395                  open_in (subtopology euclidean t) u)`,
2396   REPEAT GEN_TAC THEN REWRITE_TAC[RETRACTION] THEN STRIP_TAC THEN
2397   MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN
2398   EXISTS_TAC `\x:real^N. x` THEN
2399   ASM_REWRITE_TAC[CONTINUOUS_ON_ID; SUBSET_REFL; IMAGE_ID]);;
2400
2401 let RETRACT_OF_LOCALLY_CONNECTED = prove
2402  (`!s t:real^N->bool.
2403         s retract_of t /\ locally connected t ==> locally connected s`,
2404   REPEAT GEN_TAC THEN REWRITE_TAC[retract_of] THEN
2405   DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
2406   FIRST_ASSUM(SUBST1_TAC o SYM o el 2 o CONJUNCTS o GEN_REWRITE_RULE I
2407    [RETRACTION]) THEN
2408   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_CONNECTED_QUOTIENT_IMAGE) THEN
2409   MATCH_MP_TAC RETRACTION_IMP_QUOTIENT_MAP THEN
2410   ASM_MESON_TAC[RETRACTION]);;
2411
2412 let RETRACT_OF_LOCALLY_PATH_CONNECTED = prove
2413  (`!s t:real^N->bool.
2414         s retract_of t /\ locally path_connected t
2415         ==> locally path_connected s`,
2416   REPEAT GEN_TAC THEN REWRITE_TAC[retract_of] THEN
2417   DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
2418   FIRST_ASSUM(SUBST1_TAC o SYM o el 2 o CONJUNCTS o GEN_REWRITE_RULE I
2419    [RETRACTION]) THEN
2420   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ]
2421     LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE) THEN
2422   MATCH_MP_TAC RETRACTION_IMP_QUOTIENT_MAP THEN
2423   ASM_MESON_TAC[RETRACTION]);;
2424
2425 let RETRACT_OF_LOCALLY_COMPACT = prove
2426  (`!s t:real^N->bool.
2427         locally compact s /\ t retract_of s ==> locally compact t`,
2428   MESON_TAC[CLOSED_IN_RETRACT; LOCALLY_COMPACT_CLOSED_IN]);;
2429
2430 let RETRACT_OF_PCROSS = prove
2431  (`!s:real^M->bool s' t:real^N->bool t'.
2432         s retract_of s' /\ t retract_of t'
2433         ==> (s PCROSS t) retract_of (s' PCROSS t')`,
2434   REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN
2435   REWRITE_TAC[retract_of; retraction; SUBSET; FORALL_IN_IMAGE] THEN
2436   DISCH_THEN(CONJUNCTS_THEN2
2437    (X_CHOOSE_THEN `f:real^M->real^M` STRIP_ASSUME_TAC)
2438    (X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC)) THEN
2439   EXISTS_TAC `\z. pastecart ((f:real^M->real^M) (fstcart z))
2440                             ((g:real^N->real^N) (sndcart z))` THEN
2441   REWRITE_TAC[FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN
2442   ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
2443   MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
2444   CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
2445   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
2446   SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN
2447   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2448    CONTINUOUS_ON_SUBSET)) THEN
2449   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
2450   SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART]);;
2451
2452 let RETRACT_OF_PCROSS_EQ = prove
2453  (`!s s':real^M->bool t t':real^N->bool.
2454         s PCROSS t retract_of s' PCROSS t' <=>
2455         (s = {} \/ t = {}) /\ (s' = {} \/ t' = {}) \/
2456         s retract_of s' /\ t retract_of t'`,
2457   REPEAT GEN_TAC THEN
2458   MAP_EVERY ASM_CASES_TAC
2459    [`s:real^M->bool = {}`;
2460     `s':real^M->bool = {}`;
2461     `t:real^N->bool = {}`;
2462     `t':real^N->bool = {}`] THEN
2463   ASM_REWRITE_TAC[PCROSS_EMPTY; RETRACT_OF_EMPTY; PCROSS_EQ_EMPTY] THEN
2464   EQ_TAC THEN REWRITE_TAC[RETRACT_OF_PCROSS] THEN
2465   REWRITE_TAC[retract_of; retraction; SUBSET; FORALL_IN_PCROSS;
2466               FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN
2467   DISCH_THEN(X_CHOOSE_THEN `r:real^(M,N)finite_sum->real^(M,N)finite_sum`
2468     STRIP_ASSUME_TAC) THEN
2469   CONJ_TAC THENL
2470    [SUBGOAL_THEN `?b:real^N. b IN t` STRIP_ASSUME_TAC THENL
2471      [ASM SET_TAC[]; ALL_TAC] THEN
2472     EXISTS_TAC `\x. fstcart((r:real^(M,N)finite_sum->real^(M,N)finite_sum)
2473                             (pastecart x b))` THEN
2474     ASM_SIMP_TAC[FSTCART_PASTECART] THEN REPEAT CONJ_TAC THENL
2475      [ASM_MESON_TAC[];
2476       GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
2477       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
2478       SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_ON] THEN
2479       GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
2480       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
2481       SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID;
2482                CONTINUOUS_ON_CONST] THEN
2483       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2484           CONTINUOUS_ON_SUBSET)) THEN
2485       ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN
2486       ASM_MESON_TAC[MEMBER_NOT_EMPTY];
2487       ASM_MESON_TAC[PASTECART_FST_SND; PASTECART_IN_PCROSS; MEMBER_NOT_EMPTY]];
2488     SUBGOAL_THEN `?a:real^M. a IN s` STRIP_ASSUME_TAC THENL
2489      [ASM SET_TAC[]; ALL_TAC] THEN
2490     EXISTS_TAC `\x. sndcart((r:real^(M,N)finite_sum->real^(M,N)finite_sum)
2491                             (pastecart a x))` THEN
2492     ASM_SIMP_TAC[SNDCART_PASTECART] THEN REPEAT CONJ_TAC THENL
2493      [ASM_MESON_TAC[];
2494       GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
2495       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
2496       SIMP_TAC[LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN
2497       GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
2498       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
2499       SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID;
2500                CONTINUOUS_ON_CONST] THEN
2501       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2502           CONTINUOUS_ON_SUBSET)) THEN
2503       ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN
2504       ASM_MESON_TAC[MEMBER_NOT_EMPTY];
2505       ASM_MESON_TAC[PASTECART_FST_SND; PASTECART_IN_PCROSS;
2506                     MEMBER_NOT_EMPTY]]]);;
2507
2508 let HOMOTOPIC_INTO_RETRACT = prove
2509  (`!f:real^M->real^N g s t u.
2510         IMAGE f s SUBSET t /\ IMAGE g s SUBSET t /\ t retract_of u /\
2511         homotopic_with (\x. T) (s,u) f g
2512         ==> homotopic_with (\x. T) (s,t) f g`,
2513   REPEAT STRIP_TAC THEN
2514   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN
2515   SIMP_TAC[HOMOTOPIC_WITH; LEFT_IMP_EXISTS_THM] THEN
2516   X_GEN_TAC `h:real^(1,M)finite_sum->real^N` THEN STRIP_TAC THEN
2517   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN
2518   REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN
2519   X_GEN_TAC `r:real^N->real^N` THEN STRIP_TAC THEN
2520   EXISTS_TAC `(r:real^N->real^N) o (h:real^(1,M)finite_sum->real^N)` THEN
2521   ASM_SIMP_TAC[o_THM; IMAGE_o] THEN CONJ_TAC THENL
2522    [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE; ASM SET_TAC[]] THEN
2523   CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2524     CONTINUOUS_ON_SUBSET)) THEN
2525   ASM SET_TAC[]);;
2526
2527 (* ------------------------------------------------------------------------- *)
2528 (* Absolute retracts (AR), absolute neighbourhood retracts (ANR) and also    *)
2529 (* Euclidean neighbourhood retracts (ENR). We define AR and ANR by           *)
2530 (* specializing the standard definitions for a set in R^n to embedding in    *)
2531 (* spaces inside R^{n+1}. This turns out to be sufficient (since any set in  *)
2532 (* R^n can be embedded as a closed subset of a convex subset of R^{n+1}) to  *)
2533 (* derive the usual definitions, but we need to split them into two          *)
2534 (* implications because of the lack of type quantifiers. Then ENR turns out  *)
2535 (* to be equivalent to ANR plus local compactness.                           *)
2536 (* ------------------------------------------------------------------------- *)
2537
2538 let AR = new_definition
2539  `AR(s:real^N->bool) <=>
2540         !u s':real^(N,1)finite_sum->bool.
2541                 s homeomorphic s' /\ closed_in (subtopology euclidean u) s'
2542                 ==> s' retract_of u`;;
2543
2544 let ANR = new_definition
2545  `ANR(s:real^N->bool) <=>
2546         !u s':real^(N,1)finite_sum->bool.
2547                 s homeomorphic s' /\ closed_in (subtopology euclidean u) s'
2548                 ==> ?t. open_in (subtopology euclidean u) t /\
2549                         s' retract_of t`;;
2550
2551 let ENR = new_definition
2552  `ENR s <=> ?u. open u /\ s retract_of u`;;
2553
2554 (* ------------------------------------------------------------------------- *)
2555 (* First, show that we do indeed get the "usual" properties of ARs and ANRs. *)
2556 (* ------------------------------------------------------------------------- *)
2557
2558 let AR_IMP_ABSOLUTE_EXTENSOR = prove
2559  (`!f:real^M->real^N u t s.
2560         AR s /\ f continuous_on t /\ IMAGE f t SUBSET s /\
2561         closed_in (subtopology euclidean u) t
2562         ==> ?g. g continuous_on u /\ IMAGE g u SUBSET s /\
2563                 !x. x IN t ==> g x = f x`,
2564   REPEAT STRIP_TAC THEN
2565   SUBGOAL_THEN
2566    `?c s':real^(N,1)finite_sum->bool.
2567         convex c /\ ~(c = {}) /\ closed_in (subtopology euclidean c) s' /\
2568         (s:real^N->bool) homeomorphic s'`
2569   STRIP_ASSUME_TAC THENL
2570    [MATCH_MP_TAC HOMEOMORPHIC_CLOSED_IN_CONVEX THEN
2571     REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1; GSYM INT_OF_NUM_ADD] THEN
2572     REWRITE_TAC[INT_ARITH `x:int < y + &1 <=> x <= y`; AFF_DIM_LE_UNIV];
2573     ALL_TAC] THEN
2574   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [AR]) THEN
2575   DISCH_THEN(MP_TAC o SPECL
2576    [`c:real^(N,1)finite_sum->bool`; `s':real^(N,1)finite_sum->bool`]) THEN
2577   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
2578   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
2579   REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN
2580   MAP_EVERY X_GEN_TAC
2581    [`g:real^N->real^(N,1)finite_sum`; `h:real^(N,1)finite_sum->real^N`] THEN
2582   STRIP_TAC THEN MP_TAC(ISPECL
2583    [`(g:real^N->real^(N,1)finite_sum) o (f:real^M->real^N)`;
2584     `c:real^(N,1)finite_sum->bool`; `u:real^M->bool`; `t:real^M->bool`]
2585         DUGUNDJI) THEN
2586   ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN
2587   FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN ANTS_TAC THENL
2588    [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
2589     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
2590     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2591         CONTINUOUS_ON_SUBSET)) THEN
2592     ASM SET_TAC[];
2593     ALL_TAC] THEN
2594   DISCH_THEN(X_CHOOSE_THEN `f':real^M->real^(N,1)finite_sum`
2595     STRIP_ASSUME_TAC) THEN
2596   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN
2597   REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN
2598   X_GEN_TAC `r:real^(N,1)finite_sum->real^(N,1)finite_sum` THEN
2599   STRIP_TAC THEN
2600   EXISTS_TAC `(h:real^(N,1)finite_sum->real^N) o r o
2601               (f':real^M->real^(N,1)finite_sum)` THEN
2602   ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN
2603   CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
2604   REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
2605   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
2606   CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2607         CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);;
2608
2609 let AR_IMP_ABSOLUTE_RETRACT = prove
2610  (`!s:real^N->bool u s':real^M->bool.
2611         AR s /\ s homeomorphic s' /\ closed_in (subtopology euclidean u) s'
2612         ==> s' retract_of u`,
2613   REPEAT STRIP_TAC THEN
2614   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
2615   REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN
2616   MAP_EVERY X_GEN_TAC [`g:real^N->real^M`; `h:real^M->real^N`] THEN
2617   STRIP_TAC THEN
2618   MP_TAC(ISPECL [`h:real^M->real^N`; `u:real^M->bool`; `s':real^M->bool`;
2619                  `s:real^N->bool`] AR_IMP_ABSOLUTE_EXTENSOR) THEN
2620   ASM_REWRITE_TAC[SUBSET_REFL] THEN
2621   DISCH_THEN(X_CHOOSE_THEN `h':real^M->real^N` STRIP_ASSUME_TAC) THEN
2622   REWRITE_TAC[retract_of; retraction] THEN
2623   EXISTS_TAC `(g:real^N->real^M) o (h':real^M->real^N)` THEN
2624   FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
2625   ASM_SIMP_TAC[o_THM; IMAGE_o] THEN
2626   CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
2627   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
2628   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2629         CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);;
2630
2631 let AR_IMP_ABSOLUTE_RETRACT_UNIV = prove
2632  (`!s:real^N->bool s':real^M->bool.
2633     AR s /\ s homeomorphic s' /\ closed s' ==> s' retract_of (:real^M)`,
2634   MESON_TAC[AR_IMP_ABSOLUTE_RETRACT;
2635             TOPSPACE_EUCLIDEAN; SUBTOPOLOGY_UNIV; OPEN_IN; CLOSED_IN]);;
2636
2637 let ABSOLUTE_EXTENSOR_IMP_AR = prove
2638  (`!s:real^N->bool.
2639         (!f:real^(N,1)finite_sum->real^N u t.
2640              f continuous_on t /\ IMAGE f t SUBSET s /\
2641              closed_in (subtopology euclidean u) t
2642              ==> ?g. g continuous_on u /\ IMAGE g u SUBSET s /\
2643                      !x. x IN t ==> g x = f x)
2644         ==> AR s`,
2645   REPEAT STRIP_TAC THEN REWRITE_TAC[AR] THEN MAP_EVERY X_GEN_TAC
2646    [`u:real^(N,1)finite_sum->bool`; `t:real^(N,1)finite_sum->bool`] THEN
2647   STRIP_TAC THEN
2648   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
2649   REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC
2650    [`g:real^N->real^(N,1)finite_sum`; `h:real^(N,1)finite_sum->real^N`] THEN
2651   STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o ISPECL
2652     [`h:real^(N,1)finite_sum->real^N`;
2653      `u:real^(N,1)finite_sum->bool`; `t:real^(N,1)finite_sum->bool`]) THEN
2654   ASM_REWRITE_TAC[SUBSET_REFL] THEN DISCH_THEN(X_CHOOSE_THEN
2655     `h':real^(N,1)finite_sum->real^N` STRIP_ASSUME_TAC) THEN
2656   REWRITE_TAC[retract_of; retraction] THEN
2657   EXISTS_TAC `(g:real^N->real^(N,1)finite_sum) o
2658               (h':real^(N,1)finite_sum->real^N)` THEN
2659   FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
2660   ASM_SIMP_TAC[o_THM; IMAGE_o] THEN
2661   CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
2662   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
2663   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2664         CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);;
2665
2666 let AR_EQ_ABSOLUTE_EXTENSOR = prove
2667  (`!s:real^N->bool.
2668         AR s <=>
2669         (!f:real^(N,1)finite_sum->real^N u t.
2670              f continuous_on t /\ IMAGE f t SUBSET s /\
2671              closed_in (subtopology euclidean u) t
2672              ==> ?g. g continuous_on u /\ IMAGE g u SUBSET s /\
2673                      !x. x IN t ==> g x = f x)`,
2674   GEN_TAC THEN EQ_TAC THEN
2675   SIMP_TAC[AR_IMP_ABSOLUTE_EXTENSOR; ABSOLUTE_EXTENSOR_IMP_AR]);;
2676
2677 let AR_IMP_RETRACT = prove
2678  (`!s u:real^N->bool.
2679         AR s /\ closed_in (subtopology euclidean u) s ==> s retract_of u`,
2680   MESON_TAC[AR_IMP_ABSOLUTE_RETRACT; HOMEOMORPHIC_REFL]);;
2681
2682 let HOMEOMORPHIC_ARNESS = prove
2683  (`!s:real^M->bool t:real^N->bool.
2684       s homeomorphic t ==> (AR s <=> AR t)`,
2685   let lemma = prove
2686    (`!s:real^M->bool t:real^N->bool.
2687       s homeomorphic t /\ AR t ==> AR s`,
2688     REPEAT STRIP_TAC THEN REWRITE_TAC[AR] THEN
2689     REPEAT STRIP_TAC THEN
2690     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ]
2691       AR_IMP_ABSOLUTE_RETRACT)) THEN
2692     ASM_REWRITE_TAC[] THEN
2693     TRANS_TAC HOMEOMORPHIC_TRANS `s:real^M->bool` THEN
2694     ASM_MESON_TAC[HOMEOMORPHIC_SYM]) in
2695   REPEAT STRIP_TAC THEN EQ_TAC THEN POP_ASSUM MP_TAC THENL
2696    [ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM]; ALL_TAC] THEN
2697   ASM_MESON_TAC[lemma]);;
2698
2699 let AR_TRANSLATION = prove
2700  (`!a:real^N s. AR(IMAGE (\x. a + x) s) <=> AR s`,
2701   REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ARNESS THEN
2702   REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);;
2703
2704 add_translation_invariants [AR_TRANSLATION];;
2705
2706 let AR_LINEAR_IMAGE_EQ = prove
2707  (`!f:real^M->real^N s.
2708         linear f /\ (!x y. f x = f y ==> x = y)
2709         ==> (AR(IMAGE f s) <=> AR s)`,
2710   REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ARNESS THEN
2711   ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF]);;
2712
2713 add_linear_invariants [AR_LINEAR_IMAGE_EQ];;
2714
2715 let ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR = prove
2716  (`!f:real^M->real^N u t s.
2717         ANR s /\ f continuous_on t /\ IMAGE f t SUBSET s /\
2718         closed_in (subtopology euclidean u) t
2719         ==> ?v g. t SUBSET v /\ open_in (subtopology euclidean u) v /\
2720                   g continuous_on v /\ IMAGE g v SUBSET s /\
2721                   !x. x IN t ==> g x = f x`,
2722   REPEAT STRIP_TAC THEN
2723   SUBGOAL_THEN
2724    `?c s':real^(N,1)finite_sum->bool.
2725         convex c /\ ~(c = {}) /\ closed_in (subtopology euclidean c) s' /\
2726         (s:real^N->bool) homeomorphic s'`
2727   STRIP_ASSUME_TAC THENL
2728    [MATCH_MP_TAC HOMEOMORPHIC_CLOSED_IN_CONVEX THEN
2729     REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1; GSYM INT_OF_NUM_ADD] THEN
2730     REWRITE_TAC[INT_ARITH `x:int < y + &1 <=> x <= y`; AFF_DIM_LE_UNIV];
2731     ALL_TAC] THEN
2732   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ANR]) THEN
2733   DISCH_THEN(MP_TAC o SPECL
2734    [`c:real^(N,1)finite_sum->bool`; `s':real^(N,1)finite_sum->bool`]) THEN
2735   ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN
2736    `d:real^(N,1)finite_sum->bool` STRIP_ASSUME_TAC) THEN
2737   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
2738   REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN
2739   MAP_EVERY X_GEN_TAC
2740    [`g:real^N->real^(N,1)finite_sum`; `h:real^(N,1)finite_sum->real^N`] THEN
2741   STRIP_TAC THEN MP_TAC(ISPECL
2742    [`(g:real^N->real^(N,1)finite_sum) o (f:real^M->real^N)`;
2743     `c:real^(N,1)finite_sum->bool`; `u:real^M->bool`; `t:real^M->bool`]
2744         DUGUNDJI) THEN
2745   ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN
2746   FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
2747   FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN ANTS_TAC THENL
2748    [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
2749     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
2750     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2751         CONTINUOUS_ON_SUBSET)) THEN
2752     ASM SET_TAC[];
2753     ALL_TAC] THEN
2754   DISCH_THEN(X_CHOOSE_THEN `f':real^M->real^(N,1)finite_sum`
2755     STRIP_ASSUME_TAC) THEN
2756   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN
2757   REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN
2758   X_GEN_TAC `r:real^(N,1)finite_sum->real^(N,1)finite_sum` THEN
2759   STRIP_TAC THEN
2760   EXISTS_TAC `{x | x IN u /\ (f':real^M->real^(N,1)finite_sum) x IN d}` THEN
2761   EXISTS_TAC `(h:real^(N,1)finite_sum->real^N) o r o
2762               (f':real^M->real^(N,1)finite_sum)` THEN
2763   ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN REPEAT CONJ_TAC THENL
2764    [REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN
2765     ASM SET_TAC[];
2766     MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN ASM_MESON_TAC[];
2767     REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN
2768     REWRITE_TAC[IMAGE_o] THEN
2769     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2770           CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[];
2771     ASM SET_TAC[];
2772     ASM SET_TAC[]]);;
2773
2774 let ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT = prove
2775  (`!s:real^N->bool u s':real^M->bool.
2776         ANR s /\ s homeomorphic s' /\ closed_in (subtopology euclidean u) s'
2777         ==> ?v. open_in (subtopology euclidean u) v /\
2778                 s' retract_of v`,
2779   REPEAT STRIP_TAC THEN
2780   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
2781   REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN
2782   MAP_EVERY X_GEN_TAC [`g:real^N->real^M`; `h:real^M->real^N`] THEN
2783   STRIP_TAC THEN
2784   MP_TAC(ISPECL [`h:real^M->real^N`; `u:real^M->bool`; `s':real^M->bool`;
2785                 `s:real^N->bool`] ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN
2786   ASM_REWRITE_TAC[SUBSET_REFL] THEN
2787   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^M->bool` THEN
2788   DISCH_THEN(X_CHOOSE_THEN `h':real^M->real^N` STRIP_ASSUME_TAC) THEN
2789   ASM_REWRITE_TAC[retract_of; retraction] THEN
2790   EXISTS_TAC `(g:real^N->real^M) o (h':real^M->real^N)` THEN
2791   FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
2792   ASM_SIMP_TAC[o_THM; IMAGE_o] THEN
2793   CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
2794   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
2795   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2796         CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);;
2797
2798 let ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV = prove
2799  (`!s:real^N->bool s':real^M->bool.
2800     ANR s /\ s homeomorphic s' /\ closed s' ==> ?v. open v /\ s' retract_of v`,
2801   MESON_TAC[ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT;
2802             TOPSPACE_EUCLIDEAN; SUBTOPOLOGY_UNIV; OPEN_IN; CLOSED_IN]);;
2803
2804 let ABSOLUTE_NEIGHBOURHOOD_EXTENSOR_IMP_ANR = prove
2805  (`!s:real^N->bool.
2806         (!f:real^(N,1)finite_sum->real^N u t.
2807              f continuous_on t /\ IMAGE f t SUBSET s /\
2808              closed_in (subtopology euclidean u) t
2809              ==> ?v g. t SUBSET v /\ open_in  (subtopology euclidean u) v /\
2810                        g continuous_on v /\ IMAGE g v SUBSET s /\
2811                        !x. x IN t ==> g x = f x)
2812         ==> ANR s`,
2813   REPEAT STRIP_TAC THEN REWRITE_TAC[ANR] THEN MAP_EVERY X_GEN_TAC
2814    [`u:real^(N,1)finite_sum->bool`; `t:real^(N,1)finite_sum->bool`] THEN
2815   STRIP_TAC THEN
2816   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
2817   REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC
2818    [`g:real^N->real^(N,1)finite_sum`; `h:real^(N,1)finite_sum->real^N`] THEN
2819   STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o ISPECL
2820     [`h:real^(N,1)finite_sum->real^N`;
2821      `u:real^(N,1)finite_sum->bool`; `t:real^(N,1)finite_sum->bool`]) THEN
2822   ASM_REWRITE_TAC[SUBSET_REFL] THEN
2823   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^(N,1)finite_sum->bool` THEN
2824   DISCH_THEN(X_CHOOSE_THEN `h':real^(N,1)finite_sum->real^N`
2825     STRIP_ASSUME_TAC) THEN
2826   ASM_REWRITE_TAC[retract_of; retraction] THEN
2827   EXISTS_TAC `(g:real^N->real^(N,1)finite_sum) o
2828               (h':real^(N,1)finite_sum->real^N)` THEN
2829   FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
2830   ASM_SIMP_TAC[o_THM; IMAGE_o] THEN
2831   CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
2832   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
2833   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
2834         CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);;
2835
2836 let ANR_EQ_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR = prove
2837  (`!s:real^N->bool.
2838         ANR s <=>
2839         (!f:real^(N,1)finite_sum->real^N u t.
2840              f continuous_on t /\ IMAGE f t SUBSET s /\
2841              closed_in (subtopology euclidean u) t
2842              ==> ?v g. t SUBSET v /\ open_in  (subtopology euclidean u) v /\
2843                        g continuous_on v /\ IMAGE g v SUBSET s /\
2844                        !x. x IN t ==> g x = f x)`,
2845   GEN_TAC THEN EQ_TAC THEN
2846   SIMP_TAC[ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR;
2847            ABSOLUTE_NEIGHBOURHOOD_EXTENSOR_IMP_ANR]);;
2848
2849 let ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_RETRACT = prove
2850  (`!s:real^N->bool u s':real^M->bool.
2851         ANR s /\ s homeomorphic s' /\ closed_in (subtopology euclidean u) s'
2852         ==> ?v w. open_in (subtopology euclidean u) v /\
2853                   closed_in (subtopology euclidean u) w /\
2854                   s' SUBSET v /\ v SUBSET w /\ s' retract_of w`,
2855   REPEAT STRIP_TAC THEN
2856   SUBGOAL_THEN `?z. open_in (subtopology euclidean u) z /\
2857                     (s':real^M->bool) retract_of z`
2858   STRIP_ASSUME_TAC THENL
2859    [MATCH_MP_TAC ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT THEN ASM_MESON_TAC[];
2860     ALL_TAC] THEN
2861   MP_TAC(ISPECL
2862     [`s':real^M->bool`; `u DIFF z:real^M->bool`; `u:real^M->bool`]
2863     SEPARATION_NORMAL_LOCAL) THEN
2864   ASM_SIMP_TAC[CLOSED_IN_INTER; CLOSED_IN_REFL; CLOSED_IN_DIFF] THEN
2865   FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN
2866   ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN
2867   X_GEN_TAC `v:real^M->bool` THEN
2868   DISCH_THEN(X_CHOOSE_THEN `w:real^M->bool` STRIP_ASSUME_TAC) THEN
2869   EXISTS_TAC `u DIFF w:real^M->bool` THEN
2870   ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN
2871   REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
2872   CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
2873   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
2874    (ONCE_REWRITE_RULE[IMP_CONJ] RETRACT_OF_SUBSET)) THEN
2875   ASM SET_TAC[]);;
2876
2877 let ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_EXTENSOR = prove
2878  (`!f:real^M->real^N u t s.
2879         ANR s /\ f continuous_on t /\ IMAGE f t SUBSET s /\
2880         closed_in (subtopology euclidean u) t
2881         ==> ?v w g. open_in (subtopology euclidean u) v /\
2882                     closed_in (subtopology euclidean u) w /\
2883                     t SUBSET v /\ v SUBSET w /\
2884                     g continuous_on w /\ IMAGE g w SUBSET s /\
2885                     !x. x IN t ==> g x = f x`,
2886   REPEAT STRIP_TAC THEN
2887   SUBGOAL_THEN
2888    `?v g. t SUBSET v /\ open_in (subtopology euclidean u) v /\
2889           g continuous_on v /\ IMAGE g v SUBSET s /\
2890           !x. x IN t ==> g x = (f:real^M->real^N) x`
2891   STRIP_ASSUME_TAC THENL
2892    [MATCH_MP_TAC ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR THEN
2893     ASM_MESON_TAC[];
2894     ALL_TAC] THEN
2895   MP_TAC(ISPECL
2896     [`t:real^M->bool`; `u DIFF v:real^M->bool`; `u:real^M->bool`]
2897     SEPARATION_NORMAL_LOCAL) THEN
2898   ASM_SIMP_TAC[CLOSED_IN_INTER; CLOSED_IN_REFL; CLOSED_IN_DIFF] THEN
2899   ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN
2900   X_GEN_TAC `w:real^M->bool` THEN
2901   DISCH_THEN(X_CHOOSE_THEN `z:real^M->bool` STRIP_ASSUME_TAC) THEN
2902   EXISTS_TAC `u DIFF z:real^M->bool` THEN
2903   ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN
2904   EXISTS_TAC `g:real^M->real^N` THEN
2905   REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
2906   CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
2907   CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
2908   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
2909       (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN
2910   ASM SET_TAC[]);;
2911
2912 let ANR_IMP_NEIGHBOURHOOD_RETRACT = prove
2913  (`!s:real^N->bool u.
2914         ANR s /\ closed_in (subtopology euclidean u) s
2915         ==> ?v. open_in (subtopology euclidean u) v /\
2916                 s retract_of v`,
2917   MESON_TAC[ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT; HOMEOMORPHIC_REFL]);;
2918
2919 let ANR_IMP_CLOSED_NEIGHBOURHOOD_RETRACT = prove
2920  (`!s:real^N->bool u.
2921         ANR s /\ closed_in (subtopology euclidean u) s
2922         ==> ?v w. open_in (subtopology euclidean u) v /\
2923                   closed_in (subtopology euclidean u) w /\
2924                   s SUBSET v /\ v SUBSET w /\ s retract_of w`,
2925   MESON_TAC[ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_RETRACT;
2926             HOMEOMORPHIC_REFL]);;
2927
2928 let HOMEOMORPHIC_ANRNESS = prove
2929  (`!s:real^M->bool t:real^N->bool.
2930       s homeomorphic t ==> (ANR s <=> ANR t)`,
2931   let lemma = prove
2932    (`!s:real^M->bool t:real^N->bool.
2933       s homeomorphic t /\ ANR t ==> ANR s`,
2934     REPEAT STRIP_TAC THEN REWRITE_TAC[ANR] THEN
2935     REPEAT STRIP_TAC THEN
2936     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ]
2937       ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT)) THEN
2938     ASM_REWRITE_TAC[] THEN
2939     TRANS_TAC HOMEOMORPHIC_TRANS `s:real^M->bool` THEN
2940     ASM_MESON_TAC[HOMEOMORPHIC_SYM]) in
2941   REPEAT STRIP_TAC THEN EQ_TAC THEN POP_ASSUM MP_TAC THENL
2942    [ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM]; ALL_TAC] THEN
2943   ASM_MESON_TAC[lemma]);;
2944
2945 let ANR_TRANSLATION = prove
2946  (`!a:real^N s. ANR(IMAGE (\x. a + x) s) <=> ANR s`,
2947   REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ANRNESS THEN
2948   REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);;
2949
2950 add_translation_invariants [ANR_TRANSLATION];;
2951
2952 let ANR_LINEAR_IMAGE_EQ = prove
2953  (`!f:real^M->real^N s.
2954         linear f /\ (!x y. f x = f y ==> x = y)
2955         ==> (ANR(IMAGE f s) <=> ANR s)`,
2956   REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ANRNESS THEN
2957   ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF]);;
2958
2959 add_linear_invariants [ANR_LINEAR_IMAGE_EQ];;
2960
2961 (* ------------------------------------------------------------------------- *)
2962 (* Analogous properties of ENRs.                                             *)
2963 (* ------------------------------------------------------------------------- *)
2964
2965 let ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT = prove
2966  (`!s:real^M->bool s':real^N->bool u.
2967         ENR s /\ s homeomorphic s' /\ s' SUBSET u
2968         ==> ?t'. open_in (subtopology euclidean u) t' /\ s' retract_of t'`,
2969   REWRITE_TAC[ENR; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
2970   MAP_EVERY X_GEN_TAC
2971    [`X:real^M->bool`; `Y:real^N->bool`;
2972     `K:real^N->bool`; `U:real^M->bool`] THEN
2973   STRIP_TAC THEN
2974   SUBGOAL_THEN `locally compact (Y:real^N->bool)` ASSUME_TAC THENL
2975    [ASM_MESON_TAC[RETRACT_OF_LOCALLY_COMPACT;
2976                   OPEN_IMP_LOCALLY_COMPACT; HOMEOMORPHIC_LOCAL_COMPACTNESS];
2977     ALL_TAC] THEN
2978   SUBGOAL_THEN
2979    `?W:real^N->bool.
2980         open_in (subtopology euclidean K) W /\
2981         closed_in (subtopology euclidean W) Y`
2982   STRIP_ASSUME_TAC THENL
2983    [FIRST_ASSUM(X_CHOOSE_THEN `W:real^N->bool` STRIP_ASSUME_TAC o
2984         MATCH_MP LOCALLY_COMPACT_CLOSED_IN_OPEN) THEN
2985     EXISTS_TAC `K INTER W:real^N->bool` THEN
2986     ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; CLOSED_IN_CLOSED] THEN
2987     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN
2988     ASM SET_TAC[];
2989     ALL_TAC] THEN
2990   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
2991   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC
2992    [`f:real^M->real^N`; `g:real^N->real^M`] THEN
2993   REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN
2994   MP_TAC(ISPECL [`g:real^N->real^M`; `W:real^N->bool`; `Y:real^N->bool`]
2995         TIETZE_UNBOUNDED) THEN
2996   ASM_REWRITE_TAC[] THEN
2997   DISCH_THEN(X_CHOOSE_THEN `h:real^N->real^M` STRIP_ASSUME_TAC) THEN
2998   EXISTS_TAC `{x | x IN W /\ (h:real^N->real^M) x IN U}` THEN CONJ_TAC THENL
2999    [MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `W:real^N->bool` THEN
3000     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
3001     EXISTS_TAC `(:real^M)` THEN
3002     ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; SUBSET_UNIV];
3003     ALL_TAC] THEN
3004   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN
3005   REWRITE_TAC[retraction; retract_of; LEFT_IMP_EXISTS_THM] THEN
3006   X_GEN_TAC `r:real^M->real^M` THEN STRIP_TAC THEN
3007   EXISTS_TAC `(f:real^M->real^N) o r o (h:real^N->real^M)` THEN
3008   SUBGOAL_THEN
3009    `(W:real^N->bool) SUBSET K /\ Y SUBSET W`
3010   STRIP_ASSUME_TAC THENL
3011    [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; CLOSED_IN_IMP_SUBSET]; ALL_TAC] THEN
3012   REWRITE_TAC[IMAGE_o; o_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
3013   CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
3014   REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN
3015   REWRITE_TAC[IMAGE_o] THEN
3016   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
3017         CONTINUOUS_ON_SUBSET)) THEN
3018   ASM SET_TAC[]);;
3019
3020 let ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV = prove
3021  (`!s:real^M->bool s':real^N->bool.
3022         ENR s /\ s homeomorphic s' ==> ?t'. open t' /\ s' retract_of t'`,
3023   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[OPEN_IN] THEN
3024   ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
3025   MATCH_MP_TAC ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT THEN
3026   ASM_MESON_TAC[SUBSET_UNIV]);;
3027
3028 let HOMEOMORPHIC_ENRNESS = prove
3029  (`!s:real^M->bool t:real^N->bool.
3030       s homeomorphic t ==> (ENR s <=> ENR t)`,
3031   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
3032   REWRITE_TAC[ENR] THENL
3033    [MP_TAC(ISPECL [`s:real^M->bool`; `t:real^N->bool`]
3034         ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV);
3035     MP_TAC(ISPECL [`t:real^N->bool`; `s:real^M->bool`]
3036         ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV)] THEN
3037   ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN
3038   ASM_MESON_TAC[HOMEOMORPHIC_SYM]);;
3039
3040 let ENR_TRANSLATION = prove
3041  (`!a:real^N s. ENR(IMAGE (\x. a + x) s) <=> ENR s`,
3042   REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ENRNESS THEN
3043   REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);;
3044
3045 add_translation_invariants [ENR_TRANSLATION];;
3046
3047 let ENR_LINEAR_IMAGE_EQ = prove
3048  (`!f:real^M->real^N s.
3049         linear f /\ (!x y. f x = f y ==> x = y)
3050         ==> (ENR(IMAGE f s) <=> ENR s)`,
3051   REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ENRNESS THEN
3052   ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF]);;
3053
3054 add_linear_invariants [ENR_LINEAR_IMAGE_EQ];;
3055
3056 (* ------------------------------------------------------------------------- *)
3057 (* Some relations among the concepts. We also relate AR to being a retract   *)
3058 (* of UNIV, which is often a more convenient proxy in the closed case.       *)
3059 (* ------------------------------------------------------------------------- *)
3060
3061 let AR_IMP_ANR = prove
3062  (`!s:real^N->bool. AR s ==> ANR s`,
3063   REWRITE_TAC[AR; ANR] THEN MESON_TAC[OPEN_IN_REFL; CLOSED_IN_IMP_SUBSET]);;
3064
3065 let ENR_IMP_ANR = prove
3066  (`!s:real^N->bool. ENR s ==> ANR s`,
3067   REWRITE_TAC[ANR] THEN
3068   MESON_TAC[ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT; CLOSED_IN_IMP_SUBSET]);;
3069
3070 let ENR_ANR = prove
3071  (`!s:real^N->bool. ENR s <=> ANR s /\ locally compact s`,
3072   REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN ASM_SIMP_TAC[ENR_IMP_ANR] THENL
3073    [ASM_MESON_TAC[ENR; RETRACT_OF_LOCALLY_COMPACT; OPEN_IMP_LOCALLY_COMPACT];
3074     SUBGOAL_THEN
3075      `?t. closed t /\
3076           (s:real^N->bool) homeomorphic (t:real^(N,1)finite_sum->bool)`
3077     STRIP_ASSUME_TAC THENL
3078      [MATCH_MP_TAC LOCALLY_COMPACT_HOMEOMORPHIC_CLOSED THEN
3079       ASM_REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN ARITH_TAC;
3080       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ANR]) THEN
3081       DISCH_THEN(MP_TAC o SPECL
3082        [`(:real^(N,1)finite_sum)`; `t:real^(N,1)finite_sum->bool`]) THEN
3083       ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN; GSYM OPEN_IN] THEN
3084       REWRITE_TAC[GSYM ENR] THEN ASM_MESON_TAC[HOMEOMORPHIC_ENRNESS]]]);;
3085
3086 let AR_ANR = prove
3087  (`!s:real^N->bool. AR s <=> ANR s /\ contractible s /\ ~(s = {})`,
3088   GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[AR_IMP_ANR] THENL
3089    [CONJ_TAC THENL
3090      [ALL_TAC;
3091       ASM_MESON_TAC[AR; HOMEOMORPHIC_EMPTY; RETRACT_OF_EMPTY;
3092            FORALL_UNWIND_THM2; CLOSED_IN_EMPTY; UNIV_NOT_EMPTY]] THEN
3093     SUBGOAL_THEN
3094      `?c s':real^(N,1)finite_sum->bool.
3095           convex c /\ ~(c = {}) /\ closed_in (subtopology euclidean c) s' /\
3096           (s:real^N->bool) homeomorphic s'`
3097     STRIP_ASSUME_TAC THENL
3098      [MATCH_MP_TAC HOMEOMORPHIC_CLOSED_IN_CONVEX THEN
3099       REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1; GSYM INT_OF_NUM_ADD] THEN
3100       REWRITE_TAC[INT_ARITH `x:int < y + &1 <=> x <= y`; AFF_DIM_LE_UNIV];
3101       ALL_TAC] THEN
3102     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [AR]) THEN
3103     DISCH_THEN(MP_TAC o SPECL
3104      [`c:real^(N,1)finite_sum->bool`; `s':real^(N,1)finite_sum->bool`]) THEN
3105     ASM_REWRITE_TAC[] THEN
3106     ASM_MESON_TAC[HOMEOMORPHIC_SYM; HOMEOMORPHIC_CONTRACTIBLE;
3107                   RETRACT_OF_CONTRACTIBLE; CONVEX_IMP_CONTRACTIBLE];
3108     ALL_TAC] THEN
3109   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [contractible]) THEN
3110   REWRITE_TAC[LEFT_IMP_EXISTS_THM; homotopic_with] THEN
3111   MAP_EVERY X_GEN_TAC [`a:real^N`; `h:real^(1,N)finite_sum->real^N`] THEN
3112   STRIP_TAC THEN REWRITE_TAC[AR_EQ_ABSOLUTE_EXTENSOR] THEN
3113   MAP_EVERY X_GEN_TAC
3114    [`f:real^(N,1)finite_sum->real^N`; `w:real^(N,1)finite_sum->bool`;
3115     `t:real^(N,1)finite_sum->bool`] THEN
3116   STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o  ISPECL
3117     [`f:real^(N,1)finite_sum->real^N`; `w:real^(N,1)finite_sum->bool`;
3118      `t:real^(N,1)finite_sum->bool`]  o
3119     REWRITE_RULE[ANR_EQ_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR]) THEN
3120   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
3121   MAP_EVERY X_GEN_TAC
3122     [`u:real^(N,1)finite_sum->bool`; `g:real^(N,1)finite_sum->real^N`] THEN
3123   STRIP_TAC THEN
3124   MP_TAC(ISPECL
3125    [`t:real^(N,1)finite_sum->bool`; `w DIFF u:real^(N,1)finite_sum->bool`;
3126     `w:real^(N,1)finite_sum->bool`] SEPARATION_NORMAL_LOCAL) THEN
3127   ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN
3128   ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
3129   MAP_EVERY X_GEN_TAC
3130    [`v:real^(N,1)finite_sum->bool`; `v':real^(N,1)finite_sum->bool`] THEN
3131   STRIP_TAC THEN
3132   MP_TAC(ISPECL
3133    [`t:real^(N,1)finite_sum->bool`; `w DIFF v:real^(N,1)finite_sum->bool`;
3134     `w:real^(N,1)finite_sum->bool`; `vec 0:real^1`; `vec 1:real^1`]
3135         URYSOHN_LOCAL) THEN
3136   ASM_SIMP_TAC[SEGMENT_1; CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN
3137   ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
3138   REWRITE_TAC[DROP_VEC; REAL_POS] THEN
3139   X_GEN_TAC `e:real^(N,1)finite_sum->real^1` THEN STRIP_TAC THEN
3140   EXISTS_TAC
3141    `\x. if (x:real^(N,1)finite_sum) IN w DIFF v then a
3142         else (h:real^(1,N)finite_sum->real^N) (pastecart (e x) (g x))` THEN
3143   REWRITE_TAC[] THEN CONJ_TAC THENL
3144    [SUBGOAL_THEN `w:real^(N,1)finite_sum->bool = (w DIFF v) UNION (w DIFF v')`
3145     MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
3146     DISCH_THEN(fun th ->
3147         GEN_REWRITE_TAC RAND_CONV [th] THEN
3148         MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
3149         REWRITE_TAC[GSYM th]) THEN
3150     ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL; CONTINUOUS_ON_CONST] THEN
3151     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
3152     GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
3153     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
3154      [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN CONJ_TAC; ALL_TAC] THEN
3155     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
3156         CONTINUOUS_ON_SUBSET)) THEN
3157     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN
3158     ASM SET_TAC[];
3159     ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN RULE_ASSUM_TAC
3160      (REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS]) THEN
3161     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
3162     REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[IN_DIFF] THEN
3163     COND_CASES_TAC THEN ASM SET_TAC[]]);;
3164
3165 let ANR_RETRACT_OF_ANR = prove
3166  (`!s t:real^N->bool. ANR t /\ s retract_of t ==> ANR s`,
3167   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
3168   REWRITE_TAC[ANR_EQ_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR] THEN
3169   REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
3170   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
3171   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN
3172   REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN
3173   X_GEN_TAC `r:real^N->real^N` THEN STRIP_TAC THEN
3174   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
3175   MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
3176   DISCH_THEN(X_CHOOSE_THEN `g:real^(N,1)finite_sum->real^N`
3177         STRIP_ASSUME_TAC) THEN
3178   EXISTS_TAC `(r:real^N->real^N) o (g:real^(N,1)finite_sum->real^N)` THEN
3179   ASM_SIMP_TAC[IMAGE_o; o_THM] THEN
3180   CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
3181   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
3182   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
3183         CONTINUOUS_ON_SUBSET)) THEN
3184   ASM SET_TAC[]);;
3185
3186 let AR_RETRACT_OF_AR = prove
3187  (`!s t:real^N->bool. AR t /\ s retract_of t ==> AR s`,
3188   REWRITE_TAC[AR_ANR] THEN
3189   MESON_TAC[ANR_RETRACT_OF_ANR; RETRACT_OF_CONTRACTIBLE; RETRACT_OF_EMPTY]);;
3190
3191 let ENR_RETRACT_OF_ENR = prove
3192  (`!s t:real^N->bool. ENR t /\ s retract_of t ==> ENR s`,
3193   REWRITE_TAC[ENR] THEN MESON_TAC[RETRACT_OF_TRANS]);;
3194
3195 let RETRACT_OF_UNIV = prove
3196  (`!s:real^N->bool. s retract_of (:real^N) <=> AR s /\ closed s`,
3197   GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
3198    [MATCH_MP_TAC AR_RETRACT_OF_AR THEN EXISTS_TAC `(:real^N)` THEN
3199     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ABSOLUTE_EXTENSOR_IMP_AR THEN
3200     MESON_TAC[DUGUNDJI; CONVEX_UNIV; UNIV_NOT_EMPTY];
3201     MATCH_MP_TAC RETRACT_OF_CLOSED THEN ASM_MESON_TAC[CLOSED_UNIV];
3202     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
3203         AR_IMP_ABSOLUTE_RETRACT)) THEN
3204     ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN; HOMEOMORPHIC_REFL]]);;
3205
3206 let COMPACT_AR = prove
3207  (`!s. compact s /\ AR s <=> compact s /\ s retract_of (:real^N)`,
3208   REWRITE_TAC[RETRACT_OF_UNIV] THEN MESON_TAC[COMPACT_IMP_CLOSED]);;
3209
3210 (* ------------------------------------------------------------------------- *)
3211 (* More properties of ARs, ANRs and ENRs.                                    *)
3212 (* ------------------------------------------------------------------------- *)
3213
3214 let NOT_AR_EMPTY = prove
3215  (`~(AR({}:real^N->bool))`,
3216   REWRITE_TAC[AR_ANR]);;
3217
3218 let ENR_EMPTY = prove
3219  (`ENR {}`,
3220   REWRITE_TAC[ENR; RETRACT_OF_EMPTY] THEN MESON_TAC[OPEN_EMPTY]);;
3221
3222 let ANR_EMPTY = prove
3223  (`ANR {}`,
3224   SIMP_TAC[ENR_EMPTY; ENR_IMP_ANR]);;
3225
3226 let CONVEX_IMP_AR = prove
3227  (`!s:real^N->bool. convex s /\ ~(s = {}) ==> AR s`,
3228   REPEAT STRIP_TAC THEN
3229   MATCH_MP_TAC ABSOLUTE_EXTENSOR_IMP_AR THEN
3230   REPEAT STRIP_TAC THEN MATCH_MP_TAC DUGUNDJI THEN
3231   ASM_REWRITE_TAC[]);;
3232
3233 let CONVEX_IMP_ANR = prove
3234  (`!s:real^N->bool. convex s ==> ANR s`,
3235   MESON_TAC[ANR_EMPTY; CONVEX_IMP_AR; AR_IMP_ANR]);;
3236
3237 let ENR_CONVEX_CLOSED = prove
3238  (`!s:real^N->bool. closed s /\ convex s ==> ENR s`,
3239   MESON_TAC[CONVEX_IMP_ANR; ENR_ANR; CLOSED_IMP_LOCALLY_COMPACT]);;
3240
3241 let AR_UNIV = prove
3242  (`AR(:real^N)`,
3243   MESON_TAC[CONVEX_IMP_AR; CONVEX_UNIV; UNIV_NOT_EMPTY]);;
3244
3245 let ANR_UNIV = prove
3246  (`ANR(:real^N)`,
3247   MESON_TAC[CONVEX_IMP_ANR; CONVEX_UNIV]);;
3248
3249 let ENR_UNIV = prove
3250  (`ENR(:real^N)`,
3251   MESON_TAC[ENR_CONVEX_CLOSED; CONVEX_UNIV; CLOSED_UNIV]);;
3252
3253 let AR_SING = prove
3254  (`!a:real^N. AR {a}`,
3255   SIMP_TAC[CONVEX_IMP_AR; CONVEX_SING; NOT_INSERT_EMPTY]);;
3256
3257 let ANR_SING = prove
3258  (`!a:real^N. ANR {a}`,
3259   SIMP_TAC[AR_IMP_ANR; AR_SING]);;
3260
3261 let ENR_SING = prove
3262  (`!a:real^N. ENR {a}`,
3263   SIMP_TAC[ENR_ANR; ANR_SING; CLOSED_IMP_LOCALLY_COMPACT; CLOSED_SING]);;
3264
3265 let ANR_OPEN_IN = prove
3266  (`!s t:real^N->bool.
3267         open_in (subtopology euclidean t) s /\ ANR t ==> ANR s`,
3268   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3269   REWRITE_TAC[ANR_EQ_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR] THEN
3270   REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
3271   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
3272   FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
3273   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
3274   ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
3275   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^(N,1)finite_sum->real^N` THEN
3276   DISCH_THEN(X_CHOOSE_THEN `w:real^(N,1)finite_sum->bool`
3277         STRIP_ASSUME_TAC) THEN
3278   EXISTS_TAC `{x | x IN w /\ (g:real^(N,1)finite_sum->real^N) x IN s}` THEN
3279   ASM_REWRITE_TAC[] THEN
3280   CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL
3281    [MATCH_MP_TAC OPEN_IN_TRANS THEN
3282     EXISTS_TAC `w:real^(N,1)finite_sum->bool` THEN
3283     ASM_REWRITE_TAC[] THEN
3284     MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN ASM_MESON_TAC[];
3285     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
3286      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
3287         CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]]);;
3288
3289 let ENR_OPEN_IN = prove
3290  (`!s t:real^N->bool.
3291         open_in (subtopology euclidean t) s /\ ENR t ==> ENR s`,
3292   REWRITE_TAC[ENR_ANR] THEN MESON_TAC[ANR_OPEN_IN; LOCALLY_OPEN_SUBSET]);;
3293
3294 let ANR_NEIGHBORHOOD_RETRACT = prove
3295  (`!s t u:real^N->bool.
3296         s retract_of t /\ open_in (subtopology euclidean u) t /\ ANR u
3297         ==> ANR s`,
3298   MESON_TAC[ANR_OPEN_IN; ANR_RETRACT_OF_ANR]);;
3299
3300 let ENR_NEIGHBORHOOD_RETRACT = prove
3301  (`!s t u:real^N->bool.
3302         s retract_of t /\ open_in (subtopology euclidean u) t /\ ENR u
3303         ==> ENR s`,
3304   MESON_TAC[ENR_OPEN_IN; ENR_RETRACT_OF_ENR]);;
3305
3306 let ANR_RELATIVE_INTERIOR = prove
3307  (`!s. ANR(s) ==> ANR(relative_interior s)`,
3308   MESON_TAC[OPEN_IN_SET_RELATIVE_INTERIOR; ANR_OPEN_IN]);;
3309
3310 let ANR_DELETE = prove
3311  (`!s a:real^N. ANR(s) ==> ANR(s DELETE a)`,
3312   MESON_TAC[ANR_OPEN_IN; OPEN_IN_DELETE; OPEN_IN_REFL]);;
3313
3314 let ENR_RELATIVE_INTERIOR = prove
3315  (`!s. ENR(s) ==> ENR(relative_interior s)`,
3316   MESON_TAC[OPEN_IN_SET_RELATIVE_INTERIOR; ENR_OPEN_IN]);;
3317
3318 let ENR_DELETE = prove
3319  (`!s a:real^N. ENR(s) ==> ENR(s DELETE a)`,
3320   MESON_TAC[ENR_OPEN_IN; OPEN_IN_DELETE; OPEN_IN_REFL]);;
3321
3322 let OPEN_IMP_ENR = prove
3323  (`!s:real^N->bool. open s ==> ENR s`,
3324   REWRITE_TAC[OPEN_IN] THEN
3325   ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
3326   MESON_TAC[ENR_UNIV; ENR_OPEN_IN]);;
3327
3328 let OPEN_IMP_ANR = prove
3329  (`!s:real^N->bool. open s ==> ANR s`,
3330   SIMP_TAC[OPEN_IMP_ENR; ENR_IMP_ANR]);;
3331
3332 let ANR_BALL = prove
3333  (`!a:real^N r. ANR(ball(a,r))`,
3334   MESON_TAC[CONVEX_IMP_ANR; CONVEX_BALL]);;
3335
3336 let ENR_BALL = prove
3337  (`!a:real^N r. ENR(ball(a,r))`,
3338   SIMP_TAC[ENR_ANR; ANR_BALL; OPEN_IMP_LOCALLY_COMPACT; OPEN_BALL]);;
3339
3340 let AR_BALL = prove
3341  (`!a:real^N r. AR(ball(a,r)) <=> &0 < r`,
3342   SIMP_TAC[AR_ANR; BALL_EQ_EMPTY; ANR_BALL; CONVEX_BALL;
3343            CONVEX_IMP_CONTRACTIBLE; REAL_NOT_LE]);;
3344
3345 let ANR_CBALL = prove
3346  (`!a:real^N r. ANR(cball(a,r))`,
3347   MESON_TAC[CONVEX_IMP_ANR; CONVEX_CBALL]);;
3348
3349 let ENR_CBALL = prove
3350  (`!a:real^N r. ENR(cball(a,r))`,
3351   SIMP_TAC[ENR_ANR; ANR_CBALL; CLOSED_IMP_LOCALLY_COMPACT; CLOSED_CBALL]);;
3352
3353 let AR_CBALL = prove
3354  (`!a:real^N r. AR(cball(a,r)) <=> &0 <= r`,
3355   SIMP_TAC[AR_ANR; CBALL_EQ_EMPTY; ANR_CBALL; CONVEX_CBALL;
3356            CONVEX_IMP_CONTRACTIBLE; REAL_NOT_LT]);;
3357
3358 let ANR_INTERVAL = prove
3359  (`(!a b:real^N. ANR(interval[a,b])) /\ (!a b:real^N. ANR(interval(a,b)))`,
3360   SIMP_TAC[CONVEX_IMP_ANR; CONVEX_INTERVAL; CLOSED_INTERVAL;
3361            OPEN_IMP_ANR; OPEN_INTERVAL]);;
3362
3363 let ENR_INTERVAL = prove
3364  (`(!a b:real^N. ENR(interval[a,b])) /\ (!a b:real^N. ENR(interval(a,b)))`,
3365   SIMP_TAC[ENR_CONVEX_CLOSED; CONVEX_INTERVAL; CLOSED_INTERVAL;
3366            OPEN_IMP_ENR; OPEN_INTERVAL]);;
3367
3368 let AR_INTERVAL = prove
3369  (`(!a b:real^N. AR(interval[a,b]) <=> ~(interval[a,b] = {})) /\
3370    (!a b:real^N. AR(interval(a,b)) <=> ~(interval(a,b) = {}))`,
3371   SIMP_TAC[AR_ANR; ANR_INTERVAL; CONVEX_IMP_CONTRACTIBLE; CONVEX_INTERVAL]);;
3372
3373 let ANR_INTERIOR = prove
3374  (`!s. ANR(interior s)`,
3375   SIMP_TAC[OPEN_INTERIOR; OPEN_IMP_ANR]);;
3376
3377 let ENR_INTERIOR = prove
3378  (`!s. ENR(interior s)`,
3379   SIMP_TAC[OPEN_INTERIOR; OPEN_IMP_ENR]);;
3380
3381 let AR_IMP_CONTRACTIBLE = prove
3382  (`!s:real^N->bool. AR s ==> contractible s`,
3383   SIMP_TAC[AR_ANR]);;
3384
3385 let ENR_IMP_LOCALLY_COMPACT = prove
3386  (`!s:real^N->bool. ENR s ==> locally compact s`,
3387   SIMP_TAC[ENR_ANR]);;
3388
3389 let ANR_IMP_LOCALLY_PATH_CONNECTED = prove
3390  (`!s:real^N->bool. ANR s ==> locally path_connected s`,
3391   REPEAT STRIP_TAC THEN
3392   SUBGOAL_THEN
3393    `?c s':real^(N,1)finite_sum->bool.
3394         convex c /\ ~(c = {}) /\ closed_in (subtopology euclidean c) s' /\
3395         (s:real^N->bool) homeomorphic s'`
3396   STRIP_ASSUME_TAC THENL
3397    [MATCH_MP_TAC HOMEOMORPHIC_CLOSED_IN_CONVEX THEN
3398     REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1; GSYM INT_OF_NUM_ADD] THEN
3399     REWRITE_TAC[INT_ARITH `x:int < y + &1 <=> x <= y`; AFF_DIM_LE_UNIV];
3400     ALL_TAC] THEN
3401   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ANR]) THEN
3402   DISCH_THEN(MP_TAC o SPECL
3403    [`c:real^(N,1)finite_sum->bool`; `s':real^(N,1)finite_sum->bool`]) THEN
3404   ASM_REWRITE_TAC[] THEN
3405   ASM_MESON_TAC[HOMEOMORPHIC_SYM; HOMEOMORPHIC_LOCAL_PATH_CONNECTEDNESS;
3406                 RETRACT_OF_LOCALLY_PATH_CONNECTED;
3407                 CONVEX_IMP_LOCALLY_PATH_CONNECTED;
3408                 LOCALLY_OPEN_SUBSET]);;
3409
3410 let ANR_IMP_LOCALLY_CONNECTED = prove
3411  (`!s:real^N->bool. ANR s ==> locally connected s`,
3412   SIMP_TAC[ANR_IMP_LOCALLY_PATH_CONNECTED;
3413            LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);;
3414
3415 let AR_IMP_LOCALLY_PATH_CONNECTED = prove
3416  (`!s:real^N->bool. AR s ==> locally path_connected s`,
3417   SIMP_TAC[AR_IMP_ANR; ANR_IMP_LOCALLY_PATH_CONNECTED]);;
3418
3419 let AR_IMP_LOCALLY_CONNECTED = prove
3420  (`!s:real^N->bool. AR s ==> locally connected s`,
3421   SIMP_TAC[AR_IMP_LOCALLY_PATH_CONNECTED;
3422            LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);;
3423
3424 let ENR_IMP_LOCALLY_PATH_CONNECTED = prove
3425  (`!s:real^N->bool. ENR s ==> locally path_connected s`,
3426   SIMP_TAC[ANR_IMP_LOCALLY_PATH_CONNECTED; ENR_IMP_ANR]);;
3427
3428 let ENR_IMP_LOCALLY_CONNECTED = prove
3429  (`!s:real^N->bool. ENR s ==> locally connected s`,
3430   SIMP_TAC[ANR_IMP_LOCALLY_CONNECTED; ENR_IMP_ANR]);;
3431
3432 let COUNTABLE_ANR_COMPONENTS = prove
3433  (`!s:real^N->bool. ANR s ==> COUNTABLE(components s)`,
3434   SIMP_TAC[ANR_IMP_LOCALLY_CONNECTED; COUNTABLE_COMPONENTS]);;
3435
3436 let COUNTABLE_ANR_CONNECTED_COMPONENTS = prove
3437  (`!s:real^N->bool t.
3438         ANR s ==> COUNTABLE {connected_component s x | x IN t}`,
3439   SIMP_TAC[ANR_IMP_LOCALLY_CONNECTED; COUNTABLE_CONNECTED_COMPONENTS]);;
3440
3441 let COUNTABLE_ANR_PATH_COMPONENTS = prove
3442  (`!s:real^N->bool t.
3443         ANR s ==> COUNTABLE {path_component s x | x IN t}`,
3444   SIMP_TAC[ANR_IMP_LOCALLY_PATH_CONNECTED; COUNTABLE_PATH_COMPONENTS]);;
3445
3446 let FINITE_ANR_COMPONENTS = prove
3447  (`!s:real^N->bool. ANR s /\ compact s ==> FINITE(components s)`,
3448   SIMP_TAC[FINITE_COMPONENTS; ANR_IMP_LOCALLY_CONNECTED]);;
3449
3450 let FINITE_ENR_COMPONENTS = prove
3451  (`!s:real^N->bool. ENR s /\ compact s ==> FINITE(components s)`,
3452   SIMP_TAC[FINITE_COMPONENTS; ENR_IMP_LOCALLY_CONNECTED]);;
3453
3454 let ANR_PCROSS = prove
3455  (`!s:real^M->bool t:real^N->bool. ANR s /\ ANR t ==> ANR(s PCROSS t)`,
3456   REPEAT STRIP_TAC THEN SIMP_TAC[ANR_EQ_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR] THEN
3457   MAP_EVERY X_GEN_TAC
3458    [`f:real^((M,N)finite_sum,1)finite_sum->real^(M,N)finite_sum`;
3459     `u:real^((M,N)finite_sum,1)finite_sum->bool`;
3460     `c:real^((M,N)finite_sum,1)finite_sum->bool`] THEN
3461   STRIP_TAC THEN
3462   MP_TAC(ISPECL
3463    [`fstcart o (f:real^((M,N)finite_sum,1)finite_sum->real^(M,N)finite_sum)`;
3464     `u:real^((M,N)finite_sum,1)finite_sum->bool`;
3465     `c:real^((M,N)finite_sum,1)finite_sum->bool`;
3466     `s:real^M->bool`] ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN
3467   MP_TAC(ISPECL
3468    [`sndcart o (f:real^((M,N)finite_sum,1)finite_sum->real^(M,N)finite_sum)`;
3469     `u:real^((M,N)finite_sum,1)finite_sum->bool`;
3470     `c:real^((M,N)finite_sum,1)finite_sum->bool`;
3471     `t:real^N->bool`] ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN
3472   ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_CONTINUOUS_ON;
3473                LINEAR_FSTCART; LINEAR_SNDCART; IMAGE_o] THEN
3474   RULE_ASSUM_TAC
3475    (REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; PCROSS; IN_ELIM_THM]) THEN
3476   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ANTS_TAC THENL
3477    [ASM_MESON_TAC[SNDCART_PASTECART]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
3478   MAP_EVERY X_GEN_TAC
3479    [`w2:real^((M,N)finite_sum,1)finite_sum->bool`;
3480     `h:real^((M,N)finite_sum,1)finite_sum->real^N`] THEN
3481   STRIP_TAC THEN ANTS_TAC THENL
3482    [ASM_MESON_TAC[FSTCART_PASTECART]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
3483   MAP_EVERY X_GEN_TAC
3484    [`w1:real^((M,N)finite_sum,1)finite_sum->bool`;
3485     `g:real^((M,N)finite_sum,1)finite_sum->real^M`] THEN
3486   STRIP_TAC THEN MAP_EVERY EXISTS_TAC
3487    [`w1 INTER w2:real^((M,N)finite_sum,1)finite_sum->bool`;
3488     `\x:real^((M,N)finite_sum,1)finite_sum.
3489         pastecart (g x:real^M) (h x:real^N)`] THEN
3490   ASM_SIMP_TAC[OPEN_IN_INTER; IN_INTER; o_DEF; PASTECART_IN_PCROSS;
3491                PASTECART_FST_SND] THEN
3492   MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
3493   ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]);;
3494
3495 let ANR_PCROSS_EQ = prove
3496  (`!s:real^M->bool t:real^N->bool.
3497         ANR(s PCROSS t) <=> s = {} \/ t = {} \/ ANR s /\ ANR t`,
3498   REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN
3499   ASM_REWRITE_TAC[PCROSS_EMPTY; ANR_EMPTY] THEN
3500   ASM_CASES_TAC `t:real^N->bool = {}` THEN
3501   ASM_REWRITE_TAC[PCROSS_EMPTY; ANR_EMPTY] THEN
3502   EQ_TAC THEN REWRITE_TAC[ANR_PCROSS] THEN REPEAT STRIP_TAC THENL
3503    [UNDISCH_TAC `~(t:real^N->bool = {})` THEN
3504     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN
3505     X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN
3506     SUBGOAL_THEN `ANR ((s:real^M->bool) PCROSS {b:real^N})` MP_TAC THENL
3507      [ALL_TAC; MESON_TAC[HOMEOMORPHIC_PCROSS_SING; HOMEOMORPHIC_ANRNESS]];
3508     UNDISCH_TAC `~(s:real^M->bool = {})` THEN
3509     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN
3510     X_GEN_TAC `a:real^M` THEN DISCH_TAC THEN
3511     SUBGOAL_THEN `ANR ({a:real^M} PCROSS (t:real^N->bool))` MP_TAC THENL
3512      [ALL_TAC; MESON_TAC[HOMEOMORPHIC_PCROSS_SING; HOMEOMORPHIC_ANRNESS]]] THEN
3513   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
3514         ANR_RETRACT_OF_ANR)) THEN
3515   REWRITE_TAC[retract_of; retraction] THENL
3516    [EXISTS_TAC`\x:real^(M,N)finite_sum. pastecart (fstcart x) (b:real^N)`;
3517     EXISTS_TAC`\x:real^(M,N)finite_sum. pastecart (a:real^M) (sndcart x)`] THEN
3518   ASM_SIMP_TAC[SUBSET; FORALL_IN_PCROSS; FORALL_IN_IMAGE; IN_SING;
3519                FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS;
3520                CONTINUOUS_ON_PASTECART; LINEAR_FSTCART; LINEAR_SNDCART;
3521                LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_CONST]);;
3522
3523 let AR_PCROSS = prove
3524  (`!s:real^M->bool t:real^N->bool. AR s /\ AR t ==> AR(s PCROSS t)`,
3525   SIMP_TAC[AR_ANR; ANR_PCROSS; CONTRACTIBLE_PCROSS; PCROSS_EQ_EMPTY]);;
3526
3527 let ENR_PCROSS = prove
3528  (`!s:real^M->bool t:real^N->bool. ENR s /\ ENR t ==> ENR(s PCROSS t)`,
3529   SIMP_TAC[ENR_ANR; ANR_PCROSS; LOCALLY_COMPACT_PCROSS]);;
3530
3531 let ENR_PCROSS_EQ = prove
3532  (`!s:real^M->bool t:real^N->bool.
3533         ENR(s PCROSS t) <=> s = {} \/ t = {} \/ ENR s /\ ENR t`,
3534   REWRITE_TAC[ENR_ANR; ANR_PCROSS_EQ; LOCALLY_COMPACT_PCROSS_EQ] THEN
3535   CONV_TAC TAUT);;
3536
3537 let AR_PCROSS_EQ = prove
3538  (`!s:real^M->bool t:real^N->bool.
3539         AR(s PCROSS t) <=> AR s /\ AR t /\ ~(s = {}) /\ ~(t = {})`,
3540   SIMP_TAC[AR_ANR; ANR_PCROSS_EQ; CONTRACTIBLE_PCROSS_EQ; PCROSS_EQ_EMPTY] THEN
3541   CONV_TAC TAUT);;
3542
3543 let AR_CLOSED_UNION_LOCAL = prove
3544  (`!s t:real^N->bool.
3545         closed_in (subtopology euclidean (s UNION t)) s /\
3546         closed_in (subtopology euclidean (s UNION t)) t /\
3547         AR(s) /\ AR(t) /\ AR(s INTER t)
3548         ==> AR(s UNION t)`,
3549   let lemma = prove
3550    (`!s t u:real^N->bool.
3551         closed_in (subtopology euclidean u) s /\
3552         closed_in (subtopology euclidean u) t /\
3553         AR s /\ AR t /\ AR(s INTER t)
3554         ==> (s UNION t) retract_of u`,
3555     REPEAT STRIP_TAC THEN
3556     ASM_CASES_TAC `s INTER t:real^N->bool = {}` THENL
3557      [ASM_MESON_TAC[NOT_AR_EMPTY]; ALL_TAC] THEN
3558     SUBGOAL_THEN `(s:real^N->bool) SUBSET u /\ t SUBSET u` STRIP_ASSUME_TAC
3559     THENL [ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]; ALL_TAC] THEN
3560     MAP_EVERY ABBREV_TAC
3561      [`s' = {x:real^N | x IN u /\ setdist({x},s) <= setdist({x},t)}`;
3562       `t' = {x:real^N | x IN u /\ setdist({x},t) <= setdist({x},s)}`;
3563       `w = {x:real^N | x IN u /\ setdist({x},s) = setdist({x},t)}`] THEN
3564     SUBGOAL_THEN `closed_in (subtopology euclidean u) (s':real^N->bool) /\
3565                   closed_in (subtopology euclidean u) (t':real^N->bool)`
3566     STRIP_ASSUME_TAC THENL
3567      [MAP_EVERY EXPAND_TAC ["s'"; "t'"] THEN
3568       ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN
3569       ONCE_REWRITE_TAC[GSYM LIFT_DROP] THEN REWRITE_TAC[SET_RULE
3570        `a <= drop(lift x) <=> lift x IN {x | a <= drop x}`] THEN
3571       REWRITE_TAC[LIFT_DROP; LIFT_SUB] THEN CONJ_TAC THEN
3572       MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN
3573       SIMP_TAC[CLOSED_SING; CONTINUOUS_ON_SUB; CONTINUOUS_ON_LIFT_SETDIST;
3574                drop; CLOSED_HALFSPACE_COMPONENT_LE;
3575                REWRITE_RULE[real_ge] CLOSED_HALFSPACE_COMPONENT_GE];
3576       ALL_TAC] THEN
3577     SUBGOAL_THEN
3578      `(s:real^N->bool) SUBSET s' /\ (t:real^N->bool) SUBSET t'`
3579     STRIP_ASSUME_TAC THENL
3580       [MAP_EVERY EXPAND_TAC ["s'"; "t'"] THEN
3581        SIMP_TAC[SUBSET; IN_ELIM_THM; SETDIST_SING_IN_SET; SETDIST_POS_LE] THEN
3582        ASM SET_TAC[];
3583        ALL_TAC] THEN
3584     SUBGOAL_THEN `(s INTER t:real^N->bool) retract_of w` MP_TAC THENL
3585      [MATCH_MP_TAC AR_IMP_ABSOLUTE_RETRACT THEN
3586       EXISTS_TAC `s INTER t:real^N->bool` THEN
3587       ASM_REWRITE_TAC[HOMEOMORPHIC_REFL] THEN
3588       MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN
3589       EXISTS_TAC `u:real^N->bool` THEN
3590       ASM_SIMP_TAC[CLOSED_IN_INTER] THEN
3591       CONJ_TAC THENL [EXPAND_TAC "w"; ASM SET_TAC[]] THEN
3592       SIMP_TAC[SUBSET; IN_INTER; IN_ELIM_THM; SETDIST_SING_IN_SET] THEN
3593       ASM SET_TAC[];
3594       GEN_REWRITE_TAC LAND_CONV [retract_of] THEN
3595       REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN
3596       X_GEN_TAC `r0:real^N->real^N` THEN STRIP_TAC] THEN
3597     SUBGOAL_THEN
3598      `!x:real^N. x IN w ==> (x IN s <=> x IN t)`
3599     ASSUME_TAC THENL
3600      [EXPAND_TAC "w" THEN REWRITE_TAC[IN_ELIM_THM] THEN GEN_TAC THEN
3601       DISCH_THEN(fun th -> EQ_TAC THEN DISCH_TAC THEN MP_TAC th) THEN
3602       ASM_SIMP_TAC[SETDIST_SING_IN_SET] THEN
3603       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN
3604       REWRITE_TAC[REAL_ARITH `&0 = setdist p <=> setdist p = &0`] THEN
3605       MATCH_MP_TAC(SET_RULE
3606        `~(s = {}) /\ (p <=> s = {} \/ x IN s) ==> p ==> x IN s`) THEN
3607       (CONJ_TAC THENL
3608        [ASM SET_TAC[]; MATCH_MP_TAC SETDIST_EQ_0_CLOSED_IN]) THEN
3609       ASM SET_TAC[];
3610       ALL_TAC] THEN
3611     SUBGOAL_THEN `s' INTER t':real^N->bool = w` ASSUME_TAC THENL
3612      [ASM SET_TAC[REAL_LE_ANTISYM]; ALL_TAC] THEN
3613     SUBGOAL_THEN
3614      `closed_in (subtopology euclidean u) (w:real^N->bool)`
3615     ASSUME_TAC THENL [ASM_MESON_TAC[CLOSED_IN_INTER]; ALL_TAC] THEN
3616     ABBREV_TAC `r = \x:real^N. if x IN w then r0 x else x` THEN
3617     SUBGOAL_THEN
3618      `IMAGE (r:real^N->real^N) (w UNION s) SUBSET s /\
3619       IMAGE (r:real^N->real^N) (w UNION t) SUBSET t`
3620     STRIP_ASSUME_TAC THENL
3621      [EXPAND_TAC "r" THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
3622       ASM SET_TAC[];
3623       ALL_TAC] THEN
3624     SUBGOAL_THEN
3625      `(r:real^N->real^N) continuous_on  (w UNION s UNION t)`
3626     ASSUME_TAC THENL
3627      [EXPAND_TAC "r" THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
3628       ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN
3629       REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
3630       CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN
3631       EXISTS_TAC `u:real^N->bool` THEN
3632       ASM_SIMP_TAC[CLOSED_IN_UNION] THEN ASM SET_TAC[];
3633       ALL_TAC] THEN
3634     SUBGOAL_THEN
3635      `?g:real^N->real^N.
3636           g continuous_on u /\
3637           IMAGE g u SUBSET s /\
3638           !x. x IN w UNION s ==> g x = r x`
3639     STRIP_ASSUME_TAC THENL
3640      [MATCH_MP_TAC AR_IMP_ABSOLUTE_EXTENSOR THEN
3641       ASM_SIMP_TAC[CLOSED_IN_UNION] THEN
3642       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET; IN_UNION];
3643       ALL_TAC] THEN
3644     SUBGOAL_THEN
3645      `?h:real^N->real^N.
3646           h continuous_on u /\
3647           IMAGE h u SUBSET t /\
3648           !x. x IN w UNION t ==> h x = r x`
3649     STRIP_ASSUME_TAC THENL
3650      [MATCH_MP_TAC AR_IMP_ABSOLUTE_EXTENSOR THEN
3651       ASM_SIMP_TAC[CLOSED_IN_UNION] THEN
3652       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET; IN_UNION];
3653       ALL_TAC] THEN
3654     REWRITE_TAC[retract_of; retraction] THEN
3655     EXISTS_TAC `\x. if x IN s' then (g:real^N->real^N) x else h x` THEN
3656     REPEAT CONJ_TAC THENL
3657      [ASM SET_TAC[];
3658       ALL_TAC;
3659       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNION] THEN ASM SET_TAC[];
3660       X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_UNION] THEN
3661       STRIP_TAC THEN ASM_SIMP_TAC[IN_UNION; COND_ID] THENL
3662        [COND_CASES_TAC THENL [EXPAND_TAC "r"; ASM SET_TAC[]];
3663         COND_CASES_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
3664         TRANS_TAC EQ_TRANS `(r:real^N->real^N) x` THEN
3665         CONJ_TAC THENL [ASM SET_TAC[]; EXPAND_TAC "r"]] THEN
3666       COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
3667       FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]] THEN
3668     SUBGOAL_THEN
3669      `u:real^N->bool = s' UNION t'`
3670      (fun th -> ONCE_REWRITE_TAC[th] THEN
3671                 MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
3672                 REWRITE_TAC[GSYM th])
3673     THENL [ASM SET_TAC[REAL_LE_TOTAL]; ASM_SIMP_TAC[]] THEN
3674     REPEAT CONJ_TAC THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
3675       (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]) THEN
3676     REWRITE_TAC[TAUT `p /\ ~p \/ q /\ p <=> p /\ q`] THEN
3677     ASM_SIMP_TAC[GSYM IN_INTER; IN_UNION]) in
3678   REPEAT STRIP_TAC THEN REWRITE_TAC[AR] THEN MAP_EVERY X_GEN_TAC
3679    [`u:real^(N,1)finite_sum->bool`; `c:real^(N,1)finite_sum->bool`] THEN
3680   STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
3681   REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC
3682    [`f:real^N->real^(N,1)finite_sum`; `g:real^(N,1)finite_sum->real^N`] THEN
3683   STRIP_TAC THEN
3684   SUBGOAL_THEN
3685    `closed_in (subtopology euclidean u)
3686               {x | x IN c /\ (g:real^(N,1)finite_sum->real^N) x IN s} /\
3687     closed_in (subtopology euclidean u)
3688               {x | x IN c /\ (g:real^(N,1)finite_sum->real^N) x IN t}`
3689   STRIP_ASSUME_TAC THENL
3690    [CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_TRANS THEN
3691     EXISTS_TAC `c:real^(N,1)finite_sum->bool` THEN ASM_REWRITE_TAC[] THEN
3692     MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN
3693     EXISTS_TAC `s UNION t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL];
3694     ALL_TAC] THEN
3695   SUBGOAL_THEN
3696    `{x | x IN c /\ (g:real^(N,1)finite_sum->real^N) x IN s} UNION
3697     {x | x IN c /\ (g:real^(N,1)finite_sum->real^N) x IN t} = c`
3698    (fun th -> SUBST1_TAC(SYM th)) THENL [ASM SET_TAC[]; ALL_TAC] THEN
3699   MATCH_MP_TAC lemma THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
3700    [UNDISCH_TAC `AR(s:real^N->bool)`;
3701     UNDISCH_TAC `AR(t:real^N->bool)`;
3702     UNDISCH_TAC `AR(s INTER t:real^N->bool)`] THEN
3703   MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HOMEOMORPHIC_ARNESS THEN
3704   REWRITE_TAC[homeomorphic; homeomorphism] THEN MAP_EVERY EXISTS_TAC
3705    [`f:real^N->real^(N,1)finite_sum`; `g:real^(N,1)finite_sum->real^N`] THEN
3706   REPEAT CONJ_TAC THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
3707     (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))) THEN
3708   ASM SET_TAC[]);;
3709
3710 let ANR_CLOSED_UNION_LOCAL = prove
3711  (`!s t:real^N->bool.
3712         closed_in (subtopology euclidean (s UNION t)) s /\
3713         closed_in (subtopology euclidean (s UNION t)) t /\
3714         ANR(s) /\ ANR(t) /\ ANR(s INTER t)
3715         ==> ANR(s UNION t)`,
3716   let lemma = prove
3717    (`!s t u:real^N->bool.
3718         closed_in (subtopology euclidean u) s /\
3719         closed_in (subtopology euclidean u) t /\
3720         ANR s /\ ANR t /\ ANR(s INTER t)
3721         ==> ?v. open_in (subtopology euclidean u) v /\
3722                 (s UNION t) retract_of v`,
3723     REPEAT STRIP_TAC THEN
3724     ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[UNION_EMPTY] THENL
3725      [ASM_MESON_TAC[ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT; HOMEOMORPHIC_REFL];
3726       ALL_TAC] THEN
3727     ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[UNION_EMPTY] THENL
3728      [ASM_MESON_TAC[ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT; HOMEOMORPHIC_REFL];
3729       ALL_TAC] THEN
3730     SUBGOAL_THEN `(s:real^N->bool) SUBSET u /\ t SUBSET u`
3731     STRIP_ASSUME_TAC THENL
3732      [ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]; ALL_TAC] THEN
3733     MAP_EVERY ABBREV_TAC
3734      [`s' = {x:real^N | x IN u /\ setdist({x},s) <= setdist({x},t)}`;
3735       `t' = {x:real^N | x IN u /\ setdist({x},t) <= setdist({x},s)}`;
3736       `w = {x:real^N | x IN u /\ setdist({x},s) = setdist({x},t)}`] THEN
3737     SUBGOAL_THEN `closed_in (subtopology euclidean u) (s':real^N->bool) /\
3738                   closed_in (subtopology euclidean u) (t':real^N->bool)`
3739     STRIP_ASSUME_TAC THENL
3740      [MAP_EVERY EXPAND_TAC ["s'"; "t'"] THEN
3741       ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN
3742       ONCE_REWRITE_TAC[GSYM LIFT_DROP] THEN REWRITE_TAC[SET_RULE
3743        `a <= drop(lift x) <=> lift x IN {x | a <= drop x}`] THEN
3744       REWRITE_TAC[LIFT_DROP; LIFT_SUB] THEN CONJ_TAC THEN
3745       MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN
3746       SIMP_TAC[CLOSED_SING; CONTINUOUS_ON_SUB; CONTINUOUS_ON_LIFT_SETDIST;
3747                drop; CLOSED_HALFSPACE_COMPONENT_LE;
3748                REWRITE_RULE[real_ge] CLOSED_HALFSPACE_COMPONENT_GE];
3749       ALL_TAC] THEN
3750     SUBGOAL_THEN
3751      `(s:real^N->bool) SUBSET s' /\ (t:real^N->bool) SUBSET t'`
3752     STRIP_ASSUME_TAC THENL
3753       [MAP_EVERY EXPAND_TAC ["s'"; "t'"] THEN
3754        SIMP_TAC[SUBSET; IN_ELIM_THM; SETDIST_SING_IN_SET; SETDIST_POS_LE] THEN
3755        ASM SET_TAC[];
3756        ALL_TAC] THEN
3757     SUBGOAL_THEN `s' UNION t':real^N->bool = u` ASSUME_TAC THENL
3758      [ASM SET_TAC[REAL_LE_TOTAL]; ALL_TAC] THEN
3759     SUBGOAL_THEN `w SUBSET s' /\ (w:real^N->bool) SUBSET t'`
3760     STRIP_ASSUME_TAC THENL [ASM SET_TAC[REAL_LE_REFL]; ALL_TAC] THEN
3761     SUBGOAL_THEN
3762      `?w' w0. open_in (subtopology euclidean w) w' /\
3763                closed_in (subtopology euclidean w) w0 /\
3764                s INTER t SUBSET w' /\ w' SUBSET w0 /\
3765                (s INTER t:real^N->bool) retract_of w0`
3766     STRIP_ASSUME_TAC THENL
3767      [MATCH_MP_TAC ANR_IMP_CLOSED_NEIGHBOURHOOD_RETRACT THEN
3768       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN
3769       EXISTS_TAC `u:real^N->bool` THEN
3770       ASM_SIMP_TAC[CLOSED_IN_INTER] THEN
3771       CONJ_TAC THENL [EXPAND_TAC "w"; ASM SET_TAC[]] THEN
3772       SIMP_TAC[SUBSET; IN_INTER; IN_ELIM_THM; SETDIST_SING_IN_SET] THEN
3773       ASM SET_TAC[];
3774       ALL_TAC] THEN
3775     SUBGOAL_THEN `closed_in (subtopology euclidean u) (w:real^N->bool)`
3776     ASSUME_TAC THENL
3777      [SUBGOAL_THEN `w = s' INTER t':real^N->bool` SUBST1_TAC THENL
3778        [ASM SET_TAC[REAL_LE_ANTISYM]; ASM_SIMP_TAC[CLOSED_IN_INTER]];
3779       ALL_TAC] THEN
3780     SUBGOAL_THEN `closed_in (subtopology euclidean u) (w0:real^N->bool)`
3781     ASSUME_TAC THENL [ASM_MESON_TAC[CLOSED_IN_TRANS]; ALL_TAC] THEN
3782     SUBGOAL_THEN
3783      `?u0. open_in (subtopology euclidean u) (u0:real^N->bool) /\
3784            s INTER t SUBSET u0 /\
3785            u0 INTER w SUBSET w0`
3786     STRIP_ASSUME_TAC THENL
3787      [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
3788       REWRITE_TAC[OPEN_IN_OPEN; LEFT_AND_EXISTS_THM] THEN
3789       ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
3790       X_GEN_TAC `z:real^N->bool` THEN
3791       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN
3792       EXISTS_TAC `u INTER z:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
3793       ASM SET_TAC[];
3794       ALL_TAC] THEN
3795     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN
3796     REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN
3797     X_GEN_TAC `r0:real^N->real^N` THEN STRIP_TAC THEN
3798     SUBGOAL_THEN `w0 SUBSET (w:real^N->bool)` ASSUME_TAC THENL
3799      [ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]; ALL_TAC] THEN
3800     SUBGOAL_THEN
3801      `!x:real^N. x IN w ==> (x IN s <=> x IN t)`
3802     ASSUME_TAC THENL
3803      [EXPAND_TAC "w" THEN REWRITE_TAC[IN_ELIM_THM] THEN GEN_TAC THEN
3804       DISCH_THEN(fun th -> EQ_TAC THEN DISCH_TAC THEN MP_TAC th) THEN
3805       ASM_SIMP_TAC[SETDIST_SING_IN_SET] THEN
3806       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN
3807       REWRITE_TAC[REAL_ARITH `&0 = setdist p <=> setdist p = &0`] THEN
3808       MATCH_MP_TAC(SET_RULE
3809        `~(s = {}) /\ (p <=> s = {} \/ x IN s) ==> p ==> x IN s`) THEN
3810       (CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC SETDIST_EQ_0_CLOSED_IN]) THEN
3811       ASM SET_TAC[];
3812       ALL_TAC] THEN
3813     ABBREV_TAC `r = \x:real^N. if x IN w0 then r0 x else x` THEN
3814     SUBGOAL_THEN
3815      `IMAGE (r:real^N->real^N) (w0 UNION s) SUBSET s /\
3816       IMAGE (r:real^N->real^N) (w0 UNION t) SUBSET t`
3817     STRIP_ASSUME_TAC THENL
3818      [EXPAND_TAC "r" THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
3819       ASM SET_TAC[];
3820       ALL_TAC] THEN
3821     SUBGOAL_THEN
3822      `(r:real^N->real^N) continuous_on  (w0 UNION s UNION t)`
3823     ASSUME_TAC THENL
3824      [EXPAND_TAC "r" THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
3825       ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN
3826       REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
3827       CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN
3828       EXISTS_TAC `u:real^N->bool` THEN
3829       ASM_SIMP_TAC[CLOSED_IN_UNION] THEN ASM SET_TAC[];
3830       ALL_TAC] THEN
3831     MP_TAC(ISPECL [`r:real^N->real^N`;
3832                    `s':real^N->bool`;
3833                    `w0 UNION s:real^N->bool`;
3834                    `s:real^N->bool`]
3835           ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN
3836     ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
3837      [CONJ_TAC THENL
3838        [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
3839           CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[];
3840         MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN
3841         EXISTS_TAC `u:real^N->bool` THEN ASM_SIMP_TAC[CLOSED_IN_UNION] THEN
3842         ASM SET_TAC[]];
3843       REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
3844     MAP_EVERY X_GEN_TAC [`w1:real^N->bool`; `g:real^N->real^N`] THEN
3845     STRIP_TAC THEN
3846     MP_TAC(ISPECL [`r:real^N->real^N`;
3847                    `t':real^N->bool`;
3848                    `w0 UNION t:real^N->bool`;
3849                    `t:real^N->bool`]
3850           ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN
3851     ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
3852      [CONJ_TAC THENL
3853        [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
3854           CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[];
3855         MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN
3856         EXISTS_TAC `u:real^N->bool` THEN ASM_SIMP_TAC[CLOSED_IN_UNION] THEN
3857         ASM SET_TAC[]];
3858       REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
3859     MAP_EVERY X_GEN_TAC [`w2:real^N->bool`; `h:real^N->real^N`] THEN
3860     STRIP_TAC THEN
3861     SUBGOAL_THEN `s' INTER t':real^N->bool = w` ASSUME_TAC THENL
3862      [ASM SET_TAC[REAL_LE_ANTISYM]; ALL_TAC] THEN
3863     EXISTS_TAC
3864      `(w1 DIFF (w DIFF u0)) UNION (w2 DIFF (w DIFF u0)):real^N->bool` THEN
3865     CONJ_TAC THENL
3866      [UNDISCH_TAC `open_in (subtopology euclidean t') (w2:real^N->bool)` THEN
3867       UNDISCH_TAC `open_in (subtopology euclidean s') (w1:real^N->bool)` THEN
3868       REWRITE_TAC[OPEN_IN_OPEN; LEFT_IMP_EXISTS_THM] THEN
3869       X_GEN_TAC `o1:real^N->bool` THEN STRIP_TAC THEN
3870       X_GEN_TAC `o2:real^N->bool` THEN STRIP_TAC THEN
3871       ASM_REWRITE_TAC[GSYM OPEN_IN_OPEN] THEN
3872       SUBGOAL_THEN
3873        `s' INTER o1 DIFF (w DIFF u0) UNION t' INTER o2 DIFF (w DIFF u0)
3874          :real^N->bool =
3875         ((u DIFF t') INTER o1 UNION (u DIFF s') INTER o2 UNION
3876          u INTER o1 INTER o2) DIFF (w DIFF u0)`
3877       SUBST1_TAC THENL
3878        [REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
3879         REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN
3880         ASM SET_TAC[];
3881         ALL_TAC] THEN
3882       MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_SIMP_TAC[CLOSED_IN_DIFF] THEN
3883       REPEAT(MATCH_MP_TAC OPEN_IN_UNION THEN CONJ_TAC) THEN
3884       MATCH_MP_TAC OPEN_IN_INTER_OPEN THEN
3885       ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL; OPEN_INTER];
3886       ALL_TAC] THEN
3887     REWRITE_TAC[retract_of; retraction] THEN
3888     EXISTS_TAC `\x. if  x IN s' then g x else (h:real^N->real^N) x` THEN
3889     REPEAT CONJ_TAC THENL
3890      [ASM SET_TAC[];
3891       ALL_TAC;
3892       REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
3893       REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN
3894       ASM SET_TAC[];
3895       X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_UNION] THEN
3896       STRIP_TAC THEN ASM_SIMP_TAC[IN_UNION; COND_ID] THENL
3897        [COND_CASES_TAC THENL [EXPAND_TAC "r"; ASM SET_TAC[]];
3898         COND_CASES_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
3899         TRANS_TAC EQ_TRANS `(r:real^N->real^N) x` THEN
3900         CONJ_TAC THENL [ASM SET_TAC[]; EXPAND_TAC "r"]] THEN
3901       COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
3902       FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]] THEN
3903     MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN REPEAT CONJ_TAC THENL
3904      [UNDISCH_TAC `closed_in (subtopology euclidean u) (s':real^N->bool)` THEN
3905       REWRITE_TAC[CLOSED_IN_CLOSED] THEN MATCH_MP_TAC MONO_EXISTS THEN
3906       REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
3907       REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN
3908       ASM SET_TAC[];
3909       UNDISCH_TAC `closed_in (subtopology euclidean u) (t':real^N->bool)` THEN
3910       REWRITE_TAC[CLOSED_IN_CLOSED] THEN MATCH_MP_TAC MONO_EXISTS THEN
3911       REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
3912       REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN
3913       ASM SET_TAC[];
3914       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
3915         CONTINUOUS_ON_SUBSET)) THEN
3916       ASM SET_TAC[];
3917       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
3918         CONTINUOUS_ON_SUBSET)) THEN
3919       ASM SET_TAC[];
3920        X_GEN_TAC `x:real^N` THEN
3921       REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`)) THEN
3922       REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
3923       REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN
3924       ASM SET_TAC[]]) in
3925   REPEAT STRIP_TAC THEN REWRITE_TAC[ANR] THEN MAP_EVERY X_GEN_TAC
3926    [`u:real^(N,1)finite_sum->bool`; `c:real^(N,1)finite_sum->bool`] THEN
3927   STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
3928   REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC
3929    [`f:real^N->real^(N,1)finite_sum`; `g:real^(N,1)finite_sum->real^N`] THEN
3930   STRIP_TAC THEN
3931   SUBGOAL_THEN
3932    `closed_in (subtopology euclidean u)
3933               {x | x IN c /\ (g:real^(N,1)finite_sum->real^N) x IN s} /\
3934     closed_in (subtopology euclidean u)
3935               {x | x IN c /\ (g:real^(N,1)finite_sum->real^N) x IN t}`
3936   STRIP_ASSUME_TAC THENL
3937    [CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_TRANS THEN
3938     EXISTS_TAC `c:real^(N,1)finite_sum->bool` THEN ASM_REWRITE_TAC[] THEN
3939     MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN
3940     EXISTS_TAC `s UNION t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL];
3941     ALL_TAC] THEN
3942   SUBGOAL_THEN
3943    `{x | x IN c /\ (g:real^(N,1)finite_sum->real^N) x IN s} UNION
3944     {x | x IN c /\ (g:real^(N,1)finite_sum->real^N) x IN t} = c`
3945    (fun th -> SUBST1_TAC(SYM th)) THENL [ASM SET_TAC[]; ALL_TAC] THEN
3946   MATCH_MP_TAC lemma THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
3947    [UNDISCH_TAC `ANR(s:real^N->bool)`;
3948     UNDISCH_TAC `ANR(t:real^N->bool)`;
3949     UNDISCH_TAC `ANR(s INTER t:real^N->bool)`] THEN
3950   MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HOMEOMORPHIC_ANRNESS THEN
3951   REWRITE_TAC[homeomorphic; homeomorphism] THEN MAP_EVERY EXISTS_TAC
3952    [`f:real^N->real^(N,1)finite_sum`; `g:real^(N,1)finite_sum->real^N`] THEN
3953   REPEAT CONJ_TAC THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
3954     (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))) THEN
3955   ASM SET_TAC[]);;
3956
3957 let AR_CLOSED_UNION = prove
3958  (`!s t:real^N->bool.
3959         closed s /\ closed t /\ AR(s) /\ AR(t) /\ AR(s INTER t)
3960         ==> AR(s UNION t)`,
3961   MESON_TAC[AR_CLOSED_UNION_LOCAL; CLOSED_SUBSET; SUBSET_UNION]);;
3962
3963 let ANR_CLOSED_UNION = prove
3964  (`!s t:real^N->bool.
3965         closed s /\ closed t /\ ANR(s) /\ ANR(t) /\ ANR(s INTER t)
3966         ==> ANR(s UNION t)`,
3967   MESON_TAC[ANR_CLOSED_UNION_LOCAL; CLOSED_SUBSET; SUBSET_UNION]);;
3968
3969 let ENR_CLOSED_UNION_LOCAL = prove
3970  (`!s t:real^N->bool.
3971         closed_in (subtopology euclidean (s UNION t)) s /\
3972         closed_in (subtopology euclidean (s UNION t)) t /\
3973         ENR(s) /\ ENR(t) /\ ENR(s INTER t)
3974         ==> ENR(s UNION t)`,
3975   SIMP_TAC[ENR_ANR; ANR_CLOSED_UNION_LOCAL; LOCALLY_COMPACT_CLOSED_UNION]);;
3976
3977 let ENR_CLOSED_UNION = prove
3978  (`!s t:real^N->bool.
3979         closed s /\ closed t /\ ENR(s) /\ ENR(t) /\ ENR(s INTER t)
3980         ==> ENR(s UNION t)`,
3981   MESON_TAC[ENR_CLOSED_UNION_LOCAL; CLOSED_SUBSET; SUBSET_UNION]);;
3982
3983 let ABSOLUTE_RETRACT_UNION = prove
3984  (`!s t. s retract_of (:real^N) /\
3985          t retract_of (:real^N) /\
3986          (s INTER t) retract_of (:real^N)
3987          ==> (s UNION t) retract_of (:real^N)`,
3988   SIMP_TAC[RETRACT_OF_UNIV; AR_CLOSED_UNION; CLOSED_UNION]);;
3989
3990 let RETRACT_FROM_UNION_AND_INTER = prove
3991  (`!s t:real^N->bool.
3992         closed_in (subtopology euclidean (s UNION t)) s /\
3993         closed_in (subtopology euclidean (s UNION t)) t /\
3994         (s UNION t) retract_of u /\ (s INTER t) retract_of t
3995         ==> s retract_of u`,
3996   REPEAT STRIP_TAC THEN
3997   UNDISCH_TAC `(s UNION t) retract_of (u:real^N->bool)` THEN
3998   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] RETRACT_OF_TRANS) THEN
3999   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN
4000   REWRITE_TAC[retraction; retract_of] THEN
4001   DISCH_THEN(X_CHOOSE_THEN `r:real^N->real^N` STRIP_ASSUME_TAC) THEN
4002   EXISTS_TAC `\x:real^N. if x IN s then x else r x` THEN
4003   SIMP_TAC[] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
4004   CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
4005   MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
4006   ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN ASM SET_TAC[]);;
4007
4008 let AR_FROM_UNION_AND_INTER_LOCAL = prove
4009  (`!s t:real^N->bool.
4010         closed_in (subtopology euclidean (s UNION t)) s /\
4011         closed_in (subtopology euclidean (s UNION t)) t /\
4012         AR(s UNION t) /\ AR(s INTER t)
4013         ==> AR(s) /\ AR(t)`,
4014   SUBGOAL_THEN
4015    `!s t:real^N->bool.
4016         closed_in (subtopology euclidean (s UNION t)) s /\
4017         closed_in (subtopology euclidean (s UNION t)) t /\
4018         AR(s UNION t) /\ AR(s INTER t)
4019         ==> AR(s)`
4020   MP_TAC THENL [ALL_TAC; MESON_TAC[UNION_COMM; INTER_COMM]] THEN
4021   REPEAT STRIP_TAC THEN MATCH_MP_TAC AR_RETRACT_OF_AR THEN
4022   EXISTS_TAC `s UNION t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
4023   MATCH_MP_TAC RETRACT_FROM_UNION_AND_INTER THEN
4024   EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[RETRACT_OF_REFL] THEN
4025   MATCH_MP_TAC RETRACT_OF_SUBSET THEN EXISTS_TAC `s UNION t:real^N->bool` THEN
4026   REWRITE_TAC[INTER_SUBSET; SUBSET_UNION] THEN
4027   MATCH_MP_TAC AR_IMP_RETRACT THEN ASM_SIMP_TAC[CLOSED_IN_INTER]);;
4028
4029 let AR_FROM_UNION_AND_INTER = prove
4030  (`!s t:real^N->bool.
4031         closed s /\ closed t /\ AR(s UNION t) /\ AR(s INTER t)
4032         ==> AR(s) /\ AR(t)`,
4033   REPEAT GEN_TAC THEN STRIP_TAC THEN
4034   MATCH_MP_TAC AR_FROM_UNION_AND_INTER_LOCAL THEN
4035   ASM_MESON_TAC[CLOSED_SUBSET; SUBSET_UNION]);;
4036
4037 let ANR_FROM_UNION_AND_INTER_LOCAL = prove
4038  (`!s t:real^N->bool.
4039         closed_in (subtopology euclidean (s UNION t)) s /\
4040         closed_in (subtopology euclidean (s UNION t)) t /\
4041         ANR(s UNION t) /\ ANR(s INTER t)
4042         ==> ANR(s) /\ ANR(t)`,
4043   SUBGOAL_THEN
4044    `!s t:real^N->bool.
4045         closed_in (subtopology euclidean (s UNION t)) s /\
4046         closed_in (subtopology euclidean (s UNION t)) t /\
4047         ANR(s UNION t) /\ ANR(s INTER t)
4048         ==> ANR(s)`
4049   MP_TAC THENL [ALL_TAC; MESON_TAC[UNION_COMM; INTER_COMM]] THEN
4050   REPEAT STRIP_TAC THEN MATCH_MP_TAC ANR_NEIGHBORHOOD_RETRACT THEN
4051   ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
4052   EXISTS_TAC `s UNION t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
4053   MP_TAC(ISPECL [`s INTER t:real^N->bool`; `s UNION t:real^N->bool`]
4054         ANR_IMP_NEIGHBOURHOOD_RETRACT) THEN
4055   ASM_SIMP_TAC[CLOSED_IN_INTER] THEN
4056   DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
4057   FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN
4058   EXISTS_TAC `s UNION u:real^N->bool` THEN CONJ_TAC THENL
4059    [ALL_TAC;
4060     SUBGOAL_THEN
4061      `s UNION u:real^N->bool =
4062       ((s UNION t) DIFF t) UNION u`
4063     SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
4064     ASM_SIMP_TAC[OPEN_IN_UNION; OPEN_IN_DIFF; OPEN_IN_REFL]] THEN
4065   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN
4066   REWRITE_TAC[retract_of; retraction; LEFT_IMP_EXISTS_THM] THEN
4067   X_GEN_TAC `r:real^N->real^N` THEN STRIP_TAC THEN
4068   EXISTS_TAC `\x:real^N. if x IN s then x else r x` THEN
4069   CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
4070   CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
4071   FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
4072   SUBGOAL_THEN `s UNION u:real^N->bool = s UNION (u INTER t)`
4073   SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
4074   MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
4075   ASM_REWRITE_TAC[CONTINUOUS_ON_ID; CONJ_ASSOC] THEN
4076   CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THENL
4077    [ALL_TAC; ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]] THEN
4078   CONJ_TAC THENL
4079    [UNDISCH_TAC
4080      `closed_in(subtopology euclidean (s UNION t)) (s:real^N->bool)`;
4081     UNDISCH_TAC
4082        `closed_in(subtopology euclidean (s UNION t)) (t:real^N->bool)`] THEN
4083   REWRITE_TAC[CLOSED_IN_CLOSED] THEN MATCH_MP_TAC MONO_EXISTS THEN
4084   ASM SET_TAC[]);;
4085
4086 let ANR_FROM_UNION_AND_INTER = prove
4087  (`!s t:real^N->bool.
4088         closed s /\ closed t /\ ANR(s UNION t) /\ ANR(s INTER t)
4089         ==> ANR(s) /\ ANR(t)`,
4090   REPEAT GEN_TAC THEN STRIP_TAC THEN
4091   MATCH_MP_TAC ANR_FROM_UNION_AND_INTER_LOCAL THEN
4092   ASM_MESON_TAC[CLOSED_SUBSET; SUBSET_UNION]);;
4093
4094 let ANR_FINITE_UNIONS_CONVEX_CLOSED = prove
4095  (`!t:(real^N->bool)->bool.
4096         FINITE t /\ (!c. c IN t ==> closed c /\ convex c) ==> ANR(UNIONS t)`,
4097   GEN_TAC THEN WF_INDUCT_TAC `CARD(t:(real^N->bool)->bool)` THEN
4098   POP_ASSUM MP_TAC THEN
4099   REWRITE_TAC[TAUT `p ==> q /\ r ==> s <=> q ==> p ==> r ==> s`] THEN
4100   SPEC_TAC(`t:(real^N->bool)->bool`,`t:(real^N->bool)->bool`) THEN
4101   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
4102   REWRITE_TAC[UNIONS_0; UNIONS_INSERT; FORALL_IN_INSERT] THEN
4103   REWRITE_TAC[ANR_EMPTY] THEN
4104   MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `t:(real^N->bool)->bool`] THEN
4105   DISCH_THEN(CONJUNCTS_THEN2 (K ALL_TAC) STRIP_ASSUME_TAC) THEN
4106   REWRITE_TAC[IMP_IMP] THEN REPEAT STRIP_TAC THEN
4107   MATCH_MP_TAC ANR_CLOSED_UNION THEN ASM_SIMP_TAC[CLOSED_UNIONS] THEN
4108   ASM_SIMP_TAC[CONVEX_IMP_ANR] THEN REWRITE_TAC[INTER_UNIONS] THEN
4109   CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[CARD_CLAUSES] THEN
4110   REWRITE_TAC[FORALL_IN_GSPEC; LT_SUC_LE; LE_REFL] THEN
4111   ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; CLOSED_INTER; CONVEX_INTER] THEN
4112   ASM_SIMP_TAC[CARD_IMAGE_LE]);;
4113
4114 let FINITE_IMP_ANR = prove
4115  (`!s:real^N->bool. FINITE s ==> ANR s`,
4116   REPEAT STRIP_TAC THEN
4117   SUBGOAL_THEN `s = UNIONS {{a:real^N} | a IN s}` SUBST1_TAC THENL
4118    [REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[];
4119     MATCH_MP_TAC ANR_FINITE_UNIONS_CONVEX_CLOSED THEN
4120     ASM_SIMP_TAC[FORALL_IN_IMAGE; SIMPLE_IMAGE; FINITE_IMAGE] THEN
4121     REWRITE_TAC[CLOSED_SING; CONVEX_SING]]);;
4122
4123 let ANR_INSERT = prove
4124  (`!s a:real^N. closed s /\ ANR s ==> ANR(a INSERT s)`,
4125   REPEAT STRIP_TAC THEN
4126   ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN
4127   MATCH_MP_TAC ANR_CLOSED_UNION THEN
4128   ASM_MESON_TAC[CLOSED_SING; ANR_SING; ANR_EMPTY;
4129                 SET_RULE `{a} INTER s = {a} \/ {a} INTER s = {}`]);;
4130
4131 let ANR_TRIANGULATION = prove
4132  (`!tr. triangulation tr ==> ANR(UNIONS tr)`,
4133   REWRITE_TAC[triangulation] THEN REPEAT STRIP_TAC THEN
4134   MATCH_MP_TAC ANR_FINITE_UNIONS_CONVEX_CLOSED THEN
4135   ASM_MESON_TAC[CLOSED_SIMPLEX; CONVEX_SIMPLEX]);;
4136
4137 let ANR_SIMPLICIAL_COMPLEX = prove
4138  (`!c. simplicial_complex c ==>  ANR(UNIONS c)`,
4139   MESON_TAC[ANR_TRIANGULATION; SIMPLICIAL_COMPLEX_IMP_TRIANGULATION]);;
4140
4141 let ANR_PATH_COMPONENT_ANR = prove
4142  (`!s x:real^N. ANR(s) ==> ANR(path_component s x)`,
4143   REPEAT GEN_TAC THEN DISCH_TAC THEN
4144   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
4145     ANR_OPEN_IN)) THEN
4146   MATCH_MP_TAC OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED THEN
4147   ASM_SIMP_TAC[ANR_IMP_LOCALLY_PATH_CONNECTED]);;
4148
4149 let ANR_CONNECTED_COMPONENT_ANR = prove
4150  (`!s x:real^N. ANR(s) ==> ANR(connected_component s x)`,
4151   REPEAT GEN_TAC THEN DISCH_TAC THEN
4152   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
4153     ANR_OPEN_IN)) THEN
4154   MATCH_MP_TAC OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED THEN
4155   ASM_SIMP_TAC[ANR_IMP_LOCALLY_CONNECTED]);;
4156
4157 let ANR_COMPONENT_ANR = prove
4158  (`!s:real^N->bool.
4159         ANR s /\ c IN components s ==> ANR c`,
4160   REWRITE_TAC[IN_COMPONENTS] THEN MESON_TAC[ANR_CONNECTED_COMPONENT_ANR]);;
4161
4162 (* ------------------------------------------------------------------------- *)
4163 (* Original ANR material, now for ENRs. Eventually more of this will be      *)
4164 (* updated and generalized for AR and ANR as well.                           *)
4165 (* ------------------------------------------------------------------------- *)
4166
4167 let ENR_BOUNDED = prove
4168  (`!s:real^N->bool.
4169         bounded s
4170         ==> (ENR s <=> ?u. open u /\ bounded u /\ s retract_of u)`,
4171   REPEAT STRIP_TAC THEN REWRITE_TAC[ENR] THEN
4172   EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
4173   FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
4174   DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
4175   DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
4176   EXISTS_TAC `ball(vec 0:real^N,r) INTER u` THEN
4177   ASM_SIMP_TAC[BOUNDED_INTER; OPEN_INTER; OPEN_BALL; BOUNDED_BALL] THEN
4178   MATCH_MP_TAC RETRACT_OF_SUBSET THEN EXISTS_TAC `u:real^N->bool` THEN
4179   FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN
4180   ASM SET_TAC[]);;
4181
4182 let ABSOLUTE_RETRACT_IMP_AR_GEN = prove
4183  (`!s:real^M->bool s':real^N->bool t u.
4184       s retract_of t /\ convex t /\ ~(t = {}) /\
4185       s homeomorphic s' /\ closed_in (subtopology euclidean u) s'
4186       ==> s' retract_of u`,
4187   REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^M->bool`; `t:real^M->bool`]
4188     AR_RETRACT_OF_AR) THEN ASM_SIMP_TAC[CONVEX_IMP_AR] THEN
4189   ASM_MESON_TAC[AR_IMP_ABSOLUTE_RETRACT]);;
4190
4191 let ABSOLUTE_RETRACT_IMP_AR = prove
4192  (`!s s'. s retract_of (:real^M) /\ s homeomorphic s' /\ closed s'
4193           ==> s' retract_of (:real^N)`,
4194   REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTE_RETRACT_IMP_AR_GEN THEN
4195   MAP_EVERY EXISTS_TAC [`s:real^M->bool`; `(:real^M)`] THEN
4196   ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN
4197   REWRITE_TAC[CONVEX_UNIV; CLOSED_UNIV; UNIV_NOT_EMPTY]);;
4198
4199 let HOMEOMORPHIC_COMPACT_ARNESS = prove
4200  (`!s s'. s homeomorphic s'
4201           ==> (compact s /\ s retract_of (:real^M) <=>
4202                compact s' /\ s' retract_of (:real^N))`,
4203   REPEAT STRIP_TAC THEN
4204   ASM_CASES_TAC `compact(s:real^M->bool) /\ compact(s':real^N->bool)` THENL
4205    [ALL_TAC; ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS]] THEN
4206   ASM_REWRITE_TAC[] THEN EQ_TAC THEN
4207   MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] ABSOLUTE_RETRACT_IMP_AR) THEN
4208   ASM_MESON_TAC[HOMEOMORPHIC_SYM; COMPACT_IMP_CLOSED]);;
4209
4210 let EXTENSION_INTO_AR_LOCAL = prove
4211  (`!f:real^M->real^N c s t.
4212         f continuous_on c /\ IMAGE f c SUBSET t /\ t retract_of (:real^N) /\
4213         closed_in (subtopology euclidean s) c
4214         ==> ?g. g continuous_on s /\ IMAGE g (:real^M) SUBSET t /\
4215                 !x. x IN c ==> g x = f x`,
4216   REPEAT STRIP_TAC THEN
4217   MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `c:real^M->bool`]
4218         TIETZE_UNBOUNDED) THEN
4219   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
4220   X_GEN_TAC `g:real^M->real^N` THEN STRIP_TAC THEN
4221   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN
4222   REWRITE_TAC[retraction] THEN
4223   DISCH_THEN(X_CHOOSE_THEN `r:real^N->real^N` STRIP_ASSUME_TAC) THEN
4224   EXISTS_TAC `(r:real^N->real^N) o (g:real^M->real^N)` THEN
4225   FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
4226   REPEAT CONJ_TAC THENL
4227    [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
4228     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
4229         CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[];
4230     REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
4231     REWRITE_TAC[o_THM] THEN ASM SET_TAC[]]);;
4232
4233 let EXTENSION_INTO_AR = prove
4234  (`!f:real^M->real^N s t.
4235         f continuous_on s /\ IMAGE f s SUBSET t /\ t retract_of (:real^N) /\
4236         closed s
4237         ==> ?g. g continuous_on (:real^M) /\ IMAGE g (:real^M) SUBSET t /\
4238                 !x. x IN s ==> g x = f x`,
4239   REPEAT GEN_TAC THEN
4240   MP_TAC(ISPECL
4241    [`f:real^M->real^N`; `s:real^M->bool`; `(:real^M)`; `t:real^N->bool`]
4242    EXTENSION_INTO_AR_LOCAL) THEN
4243   REWRITE_TAC[GSYM OPEN_IN; GSYM CLOSED_IN; SUBTOPOLOGY_UNIV]);;
4244
4245 let NEIGHBOURHOOD_EXTENSION_INTO_ANR = prove
4246  (`!f:real^M->real^N s t.
4247         f continuous_on s /\ IMAGE f s SUBSET t /\ ANR t /\ closed s
4248         ==> ?v g. s SUBSET v /\ open v /\ g continuous_on v /\
4249                   IMAGE g v SUBSET t /\ !x. x IN s ==> g x = f x`,
4250   REPEAT GEN_TAC THEN
4251   MP_TAC(ISPECL
4252    [`f:real^M->real^N`; `(:real^M)`; `s:real^M->bool`; `t:real^N->bool`]
4253    ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN
4254   REWRITE_TAC[GSYM OPEN_IN; GSYM CLOSED_IN; SUBTOPOLOGY_UNIV] THEN
4255   CONV_TAC TAUT);;
4256
4257 let EXTENSION_FROM_COMPONENT = prove
4258  (`!f:real^M->real^N s c u.
4259         (locally connected s \/ compact s /\ ANR u) /\
4260         c IN components s /\
4261         f continuous_on c /\ IMAGE f c SUBSET u
4262         ==> ?g. g continuous_on s /\ IMAGE g s SUBSET u /\
4263                 !x. x IN c ==> g x = f x`,
4264   REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
4265   SUBGOAL_THEN
4266    `?t g. open_in (subtopology euclidean s) t /\
4267           closed_in (subtopology euclidean s) t /\
4268           c SUBSET t /\
4269           (g:real^M->real^N) continuous_on t /\ IMAGE g t SUBSET u /\
4270           !x. x IN c ==> g x = f x`
4271   STRIP_ASSUME_TAC THENL
4272    [FIRST_X_ASSUM(DISJ_CASES_THEN STRIP_ASSUME_TAC) THENL
4273      [MAP_EVERY EXISTS_TAC [`c:real^M->bool`; `f:real^M->real^N`] THEN
4274       ASM_SIMP_TAC[SUBSET_REFL; CLOSED_IN_COMPONENT;
4275                    OPEN_IN_COMPONENTS_LOCALLY_CONNECTED];
4276       MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `c:real^M->bool`;
4277                      `u:real^N->bool`]
4278        ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN
4279       ASM_SIMP_TAC[CLOSED_IN_COMPONENT; LEFT_IMP_EXISTS_THM] THEN
4280       MAP_EVERY X_GEN_TAC [`w:real^M->bool`; `g:real^M->real^N`] THEN
4281       STRIP_TAC THEN
4282       FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
4283       DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` (STRIP_ASSUME_TAC o GSYM)) THEN
4284       MP_TAC(ISPECL [`s:real^M->bool`; `c:real^M->bool`; `v:real^M->bool`]
4285         SURA_BURA_CLOPEN_SUBSET) THEN
4286       ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_IMP_LOCALLY_COMPACT] THEN
4287       ANTS_TAC THENL
4288        [CONJ_TAC THENL [ASM_MESON_TAC[COMPACT_COMPONENTS]; ASM SET_TAC[]];
4289         MATCH_MP_TAC MONO_EXISTS] THEN
4290       X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN
4291       EXISTS_TAC `g:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN
4292       REPEAT CONJ_TAC THENL
4293        [MATCH_MP_TAC CLOSED_SUBSET THEN
4294         ASM_MESON_TAC[COMPACT_IMP_CLOSED; OPEN_IN_IMP_SUBSET];
4295         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
4296           CONTINUOUS_ON_SUBSET)) THEN
4297         FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
4298         ASM SET_TAC[];
4299         FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
4300         ASM SET_TAC[]]];
4301     MP_TAC(ISPECL [`g:real^M->real^N`; `s:real^M->bool`;
4302                    `t:real^M->bool`; `u:real^N->bool`]
4303       EXTENSION_FROM_CLOPEN) THEN
4304     ASM_REWRITE_TAC[] THEN
4305     FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN
4306     ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN
4307     ASM SET_TAC[]]);;
4308
4309 let ABSOLUTE_RETRACT_FROM_UNION_AND_INTER = prove
4310  (`!s t. (s UNION t) retract_of (:real^N) /\
4311          (s INTER t) retract_of (:real^N) /\
4312          closed s /\ closed t
4313          ==> s retract_of (:real^N)`,
4314   MESON_TAC[RETRACT_OF_UNIV; AR_FROM_UNION_AND_INTER]);;
4315
4316 let COUNTABLE_ENR_COMPONENTS = prove
4317  (`!s:real^N->bool. ENR s ==> COUNTABLE(components s)`,
4318   SIMP_TAC[ENR_IMP_ANR; COUNTABLE_ANR_COMPONENTS]);;
4319
4320 let COUNTABLE_ENR_CONNECTED_COMPONENTS = prove
4321  (`!s:real^N->bool t.
4322         ENR s ==> COUNTABLE {connected_component s x | x | x IN t}`,
4323   SIMP_TAC[ENR_IMP_ANR; COUNTABLE_ANR_CONNECTED_COMPONENTS]);;
4324
4325 let COUNTABLE_ENR_PATH_COMPONENTS = prove
4326  (`!s:real^N->bool.
4327         ENR s ==> COUNTABLE {path_component s x | x | x IN s}`,
4328   SIMP_TAC[ENR_IMP_ANR; COUNTABLE_ANR_PATH_COMPONENTS]);;
4329
4330 let ENR_FROM_UNION_AND_INTER_GEN = prove
4331  (`!s t:real^N->bool.
4332         closed_in (subtopology euclidean (s UNION t)) s /\
4333         closed_in (subtopology euclidean (s UNION t)) t /\
4334         ENR(s UNION t) /\ ENR(s INTER t)
4335         ==> ENR s`,
4336   REWRITE_TAC[ENR_ANR] THEN
4337   MESON_TAC[LOCALLY_COMPACT_CLOSED_IN; ANR_FROM_UNION_AND_INTER_LOCAL]);;
4338
4339 let ENR_FROM_UNION_AND_INTER = prove
4340  (`!s t:real^N->bool.
4341         closed s /\ closed t /\ ENR(s UNION t) /\ ENR(s INTER t)
4342         ==> ENR s`,
4343   REPEAT GEN_TAC THEN STRIP_TAC THEN
4344   MATCH_MP_TAC ENR_FROM_UNION_AND_INTER_GEN THEN
4345   ASM_MESON_TAC[CLOSED_SUBSET; SUBSET_UNION]);;
4346
4347 let ENR_FINITE_UNIONS_CONVEX_CLOSED = prove
4348  (`!t:(real^N->bool)->bool.
4349         FINITE t /\ (!c. c IN t ==> closed c /\ convex c) ==> ENR(UNIONS t)`,
4350   SIMP_TAC[ENR_ANR; ANR_FINITE_UNIONS_CONVEX_CLOSED] THEN
4351   SIMP_TAC[CLOSED_IMP_LOCALLY_COMPACT; CLOSED_UNIONS]);;
4352
4353 let FINITE_IMP_ENR = prove
4354  (`!s:real^N->bool. FINITE s ==> ENR s`,
4355   SIMP_TAC[FINITE_IMP_ANR; FINITE_IMP_CLOSED; ENR_ANR;
4356            CLOSED_IMP_LOCALLY_COMPACT]);;
4357
4358 let ENR_INSERT = prove
4359  (`!s a:real^N. closed s /\ ENR s ==> ENR(a INSERT s)`,
4360   REPEAT STRIP_TAC THEN
4361   ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN
4362   MATCH_MP_TAC ENR_CLOSED_UNION THEN
4363   ASM_MESON_TAC[CLOSED_SING; ENR_SING; ENR_EMPTY;
4364                 SET_RULE `{a} INTER s = {a} \/ {a} INTER s = {}`]);;
4365
4366 let ENR_TRIANGULATION = prove
4367  (`!tr. triangulation tr ==> ENR(UNIONS tr)`,
4368   REWRITE_TAC[triangulation] THEN REPEAT STRIP_TAC THEN
4369   MATCH_MP_TAC ENR_FINITE_UNIONS_CONVEX_CLOSED THEN
4370   ASM_MESON_TAC[CLOSED_SIMPLEX; CONVEX_SIMPLEX]);;
4371
4372 let ENR_SIMPLICIAL_COMPLEX = prove
4373  (`!c. simplicial_complex c ==>  ENR(UNIONS c)`,
4374   MESON_TAC[ENR_TRIANGULATION; SIMPLICIAL_COMPLEX_IMP_TRIANGULATION]);;
4375
4376 let ENR_PATH_COMPONENT_ENR = prove
4377  (`!s x:real^N. ENR(s) ==> ENR(path_component s x)`,
4378   REPEAT GEN_TAC THEN DISCH_TAC THEN
4379   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
4380     ENR_OPEN_IN)) THEN
4381   MATCH_MP_TAC OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED THEN
4382   MATCH_MP_TAC RETRACT_OF_LOCALLY_PATH_CONNECTED THEN
4383   ASM_MESON_TAC[ENR; OPEN_IMP_LOCALLY_PATH_CONNECTED]);;
4384
4385 let ENR_CONNECTED_COMPONENT_ENR = prove
4386  (`!s x:real^N. ENR(s) ==> ENR(connected_component s x)`,
4387   REPEAT GEN_TAC THEN DISCH_TAC THEN
4388   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
4389     ENR_OPEN_IN)) THEN
4390   MATCH_MP_TAC OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED THEN
4391   MATCH_MP_TAC RETRACT_OF_LOCALLY_CONNECTED THEN
4392   ASM_MESON_TAC[ENR; OPEN_IMP_LOCALLY_CONNECTED]);;
4393
4394 let ENR_COMPONENT_ENR = prove
4395  (`!s:real^N->bool.
4396         ENR s /\ c IN components s ==> ENR c`,
4397   REWRITE_TAC[IN_COMPONENTS] THEN MESON_TAC[ENR_CONNECTED_COMPONENT_ENR]);;
4398
4399 let ABSOLUTE_RETRACT_HOMEOMORPHIC_CONVEX_COMPACT = prove
4400  (`!s:real^N->bool t u:real^M->bool.
4401         s homeomorphic u /\ ~(s = {}) /\ s SUBSET t /\ convex u /\ compact u
4402         ==> s retract_of t`,
4403   REPEAT STRIP_TAC THEN MP_TAC(ISPECL
4404    [`u:real^M->bool`; `t:real^N->bool`; `s:real^N->bool`]
4405         AR_IMP_ABSOLUTE_RETRACT) THEN
4406   DISCH_THEN MATCH_MP_TAC THEN
4407   ASM_MESON_TAC[CONVEX_IMP_AR; HOMEOMORPHIC_EMPTY; HOMEOMORPHIC_SYM;
4408                 CLOSED_SUBSET; COMPACT_IMP_CLOSED; HOMEOMORPHIC_COMPACTNESS]);;
4409
4410 let ABSOLUTE_RETRACT_PATH_IMAGE_ARC = prove
4411  (`!g s:real^N->bool.
4412         arc g /\ path_image g SUBSET s ==> (path_image g) retract_of s`,
4413   REPEAT STRIP_TAC THEN MP_TAC
4414    (ISPECL [`path_image g:real^N->bool`; `s:real^N->bool`;
4415             `interval[vec 0:real^1,vec 1:real^1]`]
4416         ABSOLUTE_RETRACT_HOMEOMORPHIC_CONVEX_COMPACT) THEN
4417   DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[PATH_IMAGE_NONEMPTY] THEN
4418   REWRITE_TAC[COMPACT_INTERVAL; CONVEX_INTERVAL] THEN
4419   ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
4420   MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN
4421   EXISTS_TAC `g:real^1->real^N` THEN
4422   RULE_ASSUM_TAC(REWRITE_RULE[arc; path; path_image]) THEN
4423   ASM_REWRITE_TAC[COMPACT_INTERVAL; path_image]);;
4424
4425 let RELATIVE_FRONTIER_DEFORMATION_RETRACT_OF_PUNCTURED_CONVEX = prove
4426  (`!s t a:real^N.
4427         convex s /\ convex t /\ bounded s /\ a IN relative_interior s /\
4428         relative_frontier s SUBSET t /\ t SUBSET affine hull s
4429         ==> ?r. homotopic_with (\x. T) (t DELETE a,t DELETE a) (\x. x) r /\
4430                 retraction (t DELETE a,relative_frontier s) r`,
4431   REPEAT STRIP_TAC THEN
4432   MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`]
4433     RAY_TO_RELATIVE_FRONTIER) THEN
4434   ASM_SIMP_TAC[relative_frontier; VECTOR_ADD_LID] THEN
4435   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
4436    [RIGHT_IMP_EXISTS_THM] THEN
4437   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
4438   REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN
4439   REWRITE_TAC[FORALL_AND_THM; retraction] THEN
4440   X_GEN_TAC `dd:real^N->real` THEN STRIP_TAC THEN
4441   EXISTS_TAC `\x:real^N. a + dd(x - a) % (x - a)` THEN
4442   SUBGOAL_THEN
4443    `((\x:real^N. a + dd x % x) o (\x. x - a)) continuous_on t DELETE a`
4444   MP_TAC THENL
4445    [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
4446     EXISTS_TAC `affine hull s DELETE (a:real^N)` THEN
4447     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
4448     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
4449     SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN
4450     MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
4451     SIMP_TAC[VECTOR_ARITH `x - a:real^N = y - a <=> x = y`; VECTOR_SUB_REFL;
4452              SET_RULE `(!x y. f x = f y <=> x = y)
4453                        ==> IMAGE f (s DELETE a) = IMAGE f s DELETE f a`] THEN
4454     MATCH_MP_TAC CONTINUOUS_ON_COMPACT_SURFACE_PROJECTION THEN
4455     EXISTS_TAC `relative_frontier (IMAGE (\x:real^N. x - a) s)` THEN
4456     ASM_SIMP_TAC[COMPACT_RELATIVE_FRONTIER_BOUNDED;
4457                  VECTOR_ARITH `x - a:real^N = --a + x`;
4458                  RELATIVE_FRONTIER_TRANSLATION; COMPACT_TRANSLATION_EQ] THEN
4459     REPEAT CONJ_TAC THENL
4460      [MATCH_MP_TAC(SET_RULE
4461        `s SUBSET t /\ ~(a IN IMAGE f s)
4462         ==> IMAGE f s SUBSET IMAGE f t DELETE a`) THEN
4463       REWRITE_TAC[IN_IMAGE; UNWIND_THM2;
4464                   VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN
4465       ASM_REWRITE_TAC[relative_frontier; IN_DIFF] THEN
4466       MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF u SUBSET t`) THEN
4467       REWRITE_TAC[CLOSURE_SUBSET_AFFINE_HULL];
4468       MATCH_MP_TAC SUBSPACE_IMP_CONIC THEN
4469       MATCH_MP_TAC AFFINE_IMP_SUBSPACE THEN
4470       SIMP_TAC[AFFINE_TRANSLATION; AFFINE_AFFINE_HULL; IN_IMAGE] THEN
4471       REWRITE_TAC[UNWIND_THM2;
4472                   VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN
4473       ASM_MESON_TAC[SUBSET; HULL_SUBSET; RELATIVE_INTERIOR_SUBSET];
4474       ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
4475       REWRITE_TAC[IN_DELETE; IMP_CONJ; FORALL_IN_IMAGE] THEN
4476       REWRITE_TAC[VECTOR_ARITH `--a + x:real^N = vec 0 <=> x = a`] THEN
4477       MAP_EVERY X_GEN_TAC [`k:real`; `x:real^N`] THEN REPEAT STRIP_TAC THEN
4478       REWRITE_TAC[IN_IMAGE; UNWIND_THM2; relative_frontier; VECTOR_ARITH
4479        `y:real^N = --a + x <=> x = a + y`] THEN
4480       EQ_TAC THENL
4481        [STRIP_TAC;
4482         DISCH_THEN(SUBST1_TAC o SYM) THEN
4483         CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4484         ASM_REWRITE_TAC[VECTOR_ARITH `a + --a + x:real^N = x`;
4485                         VECTOR_ARITH `--a + x:real^N = vec 0 <=> x = a`]] THEN
4486       MATCH_MP_TAC(REAL_ARITH `~(a < b) /\ ~(b < a) ==> a = b`) THEN
4487       CONJ_TAC THEN DISCH_TAC THENL
4488        [ALL_TAC;
4489         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
4490          `x IN c DIFF i ==> x IN i ==> F`)) THEN
4491         RULE_ASSUM_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]) THEN
4492         FIRST_X_ASSUM MATCH_MP_TAC THEN
4493         ASM_SIMP_TAC[REAL_LT_IMP_LE; VECTOR_ARITH `a + --a + x:real^N = x`;
4494                      VECTOR_ARITH `--a + x:real^N = vec 0 <=> x = a`]] THEN
4495       MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `a + k % (--a + x):real^N`]
4496         IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT) THEN
4497       RULE_ASSUM_TAC(REWRITE_RULE[IN_DIFF]) THEN ASM_REWRITE_TAC[] THEN
4498       REWRITE_TAC[SUBSET; IN_SEGMENT; NOT_FORALL_THM] THEN
4499       EXISTS_TAC `a + dd(--a + x) % (--a + x):real^N` THEN
4500       ASM_REWRITE_TAC[VECTOR_ARITH `a:real^N = a + k % (--a + x) <=>
4501                                     k % (x - a) = vec 0`] THEN
4502       ASM_SIMP_TAC[VECTOR_SUB_EQ; VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN
4503       REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
4504        [EXISTS_TAC `(dd:real^N->real) (--a + x) / k` THEN
4505         ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_MUL_LID] THEN
4506         REWRITE_TAC[VECTOR_ARITH `a + b:real^N = (&1 - u) % a + u % c <=>
4507                                   b = u % (c - a)`] THEN
4508         ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_ADD_SUB; REAL_DIV_RMUL;
4509                      REAL_LT_IMP_NZ] THEN
4510         MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[];
4511         MATCH_MP_TAC(SET_RULE
4512          `a IN closure s /\ ~(a IN relative_interior s)
4513           ==> ~(a IN relative_interior s)`)] THEN
4514       FIRST_X_ASSUM MATCH_MP_TAC THEN
4515       ASM_REWRITE_TAC[VECTOR_ARITH `a + --a + x:real^N = x`;
4516                       VECTOR_ARITH `--a + x:real^N = vec 0 <=> x = a`]];
4517     REWRITE_TAC[o_DEF] THEN STRIP_TAC] THEN
4518   REPEAT CONJ_TAC THENL
4519    [MATCH_MP_TAC HOMOTOPIC_WITH_LINEAR THEN
4520     ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN
4521     REWRITE_TAC[segment; SUBSET; FORALL_IN_GSPEC; IN_DELETE] THEN
4522     REPEAT(GEN_TAC THEN STRIP_TAC) THEN CONJ_TAC THENL
4523      [FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [convex]) THEN
4524       ASM_REWRITE_TAC[REAL_ARITH `&1 - u + u = &1`; REAL_SUB_LE] THEN
4525       FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
4526       REWRITE_TAC[relative_frontier] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4527       ASM_REWRITE_TAC[VECTOR_ARITH `a + x - a:real^N = x`; VECTOR_SUB_EQ] THEN
4528       ASM_MESON_TAC[HULL_SUBSET; RELATIVE_INTERIOR_SUBSET; SUBSET];
4529       ASM_SIMP_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; VECTOR_ARITH
4530        `(&1 - u) % x + u % (a + d % (x - a)):real^N = a <=>
4531         (&1 - u + u * d) % (x - a) = vec 0`] THEN
4532       MATCH_MP_TAC(REAL_ARITH
4533        `&0 <= x /\ &0 <= u /\ u <= &1 /\ ~(x = &0 /\ u = &1)
4534         ==> ~(&1 - u + x = &0)`) THEN
4535       ASM_SIMP_TAC[REAL_ENTIRE; REAL_ARITH
4536        `(u = &0 \/ d = &0) /\ u = &1 <=> d = &0 /\ u = &1`] THEN
4537       CONJ_TAC THENL
4538        [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN
4539         MATCH_MP_TAC REAL_LT_IMP_LE;
4540         MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(x = &0 /\ u = &1)`)] THEN
4541       FIRST_X_ASSUM MATCH_MP_TAC THEN
4542       ASM_REWRITE_TAC[VECTOR_SUB_EQ; VECTOR_ARITH `a + x - a:real^N = x`] THEN
4543       ASM SET_TAC[]];
4544     RULE_ASSUM_TAC(REWRITE_RULE[relative_frontier]) THEN ASM SET_TAC[];
4545     ASM_REWRITE_TAC[];
4546     MATCH_MP_TAC(SET_RULE
4547      `!s t. s SUBSET t /\ IMAGE f (t DELETE a) SUBSET u
4548             ==> IMAGE f (s DELETE a) SUBSET u`) THEN
4549     EXISTS_TAC `affine hull s:real^N->bool` THEN
4550     CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
4551     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE] THEN
4552     REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4553     ASM_REWRITE_TAC[VECTOR_SUB_EQ; VECTOR_ARITH `a + x - a:real^N = x`];
4554     X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
4555     ASM_CASES_TAC `x:real^N = a` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
4556     SUBGOAL_THEN `dd(x - a:real^N) = &1`
4557      (fun th -> REWRITE_TAC[th] THEN CONV_TAC VECTOR_ARITH) THEN
4558     MATCH_MP_TAC(REAL_ARITH `~(d < &1) /\ ~(&1 < d) ==> d = &1`) THEN
4559     CONJ_TAC THEN DISCH_TAC THEN
4560     MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`]
4561         IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT)
4562     THENL
4563      [DISCH_THEN(MP_TAC o SPEC `x:real^N`);
4564       DISCH_THEN(MP_TAC o SPEC `a + dd(x - a) % (x - a):real^N`)] THEN
4565     ASM_REWRITE_TAC[SUBSET; NOT_IMP; IN_SEGMENT; NOT_FORALL_THM] THENL
4566      [EXISTS_TAC `a + dd(x - a) % (x - a):real^N` THEN
4567       ASM_REWRITE_TAC[VECTOR_SUB_EQ; VECTOR_MUL_EQ_0; REAL_SUB_0; VECTOR_ARITH
4568        `a + d % (x - a):real^N = (&1 - u) % a + u % x <=>
4569         (u - d) % (x - a) = vec 0`] THEN
4570       CONJ_TAC THENL
4571        [EXISTS_TAC `(dd:real^N->real)(x - a)` THEN ASM_REWRITE_TAC[];
4572         MATCH_MP_TAC(SET_RULE
4573          `x IN closure s DIFF relative_interior s
4574           ==> ~(x IN relative_interior s)`)] THEN
4575       FIRST_X_ASSUM MATCH_MP_TAC THEN
4576       ASM_SIMP_TAC[VECTOR_SUB_EQ; VECTOR_ARITH `a + x - a:real^N = x`] THEN
4577       ASM_MESON_TAC[CLOSURE_SUBSET_AFFINE_HULL; SUBSET];
4578       CONJ_TAC THENL
4579        [MATCH_MP_TAC(SET_RULE
4580          `x IN closure s DIFF relative_interior s
4581           ==> x IN closure s`) THEN
4582         FIRST_X_ASSUM MATCH_MP_TAC THEN
4583         ASM_SIMP_TAC[VECTOR_SUB_EQ; VECTOR_ARITH `a + x - a:real^N = x`] THEN
4584         ASM_MESON_TAC[CLOSURE_SUBSET_AFFINE_HULL; SUBSET];
4585         EXISTS_TAC `x:real^N` THEN
4586         ASM_SIMP_TAC[VECTOR_SUB_EQ; VECTOR_MUL_EQ_0;
4587                      VECTOR_ARITH `a = a + d <=> d:real^N = vec 0`;
4588            VECTOR_ARITH `x:real^N = (&1 - u) % a + u % (a + d % (x - a)) <=>
4589                          (u * d - &1) % (x - a) = vec 0`] THEN
4590         MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN
4591         CONJ_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_TAC] THEN
4592         EXISTS_TAC `inv((dd:real^N->real)(x - a))` THEN
4593         ASM_SIMP_TAC[REAL_MUL_LINV; REAL_SUB_REFL; REAL_LT_INV_EQ] THEN
4594         ASM_SIMP_TAC[REAL_INV_LT_1] THEN ASM_REAL_ARITH_TAC]]]);;
4595
4596 let RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL = prove
4597  (`!s a:real^N.
4598         convex s /\ bounded s /\ a IN relative_interior s
4599         ==> relative_frontier s retract_of (affine hull s DELETE a)`,
4600   REPEAT STRIP_TAC THEN
4601   MP_TAC(ISPECL [`s:real^N->bool`; `affine hull s:real^N->bool`; `a:real^N`]
4602       RELATIVE_FRONTIER_DEFORMATION_RETRACT_OF_PUNCTURED_CONVEX) THEN
4603   ASM_SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; SUBSET_REFL] THEN
4604   REWRITE_TAC[retract_of] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
4605   REWRITE_TAC[relative_frontier] THEN
4606   MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s DIFF t SUBSET u`) THEN
4607   REWRITE_TAC[CLOSURE_SUBSET_AFFINE_HULL]);;
4608
4609 let RELATIVE_BOUNDARY_RETRACT_OF_PUNCTURED_AFFINE_HULL = prove
4610  (`!s a:real^N.
4611         convex s /\ compact s /\ a IN relative_interior s
4612         ==> (s DIFF relative_interior s) retract_of
4613             (affine hull s DELETE a)`,
4614   MP_TAC RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL THEN
4615   REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
4616   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
4617   ASM_SIMP_TAC[relative_frontier; COMPACT_IMP_BOUNDED; COMPACT_IMP_CLOSED;
4618                CLOSURE_CLOSED]);;
4619
4620 let PATH_CONNECTED_SPHERE_GEN = prove
4621  (`!s:real^N->bool.
4622         convex s /\ bounded s /\ ~(aff_dim s = &1)
4623         ==> path_connected(relative_frontier s)`,
4624   REPEAT STRIP_TAC THEN
4625   ASM_CASES_TAC `relative_interior s:real^N->bool = {}` THENL
4626    [ASM_MESON_TAC[RELATIVE_INTERIOR_EQ_EMPTY; PATH_CONNECTED_EMPTY;
4627                   RELATIVE_FRONTIER_EMPTY];
4628     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
4629     DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
4630     MATCH_MP_TAC RETRACT_OF_PATH_CONNECTED THEN
4631     EXISTS_TAC `affine hull s DELETE (a:real^N)` THEN
4632     ASM_SIMP_TAC[PATH_CONNECTED_PUNCTURED_CONVEX; AFFINE_AFFINE_HULL;
4633                  AFFINE_IMP_CONVEX; AFF_DIM_AFFINE_HULL;
4634                  RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL]]);;
4635
4636 let CONNECTED_SPHERE_GEN = prove
4637  (`!s:real^N->bool.
4638         convex s /\ bounded s /\ ~(aff_dim s = &1)
4639         ==> connected(relative_frontier s)`,
4640   SIMP_TAC[PATH_CONNECTED_SPHERE_GEN; PATH_CONNECTED_IMP_CONNECTED]);;
4641
4642 let ENR_RELATIVE_FRONTIER_CONVEX = prove
4643  (`!s:real^N->bool. bounded s /\ convex s ==> ENR(relative_frontier s)`,
4644   REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
4645   ASM_REWRITE_TAC[ENR; RELATIVE_FRONTIER_EMPTY] THENL
4646    [ASM_MESON_TAC[RETRACT_OF_REFL; OPEN_EMPTY]; ALL_TAC] THEN
4647   SUBGOAL_THEN `~(relative_interior s:real^N->bool = {})` MP_TAC THENL
4648    [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY]; ALL_TAC] THEN
4649   REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN
4650   X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
4651   EXISTS_TAC `{x | x IN (:real^N) /\
4652                    closest_point (affine hull s) x IN
4653                    ((:real^N) DELETE a)}` THEN
4654   CONJ_TAC THENL
4655    [REWRITE_TAC[OPEN_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
4656     MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
4657     EXISTS_TAC `(:real^N)` THEN
4658     SIMP_TAC[OPEN_IN_DELETE; OPEN_IN_REFL; SUBSET_UNIV; ETA_AX];
4659     MATCH_MP_TAC RETRACT_OF_TRANS THEN
4660     EXISTS_TAC `(affine hull s) DELETE (a:real^N)` THEN CONJ_TAC THENL
4661      [MATCH_MP_TAC RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL THEN
4662       ASM_REWRITE_TAC[];
4663       REWRITE_TAC[retract_of; retraction] THEN
4664       EXISTS_TAC `closest_point (affine hull s:real^N->bool)` THEN
4665       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE] THEN
4666       ASM_SIMP_TAC[IN_ELIM_THM; IN_UNIV; CLOSEST_POINT_SELF;
4667                    CLOSEST_POINT_IN_SET; AFFINE_HULL_EQ_EMPTY;
4668                    CLOSED_AFFINE_HULL]]] THEN
4669   MATCH_MP_TAC CONTINUOUS_ON_CLOSEST_POINT THEN
4670   ASM_SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL;
4671                CLOSED_AFFINE_HULL; AFFINE_HULL_EQ_EMPTY]);;
4672
4673 let ANR_RELATIVE_FRONTIER_CONVEX = prove
4674  (`!s:real^N->bool. bounded s /\ convex s ==> ANR(relative_frontier s)`,
4675   SIMP_TAC[ENR_IMP_ANR; ENR_RELATIVE_FRONTIER_CONVEX]);;
4676
4677 let FRONTIER_RETRACT_OF_PUNCTURED_UNIVERSE = prove
4678  (`!s a. convex s /\ bounded s /\ a IN interior s
4679          ==> (frontier s) retract_of ((:real^N) DELETE a)`,
4680   REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE
4681    `a IN s ==> ~(s = {})`)) THEN
4682   MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`]
4683         RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL) THEN
4684   ASM_SIMP_TAC[RELATIVE_FRONTIER_NONEMPTY_INTERIOR;
4685                RELATIVE_INTERIOR_NONEMPTY_INTERIOR;
4686                AFFINE_HULL_NONEMPTY_INTERIOR]);;
4687
4688 let SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE_GEN = prove
4689  (`!a r b:real^N.
4690       b IN ball(a,r) ==> sphere(a,r) retract_of ((:real^N) DELETE b)`,
4691   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM FRONTIER_CBALL] THEN
4692   MATCH_MP_TAC FRONTIER_RETRACT_OF_PUNCTURED_UNIVERSE THEN
4693   ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; INTERIOR_CBALL]);;
4694
4695 let SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE = prove
4696  (`!a r. &0 < r ==> sphere(a,r) retract_of ((:real^N) DELETE a)`,
4697   REPEAT STRIP_TAC THEN
4698   MATCH_MP_TAC SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE_GEN THEN
4699   ASM_REWRITE_TAC[CENTRE_IN_BALL]);;
4700
4701 let ENR_SPHERE = prove
4702  (`!a:real^N r. ENR(sphere(a,r))`,
4703   REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 < r` THENL
4704    [REWRITE_TAC[ENR] THEN EXISTS_TAC `(:real^N) DELETE a` THEN
4705     ASM_SIMP_TAC[SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE;
4706                  OPEN_DELETE; OPEN_UNIV];
4707     ASM_MESON_TAC[FINITE_IMP_ENR; REAL_NOT_LE; FINITE_SPHERE]]);;
4708
4709 let ANR_SPHERE = prove
4710  (`!a:real^N r. ANR(sphere(a,r))`,
4711   SIMP_TAC[ENR_SPHERE; ENR_IMP_ANR]);;
4712
4713 let LOCALLY_PATH_CONNECTED_SPHERE_GEN = prove
4714  (`!s:real^N->bool.
4715        bounded s /\ convex s ==> locally path_connected (relative_frontier s)`,
4716   REPEAT STRIP_TAC THEN
4717   ASM_CASES_TAC `relative_interior(s:real^N->bool) = {}` THENL
4718    [UNDISCH_TAC `relative_interior(s:real^N->bool) = {}` THEN
4719     ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY] THEN
4720     REWRITE_TAC[LOCALLY_EMPTY; RELATIVE_FRONTIER_EMPTY];
4721     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
4722     DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN
4723     MATCH_MP_TAC RETRACT_OF_LOCALLY_PATH_CONNECTED THEN
4724     EXISTS_TAC `(affine hull s) DELETE (a:real^N)` THEN
4725     ASM_SIMP_TAC[RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL] THEN
4726     MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
4727     EXISTS_TAC `affine hull s:real^N->bool` THEN
4728     SIMP_TAC[OPEN_IN_DELETE; OPEN_IN_REFL] THEN
4729     SIMP_TAC[CONVEX_IMP_LOCALLY_PATH_CONNECTED; AFFINE_IMP_CONVEX;
4730              AFFINE_AFFINE_HULL]]);;
4731
4732 let LOCALLY_CONNECTED_SPHERE_GEN = prove
4733  (`!s:real^N->bool.
4734        bounded s /\ convex s ==> locally connected (relative_frontier s)`,
4735   SIMP_TAC[LOCALLY_PATH_CONNECTED_SPHERE_GEN;
4736            LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);;
4737
4738 let LOCALLY_PATH_CONNECTED_SPHERE = prove
4739  (`!a:real^N r. locally path_connected (sphere(a,r))`,
4740   REPEAT GEN_TAC THEN
4741   MP_TAC(ISPEC `cball(a:real^N,r)` LOCALLY_PATH_CONNECTED_SPHERE_GEN) THEN
4742   MP_TAC(ISPECL [`a:real^N`; `r:real`] RELATIVE_FRONTIER_CBALL) THEN
4743   COND_CASES_TAC THEN
4744   ASM_SIMP_TAC[SPHERE_SING; LOCALLY_SING; PATH_CONNECTED_SING;
4745                BOUNDED_CBALL; CONVEX_CBALL]);;
4746
4747 let LOCALLY_CONNECTED_SPHERE = prove
4748  (`!a:real^N r. locally connected(sphere(a,r))`,
4749   SIMP_TAC[LOCALLY_PATH_CONNECTED_SPHERE;
4750            LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);;
4751
4752 let ABSOLUTE_RETRACTION_CONVEX_CLOSED_RELATIVE = prove
4753  (`!s:real^N->bool t.
4754         convex s /\ closed s /\ ~(s = {}) /\ s SUBSET t
4755         ==> ?r. retraction (t,s) r /\
4756                 !x. x IN (affine hull s) DIFF (relative_interior s)
4757                     ==> r(x) IN relative_frontier s`,
4758   REPEAT STRIP_TAC THEN REWRITE_TAC[retraction] THEN
4759   EXISTS_TAC `closest_point(s:real^N->bool)` THEN
4760   ASM_SIMP_TAC[CONTINUOUS_ON_CLOSEST_POINT; CLOSEST_POINT_SELF] THEN
4761   ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; CLOSEST_POINT_IN_SET] THEN
4762   REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSEST_POINT_IN_RELATIVE_FRONTIER THEN
4763   ASM_MESON_TAC[SUBSET; RELATIVE_INTERIOR_SUBSET]);;
4764
4765 let ABSOLUTE_RETRACTION_CONVEX_CLOSED = prove
4766  (`!s:real^N->bool t.
4767         convex s /\ closed s /\ ~(s = {}) /\ s SUBSET t
4768         ==> ?r. retraction (t,s) r /\
4769                 (!x. ~(x IN s) ==> r(x) IN frontier s)`,
4770   REPEAT STRIP_TAC THEN REWRITE_TAC[retraction] THEN
4771   EXISTS_TAC `closest_point(s:real^N->bool)` THEN
4772   ASM_SIMP_TAC[CONTINUOUS_ON_CLOSEST_POINT; CLOSEST_POINT_SELF] THEN
4773   ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; CLOSEST_POINT_IN_SET] THEN
4774   REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSEST_POINT_IN_FRONTIER THEN
4775   ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET]);;
4776
4777 let ABSOLUTE_RETRACT_CONVEX_CLOSED = prove
4778  (`!s:real^N->bool t.
4779         convex s /\ closed s /\ ~(s = {}) /\ s SUBSET t
4780         ==> s retract_of t`,
4781   REWRITE_TAC[retract_of] THEN MESON_TAC[ABSOLUTE_RETRACTION_CONVEX_CLOSED]);;
4782
4783 let ABSOLUTE_RETRACT_CONVEX = prove
4784  (`!s u:real^N->bool.
4785         convex s /\ ~(s = {}) /\ closed_in (subtopology euclidean u) s
4786         ==> s retract_of u`,
4787   REPEAT STRIP_TAC THEN REWRITE_TAC[retract_of; retraction] THEN
4788   MP_TAC(ISPECL [`\x:real^N. x`; `s:real^N->bool`; `u:real^N->bool`;
4789                  `s:real^N->bool`] DUGUNDJI) THEN
4790   ASM_MESON_TAC[CONTINUOUS_ON_ID; IMAGE_ID; SUBSET_REFL;
4791                 CLOSED_IN_IMP_SUBSET]);;
4792
4793 (* ------------------------------------------------------------------------- *)
4794 (* Borsuk homotopy extension thorem. It's only this late so we can use the   *)
4795 (* concept of retraction, saying that the domain sets or range set are ENRs. *)
4796 (* ------------------------------------------------------------------------- *)
4797
4798 let BORSUK_HOMOTOPY_EXTENSION_HOMOTOPIC = prove
4799  (`!f:real^M->real^N g s t u.
4800         closed_in (subtopology euclidean t) s /\
4801         (ANR s /\ ANR t \/ ANR u) /\
4802         f continuous_on t /\ IMAGE f t SUBSET u /\
4803         homotopic_with (\x. T) (s,u) f g
4804         ==> ?g'. homotopic_with (\x. T) (t,u) f g' /\
4805                  g' continuous_on t /\ IMAGE g' t SUBSET u /\
4806                  !x. x IN s ==> g'(x) = g(x)`,
4807   REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
4808   FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
4809   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN
4810   REWRITE_TAC[] THEN
4811   DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N`
4812     STRIP_ASSUME_TAC) THEN
4813   MAP_EVERY ABBREV_TAC
4814    [`h' = \z. if sndcart z IN s then (h:real^(1,M)finite_sum->real^N) z
4815              else f(sndcart z)`;
4816     `B:real^(1,M)finite_sum->bool =
4817        {vec 0} PCROSS t UNION interval[vec 0,vec 1] PCROSS s`] THEN
4818   SUBGOAL_THEN
4819    `closed_in (subtopology euclidean (interval[vec 0:real^1,vec 1] PCROSS t))
4820               ({vec 0} PCROSS (t:real^M->bool)) /\
4821     closed_in (subtopology euclidean (interval[vec 0:real^1,vec 1] PCROSS t))
4822               (interval[vec 0,vec 1] PCROSS s)`
4823   STRIP_ASSUME_TAC THENL
4824    [CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_PCROSS THEN
4825     ASM_REWRITE_TAC[CLOSED_IN_SING; CLOSED_IN_REFL; ENDS_IN_UNIT_INTERVAL];
4826     ALL_TAC] THEN
4827   SUBGOAL_THEN `(h':real^(1,M)finite_sum->real^N) continuous_on B`
4828   ASSUME_TAC THENL
4829    [MAP_EVERY EXPAND_TAC ["h'"; "B"] THEN ONCE_REWRITE_TAC[UNION_COMM] THEN
4830     MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ASM_REWRITE_TAC[] THEN
4831     ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
4832      [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
4833         (ONCE_REWRITE_RULE[IMP_CONJ] CLOSED_IN_SUBSET_TRANS)) THEN
4834       REWRITE_TAC[SUBSET_UNION; UNION_SUBSET; SUBSET_PCROSS] THEN
4835       ASM_REWRITE_TAC[SING_SUBSET; SUBSET_REFL; ENDS_IN_UNIT_INTERVAL];
4836      ASM_SIMP_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS; IN_SING;
4837                    SNDCART_PASTECART; TAUT `(p /\ q) /\ ~q <=> F`] THEN
4838       GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
4839       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
4840       ASM_SIMP_TAC[LINEAR_SNDCART; LINEAR_CONTINUOUS_ON;
4841                    IMAGE_SNDCART_PCROSS; NOT_INSERT_EMPTY]];
4842     ALL_TAC] THEN
4843   SUBGOAL_THEN `IMAGE (h':real^(1,M)finite_sum->real^N) B SUBSET u`
4844   ASSUME_TAC THENL
4845    [MAP_EVERY EXPAND_TAC ["h'"; "B"] THEN
4846       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART;
4847            SNDCART_PASTECART; PASTECART_IN_PCROSS; IN_UNION; IN_SING] THEN
4848       REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[COND_ID] THENL
4849        [ASM SET_TAC[]; ALL_TAC] THEN
4850       FIRST_X_ASSUM(MATCH_MP_TAC o SIMP_RULE[SUBSET; FORALL_IN_IMAGE]) THEN
4851       ASM_REWRITE_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL];
4852     ALL_TAC] THEN
4853   SUBGOAL_THEN
4854    `?V k:real^(1,M)finite_sum->real^N.
4855         B SUBSET V /\
4856         open_in (subtopology euclidean (interval [vec 0,vec 1] PCROSS t)) V /\
4857         k continuous_on V /\
4858         IMAGE k V SUBSET u /\
4859         (!x. x IN B ==> k x = h' x)`
4860   STRIP_ASSUME_TAC THENL
4861    [FIRST_X_ASSUM(DISJ_CASES_THEN STRIP_ASSUME_TAC) THENL
4862      [SUBGOAL_THEN `ANR(B:real^(1,M)finite_sum->bool)` MP_TAC THENL
4863        [EXPAND_TAC "B" THEN MATCH_MP_TAC ANR_CLOSED_UNION_LOCAL THEN
4864         ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
4865          [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
4866            (ONCE_REWRITE_RULE[IMP_CONJ] CLOSED_IN_SUBSET_TRANS)) THEN
4867           REWRITE_TAC[SUBSET_UNION; UNION_SUBSET; SUBSET_PCROSS] THEN
4868           ASM_REWRITE_TAC[SING_SUBSET; SUBSET_REFL; ENDS_IN_UNIT_INTERVAL];
4869           ASM_SIMP_TAC[INTER_PCROSS; SET_RULE `s SUBSET t ==> t INTER s = s`;
4870                        ENDS_IN_UNIT_INTERVAL;
4871                        SET_RULE `a IN s ==> {a} INTER s = {a}`] THEN
4872           REPEAT CONJ_TAC THEN MATCH_MP_TAC ANR_PCROSS THEN
4873           ASM_REWRITE_TAC[ANR_INTERVAL; ANR_SING]];
4874         DISCH_THEN(MP_TAC o SPEC
4875           `interval[vec 0:real^1,vec 1] PCROSS (t:real^M->bool)` o
4876          MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ]
4877            ANR_IMP_NEIGHBOURHOOD_RETRACT)) THEN
4878         ANTS_TAC THENL
4879          [EXPAND_TAC "B" THEN MATCH_MP_TAC CLOSED_IN_UNION THEN
4880           CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_PCROSS THEN
4881           ASM_REWRITE_TAC[CLOSED_IN_REFL; CLOSED_IN_SING;
4882                           ENDS_IN_UNIT_INTERVAL];
4883           MATCH_MP_TAC MONO_EXISTS] THEN
4884         X_GEN_TAC `V:real^(1,M)finite_sum->bool` THEN STRIP_TAC THEN
4885         FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN
4886         FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN
4887         REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN
4888         X_GEN_TAC `r:real^(1,M)finite_sum->real^(1,M)finite_sum` THEN
4889         STRIP_TAC THEN
4890         EXISTS_TAC `(h':real^(1,M)finite_sum->real^N) o
4891                     (r:real^(1,M)finite_sum->real^(1,M)finite_sum)` THEN
4892         ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN
4893         CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
4894         MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
4895         ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]];
4896       MATCH_MP_TAC ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR THEN
4897       ASM_SIMP_TAC[] THEN EXPAND_TAC "B" THEN
4898       ASM_SIMP_TAC[CLOSED_IN_UNION]];
4899     ABBREV_TAC `s' = {x | ?u. u IN interval[vec 0,vec 1] /\
4900                               pastecart (u:real^1) (x:real^M) IN
4901                               interval [vec 0,vec 1] PCROSS t DIFF V}` THEN
4902     SUBGOAL_THEN `closed_in (subtopology euclidean t) (s':real^M->bool)`
4903     ASSUME_TAC THENL
4904      [EXPAND_TAC "s'" THEN MATCH_MP_TAC CLOSED_IN_COMPACT_PROJECTION THEN
4905       REWRITE_TAC[COMPACT_INTERVAL] THEN MATCH_MP_TAC CLOSED_IN_DIFF THEN
4906       ASM_REWRITE_TAC[CLOSED_IN_REFL];
4907       ALL_TAC] THEN
4908     MP_TAC(ISPECL [`s:real^M->bool`; `s':real^M->bool`; `t:real^M->bool`;
4909                    `vec 1:real^1`; `vec 0:real^1`] URYSOHN_LOCAL) THEN
4910     ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
4911      [EXPAND_TAC "s'" THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN
4912       REWRITE_TAC[NOT_IN_EMPTY; IN_DIFF; PASTECART_IN_PCROSS] THEN
4913       X_GEN_TAC `x:real^M` THEN
4914       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
4915       DISCH_THEN(X_CHOOSE_THEN `p:real^1` MP_TAC) THEN
4916       REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN
4917       REWRITE_TAC[] THEN
4918       FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
4919       EXPAND_TAC "B" THEN REWRITE_TAC[IN_UNION; PASTECART_IN_PCROSS] THEN
4920       ASM SET_TAC[];
4921       ALL_TAC] THEN
4922     ONCE_REWRITE_TAC[SEGMENT_SYM] THEN
4923     REWRITE_TAC[SEGMENT_1; DROP_VEC; REAL_POS] THEN
4924     DISCH_THEN(X_CHOOSE_THEN `a:real^M->real^1` STRIP_ASSUME_TAC) THEN
4925     EXISTS_TAC
4926      `(\x. (k:real^(1,M)finite_sum->real^N) (pastecart (a x) x))` THEN
4927     ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN REPEAT CONJ_TAC THENL
4928      [SIMP_TAC[HOMOTOPIC_WITH] THEN
4929       EXISTS_TAC `(k:real^(1,M)finite_sum->real^N) o
4930           (\z. pastecart (drop(fstcart z) % a(sndcart z)) (sndcart z))` THEN
4931       REWRITE_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN
4932       REWRITE_TAC[DROP_VEC; VECTOR_MUL_LZERO; VECTOR_MUL_LID] THEN
4933       REPEAT CONJ_TAC THENL
4934        [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
4935          [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
4936           SIMP_TAC[LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN
4937           MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
4938           SIMP_TAC[o_DEF; LIFT_DROP; LINEAR_FSTCART; LINEAR_CONTINUOUS_ON;
4939                    ETA_AX] THEN
4940           GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
4941           MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
4942           SIMP_TAC[LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN
4943           ASM_SIMP_TAC[IMAGE_SNDCART_PCROSS; UNIT_INTERVAL_NONEMPTY];
4944           FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
4945             CONTINUOUS_ON_SUBSET))];
4946         REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
4947          (SET_RULE `IMAGE k t SUBSET u
4948                     ==> s SUBSET t ==> IMAGE k s SUBSET u`));
4949         X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
4950         SUBGOAL_THEN `pastecart (vec 0:real^1) (x:real^M) IN B` MP_TAC THENL
4951          [EXPAND_TAC "B" THEN
4952           ASM_REWRITE_TAC[IN_UNION; PASTECART_IN_PCROSS; IN_SING];
4953           DISCH_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
4954            `(h':real^(1,M)finite_sum->real^N) (pastecart (vec 0) x)` THEN
4955           CONJ_TAC THENL [ASM_MESON_TAC[]; EXPAND_TAC "h'"] THEN
4956           ASM_REWRITE_TAC[SNDCART_PASTECART; COND_ID]]] THEN
4957       (REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
4958        MAP_EVERY X_GEN_TAC [`p:real^1`; `x:real^M`] THEN STRIP_TAC THEN
4959        REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
4960        ASM_CASES_TAC `(x:real^M) IN s'` THENL
4961         [ASM_SIMP_TAC[VECTOR_MUL_RZERO] THEN
4962          FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN
4963          EXPAND_TAC "B" THEN REWRITE_TAC[IN_UNION; PASTECART_IN_PCROSS] THEN
4964          ASM_REWRITE_TAC[IN_SING];
4965          UNDISCH_TAC `~((x:real^M) IN s')` THEN
4966          EXPAND_TAC "s'" THEN
4967          REWRITE_TAC[IN_ELIM_THM; NOT_EXISTS_THM]  THEN
4968          DISCH_THEN(MP_TAC o SPEC `drop p % (a:real^M->real^1) x`) THEN
4969          REWRITE_TAC[PASTECART_IN_PCROSS; IN_DIFF] THEN
4970          ASM_REWRITE_TAC[CONJ_ASSOC] THEN
4971          MATCH_MP_TAC(TAUT `p ==> ~(p /\ ~q) ==> q`) THEN
4972          REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC] THEN
4973          RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
4974          ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_LMUL; REAL_ARITH
4975           `p * a <= p * &1 /\ p <= &1 ==> p * a <= &1`]]);
4976       GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
4977       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
4978       ASM_SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID] THEN
4979       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
4980           CONTINUOUS_ON_SUBSET)) THEN
4981       ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN
4982       X_GEN_TAC `x:real^M` THEN DISCH_TAC;
4983       X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
4984       FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]);
4985       X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
4986       EXISTS_TAC `(h':real^(1,M)finite_sum->real^N) (pastecart (vec 1) x)` THEN
4987       CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; EXPAND_TAC "h'"] THEN
4988       ASM_REWRITE_TAC[SNDCART_PASTECART] THEN
4989       EXPAND_TAC "B" THEN REWRITE_TAC[IN_UNION; PASTECART_IN_PCROSS] THEN
4990       ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]] THEN
4991     (ASM_CASES_TAC `(x:real^M) IN s'` THEN ASM_SIMP_TAC[] THENL
4992       [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
4993        EXPAND_TAC "B" THEN REWRITE_TAC[IN_UNION; PASTECART_IN_PCROSS] THEN
4994        ASM SET_TAC[];
4995        UNDISCH_TAC `~((x:real^M) IN s')` THEN EXPAND_TAC "s'" THEN
4996        REWRITE_TAC[IN_ELIM_THM; NOT_EXISTS_THM]  THEN
4997        DISCH_THEN(MP_TAC o SPEC `(a:real^M->real^1) x`) THEN
4998        ASM_SIMP_TAC[PASTECART_IN_PCROSS; IN_DIFF] THEN ASM SET_TAC[]])]);;
4999
5000 let BORSUK_HOMOTOPY_EXTENSION = prove
5001  (`!f:real^M->real^N g s t u.
5002         closed_in (subtopology euclidean t) s /\
5003         (ANR s /\ ANR t \/ ANR u) /\
5004         f continuous_on t /\ IMAGE f t SUBSET u /\
5005         homotopic_with (\x. T) (s,u) f g
5006         ==> ?g'. g' continuous_on t /\ IMAGE g' t SUBSET u /\
5007                  !x. x IN s ==> g'(x) = g(x)`,
5008   REPEAT GEN_TAC THEN
5009   DISCH_THEN(MP_TAC o MATCH_MP BORSUK_HOMOTOPY_EXTENSION_HOMOTOPIC) THEN
5010   MESON_TAC[]);;
5011
5012 let NULLHOMOTOPIC_INTO_ANR_EXTENSION = prove
5013  (`!f:real^M->real^N s t.
5014       closed s /\ f continuous_on s /\ ~(s = {}) /\ IMAGE f s SUBSET t /\ ANR t
5015       ==> ((?c. homotopic_with (\x. T) (s,t) f (\x. c)) <=>
5016            (?g. g continuous_on (:real^M) /\
5017                 IMAGE g (:real^M) SUBSET t /\
5018                 !x. x IN s ==> g x = f x))`,
5019   REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL
5020    [MATCH_MP_TAC BORSUK_HOMOTOPY_EXTENSION THEN
5021     ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN
5022     ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN
5023     EXISTS_TAC `(\x. c):real^M->real^N` THEN
5024     ASM_REWRITE_TAC[CLOSED_UNIV; CONTINUOUS_ON_CONST] THEN
5025     FIRST_X_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
5026     ASM SET_TAC[];
5027     MP_TAC(ISPECL [`g:real^M->real^N`; `(:real^M)`; `t:real^N->bool`]
5028          NULLHOMOTOPIC_FROM_CONTRACTIBLE) THEN
5029     ASM_REWRITE_TAC[CONTRACTIBLE_UNIV] THEN
5030     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN
5031     DISCH_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN
5032     MAP_EVERY EXISTS_TAC [`g:real^M->real^N`; `(\x. c):real^M->real^N`] THEN
5033     ASM_SIMP_TAC[] THEN MATCH_MP_TAC HOMOTOPIC_WITH_SUBSET_LEFT THEN
5034     EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]]);;
5035
5036 let NULLHOMOTOPIC_INTO_RELATIVE_FRONTIER_EXTENSION = prove
5037  (`!f:real^M->real^N s t.
5038         closed s /\ f continuous_on s /\ ~(s = {}) /\
5039         IMAGE f s SUBSET relative_frontier t /\ convex t /\ bounded t
5040         ==> ((?c. homotopic_with (\x. T) (s,relative_frontier t) f (\x. c)) <=>
5041              (?g. g continuous_on (:real^M) /\
5042                   IMAGE g (:real^M) SUBSET relative_frontier t /\
5043                   !x. x IN s ==> g x = f x))`,
5044   REPEAT STRIP_TAC THEN MATCH_MP_TAC NULLHOMOTOPIC_INTO_ANR_EXTENSION THEN
5045   MP_TAC(ISPEC `t:real^N->bool` ANR_RELATIVE_FRONTIER_CONVEX) THEN
5046   ASM_REWRITE_TAC[]);;
5047
5048 let NULLHOMOTOPIC_INTO_SPHERE_EXTENSION = prove
5049  (`!f:real^M->real^N s a r.
5050      closed s /\ f continuous_on s /\ ~(s = {}) /\ IMAGE f s SUBSET sphere(a,r)
5051      ==> ((?c. homotopic_with (\x. T) (s,sphere(a,r)) f (\x. c)) <=>
5052           (?g. g continuous_on (:real^M) /\
5053                IMAGE g (:real^M) SUBSET sphere(a,r) /\
5054                !x. x IN s ==> g x = f x))`,
5055   REPEAT GEN_TAC THEN
5056   MP_TAC(ISPECL [`a:real^N`; `r:real`] RELATIVE_FRONTIER_CBALL) THEN
5057   COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
5058    [ASM_SIMP_TAC[SPHERE_SING] THEN REPEAT STRIP_TAC THEN
5059     MATCH_MP_TAC(TAUT `p /\ q ==> (p <=> q)`) THEN CONJ_TAC THENL
5060      [EXISTS_TAC `a:real^N` THEN SIMP_TAC[HOMOTOPIC_WITH; PCROSS] THEN
5061       EXISTS_TAC `\y:real^(1,M)finite_sum. (a:real^N)`;
5062       EXISTS_TAC `(\x. a):real^M->real^N`] THEN
5063     REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[];
5064     DISCH_THEN(SUBST1_TAC o SYM) THEN STRIP_TAC THEN
5065     MATCH_MP_TAC NULLHOMOTOPIC_INTO_RELATIVE_FRONTIER_EXTENSION THEN
5066     ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL]]);;
5067
5068 let ABSOLUTE_RETRACT_CONTRACTIBLE_ANR = prove
5069  (`!s u:real^N->bool.
5070       closed_in (subtopology euclidean u) s /\
5071       contractible s /\ ~(s = {}) /\ ANR s
5072       ==> s retract_of u`,
5073   REPEAT STRIP_TAC THEN MATCH_MP_TAC AR_IMP_RETRACT THEN
5074   ASM_SIMP_TAC[AR_ANR]);;
5075
5076 (* ------------------------------------------------------------------------- *)
5077 (* More homotopy extension results and relations to components.              *)
5078 (* ------------------------------------------------------------------------- *)
5079
5080 let HOMOTOPIC_ON_COMPONENTS = prove
5081  (`!s t f g:real^M->real^N.
5082         locally connected s /\
5083         (!c. c IN components s ==> homotopic_with (\x. T) (c,t) f g)
5084         ==> homotopic_with (\x. T) (s,t) f g`,
5085   REPEAT STRIP_TAC THEN
5086   GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV o LAND_CONV) [UNIONS_COMPONENTS] THEN
5087   MATCH_MP_TAC HOMOTOPIC_ON_CLOPEN_UNIONS THEN
5088   X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN
5089   ASM_SIMP_TAC[GSYM UNIONS_COMPONENTS] THEN
5090   ASM_MESON_TAC[CLOSED_IN_COMPONENT; OPEN_IN_COMPONENTS_LOCALLY_CONNECTED]);;
5091
5092 let INESSENTIAL_ON_COMPONENTS = prove
5093  (`!f:real^M->real^N s t.
5094         locally connected s /\ path_connected t /\
5095         (!c. c IN components s ==> ?a. homotopic_with (\x. T) (c,t) f (\x. a))
5096         ==> ?a. homotopic_with (\x. T) (s,t) f (\x. a)`,
5097   REPEAT STRIP_TAC THEN
5098   ASM_CASES_TAC `components(s:real^M->bool) = {}` THENL
5099    [RULE_ASSUM_TAC(REWRITE_RULE[COMPONENTS_EQ_EMPTY]) THEN
5100     ASM_REWRITE_TAC[HOMOTOPIC_ON_EMPTY];
5101     ALL_TAC] THEN
5102   SUBGOAL_THEN `?a:real^N. a IN t` MP_TAC THENL
5103     [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
5104      DISCH_THEN(X_CHOOSE_TAC `c:real^M->bool`) THEN
5105      FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN
5106      ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
5107      GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
5108      FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN SET_TAC[];
5109      MATCH_MP_TAC MONO_EXISTS] THEN
5110   X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN
5111   MATCH_MP_TAC HOMOTOPIC_ON_COMPONENTS THEN ASM_REWRITE_TAC[] THEN
5112   X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN
5113   FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN
5114   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN
5115   DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
5116   FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
5117   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN
5118   REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN DISJ2_TAC THEN FIRST_X_ASSUM
5119    (MATCH_MP_TAC o REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]) THEN
5120   FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN ASM SET_TAC[]);;
5121
5122 let HOMOTOPIC_NEIGHBOURHOOD_EXTENSION = prove
5123  (`!f g:real^M->real^N s t u.
5124         f continuous_on s /\ IMAGE f s SUBSET u /\
5125         g continuous_on s /\ IMAGE g s SUBSET u /\
5126         closed_in (subtopology euclidean s) t /\ ANR u /\
5127         homotopic_with (\x. T) (t,u) f g
5128         ==> ?v. t SUBSET v /\
5129                 open_in (subtopology euclidean s) v /\
5130                 homotopic_with (\x. T) (v,u) f g`,
5131   REPEAT STRIP_TAC THEN
5132   FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
5133   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN
5134   DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N`
5135         STRIP_ASSUME_TAC) THEN
5136   ABBREV_TAC
5137    `h' = \z. if fstcart z IN {vec 0} then f(sndcart z)
5138              else if fstcart z IN {vec 1} then g(sndcart z)
5139              else (h:real^(1,M)finite_sum->real^N) z` THEN
5140   MP_TAC(ISPECL
5141    [`h':real^(1,M)finite_sum->real^N`;
5142     `interval[vec 0:real^1,vec 1] PCROSS (s:real^M->bool)`;
5143     `{vec 0:real^1,vec 1} PCROSS (s:real^M->bool) UNION
5144      interval[vec 0,vec 1] PCROSS t`;
5145     `u:real^N->bool`] ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN
5146   ASM_SIMP_TAC[ENR_IMP_ANR] THEN ANTS_TAC THENL
5147    [REPEAT CONJ_TAC THENL
5148      [REWRITE_TAC[SET_RULE `{a,b} = {a} UNION {b}`] THEN
5149       REWRITE_TAC[PCROSS_UNION; UNION_ASSOC] THEN EXPAND_TAC "h'" THEN
5150       REPLICATE_TAC 2 (MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
5151        REPLICATE_TAC 2 (CONJ_TAC THENL
5152         [MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN
5153          EXISTS_TAC `interval[vec 0:real^1,vec 1] PCROSS (s:real^M->bool)` THEN
5154          REWRITE_TAC[SET_RULE `t UNION u SUBSET s UNION t UNION u`] THEN
5155          REWRITE_TAC[SUBSET_UNION; UNION_SUBSET; SUBSET_PCROSS] THEN
5156          REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; ENDS_IN_UNIT_INTERVAL] THEN
5157          ASM_REWRITE_TAC[SUBSET_REFL] THEN
5158          TRY(MATCH_MP_TAC CLOSED_IN_UNION THEN CONJ_TAC) THEN
5159          MATCH_MP_TAC CLOSED_IN_PCROSS THEN
5160          ASM_REWRITE_TAC[CLOSED_IN_REFL] THEN MATCH_MP_TAC CLOSED_SUBSET THEN
5161          REWRITE_TAC[SING_SUBSET; ENDS_IN_UNIT_INTERVAL; CLOSED_SING];
5162          ALL_TAC]) THEN
5163        REPEAT CONJ_TAC THENL
5164         [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
5165          MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
5166          SIMP_TAC[LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN
5167          ASM_REWRITE_TAC[IMAGE_SNDCART_PCROSS; NOT_INSERT_EMPTY];
5168          ASM_REWRITE_TAC[];
5169          REWRITE_TAC[FORALL_PASTECART; IN_UNION; PASTECART_IN_PCROSS] THEN
5170          REWRITE_TAC[FSTCART_PASTECART; IN_SING; SNDCART_PASTECART] THEN
5171          MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^M`] THEN
5172          ASM_CASES_TAC `x:real^1 = vec 0` THEN ASM_REWRITE_TAC[] THEN
5173          REWRITE_TAC[VEC_EQ; ARITH_EQ; ENDS_IN_UNIT_INTERVAL] THEN
5174           ASM_CASES_TAC `x:real^1 = vec 1` THEN ASM_REWRITE_TAC[]]);
5175       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN
5176       REWRITE_TAC[IN_UNION; PASTECART_IN_PCROSS; IN_SING; NOT_IN_EMPTY] THEN
5177       MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^M`] THEN
5178       REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN
5179       EXPAND_TAC "h'" THEN
5180       REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_SING] THEN
5181       REPEAT(COND_CASES_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]]) THEN
5182       STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
5183        `IMAGE f s SUBSET u ==> b IN s ==> f b IN u`)) THEN
5184       ASM_REWRITE_TAC[PASTECART_IN_PCROSS];
5185       MATCH_MP_TAC CLOSED_IN_UNION THEN CONJ_TAC THEN
5186       MATCH_MP_TAC CLOSED_IN_PCROSS THEN
5187       ASM_REWRITE_TAC[CLOSED_IN_REFL] THEN
5188       MATCH_MP_TAC CLOSED_SUBSET THEN
5189       REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; ENDS_IN_UNIT_INTERVAL] THEN
5190       SIMP_TAC[CLOSED_INSERT; CLOSED_EMPTY]];
5191     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC
5192      [`w:real^(1,M)finite_sum->bool`; `k:real^(1,M)finite_sum->real^N`] THEN
5193     STRIP_TAC] THEN
5194   MP_TAC(ISPECL [`interval[vec 0:real^1,vec 1]`;
5195                  `t:real^M->bool`; `s:real^M->bool`;
5196                  `w:real^(1,M)finite_sum->bool`]
5197         TUBE_LEMMA_GEN) THEN
5198   ASM_REWRITE_TAC[COMPACT_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN
5199   ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN
5200   X_GEN_TAC `t':real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5201   SIMP_TAC[HOMOTOPIC_WITH] THEN
5202   EXISTS_TAC `k:real^(1,M)finite_sum->real^N` THEN
5203   CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN
5204   CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5205   FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
5206   CONJ_TAC THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
5207   FIRST_X_ASSUM(fun th ->
5208     W(MP_TAC o PART_MATCH (lhs o snd o dest_imp) th o lhs o snd)) THEN
5209   REWRITE_TAC[IN_UNION; PASTECART_IN_PCROSS; IN_INSERT] THEN
5210   (ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC]) THEN
5211   EXPAND_TAC "h'" THEN
5212   REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_SING] THEN
5213   REWRITE_TAC[VEC_EQ; ARITH_EQ]);;
5214
5215 let HOMOTOPIC_ON_COMPONENTS_EQ = prove
5216  (`!s t f g:real^M->real^N.
5217         (locally connected s \/ compact s /\ ANR t)
5218         ==> (homotopic_with (\x. T) (s,t) f g <=>
5219              f continuous_on s /\ IMAGE f s SUBSET t /\
5220              g continuous_on s /\ IMAGE g s SUBSET t /\
5221              !c. c IN components s ==> homotopic_with (\x. T) (c,t) f g)`,
5222   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN
5223   MATCH_MP_TAC(TAUT `(q ==> r) /\ (r ==> (q <=> s)) ==> (q <=> r /\ s)`) THEN
5224   CONJ_TAC THENL
5225    [MESON_TAC[HOMOTOPIC_WITH_IMP_CONTINUOUS; HOMOTOPIC_WITH_IMP_SUBSET];
5226     ALL_TAC] THEN
5227   STRIP_TAC THEN EQ_TAC THENL
5228    [MESON_TAC[HOMOTOPIC_WITH_SUBSET_LEFT; IN_COMPONENTS_SUBSET];
5229     ALL_TAC] THEN
5230   DISCH_TAC THEN
5231   SUBGOAL_THEN
5232    `!c. c IN components s
5233         ==> ?u. c SUBSET u /\
5234                 closed_in (subtopology euclidean s) u /\
5235                 open_in (subtopology euclidean s) u /\
5236                 homotopic_with (\x. T) (u,t) (f:real^M->real^N) g`
5237   MP_TAC THENL
5238    [X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN
5239     FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
5240     FIRST_X_ASSUM DISJ_CASES_TAC THENL
5241      [EXISTS_TAC `c:real^M->bool` THEN
5242       ASM_SIMP_TAC[CLOSED_IN_COMPONENT; SUBSET_REFL;
5243                    OPEN_IN_COMPONENTS_LOCALLY_CONNECTED];
5244       FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN
5245       ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL
5246        [`f:real^M->real^N`; `g:real^M->real^N`;
5247         `s:real^M->bool`; `c:real^M->bool`; `t:real^N->bool`]
5248         HOMOTOPIC_NEIGHBOURHOOD_EXTENSION) THEN
5249       ASM_SIMP_TAC[CLOSED_IN_COMPONENT] THEN
5250       DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN
5251       FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
5252       DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` (STRIP_ASSUME_TAC o GSYM)) THEN
5253       MP_TAC(ISPECL [`s:real^M->bool`; `c:real^M->bool`; `v:real^M->bool`]
5254         SURA_BURA_CLOPEN_SUBSET) THEN
5255       ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_IMP_LOCALLY_COMPACT] THEN
5256       ANTS_TAC THENL
5257        [CONJ_TAC THENL [ASM_MESON_TAC[COMPACT_COMPONENTS]; ASM SET_TAC[]];
5258         MATCH_MP_TAC MONO_EXISTS] THEN
5259       X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN
5260       ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL
5261        [MATCH_MP_TAC CLOSED_SUBSET THEN
5262         ASM_MESON_TAC[COMPACT_IMP_CLOSED; OPEN_IN_IMP_SUBSET];
5263         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
5264          (REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_SUBSET_LEFT)) THEN
5265         FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
5266         ASM SET_TAC[]]];
5267     GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
5268     REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
5269     X_GEN_TAC `k:(real^M->bool)->(real^M->bool)` THEN DISCH_TAC THEN
5270     SUBGOAL_THEN
5271      `s = UNIONS (IMAGE k (components(s:real^M->bool)))`
5272      (fun th -> SUBST1_TAC th THEN ASSUME_TAC(SYM th))
5273     THENL
5274       [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
5275         [GEN_REWRITE_TAC LAND_CONV [UNIONS_COMPONENTS] THEN
5276          MATCH_MP_TAC UNIONS_MONO THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN
5277          ASM_MESON_TAC[];
5278          REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN
5279          ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]];
5280        MATCH_MP_TAC HOMOTOPIC_ON_CLOPEN_UNIONS THEN
5281        ASM_SIMP_TAC[FORALL_IN_IMAGE]]]);;
5282
5283 let INESSENTIAL_ON_COMPONENTS_EQ = prove
5284  (`!s t f:real^M->real^N.
5285         (locally connected s \/ compact s /\ ANR t) /\
5286         path_connected t
5287         ==> ((?a. homotopic_with (\x. T) (s,t) f (\x. a)) <=>
5288              f continuous_on s /\ IMAGE f s SUBSET t /\
5289              !c. c IN components s
5290                  ==> ?a. homotopic_with (\x. T) (c,t) f (\x. a))`,
5291   REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN
5292   DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
5293   MATCH_MP_TAC(TAUT `(q ==> r) /\ (r ==> (q <=> s)) ==> (q <=> r /\ s)`) THEN
5294   CONJ_TAC THENL
5295    [MESON_TAC[HOMOTOPIC_WITH_IMP_CONTINUOUS; HOMOTOPIC_WITH_IMP_SUBSET];
5296     STRIP_TAC] THEN
5297   FIRST_ASSUM(fun th ->
5298        REWRITE_TAC[MATCH_MP HOMOTOPIC_ON_COMPONENTS_EQ th]) THEN
5299   ASM_REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
5300   EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
5301   ASM_CASES_TAC `s:real^M->bool = {}` THEN
5302   ASM_SIMP_TAC[COMPONENTS_EMPTY; IMAGE_CLAUSES; NOT_IN_EMPTY;
5303                EMPTY_SUBSET] THEN
5304   DISCH_TAC THEN
5305   SUBGOAL_THEN `?c:real^M->bool. c IN components s` STRIP_ASSUME_TAC THENL
5306    [ASM_MESON_TAC[MEMBER_NOT_EMPTY; COMPONENTS_EQ_EMPTY]; ALL_TAC] THEN
5307   FIRST_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN
5308   ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN
5309   X_GEN_TAC `a:real^N` THEN
5310   DISCH_THEN(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
5311   FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN
5312   CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `d:real^M->bool`] THEN
5313   DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `d:real^M->bool`) THEN
5314   ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N` MP_TAC) THEN
5315   DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET th) THEN
5316         MP_TAC th) THEN
5317   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN
5318   REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN DISJ2_TAC THEN
5319   FIRST_X_ASSUM(MATCH_MP_TAC o
5320     REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]) THEN
5321   REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY)) THEN
5322   ASM SET_TAC[]);;
5323
5324 let COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS = prove
5325  (`!s:real^M->bool t:real^N->bool.
5326         (locally connected s \/ compact s /\ ANR t)
5327          ==> ((!f g. f continuous_on s /\ IMAGE f s SUBSET t /\
5328                      g continuous_on s /\ IMAGE g s SUBSET t
5329                      ==> homotopic_with (\x. T) (s,t) f g) <=>
5330               (!c. c IN components s
5331                    ==> (!f g. f continuous_on c /\ IMAGE f c SUBSET t /\
5332                               g continuous_on c /\ IMAGE g c SUBSET t
5333                               ==> homotopic_with (\x. T) (c,t) f g)))`,
5334   REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
5335    [MP_TAC(ISPECL [`g:real^M->real^N`; `s:real^M->bool`;
5336                    `c:real^M->bool`; `t:real^N->bool`]
5337         EXTENSION_FROM_COMPONENT) THEN
5338     MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`;
5339                    `c:real^M->bool`; `t:real^N->bool`]
5340         EXTENSION_FROM_COMPONENT) THEN
5341     ANTS_TAC THENL [ASM_MESON_TAC[ENR_IMP_ANR]; ALL_TAC] THEN
5342     DISCH_THEN(X_CHOOSE_THEN `f':real^M->real^N` STRIP_ASSUME_TAC) THEN
5343     ANTS_TAC THENL [ASM_MESON_TAC[ENR_IMP_ANR]; ALL_TAC] THEN
5344     DISCH_THEN(X_CHOOSE_THEN `g':real^M->real^N` STRIP_ASSUME_TAC) THEN
5345     FIRST_X_ASSUM(MP_TAC o SPECL
5346       [`f':real^M->real^N`; `g':real^M->real^N`]) THEN
5347     ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `c:real^M->bool` o MATCH_MP
5348        (REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_SUBSET_LEFT)) THEN
5349     ASM_SIMP_TAC[IN_COMPONENTS_SUBSET] THEN MATCH_MP_TAC
5350      (ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN
5351     ASM_SIMP_TAC[];
5352     FIRST_ASSUM(fun th ->
5353        REWRITE_TAC[MATCH_MP HOMOTOPIC_ON_COMPONENTS_EQ th]) THEN
5354     ASM_REWRITE_TAC[] THEN X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN
5355     FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN
5356     ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN
5357     FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
5358     REPEAT CONJ_TAC THEN
5359     TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
5360         CONTINUOUS_ON_SUBSET))) THEN
5361     ASM SET_TAC[]]);;
5362
5363 let COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS_NULL = prove
5364  (`!s:real^M->bool t:real^N->bool.
5365         (locally connected s \/ compact s /\ ANR t) /\ path_connected t
5366          ==> ((!f. f continuous_on s /\ IMAGE f s SUBSET t
5367                    ==> ?a. homotopic_with (\x. T) (s,t) f (\x. a)) <=>
5368               (!c. c IN components s
5369                    ==> (!f. f continuous_on c /\ IMAGE f c SUBSET t
5370                             ==> ?a. homotopic_with (\x. T) (c,t) f (\x. a))))`,
5371   REPEAT GEN_TAC THEN
5372   DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
5373   FIRST_ASSUM(MP_TAC o MATCH_MP COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS) THEN
5374   ASM_SIMP_TAC[HOMOTOPIC_TRIVIALITY]);;
5375
5376 (* ------------------------------------------------------------------------- *)
5377 (* A few simple lemmas about deformation retracts.                           *)
5378 (* ------------------------------------------------------------------------- *)
5379
5380 let DEFORMATION_RETRACT_IMP_HOMOTOPY_EQUIVALENT = prove
5381  (`!s t:real^N->bool.
5382         (?r. homotopic_with (\x. T) (s,s) (\x. x) r /\ retraction(s,t) r)
5383         ==> s homotopy_equivalent t`,
5384   REPEAT GEN_TAC THEN REWRITE_TAC[homotopy_equivalent] THEN
5385   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^N->real^N` THEN
5386   REWRITE_TAC[retraction] THEN STRIP_TAC THEN
5387   EXISTS_TAC `I:real^N->real^N` THEN REWRITE_TAC[I_O_ID] THEN
5388   ASM_REWRITE_TAC[I_DEF; CONTINUOUS_ON_ID; IMAGE_ID] THEN CONJ_TAC THENL
5389    [ASM_MESON_TAC[HOMOTOPIC_WITH_SYM]; ALL_TAC] THEN
5390   MATCH_MP_TAC HOMOTOPIC_WITH_EQUAL THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL
5391    [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]);;
5392
5393 let DEFORMATION_RETRACT = prove
5394  (`!s t:real^N->bool.
5395         (?r. homotopic_with (\x. T) (s,s) (\x. x) r /\ retraction(s,t) r) <=>
5396         t retract_of s /\
5397         ?f. homotopic_with (\x. T) (s,s) (\x. x) f /\ IMAGE f s SUBSET t`,
5398   REPEAT GEN_TAC THEN REWRITE_TAC[retract_of; retraction] THEN EQ_TAC THENL
5399    [REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real^N->real^N` THEN
5400     REPEAT STRIP_TAC THEN EXISTS_TAC `r:real^N->real^N` THEN ASM_REWRITE_TAC[];
5401     DISCH_THEN(CONJUNCTS_THEN2
5402      (X_CHOOSE_THEN `r:real^N->real^N` STRIP_ASSUME_TAC) MP_TAC) THEN
5403     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:real^N->real^N` THEN
5404     STRIP_TAC THEN EXISTS_TAC `r:real^N->real^N` THEN ASM_REWRITE_TAC[] THEN
5405     TRANS_TAC HOMOTOPIC_WITH_TRANS `f:real^N->real^N` THEN
5406     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN
5407     MAP_EVERY EXISTS_TAC
5408      [`(r:real^N->real^N) o (f:real^N->real^N)`;
5409       `(r:real^N->real^N) o (\x. x)`] THEN
5410     ASM_SIMP_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5411     MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN
5412     EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
5413      [ASM_MESON_TAC[HOMOTOPIC_WITH_SYM]; ASM SET_TAC[]]]);;
5414
5415 let DEFORMATION_RETRACT_OF_CONTRACTIBLE_SING = prove
5416  (`!s a:real^N.
5417         contractible s /\ a IN s
5418         ==> ?r. homotopic_with (\x. T) (s,s) (\x. x) r /\ retraction(s,{a}) r`,
5419   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[DEFORMATION_RETRACT; RETRACT_OF_SING] THEN
5420   EXISTS_TAC `(\x. a):real^N->real^N` THEN
5421   CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5422   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [contractible]) THEN
5423   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN GEN_TAC THEN
5424   DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
5425   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN
5426   REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN DISJ2_TAC THEN
5427   FIRST_X_ASSUM(MP_TAC o MATCH_MP CONTRACTIBLE_IMP_PATH_CONNECTED) THEN
5428   REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
5429   DISCH_THEN MATCH_MP_TAC THEN
5430   FIRST_X_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
5431   ASM SET_TAC[]);;
5432
5433 let HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_CONVEX = prove
5434  (`!s t a:real^N.
5435       convex s /\ bounded s /\ a IN relative_interior s /\
5436       convex t /\ relative_frontier s SUBSET t /\ t SUBSET affine hull s
5437       ==> (relative_frontier s) homotopy_equivalent (t DELETE a)`,
5438   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMOTOPY_EQUIVALENT_SYM] THEN
5439   MATCH_MP_TAC DEFORMATION_RETRACT_IMP_HOMOTOPY_EQUIVALENT THEN ASM_SIMP_TAC
5440    [RELATIVE_FRONTIER_DEFORMATION_RETRACT_OF_PUNCTURED_CONVEX]);;
5441
5442 let HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_AFFINE_HULL = prove
5443  (`!s a:real^N.
5444       convex s /\ bounded s /\ a IN relative_interior s
5445       ==> (relative_frontier s) homotopy_equivalent (affine hull s DELETE a)`,
5446   REPEAT STRIP_TAC THEN
5447   MATCH_MP_TAC HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_CONVEX THEN
5448   ASM_SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; SUBSET_REFL] THEN
5449   REWRITE_TAC[relative_frontier] THEN
5450   MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s DIFF t SUBSET u`) THEN
5451   REWRITE_TAC[CLOSURE_SUBSET_AFFINE_HULL]);;
5452
5453 (* ------------------------------------------------------------------------- *)
5454 (* Preservation of fixpoints under (more general notion of) retraction.      *)
5455 (* ------------------------------------------------------------------------- *)
5456
5457 let INVERTIBLE_FIXPOINT_PROPERTY = prove
5458  (`!s:real^M->bool t:real^N->bool i r.
5459      i continuous_on t /\ IMAGE i t SUBSET s /\
5460      r continuous_on s /\ IMAGE r s SUBSET t /\
5461      (!y. y IN t ==> (r(i(y)) = y))
5462      ==> (!f. f continuous_on s /\ IMAGE f s SUBSET s
5463               ==> ?x. x IN s /\ (f x = x))
5464          ==> !g. g continuous_on t /\ IMAGE g t SUBSET t
5465                  ==> ?y. y IN t /\ (g y = y)`,
5466   REPEAT STRIP_TAC THEN
5467   FIRST_X_ASSUM(MP_TAC o SPEC
5468    `(i:real^N->real^M) o (g:real^N->real^N) o (r:real^M->real^N)`) THEN
5469   ANTS_TAC THENL
5470    [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; CONTINUOUS_ON_COMPOSE; IMAGE_SUBSET;
5471                   SUBSET_TRANS; IMAGE_o];
5472     RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN
5473     REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]]);;
5474
5475 let HOMEOMORPHIC_FIXPOINT_PROPERTY = prove
5476  (`!s t. s homeomorphic t
5477          ==> ((!f. f continuous_on s /\ IMAGE f s SUBSET s
5478                    ==> ?x. x IN s /\ (f x = x)) <=>
5479               (!g. g continuous_on t /\ IMAGE g t SUBSET t
5480                    ==> ?y. y IN t /\ (g y = y)))`,
5481   REWRITE_TAC[homeomorphic; homeomorphism] THEN REPEAT STRIP_TAC THEN
5482   EQ_TAC THEN MATCH_MP_TAC INVERTIBLE_FIXPOINT_PROPERTY THEN
5483   ASM_MESON_TAC[SUBSET_REFL]);;
5484
5485 let RETRACT_FIXPOINT_PROPERTY = prove
5486  (`!s t:real^N->bool.
5487         t retract_of s /\
5488         (!f. f continuous_on s /\ IMAGE f s SUBSET s
5489              ==> ?x. x IN s /\ (f x = x))
5490         ==> !g. g continuous_on t /\ IMAGE g t SUBSET t
5491                 ==> ?y. y IN t /\ (g y = y)`,
5492   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
5493   MATCH_MP_TAC INVERTIBLE_FIXPOINT_PROPERTY THEN
5494   EXISTS_TAC `\x:real^N. x` THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN
5495   POP_ASSUM MP_TAC THEN REWRITE_TAC[retract_of] THEN
5496   MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REWRITE_TAC[retraction] THEN
5497   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE]);;
5498
5499 (* ------------------------------------------------------------------------- *)
5500 (* So the Brouwer theorem for any set with nonempty interior.                *)
5501 (* ------------------------------------------------------------------------- *)
5502
5503 let BROUWER_WEAK = prove
5504  (`!f:real^N->real^N s.
5505         compact s /\ convex s /\ ~(interior s = {}) /\
5506         f continuous_on s /\ IMAGE f s SUBSET s
5507         ==> ?x. x IN s /\ f x = x`,
5508   GEN_TAC THEN ONCE_REWRITE_TAC
5509    [TAUT `a /\ b /\ c /\ d ==> e <=> a /\ b /\ c ==> d ==> e`] THEN
5510   GEN_TAC THEN STRIP_TAC THEN
5511   MP_TAC(ISPECL [`interval[vec 0:real^N,vec 1]`; `s:real^N->bool`]
5512                 HOMEOMORPHIC_CONVEX_COMPACT) THEN
5513   ANTS_TAC THENL
5514    [ASM_REWRITE_TAC[CONVEX_INTERVAL; COMPACT_INTERVAL] THEN
5515     REWRITE_TAC[INTERIOR_CLOSED_INTERVAL; INTERVAL_EQ_EMPTY] THEN
5516     MESON_TAC[VEC_COMPONENT; REAL_ARITH `~(&1 <= &0)`];
5517     DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_FIXPOINT_PROPERTY) THEN
5518     REWRITE_TAC[BROUWER_CUBE] THEN SIMP_TAC[]]);;
5519
5520 (* ------------------------------------------------------------------------- *)
5521 (* And in particular for a closed ball.                                      *)
5522 (* ------------------------------------------------------------------------- *)
5523
5524 let BROUWER_BALL = prove
5525  (`!f:real^N->real^N a e.
5526         &0 < e /\
5527         f continuous_on cball(a,e) /\ IMAGE f (cball(a,e)) SUBSET (cball(a,e))
5528         ==> ?x. x IN cball(a,e) /\ (f x = x)`,
5529   ASM_SIMP_TAC[BROUWER_WEAK; CONVEX_CBALL; COMPACT_CBALL; INTERIOR_CBALL;
5530                REAL_LT_IMP_LE; REAL_NOT_LE; BALL_EQ_EMPTY]);;
5531
5532 (* ------------------------------------------------------------------------- *)
5533 (* Still more general form; could derive this directly without using the     *)
5534 (* rather involved HOMEOMORPHIC_CONVEX_COMPACT theorem, just using           *)
5535 (* a scaling and translation to put the set inside the unit cube.            *)
5536 (* ------------------------------------------------------------------------- *)
5537
5538 let BROUWER = prove
5539  (`!f:real^N->real^N s.
5540         compact s /\ convex s /\ ~(s = {}) /\
5541         f continuous_on s /\ IMAGE f s SUBSET s
5542         ==> ?x. x IN s /\ f x = x`,
5543   REPEAT STRIP_TAC THEN
5544   SUBGOAL_THEN `?e. &0 < e /\ s SUBSET cball(vec 0:real^N,e)`
5545   STRIP_ASSUME_TAC THENL
5546    [REWRITE_TAC[SUBSET; IN_CBALL; NORM_ARITH `dist(vec 0,x) = norm(x)`] THEN
5547     ASM_MESON_TAC[BOUNDED_POS; COMPACT_IMP_BOUNDED];
5548     ALL_TAC] THEN
5549   SUBGOAL_THEN
5550    `?x:real^N. x IN cball(vec 0,e) /\ (f o closest_point s) x = x`
5551   MP_TAC THENL
5552    [MATCH_MP_TAC BROUWER_BALL THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
5553      [REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
5554       ASM_SIMP_TAC[CONTINUOUS_ON_CLOSEST_POINT; COMPACT_IMP_CLOSED] THEN
5555       MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN
5556       ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE];
5557       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN
5558       REPEAT STRIP_TAC THEN
5559       REPEAT(FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET])) THEN
5560       REWRITE_TAC[o_THM; IN_IMAGE] THEN
5561       EXISTS_TAC `closest_point s x:real^N` THEN
5562       ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSEST_POINT_IN_SET]] THEN
5563     ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSEST_POINT_IN_SET];
5564     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN
5565     REWRITE_TAC[o_THM] THEN STRIP_TAC THEN
5566     RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN
5567     ASM_MESON_TAC[CLOSEST_POINT_SELF;
5568                   CLOSEST_POINT_IN_SET; COMPACT_IMP_CLOSED]]);;
5569
5570 (* ------------------------------------------------------------------------- *)
5571 (* So we get the no-retraction theorem, first for a ball, then more general. *)
5572 (* ------------------------------------------------------------------------- *)
5573
5574 let NO_RETRACTION_CBALL = prove
5575  (`!a:real^N e. &0 < e ==> ~(sphere(a,e) retract_of cball(a,e))`,
5576   REPEAT GEN_TAC THEN DISCH_TAC THEN
5577   DISCH_THEN(MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ]
5578     RETRACT_FIXPOINT_PROPERTY)) THEN
5579   ASM_SIMP_TAC[BROUWER_BALL] THEN REWRITE_TAC[NOT_FORALL_THM] THEN
5580   EXISTS_TAC `\x:real^N. &2 % a - x` THEN REWRITE_TAC[NOT_IMP] THEN
5581   SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN
5582   ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE] THEN
5583   SIMP_TAC[dist; VECTOR_ARITH `a - (&2 % a - x) = --(a - x)`; NORM_NEG] THEN
5584   REWRITE_TAC[VECTOR_ARITH `(&2 % a - y = y) <=> (a - y = vec 0)`] THEN
5585   ASM_MESON_TAC[NORM_0; REAL_LT_REFL]);;
5586
5587 let FRONTIER_SUBSET_RETRACTION = prove
5588  (`!s:real^N->bool t r.
5589         bounded s /\
5590         frontier s SUBSET t /\
5591         r continuous_on (closure s) /\
5592         IMAGE r s SUBSET t /\
5593         (!x. x IN t ==> r x = x)
5594         ==> s SUBSET t`,
5595   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
5596   REWRITE_TAC[SET_RULE `~(s SUBSET t) <=> ?x. x IN s /\ ~(x IN t)`] THEN
5597   REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN
5598   REPLICATE_TAC 3 GEN_TAC THEN X_GEN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN
5599   ABBREV_TAC `q = \z:real^N. if z IN closure s then r(z) else z` THEN
5600   SUBGOAL_THEN
5601     `(q:real^N->real^N) continuous_on
5602       closure(s) UNION closure((:real^N) DIFF s)`
5603   MP_TAC THENL
5604    [EXPAND_TAC "q" THEN MATCH_MP_TAC CONTINUOUS_ON_CASES THEN
5605     ASM_REWRITE_TAC[CLOSED_CLOSURE; CONTINUOUS_ON_ID] THEN
5606     REWRITE_TAC[TAUT `p /\ ~p <=> F`] THEN X_GEN_TAC `z:real^N` THEN
5607     REWRITE_TAC[CLOSURE_COMPLEMENT; IN_DIFF; IN_UNIV] THEN STRIP_TAC THEN
5608     FIRST_X_ASSUM MATCH_MP_TAC THEN
5609     RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; frontier; IN_DIFF]) THEN
5610     ASM_MESON_TAC[];
5611     ALL_TAC] THEN
5612   SUBGOAL_THEN `closure(s) UNION closure((:real^N) DIFF s) = (:real^N)`
5613   SUBST1_TAC THENL
5614    [MATCH_MP_TAC(SET_RULE
5615      `s SUBSET closure s /\ t SUBSET closure t /\ s UNION t = UNIV
5616       ==> closure s UNION closure t = UNIV`) THEN
5617     REWRITE_TAC[CLOSURE_SUBSET] THEN SET_TAC[];
5618     DISCH_TAC] THEN
5619   FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o SPEC `a:real^N` o
5620     MATCH_MP BOUNDED_SUBSET_BALL o MATCH_MP BOUNDED_CLOSURE) THEN
5621   SUBGOAL_THEN `!x. ~((q:real^N->real^N) x = a)` ASSUME_TAC THENL
5622    [GEN_TAC THEN EXPAND_TAC "q" THEN COND_CASES_TAC THENL
5623      [ASM_CASES_TAC `(x:real^N) IN s` THENL [ASM SET_TAC[]; ALL_TAC] THEN
5624       SUBGOAL_THEN `(x:real^N) IN t` (fun th -> ASM_MESON_TAC[th]) THEN
5625       UNDISCH_TAC `frontier(s:real^N->bool) SUBSET t` THEN
5626       REWRITE_TAC[SUBSET; frontier; IN_DIFF] THEN
5627       DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET];
5628       ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET; CLOSURE_SUBSET]];
5629     ALL_TAC] THEN
5630   MP_TAC(ISPECL [`a:real^N`; `B:real`] NO_RETRACTION_CBALL) THEN
5631   ASM_REWRITE_TAC[retract_of; GSYM FRONTIER_CBALL] THEN
5632   EXISTS_TAC `(\y. a + B / norm(y - a) % (y - a)) o (q:real^N->real^N)` THEN
5633   REWRITE_TAC[retraction; FRONTIER_SUBSET_EQ; CLOSED_CBALL] THEN
5634   REWRITE_TAC[FRONTIER_CBALL; SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
5635   REWRITE_TAC[IN_SPHERE; DIST_0] THEN REPEAT CONJ_TAC THENL
5636    [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
5637      [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; ALL_TAC] THEN
5638     MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
5639     MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
5640     SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN
5641     REWRITE_TAC[o_DEF; real_div; LIFT_CMUL] THEN
5642     MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
5643     MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
5644     ASM_REWRITE_TAC[FORALL_IN_IMAGE; NORM_EQ_0; VECTOR_SUB_EQ] THEN
5645     SUBGOAL_THEN `(\x:real^N. lift(norm(x - a))) = (lift o norm) o (\x. x - a)`
5646     SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM]; ALL_TAC] THEN
5647     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
5648     ASM_SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN
5649     REWRITE_TAC[CONTINUOUS_ON_LIFT_NORM];
5650     REWRITE_TAC[o_THM; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM;
5651                 NORM_ARITH `dist(a,a + b) = norm b`] THEN
5652     ASM_SIMP_TAC[REAL_DIV_RMUL; VECTOR_SUB_EQ; NORM_EQ_0] THEN
5653     ASM_REAL_ARITH_TAC;
5654     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[o_THM] THEN
5655     EXPAND_TAC "q" THEN REWRITE_TAC[] THEN COND_CASES_TAC THENL
5656      [RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_BALL]) THEN
5657       ASM_MESON_TAC[REAL_LT_REFL];
5658       REWRITE_TAC[NORM_ARITH `norm(x - a) = dist(a,x)`] THEN
5659       ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; VECTOR_MUL_LID] THEN
5660       VECTOR_ARITH_TAC]]);;
5661
5662 let NO_RETRACTION_FRONTIER_BOUNDED = prove
5663  (`!s:real^N->bool.
5664         bounded s /\ ~(interior s = {}) ==> ~((frontier s) retract_of s)`,
5665   GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[retract_of; retraction] THEN
5666   REWRITE_TAC[FRONTIER_SUBSET_EQ] THEN
5667   DISCH_THEN(X_CHOOSE_THEN `r:real^N->real^N` STRIP_ASSUME_TAC) THEN
5668   MP_TAC(ISPECL [`s:real^N->bool`; `frontier s:real^N->bool`;
5669                  `r:real^N->real^N`] FRONTIER_SUBSET_RETRACTION) THEN
5670   ASM_SIMP_TAC[CLOSURE_CLOSED; SUBSET_REFL] THEN REWRITE_TAC[frontier] THEN
5671   MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN ASM SET_TAC[]);;
5672
5673 let COMPACT_SUBSET_FRONTIER_RETRACTION = prove
5674  (`!f:real^N->real^N s.
5675         compact s /\ f continuous_on s /\ (!x. x IN frontier s ==> f x = x)
5676         ==> s SUBSET IMAGE f s`,
5677   REPEAT STRIP_TAC THEN
5678   MP_TAC(ISPECL [`s UNION (IMAGE f s):real^N->bool`; `vec 0:real^N`]
5679     BOUNDED_SUBSET_BALL) THEN
5680   ASM_SIMP_TAC[BOUNDED_UNION; COMPACT_IMP_BOUNDED;
5681                COMPACT_CONTINUOUS_IMAGE; UNION_SUBSET] THEN
5682   DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
5683   ABBREV_TAC `g = \x:real^N. if x IN s then f(x) else x` THEN
5684   SUBGOAL_THEN `(g:real^N->real^N) continuous_on (:real^N)` ASSUME_TAC THENL
5685    [SUBGOAL_THEN `(:real^N) = s UNION closure((:real^N) DIFF s)` SUBST1_TAC
5686     THENL
5687      [MATCH_MP_TAC(SET_RULE `UNIV DIFF s SUBSET t ==> UNIV = s UNION t`) THEN
5688       REWRITE_TAC[CLOSURE_SUBSET];
5689       ALL_TAC] THEN
5690     EXPAND_TAC "g" THEN MATCH_MP_TAC CONTINUOUS_ON_CASES THEN
5691     ASM_SIMP_TAC[CLOSED_CLOSURE; CONTINUOUS_ON_ID; COMPACT_IMP_CLOSED] THEN
5692     REWRITE_TAC[CLOSURE_COMPLEMENT; IN_DIFF; IN_UNIV] THEN
5693     REWRITE_TAC[TAUT `p /\ ~p <=> F`] THEN REPEAT STRIP_TAC THEN
5694     FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[frontier; IN_DIFF] THEN
5695     ASM_SIMP_TAC[CLOSURE_CLOSED; COMPACT_IMP_CLOSED];
5696     ALL_TAC] THEN
5697   REWRITE_TAC[SUBSET] THEN X_GEN_TAC `p:real^N` THEN DISCH_TAC THEN
5698   SUBGOAL_THEN
5699    `?h:real^N->real^N.
5700         retraction (UNIV DELETE p,sphere(vec 0,r)) h`
5701   STRIP_ASSUME_TAC THENL
5702    [REWRITE_TAC[GSYM retract_of] THEN
5703     MATCH_MP_TAC SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE_GEN THEN
5704     ASM SET_TAC[];
5705     ALL_TAC] THEN
5706   MP_TAC(ISPECL [`vec 0:real^N`; `r:real`] NO_RETRACTION_CBALL) THEN
5707   ASM_REWRITE_TAC[retract_of; NOT_EXISTS_THM] THEN
5708   DISCH_THEN(MP_TAC o SPEC `(h:real^N->real^N) o (g:real^N->real^N)`) THEN
5709   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[] THEN
5710   REWRITE_TAC[retraction] THEN
5711   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retraction]) THEN
5712   SIMP_TAC[SUBSET; IN_SPHERE; IN_CBALL; REAL_EQ_IMP_LE] THEN
5713   REWRITE_TAC[FORALL_IN_IMAGE; IN_DELETE; IN_UNIV; o_THM] THEN STRIP_TAC THEN
5714   SUBGOAL_THEN
5715    `!x. x IN cball (vec 0,r) ==> ~((g:real^N->real^N) x = p)`
5716   ASSUME_TAC THENL
5717    [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXPAND_TAC "g" THEN
5718     COND_CASES_TAC THEN ASM SET_TAC[];
5719     ALL_TAC] THEN
5720   ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THENL
5721    [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
5722     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
5723         CONTINUOUS_ON_SUBSET)) THEN
5724     ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; IN_DELETE];
5725     SUBGOAL_THEN `(g:real^N->real^N) x = x` (fun th -> ASM_SIMP_TAC[th]) THEN
5726     EXPAND_TAC "g" THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
5727     ASM_MESON_TAC[IN_BALL; REAL_LT_REFL; SUBSET]]);;
5728
5729 let NOT_ABSOLUTE_RETRACT_COBOUNDED = prove
5730  (`!s. bounded s /\ ((:real^N) DIFF s) retract_of (:real^N) ==> s = {}`,
5731   GEN_TAC THEN DISCH_TAC THEN
5732   MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> F) ==> s = {}`) THEN
5733   X_GEN_TAC `a:real^N` THEN POP_ASSUM MP_TAC THEN
5734   GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN
5735   FIRST_X_ASSUM(MP_TAC o SPEC `vec 0:real^N` o
5736     MATCH_MP BOUNDED_SUBSET_BALL) THEN
5737   DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
5738   FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP NO_RETRACTION_CBALL) THEN
5739   REWRITE_TAC[] THEN MATCH_MP_TAC RETRACT_OF_SUBSET THEN
5740   EXISTS_TAC `(:real^N)` THEN SIMP_TAC[SUBSET_UNIV; SPHERE_SUBSET_CBALL] THEN
5741   MATCH_MP_TAC RETRACT_OF_TRANS THEN EXISTS_TAC `(:real^N) DIFF s` THEN
5742   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC RETRACT_OF_SUBSET THEN
5743   EXISTS_TAC `(:real^N) DELETE (vec 0)` THEN
5744   ASM_SIMP_TAC[SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE] THEN
5745   CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5746   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
5747   REWRITE_TAC[SUBSET; IN_BALL; IN_SPHERE; IN_DIFF; IN_UNIV] THEN
5748   MESON_TAC[REAL_LT_REFL]);;
5749
5750 let CONTRACTIBLE_SPHERE = prove
5751  (`!a:real^N r. contractible(sphere(a,r)) <=> r <= &0`,
5752   REPEAT GEN_TAC THEN REWRITE_TAC[contractible; GSYM REAL_NOT_LT] THEN
5753   REWRITE_TAC[NULLHOMOTOPIC_FROM_SPHERE_EXTENSION] THEN
5754   ASM_CASES_TAC `&0 < r` THEN ASM_REWRITE_TAC[] THENL
5755    [FIRST_ASSUM(MP_TAC o ISPEC `a:real^N` o MATCH_MP NO_RETRACTION_CBALL) THEN
5756     SIMP_TAC[retract_of; retraction; SPHERE_SUBSET_CBALL];
5757     RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN
5758     EXISTS_TAC `\x:real^N. x` THEN REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID] THEN
5759     REWRITE_TAC[SUBSET; IN_CBALL; IN_SPHERE; IN_ELIM_THM] THEN
5760     POP_ASSUM MP_TAC THEN NORM_ARITH_TAC]);;
5761
5762 (* ------------------------------------------------------------------------- *)
5763 (* Some more theorems about connectivity of retract complements.             *)
5764 (* ------------------------------------------------------------------------- *)
5765
5766 let BOUNDED_COMPONENT_RETRACT_COMPLEMENT_MEETS = prove
5767  (`!s t c. closed s /\ s retract_of t /\
5768            c IN components((:real^N) DIFF s) /\ bounded c
5769            ==> ~(c SUBSET t)`,
5770   REPEAT STRIP_TAC THEN
5771   FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN
5772   SUBGOAL_THEN `frontier(c:real^N->bool) SUBSET s` ASSUME_TAC THENL
5773    [TRANS_TAC SUBSET_TRANS `frontier((:real^N) DIFF s)` THEN
5774     ASM_SIMP_TAC[FRONTIER_OF_COMPONENTS_SUBSET] THEN
5775     REWRITE_TAC[FRONTIER_COMPLEMENT] THEN
5776     ASM_SIMP_TAC[frontier; CLOSURE_CLOSED] THEN SET_TAC[];
5777     ALL_TAC] THEN
5778   SUBGOAL_THEN `closure(c:real^N->bool) SUBSET t` ASSUME_TAC THENL
5779    [REWRITE_TAC[CLOSURE_UNION_FRONTIER] THEN ASM SET_TAC[]; ALL_TAC] THEN
5780   SUBGOAL_THEN `(c:real^N->bool) SUBSET s` ASSUME_TAC THENL
5781    [MATCH_MP_TAC FRONTIER_SUBSET_RETRACTION THEN
5782     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN
5783     REWRITE_TAC[retraction] THEN MATCH_MP_TAC MONO_EXISTS THEN
5784     X_GEN_TAC `r:real^N->real^N` THEN STRIP_TAC THEN
5785     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
5786      [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]];
5787     FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
5788     FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN
5789     ASM SET_TAC[]]);;
5790
5791 let COMPONENT_RETRACT_COMPLEMENT_MEETS = prove
5792  (`!s t c. closed s /\ s retract_of t /\ bounded t /\
5793            c IN components((:real^N) DIFF s)
5794            ==> ~(c SUBSET t)`,
5795   REPEAT STRIP_TAC THEN
5796   FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN
5797   ASM_CASES_TAC `bounded(c:real^N->bool)` THENL
5798    [ASM_MESON_TAC[BOUNDED_COMPONENT_RETRACT_COMPLEMENT_MEETS];
5799     ASM_MESON_TAC[BOUNDED_SUBSET]]);;
5800
5801 let FINITE_COMPLEMENT_ENR_COMPONENTS = prove
5802  (`!s. compact s /\ ENR s ==> FINITE(components((:real^N) DIFF s))`,
5803   GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL
5804    [ASM_SIMP_TAC[DIFF_EMPTY] THEN
5805     MESON_TAC[COMPONENTS_EQ_SING; CONNECTED_UNIV; UNIV_NOT_EMPTY; FINITE_SING];
5806     ALL_TAC] THEN
5807   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
5808   ASM_SIMP_TAC[ENR_BOUNDED; COMPACT_IMP_BOUNDED] THEN
5809   DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
5810   SUBGOAL_THEN
5811    `!c. c IN components((:real^N) DIFF s) ==> ~(c SUBSET u)`
5812   ASSUME_TAC THENL
5813    [GEN_TAC THEN DISCH_TAC THEN
5814     MATCH_MP_TAC COMPONENT_RETRACT_COMPLEMENT_MEETS THEN
5815     ASM_MESON_TAC[COMPACT_IMP_CLOSED];
5816     ALL_TAC] THEN
5817   MP_TAC(ISPECL [`u:real^N->bool`; `vec 0:real^N`]
5818         BOUNDED_SUBSET_CBALL) THEN
5819   ASM_REWRITE_TAC[] THEN
5820   DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
5821   MP_TAC(ISPEC `cball(vec 0:real^N,r) DIFF u` COMPACT_EQ_HEINE_BOREL) THEN
5822   ASM_SIMP_TAC[COMPACT_DIFF; COMPACT_CBALL] THEN
5823   DISCH_THEN(MP_TAC o SPEC `components((:real^N) DIFF s)`) THEN
5824   REWRITE_TAC[GSYM UNIONS_COMPONENTS] THEN
5825   FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN
5826   ANTS_TAC THENL
5827    [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5828     ASM_MESON_TAC[OPEN_COMPONENTS; closed; COMPACT_IMP_CLOSED];
5829     DISCH_THEN(X_CHOOSE_THEN `cs:(real^N->bool)->bool` STRIP_ASSUME_TAC)] THEN
5830   SUBGOAL_THEN `components((:real^N) DIFF s) = cs`
5831    (fun th -> REWRITE_TAC[th]) THEN
5832   ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
5833   REWRITE_TAC[SUBSET] THEN X_GEN_TAC `c:real^N->bool` THEN
5834   DISCH_TAC THEN
5835   SUBGOAL_THEN `~(c INTER (cball(vec 0:real^N,r) DIFF u) = {})` MP_TAC THENL
5836    [SUBGOAL_THEN `~(c INTER frontier(u:real^N->bool) = {})` MP_TAC THENL
5837      [MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN
5838       CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN
5839       ASM_SIMP_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN
5840       ONCE_REWRITE_TAC[INTER_COMM] THEN
5841       W(MP_TAC o PART_MATCH (rand o rand)
5842         OPEN_INTER_CLOSURE_EQ_EMPTY o rand o snd) THEN
5843       ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
5844       REWRITE_TAC[CLOSURE_UNION_FRONTIER] THEN
5845       MATCH_MP_TAC(SET_RULE
5846        `~(t = {}) /\ t SUBSET u
5847         ==> ~(u INTER (s UNION t) = {})`) THEN
5848       ASM_REWRITE_TAC[FRONTIER_EQ_EMPTY; DE_MORGAN_THM; GSYM CONJ_ASSOC] THEN
5849       CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]; ALL_TAC] THEN
5850       FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
5851       CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5852       TRANS_TAC SUBSET_TRANS `frontier((:real^N) DIFF s)` THEN
5853       ASM_SIMP_TAC[FRONTIER_OF_COMPONENTS_SUBSET] THEN
5854       REWRITE_TAC[FRONTIER_COMPLEMENT] THEN
5855       ASM_SIMP_TAC[frontier; CLOSURE_CLOSED; COMPACT_IMP_CLOSED] THEN
5856       ASM SET_TAC[];
5857       MATCH_MP_TAC(SET_RULE `s SUBSET t
5858         ==> ~(c INTER s = {}) ==> ~(c INTER t = {})`) THEN
5859       ASM_SIMP_TAC[frontier; INTERIOR_OPEN] THEN
5860       MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF u SUBSET t DIFF u`) THEN
5861       MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_REWRITE_TAC[CLOSED_CBALL]];
5862     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; LEFT_IMP_EXISTS_THM] THEN
5863     X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
5864     SUBGOAL_THEN `(x:real^N) IN UNIONS cs` MP_TAC THENL
5865      [ASM SET_TAC[]; ALL_TAC] THEN
5866     REWRITE_TAC[IN_UNIONS; LEFT_IMP_EXISTS_THM] THEN
5867     X_GEN_TAC `c':real^N->bool` THEN STRIP_TAC THEN
5868     MP_TAC(ISPECL [`(:real^N) DIFF s`; `c:real^N->bool`; `c':real^N->bool`]
5869         COMPONENTS_NONOVERLAP) THEN
5870     ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5871     ASM_CASES_TAC `c:real^N->bool = c'` THEN ASM_REWRITE_TAC[] THEN
5872     ASM SET_TAC[]]);;
5873
5874 let FINITE_COMPLEMENT_ANR_COMPONENTS = prove
5875  (`!s. compact s /\ ANR s ==> FINITE(components((:real^N) DIFF s))`,
5876   MESON_TAC[FINITE_COMPLEMENT_ENR_COMPONENTS; ENR_ANR;
5877             COMPACT_IMP_CLOSED; CLOSED_IMP_LOCALLY_COMPACT]);;
5878
5879 let CARD_LE_RETRACT_COMPLEMENT_COMPONENTS = prove
5880  (`!s t. compact s /\ s retract_of t /\ bounded t
5881          ==> components((:real^N) DIFF s) <=_c components((:real^N) DIFF t)`,
5882   REPEAT STRIP_TAC THEN
5883   FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN
5884   MATCH_MP_TAC(ISPEC `SUBSET` CARD_LE_RELATIONAL_FULL) THEN
5885   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
5886    [ALL_TAC;
5887     MAP_EVERY X_GEN_TAC
5888      [`d:real^N->bool`; `c:real^N->bool`; `c':real^N->bool`] THEN
5889     STRIP_TAC THEN MP_TAC(ISPEC `(:real^N) DIFF s` COMPONENTS_EQ) THEN
5890     ASM_SIMP_TAC[] THEN
5891     ASM_CASES_TAC `d:real^N->bool = {}` THENL [ALL_TAC; ASM SET_TAC[]] THEN
5892     ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]] THEN
5893   X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN
5894   SUBGOAL_THEN `~((u:real^N->bool) SUBSET t)` MP_TAC THENL
5895    [MATCH_MP_TAC COMPONENT_RETRACT_COMPLEMENT_MEETS THEN
5896     ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED];
5897     ALL_TAC] THEN
5898   REWRITE_TAC[SET_RULE `~(s SUBSET t) <=> ?p. p IN s /\ ~(p IN t)`] THEN
5899   REWRITE_TAC[components; EXISTS_IN_GSPEC; IN_UNIV; IN_DIFF] THEN
5900   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:real^N` THEN
5901   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5902   SUBGOAL_THEN `u = connected_component ((:real^N) DIFF s) p`
5903   SUBST_ALL_TAC THENL
5904    [MP_TAC(ISPECL [`(:real^N) DIFF s`; `u:real^N->bool`]
5905       COMPONENTS_EQ) THEN
5906     ASM_REWRITE_TAC[] THEN
5907     REWRITE_TAC[components; FORALL_IN_GSPEC; IN_DIFF; IN_UNIV] THEN
5908     DISCH_THEN(MP_TAC o SPEC `p:real^N`) THEN
5909     ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN
5910     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `p:real^N` THEN
5911     ASM_REWRITE_TAC[IN_INTER] THEN REWRITE_TAC[IN] THEN
5912     REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM SET_TAC[];
5913     MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN ASM SET_TAC[]]);;
5914
5915 let CONNECTED_RETRACT_COMPLEMENT = prove
5916  (`!s t. compact s /\ s retract_of t /\ bounded t /\
5917          connected((:real^N) DIFF t)
5918          ==> connected((:real^N) DIFF s)`,
5919   REPEAT GEN_TAC THEN
5920   REWRITE_TAC[CONNECTED_EQ_COMPONENTS_SUBSET_SING_EXISTS] THEN
5921   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5922   DISCH_THEN(X_CHOOSE_TAC `u:real^N->bool`) THEN
5923   SUBGOAL_THEN `FINITE(components((:real^N) DIFF t))` ASSUME_TAC THENL
5924    [ASM_MESON_TAC[FINITE_SUBSET; FINITE_SING]; ALL_TAC] THEN
5925   MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`]
5926         CARD_LE_RETRACT_COMPLEMENT_COMPONENTS) THEN
5927   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
5928   SUBGOAL_THEN
5929    `FINITE(components((:real^N) DIFF s)) /\
5930     CARD(components((:real^N) DIFF s)) <= CARD(components((:real^N) DIFF t))`
5931   STRIP_ASSUME_TAC THENL
5932    [ASM_MESON_TAC[CARD_LE_CARD_IMP; CARD_LE_FINITE]; ALL_TAC] THEN
5933   REWRITE_TAC[SET_RULE `s SUBSET {a} <=> s = {} \/ s = {a}`] THEN
5934   REWRITE_TAC[EXISTS_OR_THM] THEN
5935   REWRITE_TAC[GSYM HAS_SIZE_0; GSYM(HAS_SIZE_CONV `s HAS_SIZE 1`)] THEN
5936   ASM_REWRITE_TAC[HAS_SIZE; ARITH_RULE `n = 0 \/ n = 1 <=> n <= 1`] THEN
5937   TRANS_TAC LE_TRANS `CARD{u:real^N->bool}` THEN CONJ_TAC THENL
5938    [TRANS_TAC LE_TRANS `CARD(components((:real^N) DIFF t))` THEN
5939     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CARD_SUBSET THEN
5940     ASM_REWRITE_TAC[FINITE_SING];
5941     SIMP_TAC[CARD_CLAUSES; FINITE_EMPTY; NOT_IN_EMPTY] THEN ARITH_TAC]);;
5942
5943 (* ------------------------------------------------------------------------- *)
5944 (* We also get fixpoint properties for suitable ANRs.                        *)
5945 (* ------------------------------------------------------------------------- *)
5946
5947 let BROUWER_INESSENTIAL_ANR = prove
5948  (`!f:real^N->real^N s.
5949         compact s /\ ~(s = {}) /\ ANR s /\
5950         f continuous_on s /\ IMAGE f s SUBSET s /\
5951         (?a. homotopic_with (\x. T) (s,s) f (\x. a))
5952         ==> ?x. x IN s /\ f x = x`,
5953   ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN REPEAT STRIP_TAC THEN
5954   FIRST_ASSUM(X_CHOOSE_TAC `r:real` o SPEC `vec 0:real^N` o
5955     MATCH_MP BOUNDED_SUBSET_CBALL o MATCH_MP COMPACT_IMP_BOUNDED) THEN
5956   MP_TAC(ISPECL
5957    [`(\x. a):real^N->real^N`; `f:real^N->real^N`;
5958     `s:real^N->bool`; `cball(vec 0:real^N,r)`; `s:real^N->bool`]
5959     BORSUK_HOMOTOPY_EXTENSION) THEN
5960   ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_SUBSET;
5961                CONTINUOUS_ON_CONST; CLOSED_CBALL] THEN
5962   FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
5963   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5964   DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC) THEN
5965   MP_TAC(ISPECL [`g:real^N->real^N`; `cball(vec 0:real^N,r)`]
5966         BROUWER) THEN
5967   ASM_SIMP_TAC[COMPACT_CBALL; CONVEX_CBALL; CBALL_EQ_EMPTY] THEN
5968   ASM_SIMP_TAC[REAL_ARITH `&0 < r ==> ~(r < &0)`] THEN ASM SET_TAC[]);;
5969
5970 let BROUWER_CONTRACTIBLE_ANR = prove
5971  (`!f:real^N->real^N s.
5972         compact s /\ contractible s /\ ~(s = {}) /\ ANR s /\
5973         f continuous_on s /\ IMAGE f s SUBSET s
5974         ==> ?x. x IN s /\ f x = x`,
5975   REPEAT STRIP_TAC THEN MATCH_MP_TAC BROUWER_INESSENTIAL_ANR THEN
5976   ASM_REWRITE_TAC[] THEN
5977   MATCH_MP_TAC NULLHOMOTOPIC_FROM_CONTRACTIBLE THEN ASM_REWRITE_TAC[]);;
5978
5979 let FIXED_POINT_INESSENTIAL_SPHERE_MAP = prove
5980  (`!f a:real^N r c.
5981      &0 < r /\ homotopic_with (\x. T) (sphere(a,r),sphere(a,r)) f (\x. c)
5982      ==> ?x. x IN sphere(a,r) /\ f x = x`,
5983   REPEAT STRIP_TAC THEN MATCH_MP_TAC BROUWER_INESSENTIAL_ANR THEN
5984   REWRITE_TAC[ANR_SPHERE] THEN
5985   ASM_SIMP_TAC[SPHERE_EQ_EMPTY; COMPACT_SPHERE; OPEN_DELETE; OPEN_UNIV] THEN
5986   FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN
5987   FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
5988   ASM_SIMP_TAC[REAL_NOT_LT; REAL_LT_IMP_LE] THEN ASM_MESON_TAC[]);;
5989
5990 let BROUWER_AR = prove
5991  (`!f s:real^N->bool.
5992         compact s /\ AR s /\ f continuous_on s /\ IMAGE f s SUBSET s
5993          ==> ?x. x IN s /\ f x = x`,
5994   REWRITE_TAC[AR_ANR] THEN
5995   REPEAT STRIP_TAC THEN MATCH_MP_TAC BROUWER_CONTRACTIBLE_ANR THEN
5996   ASM_REWRITE_TAC[]);;
5997
5998 let BROUWER_ABSOLUTE_RETRACT = prove
5999  (`!f s. compact s /\ s retract_of (:real^N) /\
6000          f continuous_on s /\ IMAGE f s SUBSET s
6001          ==> ?x. x IN s /\ f x = x`,
6002   REWRITE_TAC[RETRACT_OF_UNIV; AR_ANR] THEN
6003   REPEAT STRIP_TAC THEN MATCH_MP_TAC BROUWER_CONTRACTIBLE_ANR THEN
6004   ASM_REWRITE_TAC[]);;
6005
6006 (* ------------------------------------------------------------------------- *)
6007 (* This interresting lemma is no longer used for Schauder but we keep it.    *)
6008 (* ------------------------------------------------------------------------- *)
6009
6010 let SCHAUDER_PROJECTION = prove
6011  (`!s:real^N->bool e.
6012         compact s /\ &0 < e
6013         ==> ?t f. FINITE t /\ t SUBSET s /\
6014                   f continuous_on s /\ IMAGE f s SUBSET (convex hull t) /\
6015                   (!x. x IN s ==> norm(f x - x) < e)`,
6016   REPEAT STRIP_TAC THEN FIRST_ASSUM
6017    (MP_TAC o SPEC `e:real` o MATCH_MP COMPACT_IMP_TOTALLY_BOUNDED) THEN
6018   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
6019   X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6020   ABBREV_TAC `g = \p x:real^N. max (&0) (e - norm(x - p))` THEN
6021   SUBGOAL_THEN
6022    `!x. x IN s ==> &0 < sum t (\p. (g:real^N->real^N->real) p x)`
6023   ASSUME_TAC THENL
6024    [REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_POS_LT THEN
6025     ASM_REWRITE_TAC[] THEN EXPAND_TAC "g" THEN
6026     REWRITE_TAC[REAL_ARITH `&0 <= max (&0) b`] THEN
6027     REWRITE_TAC[REAL_ARITH `&0 < max (&0) b <=> &0 < b`; REAL_SUB_LT] THEN
6028     UNDISCH_TAC `s SUBSET UNIONS (IMAGE (\x:real^N. ball(x,e)) t)` THEN
6029     REWRITE_TAC[SUBSET; UNIONS_IMAGE; IN_BALL; IN_ELIM_THM] THEN
6030     DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[dist; NORM_SUB];
6031     ALL_TAC] THEN
6032   EXISTS_TAC
6033    `(\x. inv(sum t (\p. g p x)) % vsum t (\p. g p x % p)):real^N->real^N` THEN
6034   REPEAT CONJ_TAC THENL
6035    [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL
6036      [MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
6037       ASM_SIMP_TAC[REAL_LT_IMP_NZ; LIFT_SUM; o_DEF];
6038       ALL_TAC] THEN
6039     MATCH_MP_TAC CONTINUOUS_ON_VSUM THEN ASM_REWRITE_TAC[] THEN
6040     X_GEN_TAC `y:real^N` THEN DISCH_TAC THENL
6041      [ALL_TAC; MATCH_MP_TAC CONTINUOUS_ON_MUL] THEN
6042     REWRITE_TAC[o_DEF; CONTINUOUS_ON_CONST] THEN
6043     EXPAND_TAC "g" THEN
6044     (SUBGOAL_THEN
6045       `(\x. lift (max (&0) (e - norm (x - y:real^N)))) =
6046        (\x. (lambda i. max (lift(&0)$i) (lift(e - norm (x - y))$i)))`
6047      SUBST1_TAC THENL
6048       [SIMP_TAC[CART_EQ; LAMBDA_BETA; FUN_EQ_THM] THEN
6049        REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP];
6050        MATCH_MP_TAC CONTINUOUS_ON_MAX] THEN
6051      REWRITE_TAC[CONTINUOUS_ON_CONST; LIFT_SUB] THEN
6052      MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
6053      REWRITE_TAC[ONCE_REWRITE_RULE[NORM_SUB] (GSYM dist)] THEN
6054      REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_DIST]);
6055     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; GSYM VSUM_LMUL; VECTOR_MUL_ASSOC] THEN
6056     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC CONVEX_VSUM THEN
6057     ASM_SIMP_TAC[HULL_INC; CONVEX_CONVEX_HULL; SUM_LMUL] THEN
6058     ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_MUL_LINV] THEN
6059     X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN
6060     ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE] THEN
6061     EXPAND_TAC "g" THEN REAL_ARITH_TAC;
6062     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
6063     REWRITE_TAC[] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN
6064     REWRITE_TAC[REWRITE_RULE[dist] (GSYM IN_BALL)] THEN
6065     REWRITE_TAC[GSYM VSUM_LMUL; VECTOR_MUL_ASSOC] THEN
6066     MATCH_MP_TAC CONVEX_VSUM_STRONG THEN
6067     ASM_REWRITE_TAC[CONVEX_BALL; SUM_LMUL; REAL_ENTIRE] THEN
6068     ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_MUL_LINV; REAL_LT_INV_EQ;
6069                  REAL_LE_MUL_EQ] THEN
6070     X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
6071     EXPAND_TAC "g" THEN REWRITE_TAC[IN_BALL; dist; NORM_SUB] THEN
6072     REAL_ARITH_TAC]);;
6073
6074 (* ------------------------------------------------------------------------- *)
6075 (* Some other related fixed-point theorems.                                  *)
6076 (* ------------------------------------------------------------------------- *)
6077
6078 let BROUWER_FACTOR_THROUGH_AR = prove
6079  (`!f:real^M->real^N g:real^N->real^M s t.
6080         f continuous_on s /\ IMAGE f s SUBSET t /\
6081         g continuous_on t /\ IMAGE g t SUBSET s /\
6082         compact s /\ AR t
6083         ==> ?x. x IN s /\ g(f x) = x`,
6084   REPEAT STRIP_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o
6085     GEN_REWRITE_RULE I [COMPACT_EQ_BOUNDED_CLOSED]) THEN
6086   FIRST_ASSUM(MP_TAC o SPEC `a:real^M` o MATCH_MP BOUNDED_SUBSET_CBALL) THEN
6087   DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
6088   MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`;
6089                  `s:real^M->bool`; `t:real^N->bool`]
6090         AR_IMP_ABSOLUTE_EXTENSOR) THEN
6091   ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN
6092   DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` STRIP_ASSUME_TAC) THEN
6093   MP_TAC(ISPECL [`(g:real^N->real^M) o (h:real^M->real^N)`;
6094                  `a:real^M`; `r:real`] BROUWER_BALL) THEN
6095   ASM_REWRITE_TAC[o_THM; IMAGE_o] THEN
6096   ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
6097   CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
6098   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
6099   ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV; IMAGE_SUBSET]);;
6100
6101 let BROUWER_ABSOLUTE_RETRACT_GEN = prove
6102  (`!f s:real^N->bool.
6103            s retract_of (:real^N) /\
6104            f continuous_on s /\ IMAGE f s SUBSET s /\ bounded(IMAGE f s)
6105            ==> ?x. x IN s /\ f x = x`,
6106   REWRITE_TAC[RETRACT_OF_UNIV] THEN REPEAT STRIP_TAC THEN
6107   MP_TAC(ISPECL [`\x:real^N. x`; `f:real^N->real^N`;
6108                  `closure(IMAGE (f:real^N->real^N) s)`; `s:real^N->bool`]
6109         BROUWER_FACTOR_THROUGH_AR) THEN
6110   ASM_REWRITE_TAC[CONTINUOUS_ON_ID; COMPACT_CLOSURE; IMAGE_ID] THEN
6111   REWRITE_TAC[CLOSURE_SUBSET] THEN
6112   MATCH_MP_TAC(TAUT `(p /\ q ==> r) /\ p ==> (p ==> q) ==> r`) THEN
6113   CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC CLOSURE_MINIMAL] THEN
6114   ASM_MESON_TAC[RETRACT_OF_CLOSED; CLOSED_UNIV]);;
6115
6116 let SCHAUDER_GEN = prove
6117  (`!f s t:real^N->bool.
6118      AR s /\ f continuous_on s /\ IMAGE f s SUBSET t /\ t SUBSET s /\ compact t
6119      ==> ?x. x IN t /\ f x = x`,
6120   REPEAT STRIP_TAC THEN
6121   MP_TAC(ISPECL [`\x:real^N. x`; `f:real^N->real^N`;
6122                  `t:real^N->bool`; `s:real^N->bool`]
6123         BROUWER_FACTOR_THROUGH_AR) THEN
6124   ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID]);;
6125
6126 let SCHAUDER = prove
6127  (`!f s t:real^N->bool.
6128         convex s /\ ~(s = {}) /\ t SUBSET s /\ compact t /\
6129         f continuous_on s /\ IMAGE f s SUBSET t
6130         ==> ?x. x IN s /\ f x = x`,
6131   REPEAT STRIP_TAC THEN
6132   MP_TAC(ISPECL [`f:real^N->real^N`; `s:real^N->bool`; `t:real^N->bool`]
6133         SCHAUDER_GEN) THEN
6134   ASM_SIMP_TAC[CONVEX_IMP_AR] THEN ASM SET_TAC[]);;
6135
6136 let SCHAUDER_UNIV = prove
6137  (`!f:real^N->real^N.
6138         f continuous_on (:real^N) /\ bounded (IMAGE f (:real^N))
6139         ==> ?x. f x = x`,
6140   REPEAT STRIP_TAC THEN
6141   MP_TAC(ISPECL [`f:real^N->real^N`; `(:real^N)`;
6142                  `closure(IMAGE (f:real^N->real^N) (:real^N))`] SCHAUDER) THEN
6143   ASM_REWRITE_TAC[UNIV_NOT_EMPTY; CONVEX_UNIV; COMPACT_CLOSURE; IN_UNIV] THEN
6144   REWRITE_TAC[SUBSET_UNIV; CLOSURE_SUBSET]);;
6145
6146 let ROTHE = prove
6147  (`!f s:real^N->bool.
6148         closed s /\ convex s /\ ~(s = {}) /\
6149         f continuous_on s /\ bounded(IMAGE f s) /\
6150         IMAGE f (frontier s) SUBSET s
6151         ==> ?x. x IN s /\ f x = x`,
6152   REPEAT STRIP_TAC THEN
6153   MP_TAC(ISPECL [`s:real^N->bool`; `(:real^N)`]
6154     ABSOLUTE_RETRACTION_CONVEX_CLOSED) THEN
6155   ASM_REWRITE_TAC[retraction; SUBSET_UNIV] THEN
6156   DISCH_THEN(X_CHOOSE_THEN `r:real^N->real^N` STRIP_ASSUME_TAC) THEN
6157   MP_TAC(ISPECL
6158    [`(r:real^N->real^N) o (f:real^N->real^N)`; `s:real^N->bool`;
6159     `IMAGE (r:real^N->real^N) (closure(IMAGE (f:real^N->real^N) s))`]
6160    SCHAUDER) THEN
6161   ANTS_TAC THENL
6162    [ASM_SIMP_TAC[CLOSURE_SUBSET; IMAGE_SUBSET; IMAGE_o] THEN
6163     CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL
6164      [MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
6165       ASM_REWRITE_TAC[COMPACT_CLOSURE];
6166       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE] THEN
6167     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV];
6168     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN
6169     REWRITE_TAC[o_THM] THEN STRIP_TAC THEN ASM SET_TAC[]]);;
6170
6171 (* ------------------------------------------------------------------------- *)
6172 (* Bijections between intervals.                                             *)
6173 (* ------------------------------------------------------------------------- *)
6174
6175 let interval_bij = new_definition
6176  `interval_bij (a:real^N,b:real^N) (u:real^N,v:real^N) (x:real^N) =
6177     (lambda i. u$i + (x$i - a$i) / (b$i - a$i) * (v$i - u$i)):real^N`;;
6178
6179 let INTERVAL_BIJ_AFFINE = prove
6180  (`interval_bij (a,b) (u,v) =
6181         \x. (lambda i. (v$i - u$i) / (b$i - a$i) * x$i) +
6182             (lambda i. u$i - (v$i - u$i) / (b$i - a$i) * a$i)`,
6183   SIMP_TAC[FUN_EQ_THM; CART_EQ; VECTOR_ADD_COMPONENT; LAMBDA_BETA;
6184            interval_bij] THEN
6185   REAL_ARITH_TAC);;
6186
6187 let CONTINUOUS_INTERVAL_BIJ = prove
6188  (`!a b u v x. (interval_bij (a:real^N,b:real^N) (u:real^N,v:real^N))
6189                   continuous at x`,
6190   REPEAT GEN_TAC THEN REWRITE_TAC[INTERVAL_BIJ_AFFINE] THEN
6191   MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN
6192   MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
6193   SIMP_TAC[linear; CART_EQ; LAMBDA_BETA;
6194            VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
6195   REAL_ARITH_TAC);;
6196
6197 let CONTINUOUS_ON_INTERVAL_BIJ = prove
6198  (`!a b u v s. interval_bij (a,b) (u,v) continuous_on s`,
6199   REPEAT GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
6200   REWRITE_TAC[CONTINUOUS_INTERVAL_BIJ]);;
6201
6202 let IN_INTERVAL_INTERVAL_BIJ = prove
6203  (`!a b u v x:real^N.
6204         x IN interval[a,b] /\ ~(interval[u,v] = {})
6205         ==> (interval_bij (a,b) (u,v) x) IN interval[u,v]`,
6206   SIMP_TAC[IN_INTERVAL; interval_bij; LAMBDA_BETA; INTERVAL_NE_EMPTY] THEN
6207   REWRITE_TAC[REAL_ARITH `u <= u + x <=> &0 <= x`;
6208               REAL_ARITH `u + x <= v <=> x <= &1 * (v - u)`] THEN
6209   REPEAT STRIP_TAC THENL
6210    [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THEN
6211     TRY(MATCH_MP_TAC REAL_LE_DIV) THEN
6212     ASM_SIMP_TAC[REAL_SUB_LE] THEN ASM_MESON_TAC[REAL_LE_TRANS];
6213     MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_SUB_LE] THEN
6214     SUBGOAL_THEN `(a:real^N)$i <= (b:real^N)$i` MP_TAC THENL
6215      [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN
6216     GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN STRIP_TAC THENL
6217      [ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_SUB_LT] THEN
6218       ASM_SIMP_TAC[REAL_ARITH `a <= x /\ x <= b ==> x - a <= &1 * (b - a)`];
6219       ASM_REWRITE_TAC[real_div; REAL_SUB_REFL; REAL_INV_0] THEN
6220       REAL_ARITH_TAC]]);;
6221
6222 let INTERVAL_BIJ_BIJ = prove
6223  (`!a b u v x:real^N.
6224         (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i < b$i /\ u$i < v$i)
6225         ==> interval_bij (a,b) (u,v) (interval_bij (u,v) (a,b) x) = x`,
6226   SIMP_TAC[interval_bij; CART_EQ; LAMBDA_BETA; REAL_ADD_SUB] THEN
6227   REPEAT GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN
6228   MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
6229   REWRITE_TAC[] THEN CONV_TAC REAL_FIELD);;
6230
6231 (* ------------------------------------------------------------------------- *)
6232 (* Fashoda meet theorem.                                                     *)
6233 (* ------------------------------------------------------------------------- *)
6234
6235 let INFNORM_2 = prove
6236  (`infnorm (x:real^2) = max (abs(x$1)) (abs(x$2))`,
6237   REWRITE_TAC[infnorm; INFNORM_SET_IMAGE; NUMSEG_CONV `1..2`; DIMINDEX_2] THEN
6238   REWRITE_TAC[IMAGE_CLAUSES; GSYM REAL_MAX_SUP]);;
6239
6240 let INFNORM_EQ_1_2 = prove
6241  (`infnorm (x:real^2) = &1 <=>
6242         abs(x$1) <= &1 /\ abs(x$2) <= &1 /\
6243         (x$1 = -- &1 \/ x$1 = &1 \/ x$2 = -- &1 \/ x$2 = &1)`,
6244   REWRITE_TAC[INFNORM_2] THEN REAL_ARITH_TAC);;
6245
6246 let INFNORM_EQ_1_IMP = prove
6247  (`infnorm (x:real^2) = &1 ==> abs(x$1) <= &1 /\ abs(x$2) <= &1`,
6248   SIMP_TAC[INFNORM_EQ_1_2]);;
6249
6250 let FASHODA_UNIT = prove
6251  (`!f:real^1->real^2 g:real^1->real^2.
6252         IMAGE f (interval[--vec 1,vec 1]) SUBSET interval[--vec 1,vec 1] /\
6253         IMAGE g (interval[--vec 1,vec 1]) SUBSET interval[--vec 1,vec 1] /\
6254         f continuous_on interval[--vec 1,vec 1] /\
6255         g continuous_on interval[--vec 1,vec 1] /\
6256         f(--vec 1)$1 = -- &1 /\ f(vec 1)$1 = &1 /\
6257         g(--vec 1)$2 = -- &1 /\ g(vec 1)$2 = &1
6258         ==> ?s t. s IN interval[--vec 1,vec 1] /\
6259                   t IN interval[--vec 1,vec 1] /\
6260                   f(s) = g(t)`,
6261   REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN
6262   DISCH_THEN(MP_TAC o REWRITE_RULE[NOT_EXISTS_THM]) THEN
6263   REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN DISCH_TAC THEN
6264   ABBREV_TAC `sqprojection = \z:real^2. inv(infnorm z) % z` THEN
6265   ABBREV_TAC `(negatex:real^2->real^2) = \x. vector[--(x$1); x$2]` THEN
6266   SUBGOAL_THEN `!z:real^2. infnorm(negatex z:real^2) = infnorm z` ASSUME_TAC
6267   THENL
6268    [EXPAND_TAC "negatex" THEN SIMP_TAC[VECTOR_2; INFNORM_2] THEN
6269     REAL_ARITH_TAC;
6270     ALL_TAC] THEN
6271   SUBGOAL_THEN
6272    `!z. ~(z = vec 0) ==> infnorm((sqprojection:real^2->real^2) z) = &1`
6273   ASSUME_TAC THENL
6274    [EXPAND_TAC "sqprojection" THEN
6275     REWRITE_TAC[INFNORM_MUL; REAL_ABS_INFNORM; REAL_ABS_INV] THEN
6276     SIMP_TAC[REAL_MUL_LINV; INFNORM_EQ_0];
6277     ALL_TAC] THEN
6278   MP_TAC(ISPECL [`(\w. (negatex:real^2->real^2)
6279                        (sqprojection(f(lift(w$1)) - g(lift(w$2)):real^2)))
6280                   :real^2->real^2`;
6281                  `interval[--vec 1,vec 1]:real^2->bool`]
6282          BROUWER_WEAK) THEN
6283   REWRITE_TAC[NOT_IMP; COMPACT_INTERVAL; CONVEX_INTERVAL] THEN
6284   REPEAT CONJ_TAC THENL
6285    [REWRITE_TAC[INTERIOR_CLOSED_INTERVAL; INTERVAL_NE_EMPTY] THEN
6286     SIMP_TAC[VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN REAL_ARITH_TAC;
6287     MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN CONJ_TAC THENL
6288      [ALL_TAC;
6289       MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN EXPAND_TAC "negatex" THEN
6290       SIMP_TAC[linear; VECTOR_2; CART_EQ; FORALL_2; DIMINDEX_2;
6291                VECTOR_MUL_COMPONENT; VECTOR_NEG_COMPONENT;
6292                VECTOR_ADD_COMPONENT; ARITH] THEN
6293       REAL_ARITH_TAC] THEN
6294     MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN CONJ_TAC THENL
6295      [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN CONJ_TAC THEN
6296       MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN
6297       SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT; DIMINDEX_2; ARITH] THEN
6298       MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
6299       EXISTS_TAC `interval[--vec 1:real^1,vec 1]`;
6300       MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
6301       EXPAND_TAC "sqprojection" THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN
6302       X_GEN_TAC `x:real^2` THEN STRIP_TAC THEN
6303       MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[CONTINUOUS_AT_ID] THEN
6304       GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_DEF] THEN
6305       MATCH_MP_TAC CONTINUOUS_AT_INV THEN
6306       REWRITE_TAC[CONTINUOUS_AT_LIFT_INFNORM; INFNORM_EQ_0; VECTOR_SUB_EQ] THEN
6307       FIRST_X_ASSUM MATCH_MP_TAC THEN
6308       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL])] THEN
6309     ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN
6310     SIMP_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2; VEC_COMPONENT; ARITH;
6311              VECTOR_NEG_COMPONENT; DROP_NEG; DROP_VEC; LIFT_DROP];
6312     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
6313     X_GEN_TAC `x:real^2` THEN STRIP_TAC THEN
6314     SIMP_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2; REAL_BOUNDS_LE;
6315              VECTOR_NEG_COMPONENT; VEC_COMPONENT; ARITH] THEN
6316     MATCH_MP_TAC INFNORM_EQ_1_IMP THEN ASM_REWRITE_TAC[] THEN
6317     FIRST_X_ASSUM MATCH_MP_TAC THEN
6318     REWRITE_TAC[VECTOR_SUB_EQ] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
6319     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL]) THEN
6320     ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN
6321     SIMP_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2; VEC_COMPONENT; ARITH;
6322              VECTOR_NEG_COMPONENT; DROP_NEG; DROP_VEC; LIFT_DROP];
6323     ALL_TAC] THEN
6324   DISCH_THEN(X_CHOOSE_THEN `x:real^2` STRIP_ASSUME_TAC) THEN
6325   SUBGOAL_THEN `infnorm(x:real^2) = &1` MP_TAC THENL
6326    [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV)
6327      [SYM th]) THEN
6328     ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
6329     REWRITE_TAC[VECTOR_SUB_EQ] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
6330     REWRITE_TAC[IN_INTERVAL_1] THEN
6331     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL]) THEN
6332     SIMP_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2; VEC_COMPONENT; ARITH;
6333              VECTOR_NEG_COMPONENT; DROP_NEG; DROP_VEC; LIFT_DROP];
6334     ALL_TAC] THEN
6335   SUBGOAL_THEN
6336    `(!x i. 1 <= i /\ i <= 2 /\ ~(x = vec 0)
6337            ==> (&0 < ((sqprojection:real^2->real^2) x)$i <=> &0 < x$i)) /\
6338     (!x i. 1 <= i /\ i <= 2 /\ ~(x = vec 0)
6339            ==> ((sqprojection x)$i < &0 <=> x$i < &0))`
6340   STRIP_ASSUME_TAC THENL
6341    [EXPAND_TAC "sqprojection" THEN
6342     SIMP_TAC[VECTOR_MUL_COMPONENT; DIMINDEX_2; ARITH] THEN
6343     REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div)] THEN
6344     SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; INFNORM_POS_LT] THEN
6345     REWRITE_TAC[REAL_MUL_LZERO];
6346     ALL_TAC] THEN
6347   REWRITE_TAC[INFNORM_EQ_1_2; CONJ_ASSOC] THEN
6348   DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC
6349    (REPEAT_TCL DISJ_CASES_THEN (fun th -> ASSUME_TAC th THEN MP_TAC th))) THEN
6350   MAP_EVERY EXPAND_TAC ["x"; "negatex"] THEN REWRITE_TAC[VECTOR_2] THENL
6351    [DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `--x = -- &1 ==> &0 < x`));
6352     DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `--x = &1 ==> x < &0`));
6353     DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `x = -- &1 ==> x < &0`));
6354     DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `x = &1 ==> &0 < x`))] THEN
6355   W(fun (_,w) -> FIRST_X_ASSUM(fun th ->
6356    MP_TAC(PART_MATCH (lhs o rand) th (lhand w)))) THEN
6357   (ANTS_TAC THENL
6358     [REWRITE_TAC[VECTOR_SUB_EQ; ARITH] THEN
6359      FIRST_X_ASSUM MATCH_MP_TAC THEN
6360      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL]) THEN
6361      ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN
6362      SIMP_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2; VEC_COMPONENT; ARITH;
6363               VECTOR_NEG_COMPONENT; DROP_NEG; DROP_VEC; LIFT_DROP] THEN
6364      REAL_ARITH_TAC;
6365      DISCH_THEN SUBST1_TAC]) THEN
6366   ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; DIMINDEX_2; ARITH;
6367                LIFT_NEG; LIFT_NUM]
6368   THENL
6369    [MATCH_MP_TAC(REAL_ARITH
6370      `abs(x$1) <= &1 /\ abs(x$2) <= &1 ==> ~(&0 < -- &1 - x$1)`);
6371     MATCH_MP_TAC(REAL_ARITH
6372      `abs(x$1) <= &1 /\ abs(x$2) <= &1 ==> ~(&1 - x$1 < &0)`);
6373     MATCH_MP_TAC(REAL_ARITH
6374      `abs(x$1) <= &1 /\ abs(x$2) <= &1 ==> ~(x$2 - -- &1 < &0)`);
6375     MATCH_MP_TAC(REAL_ARITH
6376      `abs(x$1) <= &1 /\ abs(x$2) <= &1 ==> ~(&0 < x$2 - &1)`)] THEN
6377   (SUBGOAL_THEN `!z:real^2. abs(z$1) <= &1 /\ abs(z$2) <= &1 <=>
6378                            z IN interval[--vec 1,vec 1]`
6379     (fun th -> REWRITE_TAC[th]) THENL
6380     [SIMP_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2; VEC_COMPONENT; ARITH;
6381               VECTOR_NEG_COMPONENT; DROP_NEG; DROP_VEC; LIFT_DROP] THEN
6382      REAL_ARITH_TAC;
6383      ALL_TAC]) THEN
6384   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
6385    `IMAGE f s SUBSET t ==> x IN s ==> f x IN t`)) THEN
6386   REWRITE_TAC[IN_INTERVAL_1; DROP_NEG; DROP_VEC; LIFT_DROP] THEN
6387   ASM_REWRITE_TAC[REAL_BOUNDS_LE]);;
6388
6389 let FASHODA_UNIT_PATH = prove
6390  (`!f:real^1->real^2 g:real^1->real^2.
6391         path f /\ path g /\
6392         path_image f SUBSET interval[--vec 1,vec 1] /\
6393         path_image g SUBSET interval[--vec 1,vec 1] /\
6394         (pathstart f)$1 = -- &1 /\ (pathfinish f)$1 = &1 /\
6395         (pathstart g)$2 = -- &1 /\ (pathfinish g)$2 = &1
6396         ==> ?z. z IN path_image f /\ z IN path_image g`,
6397   SIMP_TAC[path; path_image; pathstart; pathfinish] THEN REPEAT STRIP_TAC THEN
6398   ABBREV_TAC `iscale = \z:real^1. inv(&2) % (z + vec 1)` THEN
6399   MP_TAC(ISPECL
6400    [`(f:real^1->real^2) o (iscale:real^1->real^1)`;
6401     `(g:real^1->real^2) o (iscale:real^1->real^1)`]
6402    FASHODA_UNIT) THEN
6403   SUBGOAL_THEN
6404    `IMAGE (iscale:real^1->real^1) (interval[--vec 1,vec 1])
6405     SUBSET interval[vec 0,vec 1]`
6406   ASSUME_TAC THENL
6407    [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN EXPAND_TAC "iscale" THEN
6408     REWRITE_TAC[IN_INTERVAL_1; DROP_NEG; DROP_VEC; DROP_CMUL; DROP_ADD] THEN
6409     REAL_ARITH_TAC;
6410     ALL_TAC] THEN
6411   SUBGOAL_THEN `(iscale:real^1->real^1) continuous_on interval [--vec 1,vec 1]`
6412   ASSUME_TAC THENL
6413    [EXPAND_TAC "iscale" THEN
6414     SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; CONTINUOUS_ON_ADD;
6415              CONTINUOUS_ON_CONST];
6416     ALL_TAC] THEN
6417   ASM_REWRITE_TAC[IMAGE_o] THEN ANTS_TAC THENL
6418    [REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
6419     REPLICATE_TAC 2 (CONJ_TAC THENL
6420      [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
6421       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
6422       ALL_TAC]) THEN
6423     EXPAND_TAC "iscale" THEN REWRITE_TAC[o_THM] THEN
6424     ASM_REWRITE_TAC[VECTOR_ARITH `inv(&2) % (--x + x) = vec 0`;
6425                     VECTOR_ARITH `inv(&2) % (x + x) = x`];
6426     REWRITE_TAC[o_THM; LEFT_IMP_EXISTS_THM; IN_IMAGE] THEN ASM SET_TAC[]]);;
6427
6428 let FASHODA = prove
6429  (`!f g a b:real^2.
6430         path f /\ path g /\
6431         path_image f SUBSET interval[a,b] /\
6432         path_image g SUBSET interval[a,b] /\
6433         (pathstart f)$1 = a$1 /\ (pathfinish f)$1 = b$1 /\
6434         (pathstart g)$2 = a$2 /\ (pathfinish g)$2 = b$2
6435         ==> ?z. z IN path_image f /\ z IN path_image g`,
6436   REPEAT STRIP_TAC THEN
6437   SUBGOAL_THEN `~(interval[a:real^2,b] = {})` MP_TAC THENL
6438    [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
6439      `s SUBSET t ==> ~(s = {}) ==> ~(t = {})`)) THEN
6440     REWRITE_TAC[PATH_IMAGE_NONEMPTY];
6441     ALL_TAC] THEN
6442   REWRITE_TAC[INTERVAL_NE_EMPTY; DIMINDEX_2; FORALL_2] THEN STRIP_TAC THEN
6443   MP_TAC(ASSUME `(a:real^2)$1 <= (b:real^2)$1`) THEN
6444   REWRITE_TAC[REAL_ARITH `a <= b <=> b = a \/ a < b`] THEN STRIP_TAC THENL
6445    [SUBGOAL_THEN
6446       `?z:real^2. z IN path_image g /\ z$2 = (pathstart f:real^2)$2`
6447     MP_TAC THENL
6448      [MATCH_MP_TAC CONNECTED_IVT_COMPONENT THEN
6449       MAP_EVERY EXISTS_TAC [`pathstart(g:real^1->real^2)`;
6450                             `pathfinish(g:real^1->real^2)`] THEN
6451       ASM_SIMP_TAC[CONNECTED_PATH_IMAGE; PATHSTART_IN_PATH_IMAGE; REAL_LE_REFL;
6452                    PATHFINISH_IN_PATH_IMAGE; DIMINDEX_2; ARITH] THEN
6453       UNDISCH_TAC `path_image f SUBSET interval[a:real^2,b]` THEN
6454       REWRITE_TAC[SUBSET; path_image; IN_INTERVAL_1; FORALL_IN_IMAGE] THEN
6455       DISCH_THEN(MP_TAC o SPEC `vec 0:real^1`) THEN SIMP_TAC[pathstart] THEN
6456       SIMP_TAC[DROP_VEC; REAL_POS; IN_INTERVAL; FORALL_2; DIMINDEX_2];
6457       ALL_TAC] THEN
6458     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^2` THEN
6459     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[path_image; IN_IMAGE] THEN
6460     EXISTS_TAC `vec 0:real^1` THEN
6461     REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS] THEN
6462     ASM_REWRITE_TAC[CART_EQ; FORALL_2; DIMINDEX_2; pathstart] THEN
6463     SUBGOAL_THEN
6464      `(z:real^2) IN interval[a,b] /\ f(vec 0:real^1) IN interval[a,b]`
6465     MP_TAC THENL
6466      [ASM_MESON_TAC[SUBSET; path_image; IN_IMAGE; PATHSTART_IN_PATH_IMAGE;
6467                     pathstart];
6468       ASM_REWRITE_TAC[IN_INTERVAL; FORALL_2; DIMINDEX_2] THEN REAL_ARITH_TAC];
6469     ALL_TAC] THEN
6470   MP_TAC(ASSUME `(a:real^2)$2 <= (b:real^2)$2`) THEN
6471   REWRITE_TAC[REAL_ARITH `a <= b <=> b = a \/ a < b`] THEN STRIP_TAC THENL
6472    [SUBGOAL_THEN
6473       `?z:real^2. z IN path_image f /\ z$1 = (pathstart g:real^2)$1`
6474     MP_TAC THENL
6475      [MATCH_MP_TAC CONNECTED_IVT_COMPONENT THEN
6476       MAP_EVERY EXISTS_TAC [`pathstart(f:real^1->real^2)`;
6477                             `pathfinish(f:real^1->real^2)`] THEN
6478       ASM_SIMP_TAC[CONNECTED_PATH_IMAGE; PATHSTART_IN_PATH_IMAGE; REAL_LE_REFL;
6479                    PATHFINISH_IN_PATH_IMAGE; DIMINDEX_2; ARITH] THEN
6480       UNDISCH_TAC `path_image g SUBSET interval[a:real^2,b]` THEN
6481       REWRITE_TAC[SUBSET; path_image; IN_INTERVAL_1; FORALL_IN_IMAGE] THEN
6482       DISCH_THEN(MP_TAC o SPEC `vec 0:real^1`) THEN SIMP_TAC[pathstart] THEN
6483       SIMP_TAC[DROP_VEC; REAL_POS; IN_INTERVAL; FORALL_2; DIMINDEX_2];
6484       ALL_TAC] THEN
6485     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^2` THEN
6486     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[path_image; IN_IMAGE] THEN
6487     EXISTS_TAC `vec 0:real^1` THEN
6488     REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS] THEN
6489     ASM_REWRITE_TAC[CART_EQ; FORALL_2; DIMINDEX_2; pathstart] THEN
6490     SUBGOAL_THEN
6491      `(z:real^2) IN interval[a,b] /\ g(vec 0:real^1) IN interval[a,b]`
6492     MP_TAC THENL
6493      [ASM_MESON_TAC[SUBSET; path_image; IN_IMAGE; PATHSTART_IN_PATH_IMAGE;
6494                     pathstart];
6495       ASM_REWRITE_TAC[IN_INTERVAL; FORALL_2; DIMINDEX_2] THEN REAL_ARITH_TAC];
6496     ALL_TAC] THEN
6497   MP_TAC(ISPECL
6498    [`interval_bij (a,b) (--vec 1,vec 1) o (f:real^1->real^2)`;
6499     `interval_bij (a,b) (--vec 1,vec 1) o (g:real^1->real^2)`]
6500    FASHODA_UNIT_PATH) THEN
6501   RULE_ASSUM_TAC(REWRITE_RULE[path; path_image; pathstart; pathfinish]) THEN
6502   ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish; o_THM] THEN
6503   ANTS_TAC THENL
6504    [ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; CONTINUOUS_ON_INTERVAL_BIJ] THEN
6505     REWRITE_TAC[IMAGE_o] THEN REPLICATE_TAC 2 (CONJ_TAC THENL
6506      [REWRITE_TAC[SUBSET] THEN ONCE_REWRITE_TAC[FORALL_IN_IMAGE] THEN
6507       REPEAT STRIP_TAC THEN MATCH_MP_TAC IN_INTERVAL_INTERVAL_BIJ THEN
6508       SIMP_TAC[INTERVAL_NE_EMPTY; VECTOR_NEG_COMPONENT; VEC_COMPONENT] THEN
6509       CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM SET_TAC[];
6510       ALL_TAC]) THEN
6511     ASM_SIMP_TAC[interval_bij; LAMBDA_BETA; DIMINDEX_2; ARITH] THEN
6512     ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; REAL_SUB_LT] THEN
6513     REWRITE_TAC[real_div; REAL_SUB_REFL; REAL_MUL_LZERO] THEN
6514     SIMP_TAC[VECTOR_NEG_COMPONENT; VEC_COMPONENT; DIMINDEX_2; ARITH] THEN
6515     CONV_TAC REAL_RAT_REDUCE_CONV;
6516     ALL_TAC] THEN
6517   DISCH_THEN(X_CHOOSE_THEN `z:real^2`
6518    (fun th -> EXISTS_TAC `interval_bij (--vec 1,vec 1) (a,b) (z:real^2)` THEN
6519               MP_TAC th)) THEN
6520   MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN REWRITE_TAC[IMAGE_o] THEN
6521   MATCH_MP_TAC(SET_RULE
6522    `(!x. x IN s ==> g(f(x)) = x) ==> x IN IMAGE f s ==> g x IN s`) THEN
6523   REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERVAL_BIJ_BIJ THEN
6524   ASM_SIMP_TAC[FORALL_2; DIMINDEX_2; VECTOR_NEG_COMPONENT; VEC_COMPONENT;
6525                ARITH] THEN
6526   CONV_TAC REAL_RAT_REDUCE_CONV);;
6527
6528 (* ------------------------------------------------------------------------- *)
6529 (* Some slightly ad hoc lemmas I use below                                   *)
6530 (* ------------------------------------------------------------------------- *)
6531
6532 let SEGMENT_VERTICAL = prove
6533  (`!a:real^2 b:real^2 x:real^2.
6534       a$1 = b$1
6535       ==> (x IN segment[a,b] <=>
6536            x$1 = a$1 /\ x$1 = b$1 /\
6537            (a$2 <= x$2 /\ x$2 <= b$2 \/ b$2 <= x$2 /\ x$2 <= a$2))`,
6538   GEOM_ORIGIN_TAC `a:real^2` THEN
6539   REWRITE_TAC[VECTOR_ADD_COMPONENT; VEC_COMPONENT; REAL_LE_LADD;
6540               REAL_EQ_ADD_LCANCEL] THEN
6541   REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o SYM) THEN
6542   SUBST1_TAC(SYM(ISPEC `b:real^2` BASIS_EXPANSION)) THEN
6543   ASM_REWRITE_TAC[DIMINDEX_2; VSUM_2; VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN
6544   SUBST1_TAC(VECTOR_ARITH `vec 0:real^2 = &0 % basis 2`) THEN
6545   REWRITE_TAC[SEGMENT_SCALAR_MULTIPLE; IN_ELIM_THM; CART_EQ] THEN
6546   REWRITE_TAC[DIMINDEX_2; FORALL_2; VECTOR_MUL_COMPONENT] THEN
6547   SIMP_TAC[BASIS_COMPONENT; DIMINDEX_2; ARITH;
6548            REAL_MUL_RZERO; REAL_MUL_RID] THEN MESON_TAC[]);;
6549
6550 let SEGMENT_HORIZONTAL = prove
6551  (`!a:real^2 b:real^2 x:real^2.
6552       a$2 = b$2
6553       ==> (x IN segment[a,b] <=>
6554            x$2 = a$2 /\ x$2 = b$2 /\
6555            (a$1 <= x$1 /\ x$1 <= b$1 \/ b$1 <= x$1 /\ x$1 <= a$1))`,
6556   GEOM_ORIGIN_TAC `a:real^2` THEN
6557   REWRITE_TAC[VECTOR_ADD_COMPONENT; VEC_COMPONENT; REAL_LE_LADD;
6558               REAL_EQ_ADD_LCANCEL] THEN
6559   REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o SYM) THEN
6560   SUBST1_TAC(SYM(ISPEC `b:real^2` BASIS_EXPANSION)) THEN
6561   ASM_REWRITE_TAC[DIMINDEX_2; VSUM_2; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN
6562   SUBST1_TAC(VECTOR_ARITH `vec 0:real^2 = &0 % basis 1`) THEN
6563   REWRITE_TAC[SEGMENT_SCALAR_MULTIPLE; IN_ELIM_THM; CART_EQ] THEN
6564   REWRITE_TAC[DIMINDEX_2; FORALL_2; VECTOR_MUL_COMPONENT] THEN
6565   SIMP_TAC[BASIS_COMPONENT; DIMINDEX_2; ARITH;
6566            REAL_MUL_RZERO; REAL_MUL_RID] THEN MESON_TAC[]);;
6567
6568 (* ------------------------------------------------------------------------- *)
6569 (* Useful Fashoda corollary pointed out to me by Tom Hales.                  *)
6570 (* ------------------------------------------------------------------------- *)
6571
6572 let FASHODA_INTERLACE = prove
6573  (`!f g a b:real^2.
6574         path f /\ path g /\
6575         path_image f SUBSET interval[a,b] /\
6576         path_image g SUBSET interval[a,b] /\
6577         (pathstart f)$2 = a$2 /\ (pathfinish f)$2 = a$2 /\
6578         (pathstart g)$2 = a$2 /\ (pathfinish g)$2 = a$2 /\
6579         (pathstart f)$1 < (pathstart g)$1 /\
6580         (pathstart g)$1 < (pathfinish f)$1 /\
6581         (pathfinish f)$1 < (pathfinish g)$1
6582         ==> ?z. z IN path_image f /\ z IN path_image g`,
6583   REPEAT STRIP_TAC THEN
6584   SUBGOAL_THEN `~(interval[a:real^2,b] = {})` MP_TAC THENL
6585    [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
6586      `s SUBSET t ==> ~(s = {}) ==> ~(t = {})`)) THEN
6587     REWRITE_TAC[PATH_IMAGE_NONEMPTY];
6588     ALL_TAC] THEN
6589   SUBGOAL_THEN
6590    `pathstart (f:real^1->real^2) IN interval[a,b] /\
6591     pathfinish f IN interval[a,b] /\
6592     pathstart g IN interval[a,b] /\
6593     pathfinish g IN interval[a,b]`
6594   MP_TAC THENL
6595    [ASM_MESON_TAC[SUBSET; PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE];
6596     ALL_TAC] THEN
6597   REWRITE_TAC[INTERVAL_NE_EMPTY; IN_INTERVAL; FORALL_2; DIMINDEX_2] THEN
6598   REPEAT STRIP_TAC THEN
6599   MP_TAC(SPECL
6600    [`linepath(vector[a$1 - &2;a$2 - &2],vector[(pathstart f)$1;a$2 - &2]) ++
6601      linepath(vector[(pathstart f)$1;(a:real^2)$2 - &2],pathstart f) ++
6602      (f:real^1->real^2) ++
6603      linepath(pathfinish f,vector[(pathfinish f)$1;a$2 - &2]) ++
6604      linepath(vector[(pathfinish f)$1;a$2 - &2],
6605               vector[(b:real^2)$1 + &2;a$2 - &2])`;
6606     `linepath(vector[(pathstart g)$1; (pathstart g)$2 - &3],pathstart g) ++
6607      (g:real^1->real^2) ++
6608      linepath(pathfinish g,vector[(pathfinish g)$1;(a:real^2)$2 - &1]) ++
6609      linepath(vector[(pathfinish g)$1;a$2 - &1],vector[b$1 + &1;a$2 - &1]) ++
6610      linepath(vector[b$1 + &1;a$2 - &1],vector[(b:real^2)$1 + &1;b$2 + &3])`;
6611     `vector[(a:real^2)$1 - &2; a$2 - &3]:real^2`;
6612     `vector[(b:real^2)$1 + &2; b$2 + &3]:real^2`]
6613    FASHODA) THEN
6614   ASM_SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; PATH_IMAGE_JOIN;
6615                PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_LINEPATH] THEN
6616   REWRITE_TAC[VECTOR_2] THEN ANTS_TAC THENL
6617    [CONJ_TAC THEN
6618     REPEAT(MATCH_MP_TAC
6619             (SET_RULE `s SUBSET u /\ t SUBSET u ==> (s UNION t) SUBSET u`) THEN
6620            CONJ_TAC) THEN
6621     TRY(REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN
6622         MATCH_MP_TAC(REWRITE_RULE[CONVEX_CONTAINS_SEGMENT]
6623            (CONJUNCT1 (SPEC_ALL CONVEX_INTERVAL))) THEN
6624         ASM_REWRITE_TAC[IN_INTERVAL; FORALL_2; DIMINDEX_2; VECTOR_2] THEN
6625         ASM_REAL_ARITH_TAC) THEN
6626     MATCH_MP_TAC SUBSET_TRANS THEN
6627     EXISTS_TAC `interval[a:real^2,b:real^2]` THEN
6628     ASM_REWRITE_TAC[SUBSET_REFL] THEN
6629     REWRITE_TAC[SUBSET_INTERVAL; FORALL_2; DIMINDEX_2; VECTOR_2] THEN
6630     ASM_REAL_ARITH_TAC;
6631     ALL_TAC] THEN
6632   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^2` THEN
6633   REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN
6634   SUBGOAL_THEN
6635    `!f s:real^2->bool. path_image f UNION s =
6636                        path_image f UNION (s DIFF {pathstart f,pathfinish f})`
6637    (fun th -> ONCE_REWRITE_TAC[th] THEN
6638               REWRITE_TAC[GSYM UNION_ASSOC] THEN
6639               ONCE_REWRITE_TAC[SET_RULE `(s UNION t) UNION u =
6640                                          u UNION t UNION s`] THEN
6641               ONCE_REWRITE_TAC[th])
6642   THENL
6643    [REWRITE_TAC[EXTENSION; IN_UNION; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN
6644     ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE];
6645     ALL_TAC] THEN
6646   REWRITE_TAC[IN_UNION; IN_DIFF; GSYM DISJ_ASSOC; LEFT_OR_DISTRIB;
6647               RIGHT_OR_DISTRIB; GSYM CONJ_ASSOC;
6648               SET_RULE `~(z IN {x,y}) <=> ~(z = x) /\ ~(z = y)`] THEN
6649   DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN MP_TAC) THEN
6650   ASM_SIMP_TAC[SEGMENT_VERTICAL; SEGMENT_HORIZONTAL; VECTOR_2] THEN
6651   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6652   UNDISCH_TAC `path_image (f:real^1->real^2) SUBSET interval [a,b]` THEN
6653   REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN
6654   UNDISCH_TAC `path_image (g:real^1->real^2) SUBSET interval [a,b]` THEN
6655   REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN
6656   ASM_REWRITE_TAC[IN_INTERVAL; FORALL_2; DIMINDEX_2] THEN
6657   REPEAT(DISCH_THEN(fun th -> if is_imp(concl th) then ALL_TAC else
6658     ASSUME_TAC th)) THEN
6659   REPEAT(POP_ASSUM MP_TAC) THEN TRY REAL_ARITH_TAC THEN
6660   REWRITE_TAC[CART_EQ; FORALL_2; DIMINDEX_2] THEN REAL_ARITH_TAC);;
6661
6662 (* ------------------------------------------------------------------------- *)
6663 (* Complement in dimension N >= 2 of set homeomorphic to any interval in     *)
6664 (* any dimension is (path-)connected. This naively generalizes the argument  *)
6665 (* in Ryuji Maehara's paper "The Jordan curve theorem via the Brouwer        *)
6666 (* fixed point theorem", American Mathematical Monthly 1984.                 *)
6667 (* ------------------------------------------------------------------------- *)
6668
6669 let UNBOUNDED_COMPONENTS_COMPLEMENT_ABSOLUTE_RETRACT = prove
6670  (`!s c. compact s /\ AR s /\ c IN components((:real^N) DIFF s)
6671          ==> ~bounded c`,
6672   REWRITE_TAC[CONJ_ASSOC; COMPACT_AR] THEN
6673   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; components; FORALL_IN_GSPEC] THEN
6674   GEN_TAC THEN DISCH_TAC THEN DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN
6675   REWRITE_TAC[IN_DIFF; IN_UNIV] THEN REPEAT STRIP_TAC THEN
6676   SUBGOAL_THEN `open((:real^N) DIFF s)` ASSUME_TAC THENL
6677    [ASM_SIMP_TAC[GSYM closed; COMPACT_IMP_CLOSED]; ALL_TAC] THEN
6678   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN
6679   REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN
6680   X_GEN_TAC `r:real^N->real^N` THEN STRIP_TAC THEN
6681   MP_TAC(ISPECL [`connected_component ((:real^N) DIFF s) y`;
6682                  `s:real^N->bool`;
6683                  `r:real^N->real^N`]
6684                 FRONTIER_SUBSET_RETRACTION) THEN
6685   ASM_SIMP_TAC[NOT_IMP; INTERIOR_OPEN; OPEN_CONNECTED_COMPONENT] THEN
6686   REPEAT CONJ_TAC THENL
6687    [REWRITE_TAC[frontier] THEN
6688     ASM_SIMP_TAC[INTERIOR_OPEN; OPEN_CONNECTED_COMPONENT] THEN
6689     REWRITE_TAC[SUBSET; IN_DIFF] THEN X_GEN_TAC `z:real^N` THEN
6690     ASM_CASES_TAC `(z:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN
6691     ASM_SIMP_TAC[IN_CLOSURE_CONNECTED_COMPONENT; IN_UNIV; IN_DIFF] THEN
6692     CONV_TAC TAUT;
6693     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV];
6694     ASM SET_TAC[];
6695     MATCH_MP_TAC(SET_RULE
6696      `~(c = {}) /\ c SUBSET (:real^N) DIFF s ==> ~(c SUBSET s)`) THEN
6697     REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_COMPONENT_EQ_EMPTY] THEN
6698     ASM_REWRITE_TAC[IN_UNIV; IN_DIFF]]);;
6699
6700 let CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT = prove
6701  (`!s. 2 <= dimindex(:N) /\ compact s /\ AR s
6702        ==> connected((:real^N) DIFF s)`,
6703   REWRITE_TAC[COMPACT_AR] THEN
6704   REPEAT STRIP_TAC THEN REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENT_EQ] THEN
6705   REPEAT STRIP_TAC THEN MATCH_MP_TAC COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT THEN
6706   ASM_SIMP_TAC[SET_RULE`UNIV DIFF (UNIV DIFF s) = s`; COMPACT_IMP_BOUNDED] THEN
6707   CONJ_TAC THEN
6708   MATCH_MP_TAC UNBOUNDED_COMPONENTS_COMPLEMENT_ABSOLUTE_RETRACT THEN
6709   EXISTS_TAC `s:real^N->bool` THEN REWRITE_TAC[CONJ_ASSOC; COMPACT_AR] THEN
6710   ASM_REWRITE_TAC[IN_COMPONENTS] THEN ASM_MESON_TAC[]);;
6711
6712 let PATH_CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT = prove
6713  (`!s:real^N->bool.
6714         2 <= dimindex(:N) /\ compact s /\ AR s
6715         ==> path_connected((:real^N) DIFF s)`,
6716   REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM
6717    (MP_TAC o MATCH_MP CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT) THEN
6718   MATCH_MP_TAC EQ_IMP THEN CONV_TAC SYM_CONV THEN
6719   MATCH_MP_TAC PATH_CONNECTED_EQ_CONNECTED THEN
6720   REWRITE_TAC[GSYM closed] THEN
6721   ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS; COMPACT_INTERVAL;
6722                 COMPACT_IMP_CLOSED]);;
6723
6724 let CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT = prove
6725  (`!s:real^N->bool t:real^M->bool.
6726         2 <= dimindex(:N) /\ s homeomorphic t /\ convex t /\ compact t
6727         ==> connected((:real^N) DIFF s)`,
6728   REPEAT STRIP_TAC THEN
6729   ASM_CASES_TAC `s:real^N->bool = {}` THEN
6730   ASM_REWRITE_TAC[DIFF_EMPTY; CONNECTED_UNIV] THEN
6731   MATCH_MP_TAC CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT THEN
6732   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6733    [ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS]; ALL_TAC] THEN
6734   FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_ARNESS) THEN
6735   ASM_MESON_TAC[CONVEX_IMP_AR; HOMEOMORPHIC_EMPTY]);;
6736
6737 let PATH_CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT = prove
6738  (`!s:real^N->bool t:real^M->bool.
6739         2 <= dimindex(:N) /\ s homeomorphic t /\ convex t /\ compact t
6740         ==> path_connected((:real^N) DIFF s)`,
6741   REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM
6742    (MP_TAC o MATCH_MP CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT) THEN
6743   MATCH_MP_TAC EQ_IMP THEN CONV_TAC SYM_CONV THEN
6744   MATCH_MP_TAC PATH_CONNECTED_EQ_CONNECTED THEN
6745   REWRITE_TAC[GSYM closed] THEN
6746   ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS; COMPACT_INTERVAL;
6747                 COMPACT_IMP_CLOSED]);;
6748
6749 (* ------------------------------------------------------------------------- *)
6750 (* In particular, apply all these to the special case of an arc.             *)
6751 (* ------------------------------------------------------------------------- *)
6752
6753 let RETRACTION_ARC = prove
6754  (`!p. arc p
6755        ==> ?f. f continuous_on (:real^N) /\
6756                IMAGE f (:real^N) SUBSET path_image p /\
6757                (!x. x IN path_image p ==> f x = x)`,
6758   REPEAT STRIP_TAC THEN
6759   FIRST_X_ASSUM(MP_TAC o SPEC `(:real^N)` o MATCH_MP (REWRITE_RULE[IMP_CONJ]
6760         ABSOLUTE_RETRACT_PATH_IMAGE_ARC)) THEN
6761   REWRITE_TAC[SUBSET_UNIV; retract_of; retraction]);;
6762
6763 let PATH_CONNECTED_ARC_COMPLEMENT = prove
6764  (`!p. 2 <= dimindex(:N) /\ arc p
6765        ==> path_connected((:real^N) DIFF path_image p)`,
6766   REWRITE_TAC[arc; path] THEN REPEAT STRIP_TAC THEN SIMP_TAC[path_image] THEN
6767   MP_TAC(ISPECL [`path_image p:real^N->bool`; `interval[vec 0:real^1,vec 1]`]
6768         PATH_CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT) THEN
6769   ASM_REWRITE_TAC[CONVEX_INTERVAL; COMPACT_INTERVAL; path_image] THEN
6770   DISCH_THEN MATCH_MP_TAC THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
6771   MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN
6772   EXISTS_TAC `p:real^1->real^N` THEN ASM_REWRITE_TAC[COMPACT_INTERVAL]);;
6773
6774 let CONNECTED_ARC_COMPLEMENT = prove
6775  (`!p. 2 <= dimindex(:N) /\ arc p
6776        ==> connected((:real^N) DIFF path_image p)`,
6777   SIMP_TAC[PATH_CONNECTED_ARC_COMPLEMENT; PATH_CONNECTED_IMP_CONNECTED]);;
6778
6779 let INSIDE_ARC_EMPTY = prove
6780  (`!p:real^1->real^N. arc p ==> inside(path_image p) = {}`,
6781   REPEAT STRIP_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL
6782    [MATCH_MP_TAC INSIDE_CONVEX THEN
6783     ASM_SIMP_TAC[CONVEX_CONNECTED_1_GEN; CONNECTED_PATH_IMAGE; ARC_IMP_PATH];
6784     MATCH_MP_TAC INSIDE_BOUNDED_COMPLEMENT_CONNECTED_EMPTY THEN
6785     ASM_SIMP_TAC[BOUNDED_PATH_IMAGE; ARC_IMP_PATH] THEN
6786     MATCH_MP_TAC CONNECTED_ARC_COMPLEMENT THEN
6787     ASM_REWRITE_TAC[ARITH_RULE `2 <= n <=> 1 <= n /\ ~(n = 1)`] THEN
6788     REWRITE_TAC[DIMINDEX_GE_1]]);;
6789
6790 let INSIDE_SIMPLE_CURVE_IMP_CLOSED = prove
6791  (`!g x:real^N.
6792         simple_path g /\ x IN inside(path_image g)
6793         ==> pathfinish g = pathstart g`,
6794   MESON_TAC[ARC_SIMPLE_PATH; INSIDE_ARC_EMPTY; NOT_IN_EMPTY]);;