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