RichterHilbertAxiomGeometry/from_topology.ml

   1 (*              (c) Copyright, John Harrison 1998-2014                       *)
   2 (*              (c) Copyright, Valentina Bruno 2010                          *)
   3 (*          Distributed under the same license as HOL Light                  *)
   4 (*                                                                           *)
   5 (* Theorems taken directly from Multivariate/topology.ml which run after     *)
   6 (* loading Topology.ml.                                                      *)
   7
   8 needs "Library/card.ml";;
   9 needs "Multivariate/determinants.ml";;
  10 needs "RichterHilbertAxiomGeometry/Topology.ml";;
  11
  12 (* ------------------------------------------------------------------------- *)
  13 (* Open and closed balls and spheres.                                        *)
  14 (* ------------------------------------------------------------------------- *)
  15
  16 let sphere = new_definition
  17   `sphere(x,e) = { y | dist(x,y) = e}`;;
  18
  19 let IN_SPHERE = prove
  20  (`!x y e. y IN sphere(x,e) <=> dist(x,y) = e`,
  21   REWRITE_TAC[sphere; IN_ELIM_THM]);;
  22
  23 let IN_BALL_0 = prove
  24  (`!x e. x IN ball(vec 0,e) <=> norm(x) < e`,
  25   REWRITE_TAC[IN_BALL; dist; VECTOR_SUB_LZERO; NORM_NEG]);;
  26
  27 let IN_CBALL_0 = prove
  28  (`!x e. x IN cball(vec 0,e) <=> norm(x) <= e`,
  29   REWRITE_TAC[IN_CBALL; dist; VECTOR_SUB_LZERO; NORM_NEG]);;
  30
  31 let IN_SPHERE_0 = prove
  32  (`!x e. x IN sphere(vec 0,e) <=> norm(x) = e`,
  33   REWRITE_TAC[IN_SPHERE; dist; VECTOR_SUB_LZERO; NORM_NEG]);;
  34
  35 let BALL_TRIVIAL = prove
  36  (`!x. ball(x,&0) = {}`,
  37   REWRITE_TAC[EXTENSION; IN_BALL; IN_SING; NOT_IN_EMPTY] THEN NORM_ARITH_TAC);;
  38
  39 let CBALL_TRIVIAL = prove
  40  (`!x. cball(x,&0) = {x}`,
  41   REWRITE_TAC[EXTENSION; IN_CBALL; IN_SING; NOT_IN_EMPTY] THEN NORM_ARITH_TAC);;
  42
  43 let CENTRE_IN_CBALL = prove
  44  (`!x e. x IN cball(x,e) <=> &0 <= e`,
  45   MESON_TAC[IN_CBALL; DIST_REFL]);;
  46
  47 let SPHERE_SUBSET_CBALL = prove
  48  (`!x e. sphere(x,e) SUBSET cball(x,e)`,
  49   REWRITE_TAC[IN_SPHERE; IN_CBALL; SUBSET] THEN REAL_ARITH_TAC);;
  50
  51 let SUBSET_BALL = prove
  52  (`!x d e. d <= e ==> ball(x,d) SUBSET ball(x,e)`,
  53   REWRITE_TAC[SUBSET; IN_BALL] THEN MESON_TAC[REAL_LTE_TRANS]);;
  54
  55 let SUBSET_CBALL = prove
  56  (`!x d e. d <= e ==> cball(x,d) SUBSET cball(x,e)`,
  57   REWRITE_TAC[SUBSET; IN_CBALL] THEN MESON_TAC[REAL_LE_TRANS]);;
  58
  59 let BALL_MAX_UNION = prove
  60  (`!a r s. ball(a,max r s) = ball(a,r) UNION ball(a,s)`,
  61   REWRITE_TAC[IN_BALL; IN_UNION; EXTENSION] THEN REAL_ARITH_TAC);;
  62
  63 let BALL_MIN_INTER = prove
  64  (`!a r s. ball(a,min r s) = ball(a,r) INTER ball(a,s)`,
  65   REWRITE_TAC[IN_BALL; IN_INTER; EXTENSION] THEN REAL_ARITH_TAC);;
  66
  67 let CBALL_MAX_UNION = prove
  68  (`!a r s. cball(a,max r s) = cball(a,r) UNION cball(a,s)`,
  69   REWRITE_TAC[IN_CBALL; IN_UNION; EXTENSION] THEN REAL_ARITH_TAC);;
  70
  71 let CBALL_MIN_INTER = prove
  72  (`!x d e. cball(x,min d e) = cball(x,d) INTER cball(x,e)`,
  73   REWRITE_TAC[EXTENSION; IN_INTER; IN_CBALL] THEN REAL_ARITH_TAC);;
  74
  75 let BALL_TRANSLATION = prove
  76  (`!a x r. ball(a + x,r) = IMAGE (\y. a + y) (ball(x,r))`,
  77   REWRITE_TAC[ball] THEN GEOM_TRANSLATE_TAC[]);;
  78
  79 let CBALL_TRANSLATION = prove
  80  (`!a x r. cball(a + x,r) = IMAGE (\y. a + y) (cball(x,r))`,
  81   REWRITE_TAC[cball] THEN GEOM_TRANSLATE_TAC[]);;
  82
  83 let SPHERE_TRANSLATION = prove
  84  (`!a x r. sphere(a + x,r) = IMAGE (\y. a + y) (sphere(x,r))`,
  85   REWRITE_TAC[sphere] THEN GEOM_TRANSLATE_TAC[]);;
  86
  87 add_translation_invariants
  88   [BALL_TRANSLATION; CBALL_TRANSLATION; SPHERE_TRANSLATION];;
  89
  90 let BALL_LINEAR_IMAGE = prove
  91  (`!f:real^M->real^N x r.
  92         linear f /\ (!y. ?x. f x = y) /\ (!x. norm(f x) = norm x)
  93         ==> ball(f x,r) = IMAGE f (ball(x,r))`,
  94   REWRITE_TAC[ball] THEN GEOM_TRANSFORM_TAC[]);;
  95
  96 let CBALL_LINEAR_IMAGE = prove
  97  (`!f:real^M->real^N x r.
  98         linear f /\ (!y. ?x. f x = y) /\ (!x. norm(f x) = norm x)
  99         ==> cball(f x,r) = IMAGE f (cball(x,r))`,
 100   REWRITE_TAC[cball] THEN GEOM_TRANSFORM_TAC[]);;
 101
 102 let SPHERE_LINEAR_IMAGE = prove
 103  (`!f:real^M->real^N x r.
 104         linear f /\ (!y. ?x. f x = y) /\ (!x. norm(f x) = norm x)
 105         ==> sphere(f x,r) = IMAGE f (sphere(x,r))`,
 106   REWRITE_TAC[sphere] THEN GEOM_TRANSFORM_TAC[]);;
 107
 108 add_linear_invariants
 109   [BALL_LINEAR_IMAGE; CBALL_LINEAR_IMAGE; SPHERE_LINEAR_IMAGE];;
 110
 111 let BALL_SCALING = prove
 112  (`!c. &0 < c ==> !x r. ball(c % x,c * r) = IMAGE (\x. c % x) (ball(x,r))`,
 113   REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
 114   MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[] THEN CONJ_TAC THENL
 115    [ASM_MESON_TAC[SURJECTIVE_SCALING; REAL_LT_IMP_NZ]; ALL_TAC] THEN
 116   REWRITE_TAC[IN_BALL; DIST_MUL] THEN
 117   ASM_SIMP_TAC[REAL_ARITH `&0 < c ==> abs c = c`; REAL_LT_LMUL_EQ]);;
 118
 119 let CBALL_SCALING = prove
 120  (`!c. &0 < c ==> !x r. cball(c % x,c * r) = IMAGE (\x. c % x) (cball(x,r))`,
 121   REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
 122   MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[] THEN CONJ_TAC THENL
 123    [ASM_MESON_TAC[SURJECTIVE_SCALING; REAL_LT_IMP_NZ]; ALL_TAC] THEN
 124   REWRITE_TAC[IN_CBALL; DIST_MUL] THEN
 125   ASM_SIMP_TAC[REAL_ARITH `&0 < c ==> abs c = c`; REAL_LE_LMUL_EQ]);;
 126
 127 add_scaling_theorems [BALL_SCALING; CBALL_SCALING];;
 128
 129 let CBALL_DIFF_BALL = prove
 130  (`!a r. cball(a,r) DIFF ball(a,r) = sphere(a,r)`,
 131   REWRITE_TAC[ball; cball; sphere; EXTENSION; IN_DIFF; IN_ELIM_THM] THEN
 132   REAL_ARITH_TAC);;
 133
 134 let BALL_UNION_SPHERE = prove
 135  (`!a r. ball(a,r) UNION sphere(a,r) = cball(a,r)`,
 136   REWRITE_TAC[ball; cball; sphere; EXTENSION; IN_UNION; IN_ELIM_THM] THEN
 137   REAL_ARITH_TAC);;
 138
 139 let SPHERE_UNION_BALL = prove
 140  (`!a r. sphere(a,r) UNION ball(a,r)  = cball(a,r)`,
 141   REWRITE_TAC[ball; cball; sphere; EXTENSION; IN_UNION; IN_ELIM_THM] THEN
 142   REAL_ARITH_TAC);;
 143
 144 let CBALL_DIFF_SPHERE = prove
 145  (`!a r. cball(a,r) DIFF sphere(a,r) = ball(a,r)`,
 146   REWRITE_TAC[EXTENSION; IN_DIFF; IN_SPHERE; IN_BALL; IN_CBALL] THEN
 147   REAL_ARITH_TAC);;
 148
 149 let OPEN_CONTAINS_BALL_EQ = prove
 150  (`!s. open s ==> (!x. x IN s <=> ?e. &0 < e /\ ball(x,e) SUBSET s)`,
 151   MESON_TAC[OPEN_CONTAINS_BALL; SUBSET; CENTRE_IN_BALL]);;
 152
 153 let BALL_EQ_EMPTY = prove
 154  (`!x e. (ball(x,e) = {}) <=> e <= &0`,
 155   REWRITE_TAC[EXTENSION; IN_BALL; NOT_IN_EMPTY; REAL_NOT_LT] THEN
 156   MESON_TAC[DIST_POS_LE; REAL_LE_TRANS; DIST_REFL]);;
 157
 158 let BALL_EMPTY = prove
 159  (`!x e. e <= &0 ==> ball(x,e) = {}`,
 160   REWRITE_TAC[BALL_EQ_EMPTY]);;
 161
 162 let OPEN_CONTAINS_CBALL = prove
 163  (`!s. open s <=> !x. x IN s ==> ?e. &0 < e /\ cball(x,e) SUBSET s`,
 164   GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN EQ_TAC THENL
 165    [ALL_TAC; ASM_MESON_TAC[SUBSET_TRANS; BALL_SUBSET_CBALL]] THEN
 166   MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
 167   REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN
 168   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
 169   EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN
 170   SUBGOAL_THEN `e / &2 < e` (fun th -> ASM_MESON_TAC[th; REAL_LET_TRANS]) THEN
 171   ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN
 172   UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC);;
 173
 174 let OPEN_CONTAINS_CBALL_EQ = prove
 175  (`!s. open s ==> (!x. x IN s <=> ?e. &0 < e /\ cball(x,e) SUBSET s)`,
 176   MESON_TAC[OPEN_CONTAINS_CBALL; SUBSET; REAL_LT_IMP_LE; CENTRE_IN_CBALL]);;
 177
 178 let SPHERE_EQ_EMPTY = prove
 179  (`!a:real^N r. sphere(a,r) = {} <=> r < &0`,
 180   REWRITE_TAC[sphere; EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN
 181   REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; CONV_TAC NORM_ARITH] THEN
 182   MESON_TAC[VECTOR_CHOOSE_DIST; REAL_NOT_LE]);;
 183
 184 let SPHERE_EMPTY = prove
 185  (`!a:real^N r. r < &0 ==> sphere(a,r) = {}`,
 186   REWRITE_TAC[SPHERE_EQ_EMPTY]);;
 187
 188 let NEGATIONS_BALL = prove
 189  (`!r. IMAGE (--) (ball(vec 0:real^N,r)) = ball(vec 0,r)`,
 190   GEN_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
 191   REWRITE_TAC[IN_BALL_0; NORM_NEG] THEN MESON_TAC[VECTOR_NEG_NEG]);;
 192
 193 let NEGATIONS_CBALL = prove
 194  (`!r. IMAGE (--) (cball(vec 0:real^N,r)) = cball(vec 0,r)`,
 195   GEN_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
 196   REWRITE_TAC[IN_CBALL_0; NORM_NEG] THEN MESON_TAC[VECTOR_NEG_NEG]);;
 197
 198 let NEGATIONS_SPHERE = prove
 199  (`!r. IMAGE (--) (sphere(vec 0:real^N,r)) = sphere(vec 0,r)`,
 200   GEN_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
 201   REWRITE_TAC[IN_SPHERE_0; NORM_NEG] THEN MESON_TAC[VECTOR_NEG_NEG]);;
 202
 203 let ORTHOGONAL_TRANSFORMATION_BALL = prove
 204  (`!f:real^N->real^N r.
 205     orthogonal_transformation f ==> IMAGE f (ball(vec 0,r)) = ball(vec 0,r)`,
 206   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_BALL_0] THEN
 207   MESON_TAC[ORTHOGONAL_TRANSFORMATION_INVERSE; ORTHOGONAL_TRANSFORMATION]);;
 208
 209 let ORTHOGONAL_TRANSFORMATION_CBALL = prove
 210  (`!f:real^N->real^N r.
 211     orthogonal_transformation f ==> IMAGE f (cball(vec 0,r)) = cball(vec 0,r)`,
 212   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_CBALL_0] THEN
 213   MESON_TAC[ORTHOGONAL_TRANSFORMATION_INVERSE; ORTHOGONAL_TRANSFORMATION]);;
 214
 215 let ORTHOGONAL_TRANSFORMATION_SPHERE = prove
 216  (`!f:real^N->real^N r.
 217     orthogonal_transformation f
 218     ==> IMAGE f (sphere(vec 0,r)) = sphere(vec 0,r)`,
 219   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_SPHERE_0] THEN
 220   MESON_TAC[ORTHOGONAL_TRANSFORMATION_INVERSE; ORTHOGONAL_TRANSFORMATION]);;
 221
 222 (* ------------------------------------------------------------------------- *)
 223 (* Also some invariance theorems for relative topology.                      *)
 224 (* ------------------------------------------------------------------------- *)
 225
 226 let OPEN_IN_TRANSLATION_EQ = prove
 227  (`!a s t. open_in (subtopology euclidean (IMAGE (\x. a + x) t))
 228                    (IMAGE (\x. a + x) s) <=>
 229            open_in (subtopology euclidean t) s`,
 230   REWRITE_TAC[open_in] THEN GEOM_TRANSLATE_TAC[]);;
 231
 232 add_translation_invariants [OPEN_IN_TRANSLATION_EQ];;
 233
 234 let CLOSED_IN_TRANSLATION_EQ = prove
 235  (`!a s t. closed_in (subtopology euclidean (IMAGE (\x. a + x) t))
 236                    (IMAGE (\x. a + x) s) <=>
 237            closed_in (subtopology euclidean t) s`,
 238   REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
 239   GEOM_TRANSLATE_TAC[]);;
 240
 241 add_translation_invariants [CLOSED_IN_TRANSLATION_EQ];;
 242
 243 (* ------------------------------------------------------------------------- *)
 244 (* Limit points.                                                             *)
 245 (* ------------------------------------------------------------------------- *)
 246
 247 let LIMPT_APPROACHABLE = prove
 248  (`!x s. x limit_point_of s <=>
 249                 !e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ dist(x',x) < e`,
 250   REPEAT GEN_TAC THEN REWRITE_TAC[limit_point_of] THEN
 251   MESON_TAC[open_def; DIST_SYM; OPEN_BALL; CENTRE_IN_BALL; IN_BALL]);;
 252
 253 let LIMPT_APPROACHABLE_LE = prove
 254  (`!x s. x limit_point_of s <=>
 255                 !e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ dist(x',x) <= e`,
 256   REPEAT GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN
 257   MATCH_MP_TAC(TAUT `(~a <=> ~b) ==> (a <=> b)`) THEN
 258   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN
 259   REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> c ==> ~(a /\ b)`; APPROACHABLE_LT_LE]);;
 260
 261 let LIMPT_UNIV = prove
 262  (`!x:real^N. x limit_point_of UNIV`,
 263   GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE; IN_UNIV] THEN
 264   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
 265   SUBGOAL_THEN `?c:real^N. norm(c) = e / &2` CHOOSE_TAC THENL
 266    [ASM_SIMP_TAC[VECTOR_CHOOSE_SIZE; REAL_HALF; REAL_LT_IMP_LE];
 267     ALL_TAC] THEN
 268   EXISTS_TAC `x + c:real^N` THEN
 269   REWRITE_TAC[dist; VECTOR_EQ_ADDR] THEN ASM_REWRITE_TAC[VECTOR_ADD_SUB] THEN
 270   SUBGOAL_THEN `&0 < e / &2 /\ e / &2 < e`
 271    (fun th -> ASM_MESON_TAC[th; NORM_0; REAL_LT_REFL]) THEN
 272   SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN
 273   UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC);;
 274
 275 let CLOSED_POSITIVE_ORTHANT = prove
 276  (`closed {x:real^N | !i. 1 <= i /\ i <= dimindex(:N)
 277                           ==> &0 <= x$i}`,
 278   REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE] THEN
 279   REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
 280   X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN
 281   DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `--(x:real^N $ i)`) THEN
 282   ASM_REWRITE_TAC[REAL_LT_RNEG; REAL_ADD_LID; NOT_EXISTS_THM] THEN
 283   X_GEN_TAC `y:real^N` THEN
 284   MATCH_MP_TAC(TAUT `(a ==> ~c) ==> ~(a /\ b /\ c)`) THEN DISCH_TAC THEN
 285   MATCH_MP_TAC(REAL_ARITH `!b. abs x <= b /\ b <= a ==> ~(a + x < &0)`) THEN
 286   EXISTS_TAC `abs((y - x :real^N)$i)` THEN
 287   ASM_SIMP_TAC[dist; COMPONENT_LE_NORM] THEN
 288   ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; REAL_ARITH
 289    `x < &0 /\ &0 <= y ==> abs(x) <= abs(y - x)`]);;
 290
 291 let FINITE_SET_AVOID = prove
 292  (`!a:real^N s. FINITE s
 293                 ==> ?d. &0 < d /\ !x. x IN s /\ ~(x = a) ==> d <= dist(a,x)`,
 294   GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
 295   REWRITE_TAC[NOT_IN_EMPTY] THEN
 296   CONJ_TAC THENL [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN
 297   MAP_EVERY X_GEN_TAC [`x:real^N`; `s:real^N->bool`] THEN
 298   DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
 299   FIRST_X_ASSUM(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
 300   ASM_CASES_TAC `x:real^N = a` THEN REWRITE_TAC[IN_INSERT] THENL
 301    [ASM_MESON_TAC[]; ALL_TAC] THEN
 302   EXISTS_TAC `min d (dist(a:real^N,x))` THEN
 303   ASM_REWRITE_TAC[REAL_LT_MIN; GSYM DIST_NZ; REAL_MIN_LE] THEN
 304   ASM_MESON_TAC[REAL_LE_REFL]);;
 305
 306 let LIMIT_POINT_FINITE = prove
 307  (`!s a. FINITE s ==> ~(a limit_point_of s)`,
 308   REWRITE_TAC[LIMPT_APPROACHABLE; GSYM REAL_NOT_LE] THEN
 309   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM; REAL_NOT_LE;
 310     REAL_NOT_LT; TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN
 311   MESON_TAC[FINITE_SET_AVOID; DIST_SYM]);;
 312
 313 let LIMPT_SING = prove
 314  (`!x y:real^N. ~(x limit_point_of {y})`,
 315   SIMP_TAC[LIMIT_POINT_FINITE; FINITE_SING]);;
 316
 317 let LIMPT_INSERT = prove
 318  (`!s x y:real^N. x limit_point_of (y INSERT s) <=> x limit_point_of s`,
 319   ONCE_REWRITE_TAC[SET_RULE `y INSERT s = {y} UNION s`] THEN
 320   REWRITE_TAC[LIMIT_POINT_UNION] THEN
 321   SIMP_TAC[FINITE_SING; LIMIT_POINT_FINITE]);;
 322
 323 let LIMPT_OF_LIMPTS = prove
 324  (`!x:real^N s.
 325      x limit_point_of {y | y limit_point_of s} ==> x limit_point_of s`,
 326   REWRITE_TAC[LIMPT_APPROACHABLE; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN
 327   DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
 328   FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
 329   DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
 330   FIRST_X_ASSUM(MP_TAC o SPEC `dist(y:real^N,x)`) THEN
 331   ASM_SIMP_TAC[DIST_POS_LT] THEN MATCH_MP_TAC MONO_EXISTS THEN
 332   GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
 333   REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);;
 334
 335 let CLOSED_LIMPTS = prove
 336  (`!s. closed {x:real^N | x limit_point_of s}`,
 337   REWRITE_TAC[CLOSED_LIMPT; IN_ELIM_THM; LIMPT_OF_LIMPTS]);;
 338
 339 let DISCRETE_IMP_CLOSED = prove
 340  (`!s:real^N->bool e.
 341         &0 < e /\
 342         (!x y. x IN s /\ y IN s /\ norm(y - x) < e ==> y = x)
 343         ==> closed s`,
 344   REPEAT STRIP_TAC THEN
 345   SUBGOAL_THEN `!x:real^N. ~(x limit_point_of s)`
 346     (fun th -> MESON_TAC[th; CLOSED_LIMPT]) THEN
 347   GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN DISCH_TAC THEN
 348   FIRST_ASSUM(MP_TAC o SPEC `e / &2`) THEN
 349   REWRITE_TAC[REAL_HALF; ASSUME `&0 < e`] THEN
 350   DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
 351   FIRST_X_ASSUM(MP_TAC o SPEC `min (e / &2) (dist(x:real^N,y))`) THEN
 352   ASM_SIMP_TAC[REAL_LT_MIN; DIST_POS_LT; REAL_HALF] THEN
 353   DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN
 354   FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^N`; `z:real^N`]) THEN
 355   ASM_REWRITE_TAC[] THEN ASM_NORM_ARITH_TAC);;
 356
 357 let LIMPT_OF_UNIV = prove
 358  (`!x. x limit_point_of (:real^N)`,
 359   GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE; IN_UNIV] THEN
 360   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
 361   MP_TAC(ISPECL [`x:real^N`; `e / &2`] VECTOR_CHOOSE_DIST) THEN
 362   ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN
 363   POP_ASSUM MP_TAC THEN CONV_TAC NORM_ARITH);;
 364
 365 let LIMPT_OF_OPEN_IN = prove
 366  (`!s t x:real^N.
 367         open_in (subtopology euclidean s) t /\ x limit_point_of s /\ x IN t
 368         ==> x limit_point_of t`,
 369   REWRITE_TAC[open_in; SUBSET; LIMPT_APPROACHABLE] THEN
 370   REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
 371   FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
 372   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
 373   FIRST_X_ASSUM(MP_TAC o SPEC `min d e / &2`) THEN
 374   ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN
 375   GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN
 376   TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN ASM_REWRITE_TAC[] THEN
 377   ASM_REAL_ARITH_TAC);;
 378
 379 let LIMPT_OF_OPEN = prove
 380  (`!s x:real^N. open s /\ x IN s ==> x limit_point_of s`,
 381   REWRITE_TAC[OPEN_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
 382   MESON_TAC[LIMPT_OF_OPEN_IN; LIMPT_OF_UNIV]);;
 383
 384 let OPEN_IN_SING = prove
 385  (`!s a. open_in (subtopology euclidean s) {a} <=>
 386          a IN s /\ ~(a limit_point_of s)`,
 387   REWRITE_TAC[open_in; LIMPT_APPROACHABLE; SING_SUBSET; IN_SING] THEN
 388   REWRITE_TAC[FORALL_UNWIND_THM2] THEN MESON_TAC[]);;
 389
 390 (* ------------------------------------------------------------------------- *)
 391 (* Interior of a set.                                                        *)
 392 (* ------------------------------------------------------------------------- *)
 393
 394 let INTERIOR_LIMIT_POINT = prove
 395  (`!s x:real^N. x IN interior s ==> x limit_point_of s`,
 396   REPEAT GEN_TAC THEN
 397   REWRITE_TAC[IN_INTERIOR; IN_ELIM_THM; SUBSET; IN_BALL] THEN
 398   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
 399   REWRITE_TAC[LIMPT_APPROACHABLE] THEN X_GEN_TAC `d:real` THEN
 400   DISCH_TAC THEN
 401   MP_TAC(ISPECL [`x:real^N`; `min d e / &2`] VECTOR_CHOOSE_DIST) THEN
 402   ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
 403   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN
 404   REPEAT CONJ_TAC THENL
 405    [FIRST_X_ASSUM MATCH_MP_TAC;
 406     CONV_TAC (RAND_CONV SYM_CONV) THEN REWRITE_TAC[GSYM DIST_EQ_0];
 407     ONCE_REWRITE_TAC[DIST_SYM]] THEN
 408   ASM_REAL_ARITH_TAC);;
 409
 410 let INTERIOR_SING = prove
 411  (`!a:real^N. interior {a} = {}`,
 412   REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN
 413   MESON_TAC[INTERIOR_LIMIT_POINT; LIMPT_SING]);;
 414
 415 (* ------------------------------------------------------------------------- *)
 416 (* Closure of a set.                                                         *)
 417 (* ------------------------------------------------------------------------- *)
 418
 419 let LIMPT_OF_CLOSURE = prove
 420  (`!x:real^N s. x limit_point_of closure s <=> x limit_point_of s`,
 421   REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM; LIMIT_POINT_UNION] THEN
 422   REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(q ==> p) ==> (p \/ q <=> p)`) THEN
 423   REWRITE_TAC[LIMPT_OF_LIMPTS]);;
 424
 425 (* ------------------------------------------------------------------------- *)
 426 (* A variant of nets (slightly non-standard but good for our purposes).      *)
 427 (* ------------------------------------------------------------------------- *)
 428
 429 let net_tybij = new_type_definition "net" ("mk_net","netord")
 430  (prove
 431    (`?g:A->A->bool. !x y. (!z. g z x ==> g z y) \/ (!z. g z y ==> g z x)`,
 432     EXISTS_TAC `\x:A y:A. F` THEN REWRITE_TAC[]));;
 433
 434 let NET = prove
 435  (`!n x y. (!z. netord n z x ==> netord n z y) \/
 436            (!z. netord n z y ==> netord n z x)`,
 437    REWRITE_TAC[net_tybij; ETA_AX]);;
 438
 439 let OLDNET = prove
 440  (`!n x y. netord n x x /\ netord n y y
 441            ==> ?z. netord n z z /\
 442                    !w. netord n w z ==> netord n w x /\ netord n w y`,
 443   MESON_TAC[NET]);;
 444
 445 let NET_DILEMMA = prove
 446  (`!net. (?a. (?x. netord net x a) /\ (!x. netord net x a ==> P x)) /\
 447          (?b. (?x. netord net x b) /\ (!x. netord net x b ==> Q x))
 448          ==> ?c. (?x. netord net x c) /\ (!x. netord net x c ==> P x /\ Q x)`,
 449   MESON_TAC[NET]);;
 450
 451 (* ------------------------------------------------------------------------- *)
 452 (* Common nets and the "within" modifier for nets.                           *)
 453 (* ------------------------------------------------------------------------- *)
 454
 455 parse_as_infix("within",(14,"right"));;
 456 parse_as_infix("in_direction",(14,"right"));;
 457
 458 let at = new_definition
 459   `at a = mk_net(\x y. &0 < dist(x,a) /\ dist(x,a) <= dist(y,a))`;;
 460
 461 let at_infinity = new_definition
 462   `at_infinity = mk_net(\x y. norm(x) >= norm(y))`;;
 463
 464 let sequentially = new_definition
 465   `sequentially = mk_net(\m:num n. m >= n)`;;
 466
 467 let within = new_definition
 468   `net within s = mk_net(\x y. netord net x y /\ x IN s)`;;
 469
 470 let in_direction = new_definition
 471   `a in_direction v = (at a) within {b | ?c. &0 <= c /\ (b - a = c % v)}`;;
 472
 473 (* ------------------------------------------------------------------------- *)
 474 (* Prove that they are all nets.                                             *)
 475 (* ------------------------------------------------------------------------- *)
 476
 477 let NET_PROVE_TAC[def] =
 478   REWRITE_TAC[GSYM FUN_EQ_THM; def] THEN
 479   REWRITE_TAC[ETA_AX] THEN
 480   ASM_SIMP_TAC[GSYM(CONJUNCT2 net_tybij)];;
 481
 482 let AT = prove
 483  (`!a:real^N x y.
 484         netord(at a) x y <=> &0 < dist(x,a) /\ dist(x,a) <= dist(y,a)`,
 485   GEN_TAC THEN NET_PROVE_TAC[at] THEN
 486   MESON_TAC[REAL_LE_TOTAL; REAL_LE_REFL; REAL_LE_TRANS; REAL_LET_TRANS]);;
 487
 488 let AT_INFINITY = prove
 489  (`!x y. netord at_infinity x y <=> norm(x) >= norm(y)`,
 490   NET_PROVE_TAC[at_infinity] THEN
 491   REWRITE_TAC[real_ge; REAL_LE_REFL] THEN
 492   MESON_TAC[REAL_LE_TOTAL; REAL_LE_REFL; REAL_LE_TRANS]);;
 493
 494 let SEQUENTIALLY = prove
 495  (`!m n. netord sequentially m n <=> m >= n`,
 496   NET_PROVE_TAC[sequentially] THEN REWRITE_TAC[GE; LE_REFL] THEN
 497   MESON_TAC[LE_CASES; LE_REFL; LE_TRANS]);;
 498
 499 let WITHIN = prove
 500  (`!n s x y. netord(n within s) x y <=> netord n x y /\ x IN s`,
 501   GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[within; GSYM FUN_EQ_THM] THEN
 502   REWRITE_TAC[GSYM(CONJUNCT2 net_tybij); ETA_AX] THEN
 503   MESON_TAC[NET]);;
 504
 505 let IN_DIRECTION = prove
 506  (`!a v x y. netord(a in_direction v) x y <=>
 507                 &0 < dist(x,a) /\ dist(x,a) <= dist(y,a) /\
 508                  ?c. &0 <= c /\ (x - a = c % v)`,
 509   REWRITE_TAC[WITHIN; AT; in_direction; IN_ELIM_THM; CONJ_ACI]);;
 510
 511 let WITHIN_UNIV = prove
 512  (`!x:real^N. at x within UNIV = at x`,
 513   REWRITE_TAC[within; at; IN_UNIV] THEN REWRITE_TAC[ETA_AX; net_tybij]);;
 514
 515 let WITHIN_WITHIN = prove
 516  (`!net s t. (net within s) within t = net within (s INTER t)`,
 517   ONCE_REWRITE_TAC[within] THEN
 518   REWRITE_TAC[WITHIN; IN_INTER; GSYM CONJ_ASSOC]);;
 519
 520 (* ------------------------------------------------------------------------- *)
 521 (* Identify trivial limits, where we can't approach arbitrarily closely.     *)
 522 (* ------------------------------------------------------------------------- *)
 523
 524 let trivial_limit = new_definition
 525   `trivial_limit net <=>
 526      (!a:A b. a = b) \/
 527      ?a:A b. ~(a = b) /\ !x. ~(netord(net) x a) /\ ~(netord(net) x b)`;;
 528
 529 let TRIVIAL_LIMIT_WITHIN = prove
 530  (`!a:real^N. trivial_limit (at a within s) <=> ~(a limit_point_of s)`,
 531   REWRITE_TAC[trivial_limit; LIMPT_APPROACHABLE_LE; WITHIN; AT; DIST_NZ] THEN
 532   REPEAT GEN_TAC THEN EQ_TAC THENL
 533    [DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL
 534      [MESON_TAC[REAL_LT_01; REAL_LT_REFL; VECTOR_CHOOSE_DIST;
 535                 DIST_REFL; REAL_LT_IMP_LE];
 536       DISCH_THEN(X_CHOOSE_THEN `b:real^N` (X_CHOOSE_THEN `c:real^N`
 537         STRIP_ASSUME_TAC)) THEN
 538       SUBGOAL_THEN `&0 < dist(a,b:real^N) \/ &0 < dist(a,c:real^N)` MP_TAC THEN
 539       ASM_MESON_TAC[DIST_TRIANGLE; DIST_SYM; GSYM DIST_NZ; GSYM DIST_EQ_0;
 540                     REAL_ARITH `x <= &0 + &0 ==> ~(&0 < x)`]];
 541     REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN
 542     X_GEN_TAC `e:real` THEN DISCH_TAC THEN DISJ2_TAC THEN
 543     EXISTS_TAC `a:real^N` THEN
 544     SUBGOAL_THEN `?b:real^N. dist(a,b) = e` MP_TAC THENL
 545      [ASM_SIMP_TAC[VECTOR_CHOOSE_DIST; REAL_LT_IMP_LE]; ALL_TAC] THEN
 546     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN
 547     DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
 548     ASM_MESON_TAC[REAL_NOT_LE; DIST_REFL; DIST_NZ; DIST_SYM]]);;
 549
 550 let TRIVIAL_LIMIT_AT = prove
 551  (`!a. ~(trivial_limit (at a))`,
 552   ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
 553   REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; LIMPT_UNIV]);;
 554
 555 let TRIVIAL_LIMIT_AT_INFINITY = prove
 556  (`~(trivial_limit at_infinity)`,
 557   REWRITE_TAC[trivial_limit; AT_INFINITY; real_ge] THEN
 558   MESON_TAC[REAL_LE_REFL; VECTOR_CHOOSE_SIZE; REAL_LT_01; REAL_LT_LE]);;
 559
 560 let TRIVIAL_LIMIT_SEQUENTIALLY = prove
 561  (`~(trivial_limit sequentially)`,
 562   REWRITE_TAC[trivial_limit; SEQUENTIALLY] THEN
 563   MESON_TAC[GE_REFL; NOT_SUC]);;
 564
 565 let LIM_WITHIN_CLOSED_TRIVIAL = prove
 566  (`!a s. closed s /\ ~(a IN s) ==> trivial_limit (at a within s)`,
 567   REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN MESON_TAC[CLOSED_LIMPT]);;
 568
 569 let NONTRIVIAL_LIMIT_WITHIN = prove
 570  (`!net s. trivial_limit net ==> trivial_limit(net within s)`,
 571   REWRITE_TAC[trivial_limit; WITHIN] THEN MESON_TAC[]);;
 572
 573 (* ------------------------------------------------------------------------- *)
 574 (* Some property holds "sufficiently close" to the limit point.              *)
 575 (* ------------------------------------------------------------------------- *)
 576
 577 let eventually = new_definition
 578  `eventually p net <=>
 579         trivial_limit net \/
 580         ?y. (?x. netord net x y) /\ (!x. netord net x y ==> p x)`;;
 581
 582 let EVENTUALLY_HAPPENS = prove
 583  (`!net p. eventually p net ==> trivial_limit net \/ ?x. p x`,
 584   REWRITE_TAC[eventually] THEN MESON_TAC[]);;
 585
 586 let EVENTUALLY_WITHIN_LE = prove
 587  (`!s a:real^M p.
 588      eventually p (at a within s) <=>
 589         ?d. &0 < d /\ !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) <= d ==> p(x)`,
 590   REWRITE_TAC[eventually; AT; WITHIN; TRIVIAL_LIMIT_WITHIN] THEN
 591   REWRITE_TAC[LIMPT_APPROACHABLE_LE; DIST_NZ] THEN
 592   REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[REAL_LTE_TRANS]; ALL_TAC] THEN
 593   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
 594   MATCH_MP_TAC(TAUT `(a ==> b) ==> ~a \/ b`) THEN DISCH_TAC THEN
 595   SUBGOAL_THEN `?b:real^M. dist(a,b) = d` MP_TAC THENL
 596    [ASM_SIMP_TAC[VECTOR_CHOOSE_DIST; REAL_LT_IMP_LE]; ALL_TAC] THEN
 597   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^M` THEN
 598   DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
 599   ASM_MESON_TAC[REAL_NOT_LE; DIST_REFL; DIST_NZ; DIST_SYM]);;
 600
 601 let EVENTUALLY_WITHIN = prove
 602  (`!s a:real^M p.
 603      eventually p (at a within s) <=>
 604         ?d. &0 < d /\ !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) < d ==> p(x)`,
 605   REWRITE_TAC[EVENTUALLY_WITHIN_LE] THEN
 606   ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN
 607   REWRITE_TAC[APPROACHABLE_LT_LE]);;
 608
 609 let EVENTUALLY_AT = prove
 610  (`!a p. eventually p (at a) <=>
 611          ?d. &0 < d /\ !x. &0 < dist(x,a) /\ dist(x,a) < d ==> p(x)`,
 612   ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
 613   REWRITE_TAC[EVENTUALLY_WITHIN; IN_UNIV]);;
 614
 615 let EVENTUALLY_SEQUENTIALLY = prove
 616  (`!p. eventually p sequentially <=> ?N. !n. N <= n ==> p n`,
 617   REWRITE_TAC[eventually; SEQUENTIALLY; GE; LE_REFL;
 618     TRIVIAL_LIMIT_SEQUENTIALLY] THEN  MESON_TAC[LE_REFL]);;
 619
 620 let EVENTUALLY_AT_INFINITY = prove
 621  (`!p. eventually p at_infinity <=> ?b. !x. norm(x) >= b ==> p x`,
 622   REWRITE_TAC[eventually; AT_INFINITY; TRIVIAL_LIMIT_AT_INFINITY] THEN
 623   REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN
 624   MESON_TAC[real_ge; REAL_LE_REFL; VECTOR_CHOOSE_SIZE;
 625     REAL_ARITH `&0 <= b \/ (!x. x >= &0 ==> x >= b)`]);;
 626
 627 let EVENTUALLY_AT_INFINITY_POS = prove
 628  (`!p:real^N->bool.
 629         eventually p at_infinity <=> ?b. &0 < b /\ !x. norm x >= b ==> p x`,
 630   GEN_TAC THEN REWRITE_TAC[EVENTUALLY_AT_INFINITY; real_ge] THEN
 631   MESON_TAC[REAL_ARITH `&0 < abs b + &1 /\ (abs b + &1 <= x ==> b <= x)`]);;
 632
 633 let ALWAYS_EVENTUALLY = prove
 634  (`(!x. p x) ==> eventually p net`,
 635   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[eventually; trivial_limit] THEN
 636   MESON_TAC[]);;
 637
 638 (* ------------------------------------------------------------------------- *)
 639 (* Combining theorems for "eventually".                                      *)
 640 (* ------------------------------------------------------------------------- *)
 641
 642 let EVENTUALLY_AND = prove
 643  (`!net:(A net) p q.
 644         eventually (\x. p x /\ q x) net <=>
 645         eventually p net /\ eventually q net`,
 646   REPEAT GEN_TAC THEN REWRITE_TAC[eventually] THEN
 647   ASM_CASES_TAC `trivial_limit(net:(A net))` THEN ASM_REWRITE_TAC[] THEN
 648   EQ_TAC THEN SIMP_TAC[NET_DILEMMA] THEN MESON_TAC[]);;
 649
 650 let EVENTUALLY_MONO = prove
 651  (`!net:(A net) p q.
 652         (!x. p x ==> q x) /\ eventually p net
 653         ==> eventually q net`,
 654   REWRITE_TAC[eventually] THEN MESON_TAC[]);;
 655
 656 let EVENTUALLY_MP = prove
 657  (`!net:(A net) p q.
 658         eventually (\x. p x ==> q x) net /\ eventually p net
 659         ==> eventually q net`,
 660   REWRITE_TAC[GSYM EVENTUALLY_AND] THEN
 661   REWRITE_TAC[eventually] THEN MESON_TAC[]);;
 662
 663 let EVENTUALLY_FALSE = prove
 664  (`!net. eventually (\x. F) net <=> trivial_limit net`,
 665   REWRITE_TAC[eventually] THEN MESON_TAC[]);;
 666
 667 let EVENTUALLY_TRUE = prove
 668  (`!net. eventually (\x. T) net <=> T`,
 669   REWRITE_TAC[eventually; trivial_limit] THEN MESON_TAC[]);;
 670
 671 let NOT_EVENTUALLY = prove
 672  (`!net p. (!x. ~(p x)) /\ ~(trivial_limit net) ==> ~(eventually p net)`,
 673   REWRITE_TAC[eventually] THEN MESON_TAC[]);;
 674
 675 let EVENTUALLY_FORALL = prove
 676  (`!net:(A net) p s:B->bool.
 677         FINITE s /\ ~(s = {})
 678         ==> (eventually (\x. !a. a IN s ==> p a x) net <=>
 679              !a. a IN s ==> eventually (p a) net)`,
 680   GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
 681   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
 682   REWRITE_TAC[FORALL_IN_INSERT; EVENTUALLY_AND; ETA_AX] THEN
 683   MAP_EVERY X_GEN_TAC [`b:B`; `t:B->bool`] THEN
 684   ASM_CASES_TAC `t:B->bool = {}` THEN
 685   ASM_SIMP_TAC[NOT_IN_EMPTY; EVENTUALLY_TRUE]);;
 686
 687 let FORALL_EVENTUALLY = prove
 688  (`!net:(A net) p s:B->bool.
 689         FINITE s /\ ~(s = {})
 690         ==> ((!a. a IN s ==> eventually (p a) net) <=>
 691              eventually (\x. !a. a IN s ==> p a x) net)`,
 692   SIMP_TAC[EVENTUALLY_FORALL]);;
 693
 694 (* ------------------------------------------------------------------------- *)
 695 (* Limits, defined as vacuously true when the limit is trivial.              *)
 696 (* ------------------------------------------------------------------------- *)
 697
 698 parse_as_infix("-->",(12,"right"));;
 699
 700 let tendsto = new_definition
 701   `(f --> l) net <=> !e. &0 < e ==> eventually (\x. dist(f(x),l) < e) net`;;
 702
 703 let lim = new_definition
 704  `lim net f = @l. (f --> l) net`;;
 705
 706 let LIM = prove
 707  (`(f --> l) net <=>
 708         trivial_limit net \/
 709         !e. &0 < e ==> ?y. (?x. netord(net) x y) /\
 710                            !x. netord(net) x y ==> dist(f(x),l) < e`,
 711   REWRITE_TAC[tendsto; eventually] THEN MESON_TAC[]);;
 712
 713 (* ------------------------------------------------------------------------- *)
 714 (* Show that they yield usual definitions in the various cases.              *)
 715 (* ------------------------------------------------------------------------- *)
 716
 717 let LIM_WITHIN_LE = prove
 718  (`!f:real^M->real^N l a s.
 719         (f --> l)(at a within s) <=>
 720            !e. &0 < e ==> ?d. &0 < d /\
 721                               !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) <= d
 722                                    ==> dist(f(x),l) < e`,
 723   REWRITE_TAC[tendsto; EVENTUALLY_WITHIN_LE]);;
 724
 725 let LIM_WITHIN = prove
 726  (`!f:real^M->real^N l a s.
 727       (f --> l) (at a within s) <=>
 728         !e. &0 < e
 729             ==> ?d. &0 < d /\
 730                     !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) < d
 731                     ==> dist(f(x),l) < e`,
 732   REWRITE_TAC[tendsto; EVENTUALLY_WITHIN] THEN MESON_TAC[]);;
 733
 734 let LIM_AT_LE = prove
 735  (`!f l a. (f --> l) (at a) <=>
 736            !e. &0 < e
 737                ==> ?d. &0 < d /\
 738                        !x. &0 < dist(x,a) /\ dist(x,a) <= d
 739                            ==> dist (f x,l) < e`,
 740   ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
 741   REWRITE_TAC[LIM_WITHIN_LE; IN_UNIV]);;
 742
 743 let LIM_AT = prove
 744  (`!f l:real^N a:real^M.
 745       (f --> l) (at a) <=>
 746               !e. &0 < e
 747                   ==> ?d. &0 < d /\ !x. &0 < dist(x,a) /\ dist(x,a) < d
 748                           ==> dist(f(x),l) < e`,
 749   REWRITE_TAC[tendsto; EVENTUALLY_AT] THEN MESON_TAC[]);;
 750
 751 let LIM_AT_INFINITY = prove
 752  (`!f l. (f --> l) at_infinity <=>
 753                !e. &0 < e ==> ?b. !x. norm(x) >= b ==> dist(f(x),l) < e`,
 754   REWRITE_TAC[tendsto; EVENTUALLY_AT_INFINITY] THEN MESON_TAC[]);;
 755
 756 let LIM_AT_INFINITY_POS = prove
 757  (`!f l. (f --> l) at_infinity <=>
 758          !e. &0 < e ==> ?b. &0 < b /\ !x. norm x >= b ==> dist(f x,l) < e`,
 759   REPEAT GEN_TAC THEN REWRITE_TAC[LIM_AT_INFINITY] THEN
 760   MESON_TAC[REAL_ARITH `&0 < abs b + &1 /\ (x >= abs b + &1 ==> x >= b)`]);;
 761
 762 let LIM_SEQUENTIALLY = prove
 763  (`!s l. (s --> l) sequentially <=>
 764           !e. &0 < e ==> ?N. !n. N <= n ==> dist(s(n),l) < e`,
 765   REWRITE_TAC[tendsto; EVENTUALLY_SEQUENTIALLY] THEN MESON_TAC[]);;
 766
 767 let LIM_EVENTUALLY = prove
 768  (`!net f l. eventually (\x. f x = l) net ==> (f --> l) net`,
 769   REWRITE_TAC[eventually; LIM] THEN MESON_TAC[DIST_REFL]);;
 770
 771 (* ------------------------------------------------------------------------- *)
 772 (* The expected monotonicity property.                                       *)
 773 (* ------------------------------------------------------------------------- *)
 774
 775 let LIM_WITHIN_EMPTY = prove
 776  (`!f l x. (f --> l) (at x within {})`,
 777   REWRITE_TAC[LIM_WITHIN; NOT_IN_EMPTY] THEN MESON_TAC[REAL_LT_01]);;
 778
 779 let LIM_WITHIN_SUBSET = prove
 780  (`!f l a s.
 781     (f --> l) (at a within s) /\ t SUBSET s ==> (f --> l) (at a within t)`,
 782   REWRITE_TAC[LIM_WITHIN; SUBSET] THEN MESON_TAC[]);;
 783
 784 let LIM_UNION = prove
 785  (`!f x l s t.
 786         (f --> l) (at x within s) /\ (f --> l) (at x within t)
 787         ==> (f --> l) (at x within (s UNION t))`,
 788   REPEAT GEN_TAC THEN REWRITE_TAC[LIM_WITHIN; IN_UNION] THEN
 789   REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN
 790   X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_SIMP_TAC[] THEN
 791   DISCH_THEN(CONJUNCTS_THEN2
 792    (X_CHOOSE_TAC `d1:real`) (X_CHOOSE_TAC `d2:real`)) THEN
 793   EXISTS_TAC `min d1 d2` THEN ASM_MESON_TAC[REAL_LT_MIN]);;
 794
 795 let LIM_UNION_UNIV = prove
 796  (`!f x l s t.
 797         (f --> l) (at x within s) /\ (f --> l) (at x within t) /\
 798         s UNION t = (:real^N)
 799         ==> (f --> l) (at x)`,
 800   MESON_TAC[LIM_UNION; WITHIN_UNIV]);;
 801
 802 (* ------------------------------------------------------------------------- *)
 803 (* Composition of limits.                                                    *)
 804 (* ------------------------------------------------------------------------- *)
 805
 806 let LIM_COMPOSE_WITHIN = prove
 807  (`!net f:real^M->real^N g:real^N->real^P s y z.
 808     (f --> y) net /\
 809     eventually (\w. f w IN s /\ (f w = y ==> g y = z)) net /\
 810     (g --> z) (at y within s)
 811     ==> ((g o f) --> z) net`,
 812   REPEAT GEN_TAC THEN REWRITE_TAC[tendsto; CONJ_ASSOC] THEN
 813   ONCE_REWRITE_TAC[LEFT_AND_FORALL_THM] THEN
 814   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
 815   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
 816   ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
 817   REWRITE_TAC[EVENTUALLY_WITHIN; GSYM DIST_NZ; o_DEF] THEN
 818   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
 819   FIRST_X_ASSUM(MP_TAC o SPEC `d:real`) THEN
 820   ASM_REWRITE_TAC[GSYM EVENTUALLY_AND] THEN
 821   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
 822   ASM_MESON_TAC[DIST_REFL]);;
 823
 824 let LIM_COMPOSE_AT = prove
 825  (`!net f:real^M->real^N g:real^N->real^P y z.
 826     (f --> y) net /\
 827     eventually (\w. f w = y ==> g y = z) net /\
 828     (g --> z) (at y)
 829     ==> ((g o f) --> z) net`,
 830   REPEAT STRIP_TAC THEN
 831   MP_TAC(ISPECL [`net:(real^M)net`; `f:real^M->real^N`; `g:real^N->real^P`;
 832                  `(:real^N)`; `y:real^N`; `z:real^P`]
 833         LIM_COMPOSE_WITHIN) THEN
 834   ASM_REWRITE_TAC[IN_UNIV; WITHIN_UNIV]);;
 835
 836 (* ------------------------------------------------------------------------- *)
 837 (* Interrelations between restricted and unrestricted limits.                *)
 838 (* ------------------------------------------------------------------------- *)
 839
 840 let LIM_AT_WITHIN = prove
 841  (`!f l a s. (f --> l)(at a) ==> (f --> l)(at a within s)`,
 842   REWRITE_TAC[LIM_AT; LIM_WITHIN] THEN MESON_TAC[]);;
 843
 844 let LIM_WITHIN_OPEN = prove
 845  (`!f l a:real^M s.
 846      a IN s /\ open s ==> ((f --> l)(at a within s) <=> (f --> l)(at a))`,
 847   REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[LIM_AT_WITHIN] THEN
 848   REWRITE_TAC[LIM_AT; LIM_WITHIN] THEN
 849   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
 850   ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
 851    DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN
 852   FIRST_X_ASSUM(MP_TAC o SPEC `a:real^M` o GEN_REWRITE_RULE I [open_def]) THEN
 853   ASM_REWRITE_TAC[] THEN
 854   DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN
 855   MP_TAC(SPECL [`d1:real`; `d2:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN
 856   ASM_MESON_TAC[REAL_LT_TRANS]);;
 857
 858 (* ------------------------------------------------------------------------- *)
 859 (* More limit point characterizations.                                       *)
 860 (* ------------------------------------------------------------------------- *)
 861
 862 let LIMPT_SEQUENTIAL_INJ = prove
 863  (`!x:real^N s.
 864       x limit_point_of s <=>
 865              ?f. (!n. f(n) IN (s DELETE x)) /\
 866                  (!m n. f m = f n <=> m = n) /\
 867                  (f --> x) sequentially`,
 868   REPEAT GEN_TAC THEN
 869   REWRITE_TAC[LIMPT_APPROACHABLE; LIM_SEQUENTIALLY; IN_DELETE] THEN
 870   EQ_TAC THENL [ALL_TAC; MESON_TAC[GE; LE_REFL]] THEN
 871   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
 872   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
 873   X_GEN_TAC `y:real->real^N` THEN DISCH_TAC THEN
 874   (STRIP_ASSUME_TAC o  prove_recursive_functions_exist num_RECURSION)
 875    `(z 0 = y (&1)) /\
 876     (!n. z (SUC n):real^N = y(min (inv(&2 pow (SUC n))) (dist(z n,x))))` THEN
 877   EXISTS_TAC `z:num->real^N` THEN
 878   SUBGOAL_THEN
 879    `!n. z(n) IN s /\ ~(z n:real^N = x) /\ dist(z n,x) < inv(&2 pow n)`
 880   ASSUME_TAC THENL
 881    [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
 882     ASM_SIMP_TAC[REAL_LT_01] THEN FIRST_X_ASSUM(MP_TAC o SPEC
 883      `min (inv(&2 pow (SUC n))) (dist(z n:real^N,x))`) THEN
 884     ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; REAL_LT_POW2; DIST_POS_LT];
 885     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
 886      [MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[EQ_SYM_EQ] THEN
 887       SUBGOAL_THEN `!m n:num. m < n ==> dist(z n:real^N,x) < dist(z m,x)`
 888        (fun th -> MESON_TAC[th; REAL_LT_REFL; LT_REFL]) THEN
 889       MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN
 890       CONJ_TAC THENL [REAL_ARITH_TAC; GEN_TAC THEN ASM_REWRITE_TAC[]] THEN
 891       FIRST_X_ASSUM(MP_TAC o SPEC
 892        `min (inv(&2 pow (SUC n))) (dist(z n:real^N,x))`) THEN
 893       ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; REAL_LT_POW2; DIST_POS_LT];
 894       X_GEN_TAC `e:real` THEN DISCH_TAC THEN
 895       MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN
 896       ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN
 897       X_GEN_TAC `N:num` THEN REWRITE_TAC[REAL_POW_INV] THEN DISCH_TAC THEN
 898       X_GEN_TAC `n:num` THEN DISCH_TAC THEN
 899       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
 900         REAL_LT_TRANS)) THEN
 901       MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(&2 pow n)` THEN
 902       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
 903       ASM_REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO THEN
 904       REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC]]);;
 905
 906 let LIMPT_SEQUENTIAL = prove
 907  (`!x:real^N s.
 908       x limit_point_of s <=>
 909              ?f. (!n. f(n) IN (s DELETE x)) /\ (f --> x) sequentially`,
 910   REPEAT GEN_TAC THEN EQ_TAC THENL
 911    [REWRITE_TAC[LIMPT_SEQUENTIAL_INJ] THEN MESON_TAC[];
 912     REWRITE_TAC[LIMPT_APPROACHABLE; LIM_SEQUENTIALLY; IN_DELETE] THEN
 913     MESON_TAC[GE; LE_REFL]]);;
 914
 915 let [LIMPT_INFINITE_OPEN; LIMPT_INFINITE_BALL; LIMPT_INFINITE_CBALL] =
 916     (CONJUNCTS o prove)
 917  (`(!s x:real^N.
 918         x limit_point_of s <=> !t. x IN t /\ open t ==> INFINITE(s INTER t)) /\
 919    (!s x:real^N.
 920         x limit_point_of s <=> !e. &0 < e ==> INFINITE(s INTER ball(x,e))) /\
 921    (!s x:real^N.
 922         x limit_point_of s <=> !e. &0 < e ==> INFINITE(s INTER cball(x,e)))`,
 923   REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT
 924    `(q ==> p) /\ (r ==> s) /\ (s ==> q) /\ (p ==> r)
 925     ==> (p <=> q) /\ (p <=> r) /\ (p <=> s)`) THEN
 926   REPEAT CONJ_TAC THENL
 927    [REWRITE_TAC[limit_point_of; INFINITE; SET_RULE
 928      `(?y. ~(y = x) /\ y IN s /\ y IN t) <=> ~(s INTER t SUBSET {x})`] THEN
 929     MESON_TAC[FINITE_SUBSET; FINITE_SING];
 930     MESON_TAC[INFINITE_SUPERSET; BALL_SUBSET_CBALL;
 931               SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`];
 932     MESON_TAC[INFINITE_SUPERSET; OPEN_CONTAINS_CBALL;
 933               SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`];
 934     REWRITE_TAC[LIMPT_SEQUENTIAL_INJ; IN_DELETE; FORALL_AND_THM] THEN
 935     DISCH_THEN(X_CHOOSE_THEN `f:num->real^N` STRIP_ASSUME_TAC) THEN
 936     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
 937     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN
 938     DISCH_THEN(MP_TAC o SPEC `e:real`) THEN
 939     ASM_REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] IN_BALL)] THEN
 940     DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN
 941     MATCH_MP_TAC INFINITE_SUPERSET THEN
 942     EXISTS_TAC `IMAGE (f:num->real^N) (from N)` THEN
 943     ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_FROM; IN_INTER] THEN
 944     ASM_MESON_TAC[INFINITE_IMAGE_INJ; INFINITE_FROM]]);;
 945
 946 let INFINITE_OPEN_IN = prove
 947  (`!u s:real^N->bool.
 948       open_in (subtopology euclidean u) s /\ (?x. x IN s /\ x limit_point_of u)
 949       ==> INFINITE s`,
 950   REPEAT STRIP_TAC THEN
 951   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
 952   DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
 953   FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool` o
 954         GEN_REWRITE_RULE I [LIMPT_INFINITE_OPEN]) THEN
 955   FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM SET_TAC[]);;
 956
 957 (* ------------------------------------------------------------------------- *)
 958 (* Condensation points.                                                      *)
 959 (* ------------------------------------------------------------------------- *)
 960
 961 parse_as_infix ("condensation_point_of",(12,"right"));;
 962
 963 let condensation_point_of = new_definition
 964  `x condensation_point_of s <=>
 965         !t. x IN t /\ open t ==> ~COUNTABLE(s INTER t)`;;
 966
 967 let CONDENSATION_POINT_OF_SUBSET = prove
 968  (`!x:real^N s t.
 969         x condensation_point_of s /\ s SUBSET t ==> x condensation_point_of t`,
 970   REPEAT GEN_TAC THEN
 971   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
 972   REWRITE_TAC[condensation_point_of] THEN
 973   MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
 974   REWRITE_TAC[CONTRAPOS_THM] THEN
 975   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN
 976   ASM SET_TAC[]);;
 977
 978 let CONDENSATION_POINT_IMP_LIMPT = prove
 979  (`!x s. x condensation_point_of s ==> x limit_point_of s`,
 980   REWRITE_TAC[condensation_point_of; LIMPT_INFINITE_OPEN; INFINITE] THEN
 981   MESON_TAC[FINITE_IMP_COUNTABLE]);;
 982
 983 let CONDENSATION_POINT_INFINITE_BALL,CONDENSATION_POINT_INFINITE_CBALL =
 984   (CONJ_PAIR o prove)
 985  (`(!s x:real^N.
 986         x condensation_point_of s <=>
 987         !e. &0 < e ==> ~COUNTABLE(s INTER ball(x,e))) /\
 988    (!s x:real^N.
 989         x condensation_point_of s <=>
 990         !e. &0 < e ==> ~COUNTABLE(s INTER cball(x,e)))`,
 991   REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT
 992    `(p ==> q) /\ (q ==> r) /\ (r ==> p)
 993     ==> (p <=> q) /\ (p <=> r)`) THEN
 994   REWRITE_TAC[condensation_point_of] THEN REPEAT CONJ_TAC THENL
 995    [MESON_TAC[OPEN_BALL; CENTRE_IN_BALL];
 996     MESON_TAC[BALL_SUBSET_CBALL; COUNTABLE_SUBSET;
 997               SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`];
 998     MESON_TAC[COUNTABLE_SUBSET; OPEN_CONTAINS_CBALL;
 999               SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`]]);;
1000
1001 (* ------------------------------------------------------------------------- *)
1002 (* Basic arithmetical combining theorems for limits.                         *)
1003 (* ------------------------------------------------------------------------- *)
1004
1005 let LIM_LINEAR = prove
1006  (`!net:(A)net h f l.
1007         (f --> l) net /\ linear h ==> ((\x. h(f x)) --> h l) net`,
1008   REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN
1009   ASM_CASES_TAC `trivial_limit (net:(A)net)` THEN ASM_REWRITE_TAC[] THEN
1010   STRIP_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o
1011     MATCH_MP LINEAR_BOUNDED_POS) THEN
1012   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
1013   FIRST_X_ASSUM(MP_TAC o SPEC `e / B`) THEN
1014   ASM_SIMP_TAC[REAL_LT_DIV; dist; GSYM LINEAR_SUB; REAL_LT_RDIV_EQ] THEN
1015   ASM_MESON_TAC[REAL_LET_TRANS; REAL_MUL_SYM]);;
1016
1017 let LIM_CONST = prove
1018  (`!net a:real^N. ((\x. a) --> a) net`,
1019   SIMP_TAC[LIM; DIST_REFL; trivial_limit] THEN MESON_TAC[]);;
1020
1021 let LIM_CMUL = prove
1022  (`!f l c. (f --> l) net ==> ((\x. c % f x) --> c % l) net`,
1023   REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_LINEAR THEN
1024   ASM_REWRITE_TAC[REWRITE_RULE[ETA_AX]
1025     (MATCH_MP LINEAR_COMPOSE_CMUL LINEAR_ID)]);;
1026
1027 let LIM_CMUL_EQ = prove
1028  (`!net f l c.
1029         ~(c = &0) ==> (((\x. c % f x) --> c % l) net <=> (f --> l) net)`,
1030   REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[LIM_CMUL] THEN
1031   DISCH_THEN(MP_TAC o SPEC `inv c:real` o MATCH_MP LIM_CMUL) THEN
1032   ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID; ETA_AX]);;
1033
1034 let LIM_NEG = prove
1035  (`!net f l:real^N. (f --> l) net ==> ((\x. --(f x)) --> --l) net`,
1036   REPEAT GEN_TAC THEN REWRITE_TAC[LIM; dist] THEN
1037   REWRITE_TAC[VECTOR_ARITH `--x - --y = --(x - y:real^N)`; NORM_NEG]);;
1038
1039 let LIM_NEG_EQ = prove
1040  (`!net f l:real^N. ((\x. --(f x)) --> --l) net <=> (f --> l) net`,
1041   REPEAT GEN_TAC THEN EQ_TAC THEN
1042   DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG) THEN
1043   REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX]);;
1044
1045 let LIM_ADD = prove
1046  (`!net:(A)net f g l m.
1047     (f --> l) net /\ (g --> m) net ==> ((\x. f(x) + g(x)) --> l + m) net`,
1048   REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN
1049   ASM_CASES_TAC `trivial_limit (net:(A)net)` THEN
1050   ASM_REWRITE_TAC[AND_FORALL_THM] THEN
1051   DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
1052   FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
1053   DISCH_THEN(MP_TAC o MATCH_MP NET_DILEMMA) THEN MATCH_MP_TAC MONO_EXISTS THEN
1054   MESON_TAC[REAL_HALF; DIST_TRIANGLE_ADD; REAL_LT_ADD2; REAL_LET_TRANS]);;
1055
1056 let LIM_ABS = prove
1057  (`!net:(A)net f:A->real^N l.
1058      (f --> l) net
1059      ==> ((\x. lambda i. (abs(f(x)$i))) --> (lambda i. abs(l$i)):real^N) net`,
1060   REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN
1061   ASM_CASES_TAC `trivial_limit (net:(A)net)` THEN ASM_REWRITE_TAC[] THEN
1062   MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
1063   MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
1064   MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
1065   MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN
1066   MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
1067   MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
1068   MATCH_MP_TAC(NORM_ARITH
1069    `norm(x - y) <= norm(a - b) ==> dist(a,b) < e ==> dist(x,y) < e`) THEN
1070   MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN
1071   SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT] THEN
1072   REAL_ARITH_TAC);;
1073
1074 let LIM_SUB = prove
1075  (`!net:(A)net f g l m.
1076     (f --> l) net /\ (g --> m) net ==> ((\x. f(x) - g(x)) --> l - m) net`,
1077   REWRITE_TAC[real_sub; VECTOR_SUB] THEN ASM_SIMP_TAC[LIM_ADD; LIM_NEG]);;
1078
1079 let LIM_MAX = prove
1080  (`!net:(A)net f g l:real^N m:real^N.
1081     (f --> l) net /\ (g --> m) net
1082     ==> ((\x. lambda i. max (f(x)$i) (g(x)$i))
1083          --> (lambda i. max (l$i) (m$i)):real^N) net`,
1084   REPEAT GEN_TAC THEN DISCH_TAC THEN
1085   FIRST_ASSUM(MP_TAC o MATCH_MP LIM_ADD) THEN
1086   FIRST_ASSUM(MP_TAC o MATCH_MP LIM_SUB) THEN
1087   DISCH_THEN(MP_TAC o MATCH_MP LIM_ABS) THEN
1088   REWRITE_TAC[IMP_IMP] THEN
1089   DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN
1090   DISCH_THEN(MP_TAC o SPEC `inv(&2)` o MATCH_MP LIM_CMUL) THEN
1091   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN
1092   SIMP_TAC[FUN_EQ_THM; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
1093            VECTOR_SUB_COMPONENT; LAMBDA_BETA] THEN
1094   REAL_ARITH_TAC);;
1095
1096 let LIM_MIN = prove
1097  (`!net:(A)net f g l:real^N m:real^N.
1098     (f --> l) net /\ (g --> m) net
1099     ==> ((\x. lambda i. min (f(x)$i) (g(x)$i))
1100          --> (lambda i. min (l$i) (m$i)):real^N) net`,
1101   REPEAT GEN_TAC THEN
1102   DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP LIM_NEG)) THEN
1103   REWRITE_TAC[IMP_IMP] THEN
1104   DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG o MATCH_MP LIM_MAX) THEN
1105   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN
1106   SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA; VECTOR_NEG_COMPONENT] THEN
1107   REAL_ARITH_TAC);;
1108
1109 let LIM_NORM = prove
1110  (`!net f:A->real^N l.
1111         (f --> l) net ==> ((\x. lift(norm(f x))) --> lift(norm l)) net`,
1112   REPEAT GEN_TAC THEN REWRITE_TAC[tendsto; DIST_LIFT] THEN
1113   MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
1114   REWRITE_TAC[] THEN
1115   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
1116   REWRITE_TAC[] THEN NORM_ARITH_TAC);;
1117
1118 let LIM_NULL = prove
1119  (`!net f l. (f --> l) net <=> ((\x. f(x) - l) --> vec 0) net`,
1120   REWRITE_TAC[LIM; dist; VECTOR_SUB_RZERO]);;
1121
1122 let LIM_NULL_NORM = prove
1123  (`!net f. (f --> vec 0) net <=> ((\x. lift(norm(f x))) --> vec 0) net`,
1124   REWRITE_TAC[LIM; dist; VECTOR_SUB_RZERO; REAL_ABS_NORM; NORM_LIFT]);;
1125
1126 let LIM_NULL_CMUL_EQ = prove
1127  (`!net f c.
1128         ~(c = &0) ==> (((\x. c % f x) --> vec 0) net <=> (f --> vec 0) net)`,
1129   MESON_TAC[LIM_CMUL_EQ; VECTOR_MUL_RZERO]);;
1130
1131 let LIM_NULL_CMUL = prove
1132  (`!net f c. (f --> vec 0) net ==> ((\x. c % f x) --> vec 0) net`,
1133   REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN
1134   ASM_SIMP_TAC[LIM_NULL_CMUL_EQ; VECTOR_MUL_LZERO; LIM_CONST]);;
1135
1136 let LIM_NULL_COMPARISON = prove
1137  (`!net f g. eventually (\x. norm(f x) <= g x) net /\
1138              ((\x. lift(g x)) --> vec 0) net
1139              ==> (f --> vec 0) net`,
1140   REPEAT GEN_TAC THEN REWRITE_TAC[tendsto; RIGHT_AND_FORALL_THM] THEN
1141   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
1142   ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[GSYM EVENTUALLY_AND] THEN
1143   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
1144   REWRITE_TAC[dist; VECTOR_SUB_RZERO; NORM_LIFT] THEN REAL_ARITH_TAC);;
1145
1146 let LIM_COMPONENT = prove
1147  (`!net f i l:real^N. (f --> l) net /\ 1 <= i /\ i <= dimindex(:N)
1148                       ==> ((\a. lift(f(a)$i)) --> lift(l$i)) net`,
1149   REWRITE_TAC[LIM; dist; GSYM LIFT_SUB; NORM_LIFT] THEN
1150   SIMP_TAC[GSYM VECTOR_SUB_COMPONENT] THEN
1151   MESON_TAC[COMPONENT_LE_NORM; REAL_LET_TRANS]);;
1152
1153 let LIM_TRANSFORM_BOUND = prove
1154  (`!f g. eventually (\n. norm(f n) <= norm(g n)) net /\ (g --> vec 0) net
1155          ==> (f --> vec 0) net`,
1156   REPEAT GEN_TAC THEN
1157   REWRITE_TAC[tendsto; RIGHT_AND_FORALL_THM] THEN
1158   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
1159   ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[GSYM EVENTUALLY_AND] THEN
1160   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
1161   REWRITE_TAC[dist; VECTOR_SUB_RZERO] THEN REAL_ARITH_TAC);;
1162
1163 let LIM_NULL_CMUL_BOUNDED = prove
1164  (`!f g:A->real^N B.
1165         eventually (\a. g a = vec 0 \/ abs(f a) <= B) net /\
1166         (g --> vec 0) net
1167         ==> ((\n. f n % g n) --> vec 0) net`,
1168   REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN STRIP_TAC THEN
1169   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
1170   FIRST_X_ASSUM(MP_TAC o SPEC `e / (abs B + &1)`) THEN
1171   ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < abs x + &1`] THEN
1172   UNDISCH_TAC `eventually (\a. g a:real^N = vec 0 \/ abs(f a) <= B)
1173                            (net:(A net))` THEN
1174   REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND] THEN
1175   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MP) THEN
1176   REWRITE_TAC[dist; VECTOR_SUB_RZERO; o_THM; NORM_LIFT; NORM_MUL] THEN
1177   MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `x:A` THEN REWRITE_TAC[] THEN
1178   ASM_CASES_TAC `(g:A->real^N) x = vec 0` THEN
1179   ASM_REWRITE_TAC[NORM_0; REAL_MUL_RZERO] THEN
1180   STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN
1181   EXISTS_TAC `B * e / (abs B + &1)` THEN
1182   ASM_SIMP_TAC[REAL_LE_MUL2; REAL_ABS_POS; NORM_POS_LE; REAL_LT_IMP_LE] THEN
1183   REWRITE_TAC[REAL_ARITH `c * (a / b) = (c * a) / b`] THEN
1184   SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 < abs x + &1`] THEN
1185   MATCH_MP_TAC(REAL_ARITH
1186    `e * B <= e * abs B /\ &0 < e ==> B * e < e * (abs B + &1)`) THEN
1187   ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN REAL_ARITH_TAC);;
1188
1189 let LIM_NULL_VMUL_BOUNDED = prove
1190  (`!f g:A->real^N B.
1191         ((lift o f) --> vec 0) net /\
1192         eventually (\a. f a = &0 \/ norm(g a) <= B) net
1193         ==> ((\n. f n % g n) --> vec 0) net`,
1194   REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN STRIP_TAC THEN
1195   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
1196   FIRST_X_ASSUM(MP_TAC o SPEC `e / (abs B + &1)`) THEN
1197   ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < abs x + &1`] THEN
1198   UNDISCH_TAC `eventually(\a. f a = &0 \/ norm((g:A->real^N) a) <= B) net` THEN
1199   REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND] THEN
1200   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MP) THEN
1201   REWRITE_TAC[dist; VECTOR_SUB_RZERO; o_THM; NORM_LIFT; NORM_MUL] THEN
1202   MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `x:A` THEN REWRITE_TAC[] THEN
1203   ASM_CASES_TAC `(f:A->real) x = &0` THEN
1204   ASM_REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LZERO] THEN
1205   STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN
1206   EXISTS_TAC `e / (abs B + &1) * B` THEN
1207   ASM_SIMP_TAC[REAL_LE_MUL2; REAL_ABS_POS; NORM_POS_LE; REAL_LT_IMP_LE] THEN
1208   REWRITE_TAC[REAL_ARITH `(a / b) * c = (a * c) / b`] THEN
1209   SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 < abs x + &1`] THEN
1210   MATCH_MP_TAC(REAL_ARITH
1211    `e * B <= e * abs B /\ &0 < e ==> e * B < e * (abs B + &1)`) THEN
1212   ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN REAL_ARITH_TAC);;
1213
1214 let LIM_VSUM = prove
1215  (`!f:A->B->real^N s.
1216         FINITE s /\ (!i. i IN s ==> ((f i) --> (l i)) net)
1217         ==> ((\x. vsum s (\i. f i x)) --> vsum s l) net`,
1218   GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
1219   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1220   SIMP_TAC[VSUM_CLAUSES; LIM_CONST; LIM_ADD; IN_INSERT; ETA_AX]);;
1221
1222 (* ------------------------------------------------------------------------- *)
1223 (* Deducing things about the limit from the elements.                        *)
1224 (* ------------------------------------------------------------------------- *)
1225
1226 let LIM_IN_CLOSED_SET = prove
1227  (`!net f:A->real^N s l.
1228         closed s /\ eventually (\x. f(x) IN s) net /\
1229         ~(trivial_limit net) /\ (f --> l) net
1230         ==> l IN s`,
1231   REWRITE_TAC[closed] THEN REPEAT STRIP_TAC THEN
1232   MATCH_MP_TAC(SET_RULE `~(x IN (UNIV DIFF s)) ==> x IN s`) THEN
1233   DISCH_TAC THEN
1234   FIRST_ASSUM(MP_TAC o SPEC `l:real^N` o GEN_REWRITE_RULE I
1235           [OPEN_CONTAINS_BALL]) THEN
1236   ASM_REWRITE_TAC[SUBSET; IN_BALL; IN_DIFF; IN_UNION] THEN
1237   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
1238   FIRST_X_ASSUM(MP_TAC o SPEC `e:real` o GEN_REWRITE_RULE I [tendsto]) THEN
1239   UNDISCH_TAC `eventually (\x. (f:A->real^N) x IN s) net` THEN
1240   ASM_REWRITE_TAC[GSYM EVENTUALLY_AND; TAUT `a ==> ~b <=> ~(a /\ b)`] THEN
1241   MATCH_MP_TAC NOT_EVENTUALLY THEN ASM_MESON_TAC[DIST_SYM]);;
1242
1243 (* ------------------------------------------------------------------------- *)
1244 (* Need to prove closed(cball(x,e)) before deducing this as a corollary.     *)
1245 (* ------------------------------------------------------------------------- *)
1246
1247 let LIM_NORM_UBOUND = prove
1248  (`!net:(A)net f (l:real^N) b.
1249       ~(trivial_limit net) /\
1250       (f --> l) net /\
1251       eventually (\x. norm(f x) <= b) net
1252       ==> norm(l) <= b`,
1253   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1254   ASM_REWRITE_TAC[LIM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1255   ASM_REWRITE_TAC[eventually] THEN
1256   STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN
1257   ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN
1258   SUBGOAL_THEN
1259    `?x:A. dist(f(x):real^N,l) < norm(l:real^N) - b /\ norm(f x) <= b`
1260   (CHOOSE_THEN MP_TAC) THENL [ASM_MESON_TAC[NET]; ALL_TAC] THEN
1261   REWRITE_TAC[REAL_NOT_LT; REAL_LE_SUB_RADD; DE_MORGAN_THM; dist] THEN
1262   NORM_ARITH_TAC);;
1263
1264 let LIM_NORM_LBOUND = prove
1265  (`!net:(A)net f (l:real^N) b.
1266       ~(trivial_limit net) /\ (f --> l) net /\
1267       eventually (\x. b <= norm(f x)) net
1268       ==> b <= norm(l)`,
1269   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1270   ASM_REWRITE_TAC[LIM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1271   ASM_REWRITE_TAC[eventually] THEN
1272   STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN
1273   ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN
1274   SUBGOAL_THEN
1275    `?x:A. dist(f(x):real^N,l) < b - norm(l:real^N) /\ b <= norm(f x)`
1276   (CHOOSE_THEN MP_TAC) THENL [ASM_MESON_TAC[NET]; ALL_TAC] THEN
1277   REWRITE_TAC[REAL_NOT_LT; REAL_LE_SUB_RADD; DE_MORGAN_THM; dist] THEN
1278   NORM_ARITH_TAC);;
1279
1280 (* ------------------------------------------------------------------------- *)
1281 (* Uniqueness of the limit, when nontrivial.                                 *)
1282 (* ------------------------------------------------------------------------- *)
1283
1284 let LIM_UNIQUE = prove
1285  (`!net:(A)net f l:real^N l'.
1286       ~(trivial_limit net) /\ (f --> l) net /\ (f --> l') net ==> (l = l')`,
1287   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1288   DISCH_THEN(ASSUME_TAC o REWRITE_RULE[VECTOR_SUB_REFL] o MATCH_MP LIM_SUB) THEN
1289   SUBGOAL_THEN `!e. &0 < e ==> norm(l:real^N - l') <= e` MP_TAC THENL
1290    [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC LIM_NORM_UBOUND THEN
1291     MAP_EVERY EXISTS_TAC [`net:(A)net`; `\x:A. vec 0 : real^N`] THEN
1292     ASM_SIMP_TAC[NORM_0; REAL_LT_IMP_LE; eventually] THEN
1293     ASM_MESON_TAC[trivial_limit];
1294     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DIST_NZ; dist] THEN
1295     DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `norm(l - l':real^N) / &2`) THEN
1296     ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN
1297     UNDISCH_TAC `&0 < norm(l - l':real^N)` THEN REAL_ARITH_TAC]);;
1298
1299 let TENDSTO_LIM = prove
1300  (`!net f l. ~(trivial_limit net) /\ (f --> l) net ==> lim net f = l`,
1301   REWRITE_TAC[lim] THEN MESON_TAC[LIM_UNIQUE]);;
1302
1303 let LIM_CONST_EQ = prove
1304  (`!net:(A net) c d:real^N.
1305         ((\x. c) --> d) net <=> trivial_limit net \/ c = d`,
1306   REPEAT GEN_TAC THEN
1307   ASM_CASES_TAC `trivial_limit (net:A net)` THEN ASM_REWRITE_TAC[] THENL
1308    [ASM_REWRITE_TAC[LIM]; ALL_TAC] THEN
1309   EQ_TAC THEN SIMP_TAC[LIM_CONST] THEN DISCH_TAC THEN
1310   MATCH_MP_TAC(SPEC `net:A net` LIM_UNIQUE) THEN
1311   EXISTS_TAC `(\x. c):A->real^N` THEN ASM_REWRITE_TAC[LIM_CONST]);;
1312
1313 (* ------------------------------------------------------------------------- *)
1314 (* Some unwieldy but occasionally useful theorems about uniform limits.      *)
1315 (* ------------------------------------------------------------------------- *)
1316
1317 let UNIFORM_LIM_ADD = prove
1318  (`!net:(A)net P f g l m.
1319         (!e. &0 < e
1320              ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\
1321         (!e. &0 < e
1322              ==> eventually (\x. !n. P n ==> norm(g n x - m n) < e) net)
1323         ==> !e. &0 < e
1324                 ==> eventually
1325                      (\x. !n. P n
1326                               ==> norm((f n x + g n x) - (l n + m n)) < e)
1327                      net`,
1328   REPEAT GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN DISCH_TAC THEN
1329   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
1330   FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
1331   ASM_REWRITE_TAC[REAL_HALF; GSYM EVENTUALLY_AND] THEN
1332   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
1333   GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN
1334   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:B` THEN
1335   ASM_CASES_TAC `(P:B->bool) n` THEN ASM_REWRITE_TAC[] THEN
1336   CONV_TAC NORM_ARITH);;
1337
1338 let UNIFORM_LIM_SUB = prove
1339  (`!net:(A)net P f g l m.
1340         (!e. &0 < e
1341              ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\
1342         (!e. &0 < e
1343              ==> eventually (\x. !n. P n ==> norm(g n x - m n) < e) net)
1344         ==> !e. &0 < e
1345                 ==> eventually
1346                      (\x. !n. P n
1347                               ==> norm((f n x - g n x) - (l n - m n)) < e)
1348                      net`,
1349   REPEAT GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN DISCH_TAC THEN
1350   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
1351   FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
1352   ASM_REWRITE_TAC[REAL_HALF; GSYM EVENTUALLY_AND] THEN
1353   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
1354   GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN
1355   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:B` THEN
1356   ASM_CASES_TAC `(P:B->bool) n` THEN ASM_REWRITE_TAC[] THEN
1357   CONV_TAC NORM_ARITH);;
1358
1359 (* ------------------------------------------------------------------------- *)
1360 (* Limit under bilinear function, uniform version first.                     *)
1361 (* ------------------------------------------------------------------------- *)
1362
1363 let UNIFORM_LIM_BILINEAR = prove
1364  (`!net:(A)net P (h:real^M->real^N->real^P) f g l m b1 b2.
1365         bilinear h /\
1366         eventually (\x. !n. P n ==> norm(l n) <= b1) net /\
1367         eventually (\x. !n. P n ==> norm(m n) <= b2) net /\
1368         (!e. &0 < e
1369              ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\
1370         (!e. &0 < e
1371              ==> eventually (\x. !n. P n ==> norm(g n x - m n) < e) net)
1372         ==> !e. &0 < e
1373                 ==> eventually
1374                      (\x. !n. P n
1375                               ==> norm(h (f n x) (g n x) - h (l n) (m n)) < e)
1376                      net`,
1377   REPEAT GEN_TAC THEN
1378   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1379   FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o  MATCH_MP
1380    BILINEAR_BOUNDED_POS) THEN
1381   REWRITE_TAC[AND_FORALL_THM; RIGHT_AND_FORALL_THM] THEN DISCH_TAC THEN
1382   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
1383   FIRST_X_ASSUM(MP_TAC o SPEC
1384    `min (abs b2 + &1) (e / &2 / (B * (abs b1 + abs b2 + &2)))`) THEN
1385   ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; REAL_LT_MUL; REAL_LT_MIN;
1386                REAL_ARITH `&0 < abs x + &1`;
1387                REAL_ARITH `&0 < abs x + abs y + &2`] THEN
1388   REWRITE_TAC[GSYM EVENTUALLY_AND] THEN
1389   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
1390   X_GEN_TAC `x:A` THEN REWRITE_TAC[AND_FORALL_THM] THEN
1391   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:B` THEN
1392   ASM_CASES_TAC `(P:B->bool) n` THEN ASM_REWRITE_TAC[] THEN
1393   STRIP_TAC THEN
1394   ONCE_REWRITE_TAC[VECTOR_ARITH
1395     `h a b - h c d :real^N = (h a b - h a d) + (h a d - h c d)`] THEN
1396   ASM_SIMP_TAC[GSYM BILINEAR_LSUB; GSYM BILINEAR_RSUB] THEN
1397   MATCH_MP_TAC NORM_TRIANGLE_LT THEN
1398   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
1399    (MESON[REAL_LE_ADD2; REAL_LET_TRANS]
1400      `(!x y. norm(h x y:real^P) <= B * norm x * norm y)
1401        ==> B * norm a * norm b + B * norm c * norm d < e
1402            ==> norm(h a b) + norm(h c d) < e`)) THEN
1403   MATCH_MP_TAC(REAL_ARITH
1404    `x * B < e / &2 /\ y * B < e / &2 ==> B * x + B * y < e`) THEN
1405   CONJ_TAC THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THENL
1406    [ONCE_REWRITE_TAC[REAL_MUL_SYM]; ALL_TAC] THEN
1407   MATCH_MP_TAC REAL_LET_TRANS THEN
1408   EXISTS_TAC `e / &2 / (B * (abs b1 + abs b2 + &2)) *
1409              (abs b1 + abs b2 + &1)` THEN
1410   (CONJ_TAC THENL
1411     [MATCH_MP_TAC REAL_LE_MUL2 THEN
1412      ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE] THEN
1413      ASM_SIMP_TAC[REAL_ARITH `a <= b2 ==> a <= abs b1 + abs b2 + &1`] THEN
1414      ASM_MESON_TAC[NORM_ARITH
1415        `norm(f - l:real^P) < abs b2 + &1 /\ norm(l) <= b1
1416         ==> norm(f) <= abs b1 + abs b2 + &1`];
1417      ONCE_REWRITE_TAC[real_div] THEN
1418      ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_HALF; GSYM REAL_MUL_ASSOC;
1419                   REAL_INV_MUL] THEN
1420      REWRITE_TAC[REAL_ARITH `B * inv x * y < B <=> B * y / x < B * &1`] THEN
1421      ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_LT_LMUL_EQ; REAL_LT_LDIV_EQ;
1422                   REAL_ARITH `&0 < abs x + abs y + &2`] THEN
1423      REAL_ARITH_TAC]));;
1424
1425 let LIM_BILINEAR = prove
1426  (`!net:(A)net (h:real^M->real^N->real^P) f g l m.
1427         (f --> l) net /\ (g --> m) net /\ bilinear h
1428         ==> ((\x. h (f x) (g x)) --> (h l m)) net`,
1429   REPEAT STRIP_TAC THEN
1430   MP_TAC(ISPECL
1431    [`net:(A)net`; `\x:one. T`; `h:real^M->real^N->real^P`;
1432     `\n:one. (f:A->real^M)`; `\n:one. (g:A->real^N)`;
1433     `\n:one. (l:real^M)`; `\n:one. (m:real^N)`;
1434     `norm(l:real^M)`; `norm(m:real^N)`]
1435    UNIFORM_LIM_BILINEAR) THEN
1436   ASM_REWRITE_TAC[REAL_LE_REFL; EVENTUALLY_TRUE] THEN
1437   ASM_REWRITE_TAC[GSYM dist; GSYM tendsto]);;
1438
1439 (* ------------------------------------------------------------------------- *)
1440 (* These are special for limits out of the same vector space.                *)
1441 (* ------------------------------------------------------------------------- *)
1442
1443 let LIM_WITHIN_ID = prove
1444  (`!a s. ((\x. x) --> a) (at a within s)`,
1445   REWRITE_TAC[LIM_WITHIN] THEN MESON_TAC[]);;
1446
1447 let LIM_AT_ID = prove
1448  (`!a. ((\x. x) --> a) (at a)`,
1449   ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[LIM_WITHIN_ID]);;
1450
1451 let LIM_AT_ZERO = prove
1452  (`!f:real^M->real^N l a.
1453         (f --> l) (at a) <=> ((\x. f(a + x)) --> l) (at(vec 0))`,
1454   REPEAT GEN_TAC THEN REWRITE_TAC[LIM_AT] THEN
1455   AP_TERM_TAC THEN ABS_TAC THEN
1456   ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
1457   AP_TERM_TAC THEN ABS_TAC THEN
1458   ASM_CASES_TAC `&0 < d` THEN ASM_REWRITE_TAC[] THEN
1459   EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `x:real^M` THENL
1460    [FIRST_X_ASSUM(MP_TAC o SPEC `a + x:real^M`) THEN
1461     REWRITE_TAC[dist; VECTOR_ADD_SUB; VECTOR_SUB_RZERO];
1462     FIRST_X_ASSUM(MP_TAC o SPEC `x - a:real^M`) THEN
1463     REWRITE_TAC[dist; VECTOR_SUB_RZERO; VECTOR_SUB_ADD2]]);;
1464
1465 (* ------------------------------------------------------------------------- *)
1466 (* It's also sometimes useful to extract the limit point from the net.       *)
1467 (* ------------------------------------------------------------------------- *)
1468
1469 let netlimit = new_definition
1470   `netlimit net = @a. !x. ~(netord net x a)`;;
1471
1472 let NETLIMIT_WITHIN = prove
1473  (`!a:real^N s. ~(trivial_limit (at a within s))
1474                 ==> (netlimit (at a within s) = a)`,
1475   REWRITE_TAC[trivial_limit; netlimit; AT; WITHIN; DE_MORGAN_THM] THEN
1476   REPEAT STRIP_TAC THEN MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[] THEN
1477   SUBGOAL_THEN
1478    `!x:real^N. ~(&0 < dist(x,a) /\ dist(x,a) <= dist(a,a) /\ x IN s)`
1479   ASSUME_TAC THENL
1480    [ASM_MESON_TAC[DIST_REFL; REAL_NOT_LT]; ASM_MESON_TAC[]]);;
1481
1482 let NETLIMIT_AT = prove
1483  (`!a. netlimit(at a) = a`,
1484   GEN_TAC THEN ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
1485   MATCH_MP_TAC NETLIMIT_WITHIN THEN
1486   SIMP_TAC[TRIVIAL_LIMIT_AT; WITHIN_UNIV]);;
1487
1488 (* ------------------------------------------------------------------------- *)
1489 (* Transformation of limit.                                                  *)
1490 (* ------------------------------------------------------------------------- *)
1491
1492 let LIM_TRANSFORM = prove
1493  (`!net f g l.
1494      ((\x. f x - g x) --> vec 0) net /\ (f --> l) net ==> (g --> l) net`,
1495   REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN
1496   DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG) THEN MATCH_MP_TAC EQ_IMP THEN
1497   AP_THM_TAC THEN BINOP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
1498   VECTOR_ARITH_TAC);;
1499
1500 let LIM_TRANSFORM_EVENTUALLY = prove
1501  (`!net f g l.
1502         eventually (\x. f x = g x) net /\ (f --> l) net ==> (g --> l) net`,
1503   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
1504   DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o MATCH_MP LIM_EVENTUALLY) MP_TAC) THEN
1505   MESON_TAC[LIM_TRANSFORM]);;
1506
1507 let LIM_TRANSFORM_WITHIN = prove
1508  (`!f g x s d.
1509         &0 < d /\
1510         (!x'. x' IN s /\ &0 < dist(x',x) /\ dist(x',x) < d ==> f(x') = g(x')) /\
1511         (f --> l) (at x within s)
1512         ==> (g --> l) (at x within s)`,
1513   REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
1514   DISCH_TAC THEN DISCH_TAC THEN
1515   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN
1516   REWRITE_TAC[LIM_WITHIN] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `d:real` THEN
1517   ASM_SIMP_TAC[VECTOR_SUB_REFL; DIST_REFL]);;
1518
1519 let LIM_TRANSFORM_AT = prove
1520  (`!f g x d.
1521         &0 < d /\
1522         (!x'. &0 < dist(x',x) /\ dist(x',x) < d ==> f(x') = g(x')) /\
1523         (f --> l) (at x)
1524         ==> (g --> l) (at x)`,
1525   ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN MESON_TAC[LIM_TRANSFORM_WITHIN]);;
1526
1527 let LIM_TRANSFORM_EQ = prove
1528  (`!net f:A->real^N g l.
1529      ((\x. f x - g x) --> vec 0) net ==> ((f --> l) net <=> (g --> l) net)`,
1530   REPEAT STRIP_TAC THEN EQ_TAC THEN
1531   DISCH_TAC THEN MATCH_MP_TAC LIM_TRANSFORM THENL
1532    [EXISTS_TAC `f:A->real^N` THEN ASM_REWRITE_TAC[];
1533     EXISTS_TAC `g:A->real^N` THEN ASM_REWRITE_TAC[] THEN
1534     ONCE_REWRITE_TAC[GSYM LIM_NEG_EQ] THEN
1535     ASM_REWRITE_TAC[VECTOR_NEG_SUB; VECTOR_NEG_0]]);;
1536
1537 let LIM_TRANSFORM_WITHIN_SET = prove
1538  (`!f a s t.
1539         eventually (\x. x IN s <=> x IN t) (at a)
1540         ==> ((f --> l) (at a within s) <=> (f --> l) (at a within t))`,
1541   REPEAT GEN_TAC THEN REWRITE_TAC[EVENTUALLY_AT; LIM_WITHIN] THEN
1542   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
1543   EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
1544   FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
1545   DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN
1546   EXISTS_TAC `min d k:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
1547   ASM_MESON_TAC[]);;
1548
1549 (* ------------------------------------------------------------------------- *)
1550 (* Common case assuming being away from some crucial point like 0.           *)
1551 (* ------------------------------------------------------------------------- *)
1552
1553 let LIM_TRANSFORM_AWAY_WITHIN = prove
1554  (`!f:real^M->real^N g a b s.
1555         ~(a = b) /\
1556         (!x. x IN s /\ ~(x = a) /\ ~(x = b) ==> f(x) = g(x)) /\
1557         (f --> l) (at a within s)
1558         ==> (g --> l) (at a within s)`,
1559   REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN THEN
1560   MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `dist(a:real^M,b)`] THEN
1561   ASM_REWRITE_TAC[GSYM DIST_NZ] THEN X_GEN_TAC `y:real^M` THEN
1562   REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
1563   ASM_MESON_TAC[DIST_SYM; REAL_LT_REFL]);;
1564
1565 let LIM_TRANSFORM_AWAY_AT = prove
1566  (`!f:real^M->real^N g a b.
1567         ~(a = b) /\
1568         (!x. ~(x = a) /\ ~(x = b) ==> f(x) = g(x)) /\
1569         (f --> l) (at a)
1570         ==> (g --> l) (at a)`,
1571   ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
1572   MESON_TAC[LIM_TRANSFORM_AWAY_WITHIN]);;
1573
1574 (* ------------------------------------------------------------------------- *)
1575 (* Alternatively, within an open set.                                        *)
1576 (* ------------------------------------------------------------------------- *)
1577
1578 let LIM_TRANSFORM_WITHIN_OPEN = prove
1579  (`!f g:real^M->real^N s a l.
1580         open s /\ a IN s /\
1581         (!x. x IN s /\ ~(x = a) ==> f x = g x) /\
1582         (f --> l) (at a)
1583         ==> (g --> l) (at a)`,
1584   REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_AT THEN
1585   EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN
1586   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN
1587   DISCH_THEN(MP_TAC o SPEC `a:real^M`) THEN ASM_REWRITE_TAC[] THEN
1588   MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[SUBSET; IN_BALL] THEN
1589   ASM_MESON_TAC[DIST_NZ; DIST_SYM]);;
1590
1591 let LIM_TRANSFORM_WITHIN_OPEN_IN = prove
1592  (`!f g:real^M->real^N s t a l.
1593         open_in (subtopology euclidean t) s /\ a IN s /\
1594         (!x. x IN s /\ ~(x = a) ==> f x = g x) /\
1595         (f --> l) (at a within t)
1596         ==> (g --> l) (at a within t)`,
1597   REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN THEN
1598   EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN
1599   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN
1600   DISCH_THEN(MP_TAC o SPEC `a:real^M` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN
1601   MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[SUBSET; IN_INTER; IN_BALL] THEN
1602   ASM_MESON_TAC[DIST_NZ; DIST_SYM]);;
1603
1604 (* ------------------------------------------------------------------------- *)
1605 (* Another quite common idiom of an explicit conditional in a sequence.      *)
1606 (* ------------------------------------------------------------------------- *)
1607
1608 let LIM_CASES_FINITE_SEQUENTIALLY = prove
1609  (`!f g l. FINITE {n | P n}
1610            ==> (((\n. if P n then f n else g n) --> l) sequentially <=>
1611                 (g --> l) sequentially)`,
1612   REPEAT STRIP_TAC THEN EQ_TAC THEN
1613   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN
1614   FIRST_ASSUM(MP_TAC o SPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN
1615   REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN
1616   X_GEN_TAC `N:num` THEN DISCH_TAC THEN SIMP_TAC[EVENTUALLY_SEQUENTIALLY] THEN
1617   EXISTS_TAC `N + 1` THEN
1618   ASM_MESON_TAC[ARITH_RULE `~(x <= n /\ n + 1 <= x)`]);;
1619
1620 let LIM_CASES_COFINITE_SEQUENTIALLY = prove
1621  (`!f g l. FINITE {n | ~P n}
1622            ==> (((\n. if P n then f n else g n) --> l) sequentially <=>
1623                 (f --> l) sequentially)`,
1624   ONCE_REWRITE_TAC[TAUT `(if p then x else y) = (if ~p then y else x)`] THEN
1625   REWRITE_TAC[LIM_CASES_FINITE_SEQUENTIALLY]);;
1626
1627 let LIM_CASES_SEQUENTIALLY = prove
1628  (`!f g l m. (((\n. if m <= n then f n else g n) --> l) sequentially <=>
1629               (f --> l) sequentially) /\
1630              (((\n. if m < n then f n else g n) --> l) sequentially <=>
1631               (f --> l) sequentially) /\
1632              (((\n. if n <= m then f n else g n) --> l) sequentially <=>
1633               (g --> l) sequentially) /\
1634              (((\n. if n < m then f n else g n) --> l) sequentially <=>
1635               (g --> l) sequentially)`,
1636   SIMP_TAC[LIM_CASES_FINITE_SEQUENTIALLY; LIM_CASES_COFINITE_SEQUENTIALLY;
1637            NOT_LE; NOT_LT; FINITE_NUMSEG_LT; FINITE_NUMSEG_LE]);;
1638
1639 (* ------------------------------------------------------------------------- *)
1640 (* A congruence rule allowing us to transform limits assuming not at point.  *)
1641 (* ------------------------------------------------------------------------- *)
1642
1643 let LIM_CONG_WITHIN = prove
1644  (`(!x. ~(x = a) ==> f x = g x)
1645    ==> (((\x. f x) --> l) (at a within s) <=> ((g --> l) (at a within s)))`,
1646   REWRITE_TAC[LIM_WITHIN; GSYM DIST_NZ] THEN SIMP_TAC[]);;
1647
1648 let LIM_CONG_AT = prove
1649  (`(!x. ~(x = a) ==> f x = g x)
1650    ==> (((\x. f x) --> l) (at a) <=> ((g --> l) (at a)))`,
1651   REWRITE_TAC[LIM_AT; GSYM DIST_NZ] THEN SIMP_TAC[]);;
1652
1653 extend_basic_congs [LIM_CONG_WITHIN; LIM_CONG_AT];;
1654
1655 (* ------------------------------------------------------------------------- *)
1656 (* Useful lemmas on closure and set of possible sequential limits.           *)
1657 (* ------------------------------------------------------------------------- *)
1658
1659 let CLOSURE_SEQUENTIAL = prove
1660  (`!s l:real^N.
1661      l IN closure(s) <=> ?x. (!n. x(n) IN s) /\ (x --> l) sequentially`,
1662   REWRITE_TAC[closure; IN_UNION; LIMPT_SEQUENTIAL; IN_ELIM_THM; IN_DELETE] THEN
1663   REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT
1664     `((b ==> c) /\ (~a /\ c ==> b)) /\ (a ==> c) ==> (a \/ b <=> c)`) THEN
1665   CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN
1666   EXISTS_TAC `\n:num. l:real^N` THEN
1667   ASM_REWRITE_TAC[LIM_CONST]);;
1668
1669 let CLOSED_CONTAINS_SEQUENTIAL_LIMIT = prove
1670  (`!s x l:real^N.
1671         closed s /\ (!n. x n IN s) /\ (x --> l) sequentially ==> l IN s`,
1672   MESON_TAC[CLOSURE_SEQUENTIAL; CLOSURE_CLOSED]);;
1673
1674 let CLOSED_SEQUENTIAL_LIMITS = prove
1675  (`!s. closed s <=>
1676        !x l. (!n. x(n) IN s) /\ (x --> l) sequentially ==> l IN s`,
1677   MESON_TAC[CLOSURE_SEQUENTIAL; CLOSURE_CLOSED;
1678             CLOSED_LIMPT; LIMPT_SEQUENTIAL; IN_DELETE]);;
1679
1680 let CLOSURE_APPROACHABLE = prove
1681  (`!x s. x IN closure(s) <=> !e. &0 < e ==> ?y. y IN s /\ dist(y,x) < e`,
1682   REWRITE_TAC[closure; LIMPT_APPROACHABLE; IN_UNION; IN_ELIM_THM] THEN
1683   MESON_TAC[DIST_REFL]);;
1684
1685 let CLOSED_APPROACHABLE = prove
1686  (`!x s. closed s
1687          ==> ((!e. &0 < e ==> ?y. y IN s /\ dist(y,x) < e) <=> x IN s)`,
1688   MESON_TAC[CLOSURE_CLOSED; CLOSURE_APPROACHABLE]);;
1689
1690 let IN_CLOSURE_DELETE = prove
1691  (`!s x:real^N. x IN closure(s DELETE x) <=> x limit_point_of s`,
1692   SIMP_TAC[CLOSURE_APPROACHABLE; LIMPT_APPROACHABLE; IN_DELETE; CONJ_ASSOC]);;
1693
1694 (* ------------------------------------------------------------------------- *)
1695 (* Some other lemmas about sequences.                                        *)
1696 (* ------------------------------------------------------------------------- *)
1697
1698 let SEQ_OFFSET = prove
1699  (`!f l k. (f --> l) sequentially ==> ((\i. f(i + k)) --> l) sequentially`,
1700   REWRITE_TAC[LIM_SEQUENTIALLY] THEN
1701   MESON_TAC[ARITH_RULE `N <= n ==> N <= n + k:num`]);;
1702
1703 let SEQ_OFFSET_NEG = prove
1704  (`!f l k. (f --> l) sequentially ==> ((\i. f(i - k)) --> l) sequentially`,
1705   REWRITE_TAC[LIM_SEQUENTIALLY] THEN
1706   MESON_TAC[ARITH_RULE `N + k <= n ==> N <= n - k:num`]);;
1707
1708 let SEQ_OFFSET_REV = prove
1709  (`!f l k. ((\i. f(i + k)) --> l) sequentially ==> (f --> l) sequentially`,
1710   REWRITE_TAC[LIM_SEQUENTIALLY] THEN
1711   MESON_TAC[ARITH_RULE `N + k <= n ==> N <= n - k /\ (n - k) + k = n:num`]);;
1712
1713 let SEQ_HARMONIC = prove
1714  (`((\n. lift(inv(&n))) --> vec 0) sequentially`,
1715   REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
1716   FIRST_ASSUM(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC o
1717     GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN
1718   EXISTS_TAC `N:num` THEN REPEAT STRIP_TAC THEN
1719   REWRITE_TAC[dist; VECTOR_SUB_RZERO; NORM_LIFT] THEN
1720   ASM_REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN
1721   MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN
1722   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
1723   ASM_REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE; LT_NZ]);;
1724
1725 (* ------------------------------------------------------------------------- *)
1726 (* More properties of closed balls.                                          *)
1727 (* ------------------------------------------------------------------------- *)
1728
1729 let CLOSED_CBALL = prove
1730  (`!x:real^N e. closed(cball(x,e))`,
1731   REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS; IN_CBALL; dist] THEN
1732   GEN_TAC THEN GEN_TAC THEN X_GEN_TAC `s:num->real^N` THEN
1733   X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN
1734   MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN
1735   EXISTS_TAC `\n. x - (s:num->real^N) n` THEN
1736   REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN
1737   ASM_SIMP_TAC[LIM_SUB; LIM_CONST; SEQUENTIALLY] THEN MESON_TAC[GE_REFL]);;
1738
1739 let IN_INTERIOR_CBALL = prove
1740  (`!x s. x IN interior s <=> ?e. &0 < e /\ cball(x,e) SUBSET s`,
1741   REWRITE_TAC[interior; IN_ELIM_THM] THEN
1742   MESON_TAC[OPEN_CONTAINS_CBALL; SUBSET_TRANS;
1743             BALL_SUBSET_CBALL; CENTRE_IN_BALL; OPEN_BALL]);;
1744
1745 let LIMPT_BALL = prove
1746  (`!x:real^N y e. y limit_point_of ball(x,e) <=> &0 < e /\ y IN cball(x,e)`,
1747   REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 < e` THENL
1748    [ALL_TAC; ASM_MESON_TAC[LIMPT_EMPTY; REAL_NOT_LT; BALL_EQ_EMPTY]] THEN
1749   ASM_REWRITE_TAC[] THEN EQ_TAC THENL
1750    [MESON_TAC[CLOSED_CBALL; CLOSED_LIMPT; LIMPT_SUBSET; BALL_SUBSET_CBALL];
1751     REWRITE_TAC[IN_CBALL; LIMPT_APPROACHABLE; IN_BALL]] THEN
1752   DISCH_TAC THEN X_GEN_TAC `d:real` THEN DISCH_TAC THEN
1753   ASM_CASES_TAC `y:real^N = x` THEN ASM_REWRITE_TAC[DIST_NZ] THENL
1754    [MP_TAC(SPECL [`d:real`; `e:real`] REAL_DOWN2) THEN
1755     ASM_REWRITE_TAC[] THEN
1756     GEN_MESON_TAC 0 40 1 [VECTOR_CHOOSE_DIST; DIST_SYM; REAL_LT_IMP_LE];
1757     ALL_TAC] THEN
1758   MP_TAC(SPECL [`norm(y:real^N - x)`; `d:real`] REAL_DOWN2) THEN
1759   RULE_ASSUM_TAC(REWRITE_RULE[DIST_NZ; dist]) THEN ASM_REWRITE_TAC[] THEN
1760   DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN
1761   EXISTS_TAC `(y:real^N) - (k / dist(y,x)) % (y - x)` THEN
1762   REWRITE_TAC[dist; VECTOR_ARITH `(y - c % z) - y = --c % z`] THEN
1763   REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_ABS_NEG] THEN
1764   ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ] THEN
1765   REWRITE_TAC[VECTOR_ARITH `x - (y - k % (y - x)) = (&1 - k) % (x - y)`] THEN
1766   ASM_SIMP_TAC[REAL_ARITH `&0 < k ==> &0 < abs k`; NORM_MUL] THEN
1767   ASM_SIMP_TAC[REAL_ARITH `&0 < k /\ k < d ==> abs k < d`] THEN
1768   MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `norm(x:real^N - y)` THEN
1769   ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
1770   MATCH_MP_TAC REAL_LT_RMUL THEN CONJ_TAC THENL
1771    [ALL_TAC; ASM_MESON_TAC[NORM_SUB]] THEN
1772   MATCH_MP_TAC(REAL_ARITH `&0 < k /\ k < &1 ==> abs(&1 - k) < &1`) THEN
1773   ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_MUL_LZERO;
1774                REAL_MUL_LID]);;
1775
1776 let CLOSURE_BALL = prove
1777  (`!x:real^N e. &0 < e ==> (closure(ball(x,e)) = cball(x,e))`,
1778   SIMP_TAC[EXTENSION; closure; IN_ELIM_THM; IN_UNION; LIMPT_BALL] THEN
1779   REWRITE_TAC[IN_BALL; IN_CBALL] THEN REAL_ARITH_TAC);;
1780
1781 let INTERIOR_BALL = prove
1782  (`!a r. interior(ball(a,r)) = ball(a,r)`,
1783   SIMP_TAC[INTERIOR_OPEN; OPEN_BALL]);;
1784
1785 let INTERIOR_CBALL = prove
1786  (`!x:real^N e. interior(cball(x,e)) = ball(x,e)`,
1787   REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 <= e` THENL
1788    [ALL_TAC;
1789     SUBGOAL_THEN `cball(x:real^N,e) = {} /\ ball(x:real^N,e) = {}`
1790      (fun th -> REWRITE_TAC[th; INTERIOR_EMPTY]) THEN
1791     REWRITE_TAC[IN_BALL; IN_CBALL; EXTENSION; NOT_IN_EMPTY] THEN
1792     CONJ_TAC THEN X_GEN_TAC `y:real^N` THEN
1793     MP_TAC(ISPECL [`x:real^N`; `y:real^N`] DIST_POS_LE) THEN
1794     POP_ASSUM MP_TAC THEN REAL_ARITH_TAC] THEN
1795   MATCH_MP_TAC INTERIOR_UNIQUE THEN
1796   REWRITE_TAC[BALL_SUBSET_CBALL; OPEN_BALL] THEN
1797   X_GEN_TAC `t:real^N->bool` THEN
1798   SIMP_TAC[SUBSET; IN_CBALL; IN_BALL; REAL_LT_LE] THEN STRIP_TAC THEN
1799   X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
1800   FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N` o GEN_REWRITE_RULE I [open_def]) THEN
1801   ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` MP_TAC) THEN
1802   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1803   ASM_CASES_TAC `z:real^N = x` THENL
1804    [FIRST_X_ASSUM SUBST_ALL_TAC THEN
1805     FIRST_X_ASSUM(X_CHOOSE_TAC `k:real` o MATCH_MP REAL_DOWN) THEN
1806     SUBGOAL_THEN `?w:real^N. dist(w,x) = k` STRIP_ASSUME_TAC THENL
1807      [ASM_MESON_TAC[VECTOR_CHOOSE_DIST; DIST_SYM; REAL_LT_IMP_LE];
1808       ASM_MESON_TAC[REAL_NOT_LE; DIST_REFL; DIST_SYM]];
1809     RULE_ASSUM_TAC(REWRITE_RULE[DIST_NZ]) THEN
1810     DISCH_THEN(MP_TAC o SPEC `z + ((d / &2) / dist(z,x)) % (z - x:real^N)`) THEN
1811     REWRITE_TAC[dist; VECTOR_ADD_SUB; NORM_MUL; REAL_ABS_DIV;
1812                 REAL_ABS_NORM; REAL_ABS_NUM] THEN
1813     ASM_SIMP_TAC[REAL_DIV_RMUL; GSYM dist; REAL_LT_IMP_NZ] THEN
1814     ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN
1815     ASM_REWRITE_TAC[REAL_ARITH `abs d < d * &2 <=> &0 < d`] THEN
1816     DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[dist] THEN
1817     REWRITE_TAC[VECTOR_ARITH `x - (z + k % (z - x)) = (&1 + k) % (x - z)`] THEN
1818     REWRITE_TAC[REAL_NOT_LE; NORM_MUL] THEN
1819     GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN
1820     ONCE_REWRITE_TAC[NORM_SUB] THEN
1821     ASM_SIMP_TAC[REAL_LT_RMUL_EQ; GSYM dist] THEN
1822     MATCH_MP_TAC(REAL_ARITH `&0 < x ==> &1 < abs(&1 + x)`) THEN
1823     ONCE_REWRITE_TAC[DIST_SYM] THEN
1824     ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH]]);;
1825
1826 let FRONTIER_BALL = prove
1827  (`!a e. &0 < e ==> frontier(ball(a,e)) = sphere(a,e)`,
1828   SIMP_TAC[frontier; sphere; CLOSURE_BALL; INTERIOR_OPEN; OPEN_BALL;
1829            REAL_LT_IMP_LE] THEN
1830   REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM; IN_BALL; IN_CBALL] THEN
1831   REAL_ARITH_TAC);;
1832
1833 let FRONTIER_CBALL = prove
1834  (`!a e. frontier(cball(a,e)) = sphere(a,e)`,
1835   SIMP_TAC[frontier; sphere; INTERIOR_CBALL; CLOSED_CBALL; CLOSURE_CLOSED;
1836            REAL_LT_IMP_LE] THEN
1837   REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM; IN_BALL; IN_CBALL] THEN
1838   REAL_ARITH_TAC);;
1839
1840 let CBALL_EQ_EMPTY = prove
1841  (`!x e. (cball(x,e) = {}) <=> e < &0`,
1842   REWRITE_TAC[EXTENSION; IN_CBALL; NOT_IN_EMPTY; REAL_NOT_LE] THEN
1843   MESON_TAC[DIST_POS_LE; DIST_REFL; REAL_LTE_TRANS]);;
1844
1845 let CBALL_EMPTY = prove
1846  (`!x e. e < &0 ==> cball(x,e) = {}`,
1847   REWRITE_TAC[CBALL_EQ_EMPTY]);;
1848
1849 let CBALL_EQ_SING = prove
1850  (`!x:real^N e. (cball(x,e) = {x}) <=> e = &0`,
1851   REPEAT GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_CBALL; IN_SING] THEN
1852   EQ_TAC THENL [ALL_TAC; MESON_TAC[DIST_LE_0]] THEN
1853   DISCH_THEN(fun th -> MP_TAC(SPEC `x + (e / &2) % basis 1:real^N` th) THEN
1854                        MP_TAC(SPEC `x:real^N` th)) THEN
1855   REWRITE_TAC[dist; VECTOR_ARITH `x - (x + e):real^N = --e`;
1856               VECTOR_ARITH `x + e = x <=> e:real^N = vec 0`] THEN
1857   REWRITE_TAC[NORM_NEG; NORM_MUL; VECTOR_MUL_EQ_0; NORM_0; VECTOR_SUB_REFL] THEN
1858   SIMP_TAC[NORM_BASIS; BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1] THEN
1859   REAL_ARITH_TAC);;
1860
1861 let CBALL_SING = prove
1862  (`!x e. e = &0 ==> cball(x,e) = {x}`,
1863   REWRITE_TAC[CBALL_EQ_SING]);;
1864
1865 let SPHERE_SING = prove
1866  (`!x e. e = &0 ==> sphere(x,e) = {x}`,
1867   SIMP_TAC[sphere; DIST_EQ_0; SING_GSPEC]);;
1868
1869 let SPHERE_EQ_SING = prove
1870  (`!a:real^N r x. sphere(a,r) = {x} <=> x = a /\ r = &0`,
1871   REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[SPHERE_SING] THEN
1872   ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[SPHERE_EMPTY; NOT_INSERT_EMPTY] THEN
1873   ASM_CASES_TAC `r = &0` THEN ASM_SIMP_TAC[SPHERE_SING] THENL
1874    [ASM SET_TAC[]; ALL_TAC] THEN
1875   MATCH_MP_TAC(SET_RULE
1876    `!y. (x IN s ==> y IN s /\ ~(y = x)) ==> ~(s = {x})`) THEN
1877   EXISTS_TAC `a - (x - a):real^N` THEN REWRITE_TAC[IN_SPHERE] THEN
1878   REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC NORM_ARITH);;
1879
1880 (* ------------------------------------------------------------------------- *)
1881 (* For points in the interior, localization of limits makes no difference.   *)
1882 (* ------------------------------------------------------------------------- *)
1883
1884 let EVENTUALLY_WITHIN_INTERIOR = prove
1885  (`!p s x.
1886         x IN interior s
1887         ==> (eventually p (at x within s) <=> eventually p (at x))`,
1888   REWRITE_TAC[EVENTUALLY_WITHIN; EVENTUALLY_AT; IN_INTERIOR] THEN
1889   REPEAT GEN_TAC THEN SIMP_TAC[SUBSET; IN_BALL; LEFT_IMP_FORALL_THM] THEN
1890   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
1891   EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
1892   EXISTS_TAC `min (d:real) e` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
1893   ASM_MESON_TAC[DIST_SYM]);;
1894
1895 let LIM_WITHIN_INTERIOR = prove
1896  (`!f l s x.
1897         x IN interior s
1898         ==> ((f --> l) (at x within s) <=> (f --> l) (at x))`,
1899   SIMP_TAC[tendsto; EVENTUALLY_WITHIN_INTERIOR]);;
1900
1901 let NETLIMIT_WITHIN_INTERIOR = prove
1902  (`!s x:real^N. x IN interior s ==> netlimit(at x within s) = x`,
1903   REPEAT STRIP_TAC THEN MATCH_MP_TAC NETLIMIT_WITHIN THEN
1904   REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN
1905   FIRST_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[OPEN_CONTAINS_BALL]
1906    (SPEC_ALL OPEN_INTERIOR))) THEN
1907   ASM_MESON_TAC[LIMPT_SUBSET; LIMPT_BALL; CENTRE_IN_CBALL; REAL_LT_IMP_LE;
1908                 SUBSET_TRANS; INTERIOR_SUBSET]);;
1909
1910 (* ------------------------------------------------------------------------- *)
1911 (* A non-singleton connected set is perfect (i.e. has no isolated points).   *)
1912 (* ------------------------------------------------------------------------- *)
1913
1914 let CONNECTED_IMP_PERFECT = prove
1915  (`!s x:real^N.
1916         connected s /\ ~(?a. s = {a}) /\ x IN s ==> x limit_point_of s`,
1917   REPEAT STRIP_TAC THEN REWRITE_TAC[limit_point_of] THEN
1918   X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
1919   MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
1920   FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I
1921    [OPEN_CONTAINS_CBALL]) THEN
1922   ASM_REWRITE_TAC[] THEN
1923   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
1924   FIRST_X_ASSUM(MP_TAC o SPEC `{x:real^N}` o
1925     GEN_REWRITE_RULE I [CONNECTED_CLOPEN]) THEN
1926   REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL
1927    [REWRITE_TAC[OPEN_IN_OPEN] THEN EXISTS_TAC `t:real^N->bool` THEN
1928     ASM SET_TAC[];
1929     REWRITE_TAC[CLOSED_IN_CLOSED] THEN
1930     EXISTS_TAC `cball(x:real^N,e)` THEN REWRITE_TAC[CLOSED_CBALL] THEN
1931     REWRITE_TAC[EXTENSION; IN_INTER; IN_SING] THEN
1932     ASM_MESON_TAC[CENTRE_IN_CBALL; SUBSET; REAL_LT_IMP_LE];
1933     ASM SET_TAC[]]);;
1934
1935 (* ------------------------------------------------------------------------- *)
1936 (* Boundedness.                                                              *)
1937 (* ------------------------------------------------------------------------- *)
1938
1939 let bounded = new_definition
1940   `bounded s <=> ?a. !x:real^N. x IN s ==> norm(x) <= a`;;
1941
1942 let BOUNDED_EMPTY = prove
1943  (`bounded {}`,
1944   REWRITE_TAC[bounded; NOT_IN_EMPTY]);;
1945
1946 let BOUNDED_SUBSET = prove
1947  (`!s t. bounded t /\ s SUBSET t ==> bounded s`,
1948   MESON_TAC[bounded; SUBSET]);;
1949
1950 let BOUNDED_INTERIOR = prove
1951  (`!s:real^N->bool. bounded s ==> bounded(interior s)`,
1952   MESON_TAC[BOUNDED_SUBSET; INTERIOR_SUBSET]);;
1953
1954 let BOUNDED_CLOSURE = prove
1955  (`!s:real^N->bool. bounded s ==> bounded(closure s)`,
1956   REWRITE_TAC[bounded; CLOSURE_SEQUENTIAL] THEN
1957   GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
1958   MESON_TAC[REWRITE_RULE[eventually] LIM_NORM_UBOUND;
1959             TRIVIAL_LIMIT_SEQUENTIALLY; trivial_limit]);;
1960
1961 let BOUNDED_CLOSURE_EQ = prove
1962  (`!s:real^N->bool. bounded(closure s) <=> bounded s`,
1963   GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[BOUNDED_CLOSURE] THEN
1964   MESON_TAC[BOUNDED_SUBSET; CLOSURE_SUBSET]);;
1965
1966 let BOUNDED_CBALL = prove
1967  (`!x:real^N e. bounded(cball(x,e))`,
1968   REPEAT GEN_TAC THEN REWRITE_TAC[bounded] THEN
1969   EXISTS_TAC `norm(x:real^N) + e` THEN REWRITE_TAC[IN_CBALL; dist] THEN
1970   NORM_ARITH_TAC);;
1971
1972 let BOUNDED_BALL = prove
1973  (`!x e. bounded(ball(x,e))`,
1974   MESON_TAC[BALL_SUBSET_CBALL; BOUNDED_CBALL; BOUNDED_SUBSET]);;
1975
1976 let FINITE_IMP_BOUNDED = prove
1977  (`!s:real^N->bool. FINITE s ==> bounded s`,
1978   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[BOUNDED_EMPTY] THEN
1979   REWRITE_TAC[bounded; IN_INSERT] THEN X_GEN_TAC `x:real^N` THEN GEN_TAC THEN
1980   DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B:real`) STRIP_ASSUME_TAC) THEN
1981   EXISTS_TAC `norm(x:real^N) + abs B` THEN REPEAT STRIP_TAC THEN
1982   ASM_MESON_TAC[NORM_POS_LE; REAL_ARITH
1983    `(y <= b /\ &0 <= x ==> y <= x + abs b) /\ x <= x + abs b`]);;
1984
1985 let BOUNDED_UNION = prove
1986  (`!s t. bounded (s UNION t) <=> bounded s /\ bounded t`,
1987   REWRITE_TAC[bounded; IN_UNION] THEN MESON_TAC[REAL_LE_MAX]);;
1988
1989 let BOUNDED_UNIONS = prove
1990  (`!f. FINITE f /\ (!s. s IN f ==> bounded s) ==> bounded(UNIONS f)`,
1991   REWRITE_TAC[IMP_CONJ] THEN
1992   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
1993   REWRITE_TAC[UNIONS_0; BOUNDED_EMPTY; IN_INSERT; UNIONS_INSERT] THEN
1994   MESON_TAC[BOUNDED_UNION]);;
1995
1996 let BOUNDED_POS = prove
1997  (`!s. bounded s <=> ?b. &0 < b /\ !x. x IN s ==> norm(x) <= b`,
1998   REWRITE_TAC[bounded] THEN
1999   MESON_TAC[REAL_ARITH `&0 < &1 + abs(y) /\ (x <= y ==> x <= &1 + abs(y))`]);;
2000
2001 let BOUNDED_POS_LT = prove
2002  (`!s. bounded s <=> ?b. &0 < b /\ !x. x IN s ==> norm(x) < b`,
2003   REWRITE_TAC[bounded] THEN
2004   MESON_TAC[REAL_LT_IMP_LE;
2005             REAL_ARITH `&0 < &1 + abs(y) /\ (x <= y ==> x < &1 + abs(y))`]);;
2006
2007 let BOUNDED_INTER = prove
2008  (`!s t. bounded s \/ bounded t ==> bounded (s INTER t)`,
2009   MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET]);;
2010
2011 let BOUNDED_DIFF = prove
2012  (`!s t. bounded s ==> bounded (s DIFF t)`,
2013   MESON_TAC[BOUNDED_SUBSET; SUBSET_DIFF]);;
2014
2015 let BOUNDED_INSERT = prove
2016  (`!x s. bounded(x INSERT s) <=> bounded s`,
2017   ONCE_REWRITE_TAC[SET_RULE `x INSERT s = {x} UNION s`] THEN
2018   SIMP_TAC[BOUNDED_UNION; FINITE_IMP_BOUNDED; FINITE_RULES]);;
2019
2020 let BOUNDED_SING = prove
2021  (`!a. bounded {a}`,
2022   REWRITE_TAC[BOUNDED_INSERT; BOUNDED_EMPTY]);;
2023
2024 let BOUNDED_INTERS = prove
2025  (`!f:(real^N->bool)->bool.
2026         (?s:real^N->bool. s IN f /\ bounded s) ==> bounded(INTERS f)`,
2027   REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN REPEAT GEN_TAC THEN
2028   DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN
2029   ASM SET_TAC[]);;
2030
2031 let NOT_BOUNDED_UNIV = prove
2032  (`~(bounded (:real^N))`,
2033   REWRITE_TAC[BOUNDED_POS; NOT_FORALL_THM; NOT_EXISTS_THM; IN_UNIV;
2034               DE_MORGAN_THM; REAL_NOT_LE] THEN
2035   X_GEN_TAC `B:real` THEN ASM_CASES_TAC `&0 < B` THEN ASM_REWRITE_TAC[] THEN
2036   MP_TAC(SPEC `B + &1` VECTOR_CHOOSE_SIZE) THEN
2037   ASM_SIMP_TAC[REAL_ARITH `&0 < B ==> &0 <= B + &1`] THEN
2038   MATCH_MP_TAC MONO_EXISTS THEN REAL_ARITH_TAC);;
2039
2040 let COBOUNDED_IMP_UNBOUNDED = prove
2041  (`!s. bounded((:real^N) DIFF s) ==> ~bounded s`,
2042   GEN_TAC THEN REWRITE_TAC[TAUT `a ==> ~b <=> ~(a /\ b)`] THEN
2043   REWRITE_TAC[GSYM BOUNDED_UNION; SET_RULE `UNIV DIFF s UNION s = UNIV`] THEN
2044   REWRITE_TAC[NOT_BOUNDED_UNIV]);;
2045
2046 let BOUNDED_LINEAR_IMAGE = prove
2047  (`!f:real^M->real^N s. bounded s /\ linear f ==> bounded(IMAGE f s)`,
2048   REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN
2049   DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B1:real`) MP_TAC) THEN
2050   DISCH_THEN(X_CHOOSE_TAC `B2:real` o MATCH_MP LINEAR_BOUNDED_POS) THEN
2051   EXISTS_TAC `B2 * B1` THEN ASM_SIMP_TAC[REAL_LT_MUL; FORALL_IN_IMAGE] THEN
2052   X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
2053   MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `B2 * norm(x:real^M)` THEN
2054   ASM_SIMP_TAC[REAL_LE_LMUL_EQ]);;
2055
2056 let BOUNDED_LINEAR_IMAGE_EQ = prove
2057  (`!f s. linear f /\ (!x y. f x = f y ==> x = y)
2058          ==> (bounded (IMAGE f s) <=> bounded s)`,
2059   MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE BOUNDED_LINEAR_IMAGE));;
2060
2061 add_linear_invariants [BOUNDED_LINEAR_IMAGE_EQ];;
2062
2063 let BOUNDED_SCALING = prove
2064  (`!c s. bounded s ==> bounded (IMAGE (\x. c % x) s)`,
2065   REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_LINEAR_IMAGE THEN
2066   ASM_SIMP_TAC[LINEAR_COMPOSE_CMUL; LINEAR_ID]);;
2067
2068 let BOUNDED_NEGATIONS = prove
2069  (`!s. bounded s ==> bounded (IMAGE (--) s)`,
2070   GEN_TAC THEN
2071   DISCH_THEN(MP_TAC o SPEC `-- &1` o MATCH_MP BOUNDED_SCALING) THEN
2072   REWRITE_TAC[bounded; IN_IMAGE; VECTOR_MUL_LNEG; VECTOR_MUL_LID]);;
2073
2074 let BOUNDED_TRANSLATION = prove
2075  (`!a:real^N s. bounded s ==> bounded (IMAGE (\x. a + x) s)`,
2076   REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN
2077   DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN
2078   EXISTS_TAC `B + norm(a:real^N)` THEN POP_ASSUM MP_TAC THEN
2079   MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [NORM_ARITH_TAC; ALL_TAC] THEN
2080   MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
2081   REWRITE_TAC[] THEN NORM_ARITH_TAC);;
2082
2083 let BOUNDED_TRANSLATION_EQ = prove
2084  (`!a s. bounded (IMAGE (\x:real^N. a + x) s) <=> bounded s`,
2085   REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[BOUNDED_TRANSLATION] THEN
2086   DISCH_THEN(MP_TAC o SPEC `--a:real^N` o MATCH_MP BOUNDED_TRANSLATION) THEN
2087   REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID;
2088               VECTOR_ARITH `--a + a + x:real^N = x`]);;
2089
2090 add_translation_invariants [BOUNDED_TRANSLATION_EQ];;
2091
2092 let BOUNDED_DIFFS = prove
2093  (`!s t:real^N->bool.
2094         bounded s /\ bounded t ==> bounded {x - y | x IN s /\ y IN t}`,
2095   REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN
2096   DISCH_THEN(CONJUNCTS_THEN2
2097    (X_CHOOSE_TAC `B:real`) (X_CHOOSE_TAC `C:real`)) THEN
2098   EXISTS_TAC `B + C:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN
2099   CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REPEAT STRIP_TAC] THEN
2100   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH
2101    `norm x <= a /\ norm y <= b ==> norm(x - y) <= a + b`) THEN
2102   ASM_SIMP_TAC[]);;
2103
2104 let BOUNDED_SUMS = prove
2105  (`!s t:real^N->bool.
2106         bounded s /\ bounded t ==> bounded {x + y | x IN s /\ y IN t}`,
2107   REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN
2108   DISCH_THEN(CONJUNCTS_THEN2
2109    (X_CHOOSE_TAC `B:real`) (X_CHOOSE_TAC `C:real`)) THEN
2110   EXISTS_TAC `B + C:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN
2111   CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REPEAT STRIP_TAC] THEN
2112   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH
2113    `norm x <= a /\ norm y <= b ==> norm(x + y) <= a + b`) THEN
2114   ASM_SIMP_TAC[]);;
2115
2116 let BOUNDED_SUMS_IMAGE = prove
2117  (`!f g t. bounded {f x | x IN t} /\ bounded {g x | x IN t}
2118            ==> bounded {f x + g x | x IN t}`,
2119   REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUMS) THEN
2120   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN
2121   SET_TAC[]);;
2122
2123 let BOUNDED_SUMS_IMAGES = prove
2124  (`!f:A->B->real^N t s.
2125         FINITE s /\
2126         (!a. a IN s ==> bounded {f x a | x IN t})
2127         ==> bounded { vsum s (f x) | x IN t}`,
2128   GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
2129   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
2130   SIMP_TAC[VSUM_CLAUSES] THEN CONJ_TAC THENL
2131    [DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC BOUNDED_SUBSET THEN
2132     EXISTS_TAC `{vec 0:real^N}` THEN
2133     SIMP_TAC[FINITE_IMP_BOUNDED; FINITE_RULES] THEN SET_TAC[];
2134     ALL_TAC] THEN
2135   REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_SUMS_IMAGE THEN
2136   ASM_SIMP_TAC[IN_INSERT]);;
2137
2138 let BOUNDED_SUBSET_BALL = prove
2139  (`!s x:real^N. bounded(s) ==> ?r. &0 < r /\ s SUBSET ball(x,r)`,
2140   REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN
2141   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
2142   EXISTS_TAC `&2 * B + norm(x:real^N)` THEN
2143   ASM_SIMP_TAC[NORM_POS_LE; REAL_ARITH
2144     `&0 < B /\ &0 <= x ==> &0 < &2 * B + x`] THEN
2145   REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
2146   FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[IN_BALL] THEN
2147   UNDISCH_TAC `&0 < B` THEN NORM_ARITH_TAC);;
2148
2149 let BOUNDED_SUBSET_CBALL = prove
2150  (`!s x:real^N. bounded(s) ==> ?r. &0 < r /\ s SUBSET cball(x,r)`,
2151   MESON_TAC[BOUNDED_SUBSET_BALL; SUBSET_TRANS; BALL_SUBSET_CBALL]);;
2152
2153 let UNBOUNDED_INTER_COBOUNDED = prove
2154  (`!s t. ~bounded s /\ bounded((:real^N) DIFF t) ==> ~(s INTER t = {})`,
2155   REWRITE_TAC[SET_RULE `s INTER t = {} <=> s SUBSET (:real^N) DIFF t`] THEN
2156   MESON_TAC[BOUNDED_SUBSET]);;
2157
2158 let COBOUNDED_INTER_UNBOUNDED = prove
2159  (`!s t. bounded((:real^N) DIFF s) /\ ~bounded t ==> ~(s INTER t = {})`,
2160   REWRITE_TAC[SET_RULE `s INTER t = {} <=> t SUBSET (:real^N) DIFF s`] THEN
2161   MESON_TAC[BOUNDED_SUBSET]);;
2162
2163 let SUBSPACE_BOUNDED_EQ_TRIVIAL = prove
2164  (`!s:real^N->bool. subspace s ==> (bounded s <=> s = {vec 0})`,
2165   REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[BOUNDED_SING] THEN
2166   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
2167   DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
2168    `~(s = {a}) ==> a IN s ==> ?b. b IN s /\ ~(b = a)`)) THEN
2169   ASM_SIMP_TAC[SUBSPACE_0] THEN
2170   DISCH_THEN(X_CHOOSE_THEN `v:real^N` STRIP_ASSUME_TAC) THEN
2171   REWRITE_TAC[bounded; NOT_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN
2172   DISCH_THEN(MP_TAC o SPEC `(B + &1) / norm v % v:real^N`) THEN
2173   ASM_SIMP_TAC[SUBSPACE_MUL; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
2174   ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN REAL_ARITH_TAC);;
2175
2176 let BOUNDED_COMPONENTWISE = prove
2177  (`!s:real^N->bool.
2178         bounded s <=> !i. 1 <= i /\ i <= dimindex(:N)
2179                           ==> bounded (IMAGE (\x. lift(x$i)) s)`,
2180   GEN_TAC THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; NORM_LIFT] THEN
2181   EQ_TAC THENL [ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]; ALL_TAC] THEN
2182   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
2183   SIMP_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:num->real` THEN
2184   DISCH_TAC THEN EXISTS_TAC `sum(1..dimindex(:N)) b` THEN CONJ_TAC THENL
2185    [MATCH_MP_TAC REAL_LET_TRANS THEN
2186     EXISTS_TAC `sum(1..dimindex(:N)) (\i. &0)` THEN
2187     SIMP_TAC[SUM_POS_LE_NUMSEG; REAL_POS] THEN
2188     MATCH_MP_TAC SUM_LT_ALL THEN
2189     ASM_SIMP_TAC[IN_NUMSEG; FINITE_NUMSEG; NUMSEG_EMPTY] THEN
2190     REWRITE_TAC[NOT_LT; DIMINDEX_GE_1];
2191     REPEAT STRIP_TAC THEN
2192     W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN
2193     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
2194     MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[IN_NUMSEG; FINITE_NUMSEG]]);;
2195
2196 (* ------------------------------------------------------------------------- *)
2197 (* Some theorems on sups and infs using the notion "bounded".                *)
2198 (* ------------------------------------------------------------------------- *)
2199
2200 let BOUNDED_LIFT = prove
2201  (`!s. bounded(IMAGE lift s) <=>  ?a. !x. x IN s ==> abs(x) <= a`,
2202   REWRITE_TAC[bounded; FORALL_LIFT; NORM_LIFT; LIFT_IN_IMAGE_LIFT]);;
2203
2204 let BOUNDED_HAS_SUP = prove
2205  (`!s. bounded(IMAGE lift s) /\ ~(s = {})
2206        ==> (!x. x IN s ==> x <= sup s) /\
2207            (!b. (!x. x IN s ==> x <= b) ==> sup s <= b)`,
2208   REWRITE_TAC[BOUNDED_LIFT; IMAGE_EQ_EMPTY] THEN
2209   MESON_TAC[SUP; REAL_ARITH `abs(x) <= a ==> x <= a`]);;
2210
2211 let SUP_INSERT = prove
2212  (`!x s. bounded (IMAGE lift s)
2213          ==> sup(x INSERT s) = if s = {} then x else max x (sup s)`,
2214   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_SUP_UNIQUE THEN
2215   COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING] THENL
2216    [MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN
2217   REWRITE_TAC[REAL_LE_MAX; REAL_LT_MAX; IN_INSERT] THEN
2218   MP_TAC(ISPEC `s:real->bool` BOUNDED_HAS_SUP) THEN ASM_REWRITE_TAC[] THEN
2219   REPEAT STRIP_TAC THEN ASM_MESON_TAC[REAL_LE_REFL; REAL_NOT_LT]);;
2220
2221 let BOUNDED_HAS_INF = prove
2222  (`!s. bounded(IMAGE lift s) /\ ~(s = {})
2223        ==> (!x. x IN s ==> inf s <= x) /\
2224            (!b. (!x. x IN s ==> b <= x) ==> b <= inf s)`,
2225   REWRITE_TAC[BOUNDED_LIFT; IMAGE_EQ_EMPTY] THEN
2226   MESON_TAC[INF; REAL_ARITH `abs(x) <= a ==> --a <= x`]);;
2227
2228 let INF_INSERT = prove
2229  (`!x s. bounded (IMAGE lift s)
2230          ==> inf(x INSERT s) = if s = {} then x else min x (inf s)`,
2231   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INF_UNIQUE THEN
2232   COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING] THENL
2233    [MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN
2234   REWRITE_TAC[REAL_MIN_LE; REAL_MIN_LT; IN_INSERT] THEN
2235   MP_TAC(ISPEC `s:real->bool` BOUNDED_HAS_INF) THEN ASM_REWRITE_TAC[] THEN
2236   REPEAT STRIP_TAC THEN ASM_MESON_TAC[REAL_LE_REFL; REAL_NOT_LT]);;
2237
2238 (* ------------------------------------------------------------------------- *)
2239 (* Subset and overlapping relations on balls.                                *)
2240 (* ------------------------------------------------------------------------- *)
2241
2242 let SUBSET_BALLS = prove
2243  (`(!a a':real^N r r'.
2244       ball(a,r) SUBSET ball(a',r') <=> dist(a,a') + r <= r' \/ r <= &0) /\
2245    (!a a':real^N r r'.
2246       ball(a,r) SUBSET cball(a',r') <=> dist(a,a') + r <= r' \/ r <= &0) /\
2247    (!a a':real^N r r'.
2248       cball(a,r) SUBSET ball(a',r') <=> dist(a,a') + r < r' \/ r < &0) /\
2249    (!a a':real^N r r'.
2250       cball(a,r) SUBSET cball(a',r') <=> dist(a,a') + r <= r' \/ r < &0)`,
2251   let lemma = prove
2252    (`(!a':real^N r r'.
2253        cball(a,r) SUBSET cball(a',r') <=> dist(a,a') + r <= r' \/ r < &0) /\
2254      (!a':real^N r r'.
2255        cball(a,r) SUBSET ball(a',r') <=> dist(a,a') + r < r' \/ r < &0)`,
2256     CONJ_TAC THEN
2257     (GEOM_ORIGIN_TAC `a':real^N` THEN
2258     REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET; IN_CBALL; IN_BALL] THEN
2259     EQ_TAC THENL [REWRITE_TAC[DIST_0]; NORM_ARITH_TAC] THEN
2260     DISJ_CASES_TAC(REAL_ARITH `r < &0 \/ &0 <= r`) THEN
2261     ASM_REWRITE_TAC[] THEN DISCH_TAC THEN DISJ1_TAC THEN
2262     ASM_CASES_TAC `a:real^N = vec 0` THENL
2263      [FIRST_X_ASSUM(MP_TAC o SPEC `r % basis 1:real^N`) THEN
2264       ASM_SIMP_TAC[DIST_0; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL];
2265       FIRST_X_ASSUM(MP_TAC o SPEC `(&1 + r / norm(a)) % a:real^N`) THEN
2266       SIMP_TAC[dist; VECTOR_ARITH `a - (&1 + x) % a:real^N = --(x % a)`] THEN
2267       ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; NORM_NEG; REAL_POS;
2268                    REAL_LE_DIV; NORM_POS_LE; REAL_ADD_RDISTRIB; REAL_DIV_RMUL;
2269                NORM_EQ_0; REAL_ARITH `&0 <= x ==> abs(&1 + x) = &1 + x`]] THEN
2270     UNDISCH_TAC `&0 <= r` THEN NORM_ARITH_TAC))
2271   and tac = DISCH_THEN(MP_TAC o MATCH_MP SUBSET_CLOSURE) THEN
2272             ASM_SIMP_TAC[CLOSED_CBALL; CLOSURE_CLOSED; CLOSURE_BALL] in
2273   REWRITE_TAC[AND_FORALL_THM] THEN GEOM_ORIGIN_TAC `a':real^N` THEN
2274   REPEAT STRIP_TAC THEN
2275   (EQ_TAC THENL
2276     [ALL_TAC; REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN NORM_ARITH_TAC]) THEN
2277   MATCH_MP_TAC(SET_RULE
2278    `(s = {} <=> q) /\ (s SUBSET t /\ ~(s = {}) /\ ~(t = {}) ==> p)
2279     ==> s SUBSET t ==> p \/ q`) THEN
2280   REWRITE_TAC[BALL_EQ_EMPTY; CBALL_EQ_EMPTY; REAL_NOT_LE; REAL_NOT_LT] THEN
2281   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THENL
2282    [tac; tac; ALL_TAC; ALL_TAC] THEN REWRITE_TAC[lemma] THEN
2283   REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);;
2284
2285 let INTER_BALLS_EQ_EMPTY = prove
2286  (`(!a b:real^N r s. ball(a,r) INTER ball(b,s) = {} <=>
2287                      r <= &0 \/ s <= &0 \/ r + s <= dist(a,b)) /\
2288    (!a b:real^N r s. ball(a,r) INTER cball(b,s) = {} <=>
2289                      r <= &0 \/ s < &0 \/ r + s <= dist(a,b)) /\
2290    (!a b:real^N r s. cball(a,r) INTER ball(b,s) = {} <=>
2291                      r < &0 \/ s <= &0 \/ r + s <= dist(a,b)) /\
2292    (!a b:real^N r s. cball(a,r) INTER cball(b,s) = {} <=>
2293                      r < &0 \/ s < &0 \/ r + s < dist(a,b))`,
2294   REPEAT STRIP_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN
2295   GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN REPEAT STRIP_TAC THEN
2296   REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_CBALL; IN_BALL] THEN
2297   (EQ_TAC THENL
2298     [ALL_TAC;
2299      SPEC_TAC(`b % basis 1:real^N`,`v:real^N`) THEN CONV_TAC NORM_ARITH]) THEN
2300   DISCH_THEN(MP_TAC o GEN `c:real` o SPEC `c % basis 1:real^N`) THEN
2301   SIMP_TAC[NORM_MUL; NORM_BASIS; LE_REFL; DIMINDEX_GE_1; dist; NORM_NEG;
2302            VECTOR_SUB_LZERO; GSYM VECTOR_SUB_RDISTRIB; REAL_MUL_RID] THEN
2303   ASM_REWRITE_TAC[real_abs] THEN REWRITE_TAC[GSYM real_abs] THEN
2304   DISCH_THEN(fun th ->
2305     MP_TAC(SPEC `min b r:real` th) THEN
2306     MP_TAC(SPEC `max (&0) (b - s:real)` th) THEN
2307     MP_TAC(SPEC `(r + (b - s)) / &2` th)) THEN
2308   ASM_REAL_ARITH_TAC);;
2309
2310 (* ------------------------------------------------------------------------- *)
2311 (* Every closed set is a G_Delta.                                            *)
2312 (* ------------------------------------------------------------------------- *)
2313
2314 let CLOSED_AS_GDELTA = prove
2315  (`!s:real^N->bool.
2316         closed s
2317         ==> ?g. COUNTABLE g /\
2318                 (!u. u IN g ==> open u) /\
2319                 INTERS g = s`,
2320   REPEAT STRIP_TAC THEN EXISTS_TAC
2321    `{ UNIONS { ball(x:real^N,inv(&n + &1)) | x IN s} | n IN (:num)}` THEN
2322   SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN
2323   SIMP_TAC[FORALL_IN_IMAGE; OPEN_UNIONS; OPEN_BALL] THEN
2324   MATCH_MP_TAC(SET_RULE
2325    `closure s = s /\ s SUBSET t /\ t SUBSET closure s
2326     ==> t = s`) THEN
2327   ASM_REWRITE_TAC[CLOSURE_EQ] THEN CONJ_TAC THENL
2328    [REWRITE_TAC[SUBSET_INTERS; FORALL_IN_IMAGE; IN_UNIV] THEN
2329     X_GEN_TAC `n:num` THEN REWRITE_TAC[UNIONS_IMAGE; SUBSET; IN_ELIM_THM] THEN
2330     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `x:real^N` THEN
2331     ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_INV_EQ] THEN REAL_ARITH_TAC;
2332     REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE; INTERS_IMAGE; IN_UNIV] THEN
2333     X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM; UNIONS_IMAGE] THEN
2334     DISCH_TAC THEN X_GEN_TAC `e:real` THEN  DISCH_TAC THEN
2335     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN
2336     DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN
2337     FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[IN_BALL] THEN
2338     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN
2339     MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN
2340     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LT_TRANS) THEN
2341     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
2342         REAL_LT_TRANS)) THEN
2343     MATCH_MP_TAC REAL_LT_INV2 THEN
2344     REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]);;
2345
2346 (* ------------------------------------------------------------------------- *)
2347 (* Compactness (the definition is the one based on convegent subsequences).  *)
2348 (* ------------------------------------------------------------------------- *)
2349
2350 let compact = new_definition
2351   `compact s <=>
2352         !f:num->real^N.
2353             (!n. f(n) IN s)
2354             ==> ?l r. l IN s /\ (!m n:num. m < n ==> r(m) < r(n)) /\
2355                       ((f o r) --> l) sequentially`;;
2356
2357 let MONOTONE_BIGGER = prove
2358  (`!r. (!m n. m < n ==> r(m) < r(n)) ==> !n:num. n <= r(n)`,
2359   GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN
2360   ASM_MESON_TAC[LE_0; ARITH_RULE `n <= m /\ m < p ==> SUC n <= p`; LT]);;
2361
2362 let LIM_SUBSEQUENCE = prove
2363  (`!s r l. (!m n. m < n ==> r(m) < r(n)) /\ (s --> l) sequentially
2364            ==> (s o r --> l) sequentially`,
2365   REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN
2366   MESON_TAC[MONOTONE_BIGGER; LE_TRANS]);;
2367
2368 let MONOTONE_SUBSEQUENCE = prove
2369  (`!s:num->real. ?r:num->num.
2370            (!m n. m < n ==> r(m) < r(n)) /\
2371            ((!m n. m <= n ==> s(r(m)) <= s(r(n))) \/
2372             (!m n. m <= n ==> s(r(n)) <= s(r(m))))`,
2373   GEN_TAC THEN
2374   ASM_CASES_TAC `!n:num. ?p. n < p /\ !m. p <= m ==> s(m) <= s(p)` THEN
2375   POP_ASSUM MP_TAC THEN
2376   REWRITE_TAC[NOT_FORALL_THM; NOT_EXISTS_THM; NOT_IMP; DE_MORGAN_THM] THEN
2377   REWRITE_TAC[RIGHT_OR_EXISTS_THM; SKOLEM_THM; REAL_NOT_LE; REAL_NOT_LT] THENL
2378    [ABBREV_TAC `N = 0`; DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC)] THEN
2379   DISCH_THEN(X_CHOOSE_THEN `next:num->num` STRIP_ASSUME_TAC) THEN
2380   (MP_TAC o prove_recursive_functions_exist num_RECURSION)
2381    `(r 0 = next(SUC N)) /\ (!n. r(SUC n) = next(r n))` THEN
2382   MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THENL
2383    [SUBGOAL_THEN `!m:num n:num. r n <= m ==> s(m) <= s(r n):real`
2384     ASSUME_TAC THEN TRY CONJ_TAC THEN TRY DISJ2_TAC THEN
2385     GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LT; LE] THEN
2386     ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL; LT_IMP_LE; LT_TRANS];
2387     SUBGOAL_THEN `!n. N < (r:num->num) n` ASSUME_TAC THEN
2388     TRY(CONJ_TAC THENL [GEN_TAC; DISJ1_TAC THEN GEN_TAC]) THEN
2389     INDUCT_TAC THEN ASM_REWRITE_TAC[LT; LE] THEN
2390     TRY STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
2391     ASM_MESON_TAC[REAL_LT_REFL; LT_LE; LTE_TRANS; REAL_LE_REFL;
2392                   REAL_LT_LE; REAL_LE_TRANS; LT]]);;
2393
2394 let CONVERGENT_BOUNDED_INCREASING = prove
2395  (`!s:num->real b. (!m n. m <= n ==> s m <= s n) /\ (!n. abs(s n) <= b)
2396                    ==> ?l. !e. &0 < e ==> ?N. !n. N <= n ==> abs(s n - l) < e`,
2397   REPEAT STRIP_TAC THEN
2398   MP_TAC(SPEC `\x. ?n. (s:num->real) n = x` REAL_COMPLETE) THEN
2399   REWRITE_TAC[] THEN ANTS_TAC THENL
2400    [ASM_MESON_TAC[REAL_ARITH `abs(x) <= b ==> x <= b`]; ALL_TAC] THEN
2401   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real` THEN STRIP_TAC THEN
2402   X_GEN_TAC `e:real` THEN STRIP_TAC THEN
2403   FIRST_X_ASSUM(MP_TAC o SPEC `l - e`) THEN
2404   ASM_MESON_TAC[REAL_ARITH `&0 < e ==> ~(l <= l - e)`;
2405       REAL_ARITH `x <= y /\ y <= l /\ ~(x <= l - e) ==> abs(y - l) < e`]);;
2406
2407 let CONVERGENT_BOUNDED_MONOTONE = prove
2408  (`!s:num->real b. (!n. abs(s n) <= b) /\
2409                    ((!m n. m <= n ==> s m <= s n) \/
2410                     (!m n. m <= n ==> s n <= s m))
2411                    ==> ?l. !e. &0 < e ==> ?N. !n. N <= n ==> abs(s n - l) < e`,
2412   REPEAT STRIP_TAC THENL
2413    [ASM_MESON_TAC[CONVERGENT_BOUNDED_INCREASING]; ALL_TAC] THEN
2414   MP_TAC(SPEC `\n. --((s:num->real) n)` CONVERGENT_BOUNDED_INCREASING) THEN
2415   ASM_REWRITE_TAC[REAL_LE_NEG2; REAL_ABS_NEG] THEN
2416   ASM_MESON_TAC[REAL_ARITH `abs(x - --l) = abs(--x - l)`]);;
2417
2418 let COMPACT_REAL_LEMMA = prove
2419  (`!s b. (!n:num. abs(s n) <= b)
2420          ==> ?l r. (!m n:num. m < n ==> r(m) < r(n)) /\
2421                    !e. &0 < e ==> ?N. !n. N <= n ==> abs(s(r n) - l) < e`,
2422   REPEAT GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
2423   MP_TAC(SPEC `s:num->real` MONOTONE_SUBSEQUENCE) THEN
2424   MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN ASM_SIMP_TAC[] THEN
2425   MATCH_MP_TAC CONVERGENT_BOUNDED_MONOTONE THEN ASM_MESON_TAC[]);;
2426
2427 let COMPACT_LEMMA = prove
2428  (`!s. bounded s /\ (!n. (x:num->real^N) n IN s)
2429        ==> !d. d <= dimindex(:N)
2430                ==> ?l:real^N r. (!m n. m < n ==> r m < (r:num->num) n) /\
2431                          !e. &0 < e
2432                              ==> ?N. !n i. 1 <= i /\ i <= d
2433                                            ==> N <= n
2434                                                ==> abs(x(r n)$i - l$i) < e`,
2435   GEN_TAC THEN REWRITE_TAC[bounded] THEN
2436   DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `b:real`) ASSUME_TAC) THEN
2437   INDUCT_TAC THENL
2438    [REWRITE_TAC[ARITH_RULE `1 <= i /\ i <= 0 <=> F`; CONJ_ASSOC] THEN
2439     DISCH_TAC THEN EXISTS_TAC `\n:num. n` THEN REWRITE_TAC[];
2440     ALL_TAC] THEN
2441   DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN
2442   ASM_SIMP_TAC[ARITH_RULE `SUC d <= n ==> d <= n`] THEN STRIP_TAC THEN
2443   MP_TAC(SPECL [`\n:num. (x:num->real^N) (r n) $ (SUC d)`; `b:real`]
2444          COMPACT_REAL_LEMMA) THEN
2445   REWRITE_TAC[] THEN ANTS_TAC THENL
2446    [ASM_MESON_TAC[REAL_LE_TRANS; COMPONENT_LE_NORM; ARITH_RULE `1 <= SUC n`];
2447     ALL_TAC] THEN
2448   DISCH_THEN(X_CHOOSE_THEN `y:real` (X_CHOOSE_THEN `s:num->num`
2449         STRIP_ASSUME_TAC)) THEN
2450   MAP_EVERY EXISTS_TAC
2451    [`(lambda k. if k = SUC d then y else (l:real^N)$k):real^N`;
2452     `(r:num->num) o (s:num->num)`] THEN
2453   ASM_SIMP_TAC[o_THM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
2454   REPEAT(FIRST_ASSUM(C UNDISCH_THEN (MP_TAC o SPEC `e:real`) o concl)) THEN
2455   ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN
2456   DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `N1 + N2:num` THEN
2457   FIRST_ASSUM(fun th -> SIMP_TAC[LAMBDA_BETA; MATCH_MP(ARITH_RULE
2458    `SUC d <= n ==> !i. 1 <= i /\ i <= SUC d ==> 1 <= i /\ i <= n`) th]) THEN
2459   REWRITE_TAC[LE] THEN REPEAT STRIP_TAC THEN
2460   ASM_REWRITE_TAC[] THEN TRY COND_CASES_TAC THEN
2461   ASM_MESON_TAC[MONOTONE_BIGGER; LE_TRANS;
2462     ARITH_RULE `N1 + N2 <= n ==> N2 <= n:num /\ N1 <= n`;
2463     ARITH_RULE `1 <= i /\ i <= d /\ SUC d <= n
2464                 ==> ~(i = SUC d) /\ 1 <= SUC d /\ d <= n /\ i <= n`]);;
2465
2466 let BOUNDED_CLOSED_IMP_COMPACT = prove
2467  (`!s:real^N->bool. bounded s /\ closed s ==> compact s`,
2468   REPEAT STRIP_TAC THEN REWRITE_TAC[compact] THEN
2469   X_GEN_TAC `x:num->real^N` THEN DISCH_TAC THEN
2470   MP_TAC(ISPEC `s:real^N->bool` COMPACT_LEMMA) THEN
2471   ASM_REWRITE_TAC[] THEN
2472   DISCH_THEN(MP_TAC o SPEC `dimindex(:N)`) THEN
2473   REWRITE_TAC[LE_REFL] THEN
2474   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N` THEN
2475   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN ASM_SIMP_TAC[] THEN
2476   STRIP_TAC THEN MATCH_MP_TAC(TAUT `(b ==> a) /\ b ==> a /\ b`) THEN
2477   REPEAT STRIP_TAC THENL
2478    [FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CLOSED_SEQUENTIAL_LIMITS]) THEN
2479     EXISTS_TAC `(x:num->real^N) o (r:num->num)` THEN
2480     ASM_REWRITE_TAC[o_THM];
2481     ALL_TAC] THEN
2482   REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
2483   FIRST_X_ASSUM(MP_TAC o SPEC `e / &2 / &(dimindex(:N))`) THEN
2484   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; DIMINDEX_NONZERO;
2485                REAL_HALF; ARITH_RULE `0 < n <=> ~(n = 0)`] THEN
2486   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
2487   REWRITE_TAC[dist] THEN REPEAT STRIP_TAC THEN
2488   MATCH_MP_TAC(MATCH_MP (REAL_ARITH `a <= b ==> b < e ==> a < e`)
2489                         (SPEC_ALL NORM_LE_L1)) THEN
2490   MATCH_MP_TAC REAL_LET_TRANS THEN
2491   EXISTS_TAC `sum (1..dimindex(:N))
2492                   (\k. e / &2 / &(dimindex(:N)))` THEN
2493   CONJ_TAC THENL
2494    [MATCH_MP_TAC SUM_LE_NUMSEG THEN
2495     SIMP_TAC[o_THM; LAMBDA_BETA; vector_sub] THEN
2496     ASM_MESON_TAC[REAL_LT_IMP_LE; LE_TRANS];
2497     ASM_SIMP_TAC[SUM_CONST_NUMSEG; ADD_SUB; REAL_DIV_LMUL; REAL_OF_NUM_EQ;
2498                  DIMINDEX_NONZERO; REAL_LE_REFL; REAL_LT_LDIV_EQ; ARITH;
2499                  REAL_OF_NUM_LT; REAL_ARITH `x < x * &2 <=> &0 < x`]]);;
2500
2501 (* ------------------------------------------------------------------------- *)
2502 (* Completeness.                                                             *)
2503 (* ------------------------------------------------------------------------- *)
2504
2505 let cauchy = new_definition
2506   `cauchy (s:num->real^N) <=>
2507      !e. &0 < e ==> ?N. !m n. m >= N /\ n >= N ==> dist(s m,s n) < e`;;
2508
2509 let complete = new_definition
2510   `complete s <=>
2511      !f:num->real^N. (!n. f n IN s) /\ cauchy f
2512                       ==> ?l. l IN s /\ (f --> l) sequentially`;;
2513
2514 let CAUCHY = prove
2515  (`!s:num->real^N.
2516       cauchy s <=> !e. &0 < e ==> ?N. !n. n >= N ==> dist(s n,s N) < e`,
2517   REPEAT GEN_TAC THEN REWRITE_TAC[cauchy; GE] THEN EQ_TAC THENL
2518    [MESON_TAC[LE_REFL]; DISCH_TAC] THEN
2519   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
2520   FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
2521   MESON_TAC[DIST_TRIANGLE_HALF_L]);;
2522
2523 let CONVERGENT_IMP_CAUCHY = prove
2524  (`!s l. (s --> l) sequentially ==> cauchy s`,
2525   REWRITE_TAC[LIM_SEQUENTIALLY; cauchy] THEN
2526   REPEAT GEN_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
2527   FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
2528   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
2529   ASM_MESON_TAC[GE; LE_REFL; DIST_TRIANGLE_HALF_L]);;
2530
2531 let CAUCHY_IMP_BOUNDED = prove
2532  (`!s:num->real^N. cauchy s ==> bounded {y | ?n. y = s n}`,
2533   REWRITE_TAC[cauchy; bounded; IN_ELIM_THM] THEN GEN_TAC THEN
2534   DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN
2535   DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N:num`)) THEN
2536   REWRITE_TAC[GE_REFL] THEN DISCH_TAC THEN
2537   SUBGOAL_THEN `!n:num. N <= n ==> norm(s n :real^N) <= norm(s N) + &1`
2538   ASSUME_TAC THENL
2539    [ASM_MESON_TAC[GE; dist; DIST_SYM; NORM_TRIANGLE_SUB;
2540                   REAL_ARITH `a <= b + c /\ c < &1 ==> a <= b + &1`];
2541     MP_TAC(ISPECL [`\n:num. norm(s n :real^N)`; `0..N`]
2542                   UPPER_BOUND_FINITE_SET_REAL) THEN
2543     SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; LE_0; LEFT_IMP_EXISTS_THM] THEN
2544     ASM_MESON_TAC[LE_CASES;
2545                   REAL_ARITH `x <= a \/ x <= b ==> x <= abs a + abs b`]]);;
2546
2547 let COMPACT_IMP_COMPLETE = prove
2548  (`!s:real^N->bool. compact s ==> complete s`,
2549   GEN_TAC THEN REWRITE_TAC[complete; compact] THEN
2550   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `f:num->real^N` THEN
2551   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
2552   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
2553   DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN
2554   FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_ADD)) THEN
2555   DISCH_THEN(MP_TAC o SPEC `\n. (f:num->real^N)(n) - f(r n)`) THEN
2556   DISCH_THEN(MP_TAC o SPEC `vec 0: real^N`) THEN ASM_REWRITE_TAC[o_THM] THEN
2557   REWRITE_TAC[VECTOR_ADD_RID; VECTOR_SUB_ADD2; ETA_AX] THEN
2558   DISCH_THEN MATCH_MP_TAC THEN
2559   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [cauchy]) THEN
2560   REWRITE_TAC[GE; LIM; SEQUENTIALLY; dist; VECTOR_SUB_RZERO] THEN
2561   SUBGOAL_THEN `!n:num. n <= r(n)` MP_TAC THENL [INDUCT_TAC; ALL_TAC] THEN
2562   ASM_MESON_TAC[ LE_TRANS; LE_REFL; LT; LET_TRANS; LE_0; LE_SUC_LT]);;
2563
2564 let COMPLETE_UNIV = prove
2565  (`complete(:real^N)`,
2566   REWRITE_TAC[complete; IN_UNIV] THEN X_GEN_TAC `x:num->real^N` THEN
2567   DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CAUCHY_IMP_BOUNDED) THEN
2568   DISCH_THEN(ASSUME_TAC o MATCH_MP BOUNDED_CLOSURE) THEN
2569   MP_TAC(ISPEC `closure {y:real^N | ?n:num. y = x n}`
2570                COMPACT_IMP_COMPLETE) THEN
2571   ASM_SIMP_TAC[BOUNDED_CLOSED_IMP_COMPACT; CLOSED_CLOSURE; complete] THEN
2572   DISCH_THEN(MP_TAC o SPEC `x:num->real^N`) THEN
2573   ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
2574   ASM_REWRITE_TAC[closure; IN_ELIM_THM; IN_UNION] THEN MESON_TAC[]);;
2575
2576 let COMPLETE_EQ_CLOSED = prove
2577  (`!s:real^N->bool. complete s <=> closed s`,
2578   GEN_TAC THEN EQ_TAC THENL
2579    [REWRITE_TAC[complete; CLOSED_LIMPT; LIMPT_SEQUENTIAL] THEN
2580     REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN GEN_TAC THEN
2581     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MATCH_MP_TAC MONO_FORALL THEN
2582     MESON_TAC[CONVERGENT_IMP_CAUCHY; IN_DELETE; LIM_UNIQUE;
2583               TRIVIAL_LIMIT_SEQUENTIALLY];
2584     REWRITE_TAC[complete; CLOSED_SEQUENTIAL_LIMITS] THEN DISCH_TAC THEN
2585     X_GEN_TAC `f:num->real^N` THEN STRIP_TAC THEN
2586     MP_TAC(REWRITE_RULE[complete] COMPLETE_UNIV) THEN
2587     DISCH_THEN(MP_TAC o SPEC `f:num->real^N`) THEN
2588     ASM_REWRITE_TAC[IN_UNIV] THEN ASM_MESON_TAC[]]);;
2589
2590 let CONVERGENT_EQ_CAUCHY = prove
2591  (`!s. (?l. (s --> l) sequentially) <=> cauchy s`,
2592   GEN_TAC THEN EQ_TAC THENL
2593    [REWRITE_TAC[LEFT_IMP_EXISTS_THM; CONVERGENT_IMP_CAUCHY];
2594     REWRITE_TAC[REWRITE_RULE[complete; IN_UNIV] COMPLETE_UNIV]]);;
2595
2596 let CONVERGENT_IMP_BOUNDED = prove
2597  (`!s l. (s --> l) sequentially ==> bounded (IMAGE s (:num))`,
2598   REWRITE_TAC[LEFT_FORALL_IMP_THM; CONVERGENT_EQ_CAUCHY] THEN
2599   REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CAUCHY_IMP_BOUNDED) THEN
2600   REWRITE_TAC[IMAGE; IN_UNIV]);;
2601
2602 (* ------------------------------------------------------------------------- *)
2603 (* Total boundedness.                                                        *)
2604 (* ------------------------------------------------------------------------- *)
2605
2606 let COMPACT_IMP_TOTALLY_BOUNDED = prove
2607  (`!s:real^N->bool.
2608         compact s
2609         ==> !e. &0 < e ==> ?k. FINITE k /\ k SUBSET s /\
2610                                s SUBSET (UNIONS(IMAGE (\x. ball(x,e)) k))`,
2611   GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
2612   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN
2613   REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`; SUBSET] THEN
2614   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
2615   SUBGOAL_THEN
2616    `?x:num->real^N. !n. x(n) IN s /\ !m. m < n ==> ~(dist(x(m),x(n)) < e)`
2617   MP_TAC THENL
2618    [SUBGOAL_THEN
2619      `?x:num->real^N.
2620           !n. x(n) = @y. y IN s /\ !m. m < n ==> ~(dist(x(m),y) < e)`
2621     MP_TAC THENL
2622      [MATCH_MP_TAC(MATCH_MP WF_REC WF_num) THEN SIMP_TAC[]; ALL_TAC] THEN
2623     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:num->real^N` THEN
2624     DISCH_TAC THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN
2625     FIRST_X_ASSUM(SUBST1_TAC o SPEC `n:num`) THEN STRIP_TAC THEN
2626     CONV_TAC SELECT_CONV THEN
2627     FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (x:num->real^N) {m | m < n}`) THEN
2628     SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT; NOT_FORALL_THM; NOT_IMP] THEN
2629     REWRITE_TAC[IN_UNIONS; IN_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[IN_BALL];
2630     ALL_TAC] THEN
2631   REWRITE_TAC[compact; NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
2632   X_GEN_TAC `x:num->real^N` THEN  REWRITE_TAC[NOT_IMP; FORALL_AND_THM] THEN
2633   STRIP_TAC THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN REPEAT STRIP_TAC THEN
2634   FIRST_X_ASSUM(MP_TAC o MATCH_MP CONVERGENT_IMP_CAUCHY) THEN
2635   REWRITE_TAC[cauchy] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN
2636   ASM_REWRITE_TAC[o_THM; NOT_EXISTS_THM; NOT_IMP; NOT_FORALL_THM; NOT_IMP] THEN
2637   X_GEN_TAC `N:num` THEN MAP_EVERY EXISTS_TAC [`N:num`; `SUC N`] THEN
2638   CONJ_TAC THENL [ARITH_TAC; ASM_MESON_TAC[LT]]);;
2639
2640 (* ------------------------------------------------------------------------- *)
2641 (* Heine-Borel theorem (following Burkill & Burkill vol. 2)                  *)
2642 (* ------------------------------------------------------------------------- *)
2643
2644 let HEINE_BOREL_LEMMA = prove
2645  (`!s:real^N->bool.
2646       compact s
2647       ==> !t. s SUBSET (UNIONS t) /\ (!b. b IN t ==> open b)
2648               ==> ?e. &0 < e /\
2649                       !x. x IN s ==> ?b. b IN t /\ ball(x,e) SUBSET b`,
2650   GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
2651   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN
2652   DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
2653   DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `&1 / (&n + &1)`) THEN
2654   SIMP_TAC[REAL_LT_DIV; REAL_LT_01; REAL_ARITH `x <= y ==> x < y + &1`;
2655    FORALL_AND_THM; REAL_POS; NOT_FORALL_THM; NOT_IMP; SKOLEM_THM; compact] THEN
2656   MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REWRITE_TAC[NOT_EXISTS_THM] THEN
2657   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN
2658   DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`l:real^N`; `r:num->num`] THEN
2659   STRIP_TAC THEN
2660   SUBGOAL_THEN `?b:real^N->bool. l IN b /\ b IN t` STRIP_ASSUME_TAC THENL
2661    [ASM_MESON_TAC[SUBSET; IN_UNIONS]; ALL_TAC] THEN
2662   SUBGOAL_THEN `?e. &0 < e /\ !z:real^N. dist(z,l) < e ==> z IN b`
2663   STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[open_def]; ALL_TAC] THEN
2664   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN
2665   DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN
2666   SUBGOAL_THEN `&0 < e / &2` (fun th ->
2667     REWRITE_TAC[th; o_THM] THEN MP_TAC(GEN_REWRITE_RULE I [REAL_ARCH_INV] th))
2668   THENL [ASM_REWRITE_TAC[REAL_HALF]; ALL_TAC] THEN
2669   DISCH_THEN(X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC) THEN
2670   DISCH_THEN(X_CHOOSE_THEN `N2:num` STRIP_ASSUME_TAC) THEN
2671   FIRST_X_ASSUM(MP_TAC o SPECL
2672    [`(r:num->num)(N1 + N2)`; `b:real^N->bool`]) THEN
2673   ASM_REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
2674   FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC DIST_TRIANGLE_HALF_R THEN
2675   EXISTS_TAC `(f:num->real^N)(r(N1 + N2:num))` THEN CONJ_TAC THENL
2676    [ALL_TAC; FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC] THEN
2677   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN
2678   MATCH_MP_TAC(REAL_ARITH `a <= b ==> x < a ==> x < b`) THEN
2679   MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&N1)` THEN
2680   ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN
2681   MATCH_MP_TAC REAL_LE_INV2 THEN
2682   REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
2683   ASM_MESON_TAC[ARITH_RULE `(~(n = 0) ==> 0 < n)`; LE_ADD; MONOTONE_BIGGER;
2684                 LT_IMP_LE; LE_TRANS]);;
2685
2686 let COMPACT_IMP_HEINE_BOREL = prove
2687  (`!s. compact (s:real^N->bool)
2688        ==> !f. (!t. t IN f ==> open t) /\ s SUBSET (UNIONS f)
2689                ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET (UNIONS f')`,
2690   REPEAT STRIP_TAC THEN
2691   FIRST_ASSUM(MP_TAC o SPEC `f:(real^N->bool)->bool` o
2692     MATCH_MP HEINE_BOREL_LEMMA) THEN ASM_REWRITE_TAC[] THEN
2693   DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
2694   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
2695   REWRITE_TAC[SKOLEM_THM; SUBSET; IN_BALL] THEN
2696   DISCH_THEN(X_CHOOSE_TAC `B:real^N->real^N->bool`) THEN
2697   FIRST_ASSUM(MP_TAC o SPEC `e:real` o
2698     MATCH_MP COMPACT_IMP_TOTALLY_BOUNDED) THEN
2699   ASM_REWRITE_TAC[UNIONS_IMAGE; SUBSET; IN_ELIM_THM] THEN
2700   REWRITE_TAC[IN_UNIONS; IN_BALL] THEN
2701   DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN
2702   EXISTS_TAC `IMAGE (B:real^N->real^N->bool) k` THEN
2703   ASM_SIMP_TAC[FINITE_IMAGE; SUBSET; IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN
2704   ASM_MESON_TAC[IN_BALL]);;
2705
2706 (* ------------------------------------------------------------------------- *)
2707 (* Bolzano-Weierstrass property.                                             *)
2708 (* ------------------------------------------------------------------------- *)
2709
2710 let HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS = prove
2711  (`!s:real^N->bool.
2712         (!f. (!t. t IN f ==> open t) /\ s SUBSET (UNIONS f)
2713              ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET (UNIONS f'))
2714         ==> !t. INFINITE t /\ t SUBSET s ==> ?x. x IN s /\ x limit_point_of t`,
2715   REWRITE_TAC[RIGHT_IMP_FORALL_THM; limit_point_of] THEN REPEAT GEN_TAC THEN
2716   ONCE_REWRITE_TAC[TAUT `a ==> b /\ c ==> d <=> c ==> ~d ==> a ==> ~b`] THEN
2717   REWRITE_TAC[NOT_FORALL_THM; NOT_EXISTS_THM; RIGHT_AND_FORALL_THM] THEN
2718   DISCH_TAC THEN REWRITE_TAC[SKOLEM_THM] THEN
2719   DISCH_THEN(X_CHOOSE_TAC `f:real^N->real^N->bool`) THEN
2720   DISCH_THEN(MP_TAC o SPEC
2721    `{t:real^N->bool | ?x:real^N. x IN s /\ (t = f x)}`) THEN
2722   REWRITE_TAC[INFINITE; SUBSET; IN_ELIM_THM; IN_UNIONS; NOT_IMP] THEN
2723   ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
2724   DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
2725   MATCH_MP_TAC FINITE_SUBSET THEN
2726   EXISTS_TAC `{x:real^N | x IN t /\ (f(x):real^N->bool) IN g}` THEN
2727   CONJ_TAC THENL
2728    [MATCH_MP_TAC FINITE_IMAGE_INJ_GENERAL THEN ASM_MESON_TAC[SUBSET];
2729     SIMP_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `u:real^N` THEN
2730     DISCH_TAC THEN SUBGOAL_THEN `(u:real^N) IN s` ASSUME_TAC THEN
2731     ASM_MESON_TAC[SUBSET]]);;
2732
2733 (* ------------------------------------------------------------------------- *)
2734 (* Complete the chain of compactness variants.                               *)
2735 (* ------------------------------------------------------------------------- *)
2736
2737 let BOLZANO_WEIERSTRASS_IMP_BOUNDED = prove
2738  (`!s:real^N->bool.
2739         (!t. INFINITE t /\ t SUBSET s ==> ?x. x limit_point_of t)
2740         ==> bounded s`,
2741   GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
2742   SIMP_TAC[compact; bounded] THEN
2743   REWRITE_TAC[NOT_FORALL_THM; NOT_EXISTS_THM; SKOLEM_THM; NOT_IMP] THEN
2744   REWRITE_TAC[REAL_NOT_LE] THEN
2745   DISCH_THEN(X_CHOOSE_TAC `beyond:real->real^N`) THEN
2746   (MP_TAC o prove_recursive_functions_exist num_RECURSION)
2747    `(f(0) = beyond(&0)) /\
2748     (!n. f(SUC n) = beyond(norm(f n) + &1):real^N)` THEN
2749   DISCH_THEN(X_CHOOSE_THEN `x:num->real^N` STRIP_ASSUME_TAC) THEN
2750   EXISTS_TAC `IMAGE (x:num->real^N) UNIV` THEN
2751   SUBGOAL_THEN
2752    `!m n. m < n ==> norm((x:num->real^N) m) + &1 < norm(x n)`
2753   ASSUME_TAC THENL
2754    [GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LT] THEN
2755     ASM_MESON_TAC[REAL_LT_TRANS; REAL_ARITH `b < b + &1`];
2756     ALL_TAC] THEN
2757   SUBGOAL_THEN `!m n. ~(m = n) ==> &1 < dist((x:num->real^N) m,x n)`
2758   ASSUME_TAC THENL
2759    [REPEAT GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
2760      (SPECL [`m:num`; `n:num`] LT_CASES) THEN
2761     ASM_MESON_TAC[dist; LT_CASES; NORM_TRIANGLE_SUB; NORM_SUB;
2762                   REAL_ARITH `x + &1 < y /\ y <= x + d ==> &1 < d`];
2763     ALL_TAC] THEN
2764   REPEAT CONJ_TAC THENL
2765    [ASM_MESON_TAC[INFINITE_IMAGE_INJ; num_INFINITE; DIST_REFL;
2766                   REAL_ARITH `~(&1 < &0)`];
2767     REWRITE_TAC[SUBSET; IN_IMAGE; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN
2768     GEN_TAC THEN INDUCT_TAC THEN ASM_MESON_TAC[];
2769     ALL_TAC] THEN
2770   X_GEN_TAC `l:real^N` THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN
2771   REWRITE_TAC[IN_IMAGE; IN_UNIV; LEFT_AND_EXISTS_THM] THEN
2772   ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN
2773   STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `&1 / &2`) THEN
2774   CONV_TAC REAL_RAT_REDUCE_CONV THEN
2775   DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN
2776   FIRST_X_ASSUM(MP_TAC o SPEC `dist((x:num->real^N) k,l)`) THEN
2777   ASM_SIMP_TAC[DIST_POS_LT] THEN
2778   DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN
2779   ASM_CASES_TAC `m:num = k` THEN
2780   ASM_MESON_TAC[DIST_TRIANGLE_HALF_L; REAL_LT_TRANS; REAL_LT_REFL]);;
2781
2782 let SEQUENCE_INFINITE_LEMMA = prove
2783  (`!f l. (!n. ~(f(n) = l)) /\ (f --> l) sequentially
2784          ==> INFINITE {y:real^N | ?n. y = f n}`,
2785   REWRITE_TAC[INFINITE] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC
2786    `IMAGE (\y:real^N. dist(y,l)) {y | ?n:num. y = f n}` INF_FINITE) THEN
2787   ASM_SIMP_TAC[GSYM MEMBER_NOT_EMPTY; IN_IMAGE; FINITE_IMAGE; IN_ELIM_THM] THEN
2788   ASM_MESON_TAC[LIM_SEQUENTIALLY; LE_REFL; REAL_NOT_LE; DIST_POS_LT]);;
2789
2790 let LIMPT_OF_SEQUENCE_SUBSEQUENCE = prove
2791  (`!f:num->real^N l.
2792         l limit_point_of (IMAGE f (:num))
2793         ==> ?r. (!m n. m < n ==> r(m) < r(n)) /\ ((f o r) --> l) sequentially`,
2794   REPEAT STRIP_TAC THEN
2795   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_APPROACHABLE]) THEN
2796   DISCH_THEN(MP_TAC o GEN `n:num` o SPEC
2797    `inf((inv(&n + &1)) INSERT
2798     IMAGE (\k. dist((f:num->real^N) k,l))
2799           {k | k IN 0..n /\ ~(f k = l)})`) THEN
2800   SIMP_TAC[REAL_LT_INF_FINITE; FINITE_INSERT; NOT_INSERT_EMPTY;
2801            FINITE_RESTRICT; FINITE_NUMSEG; FINITE_IMAGE] THEN
2802   REWRITE_TAC[FORALL_IN_INSERT; EXISTS_IN_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN
2803   REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
2804   SIMP_TAC[FORALL_AND_THM; FORALL_IN_GSPEC; GSYM DIST_NZ; SKOLEM_THM] THEN
2805   DISCH_THEN(X_CHOOSE_THEN `nn:num->num` STRIP_ASSUME_TAC) THEN
2806   (MP_TAC o prove_recursive_functions_exist num_RECURSION)
2807    `r 0 = nn 0 /\ (!n. r (SUC n) = nn(r n))` THEN
2808   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN
2809   STRIP_TAC THEN
2810   MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
2811    [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN REWRITE_TAC[LT_TRANS] THEN
2812     X_GEN_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN
2813     FIRST_X_ASSUM(MP_TAC o SPECL
2814      [`(r:num->num) n`; `(nn:num->num)(r(n:num))`]) THEN
2815     ASM_REWRITE_TAC[IN_NUMSEG; LE_0; REAL_LT_REFL] THEN ARITH_TAC;
2816     DISCH_THEN(ASSUME_TAC o MATCH_MP MONOTONE_BIGGER)] THEN
2817   REWRITE_TAC[LIM_SEQUENTIALLY] THEN
2818   X_GEN_TAC `e:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN
2819   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN
2820   MATCH_MP_TAC num_INDUCTION THEN ASM_REWRITE_TAC[CONJUNCT1 LE] THEN
2821   X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN DISCH_TAC THEN
2822   ASM_REWRITE_TAC[o_THM] THEN MATCH_MP_TAC REAL_LT_TRANS THEN
2823   EXISTS_TAC `inv(&((r:num->num) n) + &1)` THEN ASM_REWRITE_TAC[] THEN
2824   MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN
2825   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
2826   ASM_SIMP_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; LE_1; REAL_OF_NUM_ADD] THEN
2827   MATCH_MP_TAC(ARITH_RULE `N <= SUC n /\ n <= r n ==> N <= r n + 1`) THEN
2828   ASM_REWRITE_TAC[]);;
2829
2830 let SEQUENCE_UNIQUE_LIMPT = prove
2831  (`!f l l':real^N.
2832         (f --> l) sequentially /\ l' limit_point_of {y | ?n. y = f n}
2833         ==> l' = l`,
2834   REWRITE_TAC[SET_RULE `{y | ?n. y = f n} = IMAGE f (:num)`] THEN
2835   REPEAT STRIP_TAC THEN
2836   FIRST_X_ASSUM(MP_TAC o MATCH_MP LIMPT_OF_SEQUENCE_SUBSEQUENCE) THEN
2837   DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN
2838   MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
2839   EXISTS_TAC `(f:num->real^N) o (r:num->num)` THEN
2840   ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIM_SUBSEQUENCE]);;
2841
2842 let BOLZANO_WEIERSTRASS_IMP_CLOSED = prove
2843  (`!s:real^N->bool.
2844         (!t. INFINITE t /\ t SUBSET s ==> ?x. x IN s /\ x limit_point_of t)
2845         ==> closed s`,
2846   REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS] THEN
2847   MAP_EVERY X_GEN_TAC [`f:num->real^N`; `l:real^N`] THEN
2848   DISCH_TAC THEN
2849   MAP_EVERY (MP_TAC o ISPECL [`f:num->real^N`; `l:real^N`])
2850    [SEQUENCE_UNIQUE_LIMPT; SEQUENCE_INFINITE_LEMMA] THEN
2851   MATCH_MP_TAC(TAUT
2852    `(~d ==> a /\ ~(b /\ c)) ==> (a ==> b) ==> c ==> d`) THEN
2853   DISCH_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[]; STRIP_TAC] THEN
2854   FIRST_X_ASSUM(MP_TAC o SPEC `{y:real^N | ?n:num. y = f n}`) THEN
2855   ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
2856    [REWRITE_TAC[SUBSET; IN_ELIM_THM];
2857     ABBREV_TAC `t = {y:real^N | ?n:num. y = f n}`] THEN
2858   ASM_MESON_TAC[]);;
2859
2860 (* ------------------------------------------------------------------------- *)
2861 (* Hence express everything as an equivalence.                               *)
2862 (* ------------------------------------------------------------------------- *)
2863
2864 let COMPACT_EQ_HEINE_BOREL = prove
2865  (`!s:real^N->bool.
2866         compact s <=>
2867            !f. (!t. t IN f ==> open t) /\ s SUBSET (UNIONS f)
2868                ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET (UNIONS f')`,
2869   GEN_TAC THEN EQ_TAC THEN SIMP_TAC[COMPACT_IMP_HEINE_BOREL] THEN
2870   DISCH_THEN(MP_TAC o MATCH_MP HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS) THEN
2871   DISCH_TAC THEN MATCH_MP_TAC BOUNDED_CLOSED_IMP_COMPACT THEN
2872   ASM_MESON_TAC[BOLZANO_WEIERSTRASS_IMP_BOUNDED;
2873                 BOLZANO_WEIERSTRASS_IMP_CLOSED]);;
2874
2875 let COMPACT_EQ_BOLZANO_WEIERSTRASS = prove
2876  (`!s:real^N->bool.
2877         compact s <=>
2878            !t. INFINITE t /\ t SUBSET s ==> ?x. x IN s /\ x limit_point_of t`,
2879   GEN_TAC THEN EQ_TAC THENL
2880    [SIMP_TAC[COMPACT_EQ_HEINE_BOREL; HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS];
2881     MESON_TAC[BOLZANO_WEIERSTRASS_IMP_BOUNDED; BOLZANO_WEIERSTRASS_IMP_CLOSED;
2882               BOUNDED_CLOSED_IMP_COMPACT]]);;
2883
2884 let COMPACT_EQ_BOUNDED_CLOSED = prove
2885  (`!s:real^N->bool. compact s <=> bounded s /\ closed s`,
2886   GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[BOUNDED_CLOSED_IMP_COMPACT] THEN
2887   MESON_TAC[COMPACT_EQ_BOLZANO_WEIERSTRASS; BOLZANO_WEIERSTRASS_IMP_BOUNDED;
2888             BOLZANO_WEIERSTRASS_IMP_CLOSED]);;
2889
2890 let COMPACT_IMP_BOUNDED = prove
2891  (`!s. compact s ==> bounded s`,
2892   SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED]);;
2893
2894 let COMPACT_IMP_CLOSED = prove
2895  (`!s. compact s ==> closed s`,
2896   SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED]);;
2897
2898 let COMPACT_SEQUENCE_WITH_LIMIT = prove
2899  (`!f l:real^N.
2900         (f --> l) sequentially ==> compact (l INSERT IMAGE f (:num))`,
2901   REPEAT STRIP_TAC THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN
2902   REWRITE_TAC[BOUNDED_INSERT] THEN CONJ_TAC THENL
2903    [ASM_MESON_TAC[CONVERGENT_IMP_BOUNDED];
2904     SIMP_TAC[CLOSED_LIMPT; LIMPT_INSERT; IN_INSERT] THEN
2905     REWRITE_TAC[IMAGE; IN_UNIV] THEN REPEAT STRIP_TAC THEN DISJ1_TAC THEN
2906     MATCH_MP_TAC SEQUENCE_UNIQUE_LIMPT THEN ASM_MESON_TAC[]]);;
2907
2908 let CLOSED_IN_COMPACT = prove
2909  (`!s t:real^N->bool.
2910         compact s /\ closed_in (subtopology euclidean s) t
2911         ==> compact t`,
2912   SIMP_TAC[IMP_CONJ; COMPACT_EQ_BOUNDED_CLOSED; CLOSED_IN_CLOSED_EQ] THEN
2913   MESON_TAC[BOUNDED_SUBSET]);;
2914
2915 let CLOSED_IN_COMPACT_EQ = prove
2916  (`!s t. compact s
2917          ==> (closed_in (subtopology euclidean s) t <=>
2918               compact t /\ t SUBSET s)`,
2919   MESON_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET]);;
2920
2921 (* ------------------------------------------------------------------------- *)
2922 (* A version of Heine-Borel for subtopology.                                 *)
2923 (* ------------------------------------------------------------------------- *)
2924
2925 let COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY = prove
2926  (`!s:real^N->bool.
2927         compact s <=>
2928         (!f. (!t. t IN f ==> open_in(subtopology euclidean s) t) /\
2929              s SUBSET UNIONS f
2930              ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET UNIONS f')`,
2931   GEN_TAC THEN REWRITE_TAC[COMPACT_EQ_HEINE_BOREL] THEN EQ_TAC THEN
2932   DISCH_TAC THEN X_GEN_TAC `f:(real^N->bool)->bool` THENL
2933    [REWRITE_TAC[OPEN_IN_OPEN] THEN
2934     GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
2935     REWRITE_TAC[SKOLEM_THM] THEN
2936     DISCH_THEN(CONJUNCTS_THEN2
2937      (X_CHOOSE_TAC `m:(real^N->bool)->(real^N->bool)`) ASSUME_TAC) THEN
2938     FIRST_X_ASSUM(MP_TAC o SPEC
2939      `IMAGE (m:(real^N->bool)->(real^N->bool)) f`) THEN
2940     ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN
2941     ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
2942     DISCH_THEN(X_CHOOSE_THEN `f':(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
2943     EXISTS_TAC `IMAGE (\t:real^N->bool. s INTER t) f'` THEN
2944     ASM_SIMP_TAC[FINITE_IMAGE; UNIONS_IMAGE; SUBSET; FORALL_IN_IMAGE] THEN
2945     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
2946     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET_IMAGE]) THEN
2947     STRIP_TAC THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_MESON_TAC[SUBSET];
2948     DISCH_TAC THEN
2949     FIRST_X_ASSUM(MP_TAC o SPEC `{s INTER t:real^N->bool | t IN f}`) THEN
2950     REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; OPEN_IN_OPEN; UNIONS_IMAGE] THEN
2951     ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
2952     ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN
2953     REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE; UNIONS_IMAGE] THEN
2954     MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]]);;
2955
2956 (* ------------------------------------------------------------------------- *)
2957 (* More easy lemmas.                                                         *)
2958 (* ------------------------------------------------------------------------- *)
2959
2960 let COMPACT_CLOSURE = prove
2961  (`!s. compact(closure s) <=> bounded s`,
2962   REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE; BOUNDED_CLOSURE_EQ]);;
2963
2964 let BOLZANO_WEIERSTRASS_CONTRAPOS = prove
2965  (`!s t:real^N->bool.
2966         compact s /\ t SUBSET s /\
2967         (!x. x IN s ==> ~(x limit_point_of t))
2968         ==> FINITE t`,
2969   REWRITE_TAC[COMPACT_EQ_BOLZANO_WEIERSTRASS; INFINITE] THEN MESON_TAC[]);;
2970
2971 let DISCRETE_BOUNDED_IMP_FINITE = prove
2972  (`!s:real^N->bool e.
2973         &0 < e /\
2974         (!x y. x IN s /\ y IN s /\ norm(y - x) < e ==> y = x) /\
2975         bounded s
2976         ==> FINITE s`,
2977   REPEAT STRIP_TAC THEN
2978   SUBGOAL_THEN `compact(s:real^N->bool)` MP_TAC THENL
2979    [ASM_REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN
2980     ASM_MESON_TAC[DISCRETE_IMP_CLOSED];
2981     DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_HEINE_BOREL)] THEN
2982   DISCH_THEN(MP_TAC o SPEC `IMAGE (\x:real^N. ball(x,e)) s`) THEN
2983   REWRITE_TAC[FORALL_IN_IMAGE; OPEN_BALL; UNIONS_IMAGE; IN_ELIM_THM] THEN
2984   ANTS_TAC THENL
2985    [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[CENTRE_IN_BALL];
2986     ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`]] THEN
2987   REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN
2988   DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
2989   SUBGOAL_THEN `s:real^N->bool = t` (fun th -> ASM_REWRITE_TAC[th]) THEN
2990   MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN
2991   REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
2992   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [UNIONS_IMAGE]) THEN
2993   DISCH_THEN(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN
2994   ASM_REWRITE_TAC[IN_ELIM_THM; IN_BALL; dist] THEN ASM_MESON_TAC[SUBSET]);;
2995
2996 let BOLZANO_WEIERSTRASS = prove
2997  (`!s:real^N->bool. bounded s /\ INFINITE s ==> ?x. x limit_point_of s`,
2998   GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
2999   FIRST_ASSUM(ASSUME_TAC o MATCH_MP NO_LIMIT_POINT_IMP_CLOSED) THEN
3000   STRIP_TAC THEN
3001   MP_TAC(ISPEC `s:real^N->bool` COMPACT_EQ_BOLZANO_WEIERSTRASS) THEN
3002   ASM_REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN
3003   DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN
3004   ASM_REWRITE_TAC[SUBSET_REFL] THEN ASM_MESON_TAC[]);;
3005
3006 let BOUNDED_EQ_BOLZANO_WEIERSTRASS = prove
3007  (`!s:real^N->bool.
3008         bounded s <=> !t. t SUBSET s /\ INFINITE t ==> ?x. x limit_point_of t`,
3009   MESON_TAC[BOLZANO_WEIERSTRASS_IMP_BOUNDED; BOLZANO_WEIERSTRASS;
3010             BOUNDED_SUBSET]);;
3011
3012 (* ------------------------------------------------------------------------- *)
3013 (* In particular, some common special cases.                                 *)
3014 (* ------------------------------------------------------------------------- *)
3015
3016 let COMPACT_EMPTY = prove
3017  (`compact {}`,
3018   REWRITE_TAC[compact; NOT_IN_EMPTY]);;
3019
3020 let COMPACT_UNION = prove
3021  (`!s t. compact s /\ compact t ==> compact (s UNION t)`,
3022   SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_UNION; CLOSED_UNION]);;
3023
3024 let COMPACT_INTER = prove
3025  (`!s t. compact s /\ compact t ==> compact (s INTER t)`,
3026   SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_INTER; CLOSED_INTER]);;
3027
3028 let COMPACT_INTER_CLOSED = prove
3029  (`!s t. compact s /\ closed t ==> compact (s INTER t)`,
3030   SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTER] THEN
3031   MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET]);;
3032
3033 let CLOSED_INTER_COMPACT = prove
3034  (`!s t. closed s /\ compact t ==> compact (s INTER t)`,
3035   MESON_TAC[COMPACT_INTER_CLOSED; INTER_COMM]);;
3036
3037 let COMPACT_INTERS = prove
3038  (`!f:(real^N->bool)->bool.
3039         (!s. s IN f ==> compact s) /\ ~(f = {})
3040         ==> compact(INTERS f)`,
3041   SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTERS] THEN
3042   REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_INTERS THEN ASM SET_TAC[]);;
3043
3044 let FINITE_IMP_CLOSED = prove
3045  (`!s. FINITE s ==> closed s`,
3046   MESON_TAC[BOLZANO_WEIERSTRASS_IMP_CLOSED; INFINITE; FINITE_SUBSET]);;
3047
3048 let FINITE_IMP_CLOSED_IN = prove
3049  (`!s t. FINITE s /\ s SUBSET t ==> closed_in (subtopology euclidean t) s`,
3050   SIMP_TAC[CLOSED_SUBSET_EQ; FINITE_IMP_CLOSED]);;
3051
3052 let FINITE_IMP_COMPACT = prove
3053  (`!s. FINITE s ==> compact s`,
3054   SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; FINITE_IMP_CLOSED; FINITE_IMP_BOUNDED]);;
3055
3056 let COMPACT_SING = prove
3057  (`!a. compact {a}`,
3058   SIMP_TAC[FINITE_IMP_COMPACT; FINITE_RULES]);;
3059
3060 let COMPACT_INSERT = prove
3061  (`!a s. compact s ==> compact(a INSERT s)`,
3062   ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN
3063   SIMP_TAC[COMPACT_UNION; COMPACT_SING]);;
3064
3065 let CLOSED_SING = prove
3066  (`!a. closed {a}`,
3067   MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; COMPACT_SING]);;
3068
3069 let CLOSED_IN_SING = prove
3070  (`!u x:real^N. closed_in (subtopology euclidean u) {x} <=> x IN u`,
3071   SIMP_TAC[CLOSED_SUBSET_EQ; CLOSED_SING] THEN SET_TAC[]);;
3072
3073 let CLOSURE_SING = prove
3074  (`!x:real^N. closure {x} = {x}`,
3075   SIMP_TAC[CLOSURE_CLOSED; CLOSED_SING]);;
3076
3077 let CLOSED_INSERT = prove
3078  (`!a s. closed s ==> closed(a INSERT s)`,
3079   ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN
3080   SIMP_TAC[CLOSED_UNION; CLOSED_SING]);;
3081
3082 let COMPACT_CBALL = prove
3083  (`!x e. compact(cball(x,e))`,
3084   REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_CBALL; CLOSED_CBALL]);;
3085
3086 let COMPACT_FRONTIER_BOUNDED = prove
3087  (`!s. bounded s ==> compact(frontier s)`,
3088   SIMP_TAC[frontier; COMPACT_EQ_BOUNDED_CLOSED;
3089            CLOSED_DIFF; OPEN_INTERIOR; CLOSED_CLOSURE] THEN
3090   MESON_TAC[SUBSET_DIFF; BOUNDED_SUBSET; BOUNDED_CLOSURE]);;
3091
3092 let COMPACT_FRONTIER = prove
3093  (`!s. compact s ==> compact (frontier s)`,
3094   MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; COMPACT_FRONTIER_BOUNDED]);;
3095
3096 let BOUNDED_FRONTIER = prove
3097  (`!s:real^N->bool. bounded s ==> bounded(frontier s)`,
3098   MESON_TAC[COMPACT_FRONTIER_BOUNDED; COMPACT_IMP_BOUNDED]);;
3099
3100 let FRONTIER_SUBSET_COMPACT = prove
3101  (`!s. compact s ==> frontier s SUBSET s`,
3102   MESON_TAC[FRONTIER_SUBSET_CLOSED; COMPACT_EQ_BOUNDED_CLOSED]);;
3103
3104 let OPEN_DELETE = prove
3105  (`!s x. open s ==> open(s DELETE x)`,
3106   let lemma = prove(`s DELETE x = s DIFF {x}`,SET_TAC[]) in
3107   SIMP_TAC[lemma; OPEN_DIFF; CLOSED_SING]);;
3108
3109 let OPEN_IN_DELETE = prove
3110  (`!u s a:real^N.
3111         open_in (subtopology euclidean u) s
3112         ==> open_in (subtopology euclidean u) (s DELETE a)`,
3113   REPEAT STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THENL
3114    [ONCE_REWRITE_TAC[SET_RULE `s DELETE a = s DIFF {a}`] THEN
3115     MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[CLOSED_IN_SING] THEN
3116     FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[];
3117     ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> s DELETE a = s`]]);;
3118
3119 let CLOSED_INTERS_COMPACT = prove
3120  (`!s:real^N->bool.
3121         closed s <=> !e. compact(cball(vec 0,e) INTER s)`,
3122   GEN_TAC THEN EQ_TAC THENL
3123    [SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTER; CLOSED_CBALL;
3124              BOUNDED_INTER; BOUNDED_CBALL];
3125     ALL_TAC] THEN
3126   STRIP_TAC THEN REWRITE_TAC[CLOSED_LIMPT] THEN
3127   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
3128   FIRST_X_ASSUM(MP_TAC o SPEC `norm(x:real^N) + &1`) THEN
3129   DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_CLOSED) THEN
3130   REWRITE_TAC[CLOSED_LIMPT] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
3131   REWRITE_TAC[IN_INTER] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
3132   POP_ASSUM MP_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN
3133   DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
3134   FIRST_X_ASSUM(MP_TAC o SPEC `min e (&1 / &2)`) THEN
3135   ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN
3136   X_GEN_TAC `y:real^N` THEN SIMP_TAC[IN_INTER; IN_CBALL] THEN NORM_ARITH_TAC);;
3137
3138 let COMPACT_UNIONS = prove
3139  (`!s. FINITE s /\ (!t. t IN s ==> compact t) ==> compact(UNIONS s)`,
3140   SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_UNIONS; BOUNDED_UNIONS]);;
3141
3142 let COMPACT_DIFF = prove
3143  (`!s t. compact s /\ open t ==> compact(s DIFF t)`,
3144   ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN
3145   SIMP_TAC[COMPACT_INTER_CLOSED; GSYM OPEN_CLOSED]);;
3146
3147 let COMPACT_SPHERE = prove
3148  (`!a:real^N r. compact(sphere(a,r))`,
3149   REPEAT GEN_TAC THEN
3150   REWRITE_TAC[GSYM FRONTIER_CBALL] THEN MATCH_MP_TAC COMPACT_FRONTIER THEN
3151   REWRITE_TAC[COMPACT_CBALL]);;
3152
3153 let BOUNDED_SPHERE = prove
3154  (`!a:real^N r. bounded(sphere(a,r))`,
3155   SIMP_TAC[COMPACT_SPHERE; COMPACT_IMP_BOUNDED]);;
3156
3157 let CLOSED_SPHERE = prove
3158  (`!a r. closed(sphere(a,r))`,
3159   SIMP_TAC[COMPACT_SPHERE; COMPACT_IMP_CLOSED]);;
3160
3161 let FRONTIER_SING = prove
3162  (`!a:real^N. frontier {a} = {a}`,
3163   REWRITE_TAC[frontier; CLOSURE_SING; INTERIOR_SING; DIFF_EMPTY]);;
3164
3165 (* ------------------------------------------------------------------------- *)
3166 (* Finite intersection property. I could make it an equivalence in fact.     *)
3167 (* ------------------------------------------------------------------------- *)
3168
3169 let COMPACT_IMP_FIP = prove
3170  (`!s:real^N->bool f.
3171         compact s /\
3172         (!t. t IN f ==> closed t) /\
3173         (!f'. FINITE f' /\ f' SUBSET f ==> ~(s INTER (INTERS f') = {}))
3174         ==> ~(s INTER (INTERS f) = {})`,
3175   let lemma = prove(`(s = UNIV DIFF t) <=> (UNIV DIFF s = t)`,SET_TAC[]) in
3176   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3177   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL]) THEN
3178   DISCH_THEN(MP_TAC o SPEC `IMAGE (\t:real^N->bool. UNIV DIFF t) f`) THEN
3179   ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN
3180   DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN
3181   ASM_SIMP_TAC[OPEN_DIFF; CLOSED_DIFF; OPEN_UNIV; CLOSED_UNIV; NOT_IMP] THEN
3182   CONJ_TAC THENL
3183    [UNDISCH_TAC `(s:real^N->bool) INTER INTERS f = {}` THEN
3184     ONCE_REWRITE_TAC[SUBSET; EXTENSION] THEN
3185     REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE] THEN SET_TAC[];
3186     DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` MP_TAC) THEN
3187     FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (\t:real^N->bool. UNIV DIFF t) g`) THEN
3188     ASM_CASES_TAC `FINITE(g:(real^N->bool)->bool)` THEN
3189     ASM_SIMP_TAC[FINITE_IMAGE] THEN ONCE_REWRITE_TAC[SUBSET; EXTENSION] THEN
3190     REWRITE_TAC[FORALL_IN_IMAGE; IN_INTER; IN_INTERS; IN_IMAGE; IN_DIFF;
3191                 IN_UNIV; NOT_IN_EMPTY; lemma; UNWIND_THM1; IN_UNIONS] THEN
3192     SET_TAC[]]);;
3193
3194 let CLOSED_IMP_FIP = prove
3195  (`!s:real^N->bool f.
3196         closed s /\
3197         (!t. t IN f ==> closed t) /\ (?t. t IN f /\ bounded t) /\
3198         (!f'. FINITE f' /\ f' SUBSET f ==> ~(s INTER (INTERS f') = {}))
3199         ==> ~(s INTER (INTERS f) = {})`,
3200   REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(SET_RULE
3201    `~((s INTER t) INTER u = {}) ==> ~(s INTER u = {})`) THEN
3202   MATCH_MP_TAC COMPACT_IMP_FIP THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
3203    [ASM_MESON_TAC[CLOSED_INTER_COMPACT; COMPACT_EQ_BOUNDED_CLOSED];
3204     REWRITE_TAC[INTER_ASSOC] THEN ONCE_REWRITE_TAC[GSYM INTERS_INSERT]] THEN
3205   GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
3206   ASM_SIMP_TAC[FINITE_INSERT; INSERT_SUBSET]);;
3207
3208 let CLOSED_IMP_FIP_COMPACT = prove
3209  (`!s:real^N->bool f.
3210         closed s /\ (!t. t IN f ==> compact t) /\
3211         (!f'. FINITE f' /\ f' SUBSET f ==> ~(s INTER (INTERS f') = {}))
3212         ==> ~(s INTER (INTERS f) = {})`,
3213   REPEAT GEN_TAC THEN
3214   ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN
3215   ASM_SIMP_TAC[SUBSET_EMPTY; INTERS_0; INTER_UNIV] THENL
3216    [MESON_TAC[FINITE_EMPTY]; ALL_TAC] THEN
3217   STRIP_TAC THEN MATCH_MP_TAC CLOSED_IMP_FIP THEN
3218   ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; MEMBER_NOT_EMPTY]);;
3219
3220 let CLOSED_FIP = prove
3221  (`!f. (!t:real^N->bool. t IN f ==> closed t) /\ (?t. t IN f /\ bounded t) /\
3222        (!f'. FINITE f' /\ f' SUBSET f ==> ~(INTERS f' = {}))
3223        ==> ~(INTERS f = {})`,
3224   GEN_TAC THEN DISCH_TAC THEN
3225   ONCE_REWRITE_TAC[SET_RULE `s = {} <=> UNIV INTER s = {}`] THEN
3226   MATCH_MP_TAC CLOSED_IMP_FIP THEN ASM_REWRITE_TAC[CLOSED_UNIV; INTER_UNIV]);;
3227
3228 let COMPACT_FIP = prove
3229  (`!f. (!t:real^N->bool. t IN f ==> compact t) /\
3230        (!f'. FINITE f' /\ f' SUBSET f ==> ~(INTERS f' = {}))
3231        ==> ~(INTERS f = {})`,
3232   GEN_TAC THEN DISCH_TAC THEN
3233   ONCE_REWRITE_TAC[SET_RULE `s = {} <=> UNIV INTER s = {}`] THEN
3234   MATCH_MP_TAC CLOSED_IMP_FIP_COMPACT THEN
3235   ASM_REWRITE_TAC[CLOSED_UNIV; INTER_UNIV]);;
3236
3237 (* ------------------------------------------------------------------------- *)
3238 (* Bounded closed nest property (proof does not use Heine-Borel).            *)
3239 (* ------------------------------------------------------------------------- *)
3240
3241 let BOUNDED_CLOSED_NEST = prove
3242  (`!s. (!n. closed(s n)) /\ (!n. ~(s n = {})) /\
3243        (!m n. m <= n ==> s(n) SUBSET s(m)) /\
3244        bounded(s 0)
3245        ==> ?a:real^N. !n:num. a IN s(n)`,
3246   GEN_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; SKOLEM_THM] THEN
3247   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3248   DISCH_THEN(CONJUNCTS_THEN2
3249      (X_CHOOSE_TAC `a:num->real^N`) STRIP_ASSUME_TAC) THEN
3250   SUBGOAL_THEN `compact(s 0:real^N->bool)` MP_TAC THENL
3251    [ASM_MESON_TAC[BOUNDED_CLOSED_IMP_COMPACT]; ALL_TAC] THEN
3252   REWRITE_TAC[compact] THEN
3253   DISCH_THEN(MP_TAC o SPEC `a:num->real^N`) THEN
3254   ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; LE_0]; ALL_TAC] THEN
3255   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N` THEN
3256   REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN
3257   DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN
3258   GEN_REWRITE_TAC I [TAUT `p <=> ~(~p)`] THEN
3259   GEN_REWRITE_TAC RAND_CONV [NOT_FORALL_THM] THEN
3260   DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN
3261   MP_TAC(ISPECL [`l:real^N`; `(s:num->real^N->bool) N`]
3262                 CLOSED_APPROACHABLE) THEN
3263   ASM_MESON_TAC[SUBSET; LE_REFL; LE_TRANS; LE_CASES; MONOTONE_BIGGER]);;
3264
3265 (* ------------------------------------------------------------------------- *)
3266 (* Decreasing case does not even need compactness, just completeness.        *)
3267 (* ------------------------------------------------------------------------- *)
3268
3269 let DECREASING_CLOSED_NEST = prove
3270  (`!s. (!n. closed(s n)) /\ (!n. ~(s n = {})) /\
3271        (!m n. m <= n ==> s(n) SUBSET s(m)) /\
3272        (!e. &0 < e ==> ?n. !x y. x IN s(n) /\ y IN s(n) ==> dist(x,y) < e)
3273        ==> ?a:real^N. !n:num. a IN s(n)`,
3274   GEN_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; SKOLEM_THM] THEN
3275   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3276   DISCH_THEN(CONJUNCTS_THEN2
3277      (X_CHOOSE_TAC `a:num->real^N`) STRIP_ASSUME_TAC) THEN
3278   SUBGOAL_THEN `?l:real^N. (a --> l) sequentially` MP_TAC THENL
3279    [ASM_MESON_TAC[cauchy; GE; SUBSET; LE_TRANS; LE_REFL;
3280                   complete; COMPLETE_UNIV; IN_UNIV];
3281     ASM_MESON_TAC[LIM_SEQUENTIALLY; CLOSED_APPROACHABLE;
3282                   SUBSET; LE_REFL; LE_TRANS; LE_CASES]]);;
3283
3284 (* ------------------------------------------------------------------------- *)
3285 (* Strengthen it to the intersection actually being a singleton.             *)
3286 (* ------------------------------------------------------------------------- *)
3287
3288 let DECREASING_CLOSED_NEST_SING = prove
3289  (`!s. (!n. closed(s n)) /\ (!n. ~(s n = {})) /\
3290        (!m n. m <= n ==> s(n) SUBSET s(m)) /\
3291        (!e. &0 < e ==> ?n. !x y. x IN s(n) /\ y IN s(n) ==> dist(x,y) < e)
3292        ==> ?a:real^N. INTERS {t | ?n:num. t = s n} = {a}`,
3293   GEN_TAC THEN DISCH_TAC THEN
3294   FIRST_ASSUM(MP_TAC o MATCH_MP DECREASING_CLOSED_NEST) THEN
3295   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN
3296   DISCH_TAC THEN REWRITE_TAC[EXTENSION; IN_INTERS; IN_SING; IN_ELIM_THM] THEN
3297   ASM_MESON_TAC[DIST_POS_LT; REAL_LT_REFL; SUBSET; LE_CASES]);;
3298
3299 (* ------------------------------------------------------------------------- *)
3300 (* A version for a more general chain, not indexed by N.                     *)
3301 (* ------------------------------------------------------------------------- *)
3302
3303 let BOUNDED_CLOSED_CHAIN = prove
3304  (`!f b:real^N->bool.
3305         (!s. s IN f ==> closed s /\ ~(s = {})) /\
3306         (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) /\
3307          b IN f /\ bounded b
3308          ==> ~(INTERS f = {})`,
3309   REPEAT GEN_TAC THEN STRIP_TAC THEN
3310   SUBGOAL_THEN `~(b INTER (INTERS f):real^N->bool = {})` MP_TAC THENL
3311    [ALL_TAC; SET_TAC[]] THEN
3312   MATCH_MP_TAC COMPACT_IMP_FIP THEN
3313   ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN
3314   X_GEN_TAC `u:(real^N->bool)->bool` THEN STRIP_TAC THEN
3315   SUBGOAL_THEN `?s:real^N->bool. s IN f /\ !t. t IN u ==> s SUBSET t`
3316   MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
3317   UNDISCH_TAC `(u:(real^N->bool)->bool) SUBSET f` THEN
3318   UNDISCH_TAC `FINITE(u:(real^N->bool)->bool)` THEN
3319   SPEC_TAC(`u:(real^N->bool)->bool`,`u:(real^N->bool)->bool`) THEN
3320   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
3321   CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
3322   MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:(real^N->bool)->bool`] THEN
3323   REWRITE_TAC[INSERT_SUBSET] THEN
3324   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
3325   ASM_REWRITE_TAC[] THEN
3326   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
3327   DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN
3328   FIRST_X_ASSUM(MP_TAC o SPECL [`s:real^N->bool`; `t:real^N->bool`]) THEN
3329   ASM SET_TAC[]);;
3330
3331 (* ------------------------------------------------------------------------- *)
3332 (* Analogous things directly for compactness.                                *)
3333 (* ------------------------------------------------------------------------- *)
3334
3335 let COMPACT_CHAIN = prove
3336  (`!f:(real^N->bool)->bool.
3337         (!s. s IN f ==> compact s /\ ~(s = {})) /\
3338         (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s)
3339         ==> ~(INTERS f = {})`,
3340   GEN_TAC THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN STRIP_TAC THEN
3341   ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL
3342    [ASM_REWRITE_TAC[INTERS_0] THEN SET_TAC[];
3343     MATCH_MP_TAC BOUNDED_CLOSED_CHAIN THEN ASM SET_TAC[]]);;
3344
3345 let COMPACT_NEST = prove
3346  (`!s. (!n. compact(s n) /\ ~(s n = {})) /\
3347        (!m n. m <= n ==> s n SUBSET s m)
3348        ==> ~(INTERS {s n | n IN (:num)} = {})`,
3349   GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC COMPACT_CHAIN THEN
3350   ASM_SIMP_TAC[FORALL_IN_GSPEC; IN_UNIV; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
3351   MATCH_MP_TAC WLOG_LE THEN ASM_MESON_TAC[]);;
3352
3353 (* ------------------------------------------------------------------------- *)
3354 (* Cauchy-type criteria for *uniform* convergence.                           *)
3355 (* ------------------------------------------------------------------------- *)
3356
3357 let UNIFORMLY_CONVERGENT_EQ_CAUCHY = prove
3358  (`!P s:num->A->real^N.
3359          (?l. !e. &0 < e
3360                   ==> ?N. !n x. N <= n /\ P x ==> dist(s n x,l x) < e) <=>
3361          (!e. &0 < e
3362               ==> ?N. !m n x. N <= m /\ N <= n /\ P x
3363                               ==> dist(s m x,s n x) < e)`,
3364   REPEAT GEN_TAC THEN EQ_TAC THENL
3365    [DISCH_THEN(X_CHOOSE_TAC `l:A->real^N`) THEN X_GEN_TAC `e:real` THEN
3366     DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
3367     ASM_REWRITE_TAC[REAL_HALF] THEN MESON_TAC[DIST_TRIANGLE_HALF_L];
3368     ALL_TAC] THEN
3369   DISCH_TAC THEN
3370   SUBGOAL_THEN `!x:A. P x ==> cauchy (\n. s n x :real^N)` MP_TAC THENL
3371    [REWRITE_TAC[cauchy; GE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN
3372   REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY; LIM_SEQUENTIALLY] THEN
3373   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
3374   REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
3375   X_GEN_TAC `l:A->real^N` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN
3376   DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
3377   ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN
3378   X_GEN_TAC `N:num` THEN STRIP_TAC THEN
3379   MAP_EVERY X_GEN_TAC [`n:num`; `x:A`] THEN STRIP_TAC THEN
3380   FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN
3381   DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
3382   DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN
3383   FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `N + M:num`; `x:A`]) THEN
3384   ASM_REWRITE_TAC[LE_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
3385   FIRST_X_ASSUM(MP_TAC o SPEC `M + N:num`) THEN REWRITE_TAC[LE_ADD] THEN
3386   ASM_MESON_TAC[DIST_TRIANGLE_HALF_L; DIST_SYM]);;
3387
3388 let UNIFORMLY_CAUCHY_IMP_UNIFORMLY_CONVERGENT = prove
3389  (`!P (s:num->A->real^N) l.
3390     (!e. &0 < e
3391          ==> ?N. !m n x. N <= m /\ N <= n /\ P x ==> dist(s m x,s n x) < e) /\
3392     (!x. P x ==> !e. &0 < e ==> ?N. !n. N <= n ==> dist(s n x,l x) < e)
3393     ==> (!e. &0 < e ==> ?N. !n x. N <= n /\ P x ==> dist(s n x,l x) < e)`,
3394   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM UNIFORMLY_CONVERGENT_EQ_CAUCHY] THEN
3395   DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `l':A->real^N`) ASSUME_TAC) THEN
3396   SUBGOAL_THEN `!x. P x ==> (l:A->real^N) x = l' x` MP_TAC THENL
3397    [ALL_TAC; ASM_MESON_TAC[]] THEN
3398   REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
3399   EXISTS_TAC `\n. (s:num->A->real^N) n x` THEN
3400   REWRITE_TAC[LIM_SEQUENTIALLY; TRIVIAL_LIMIT_SEQUENTIALLY] THEN
3401   ASM_MESON_TAC[]);;
3402
3403 (* ------------------------------------------------------------------------- *)
3404 (* Define continuity over a net to take in restrictions of the set.          *)
3405 (* ------------------------------------------------------------------------- *)
3406
3407 parse_as_infix ("continuous",(12,"right"));;
3408
3409 let continuous = new_definition
3410   `f continuous net <=> (f --> f(netlimit net)) net`;;
3411
3412 let CONTINUOUS_TRIVIAL_LIMIT = prove
3413  (`!f net. trivial_limit net ==> f continuous net`,
3414   SIMP_TAC[continuous; LIM]);;
3415
3416 let CONTINUOUS_WITHIN = prove
3417  (`!f x:real^M. f continuous (at x within s) <=> (f --> f(x)) (at x within s)`,
3418   REPEAT GEN_TAC THEN REWRITE_TAC[continuous] THEN
3419   ASM_CASES_TAC `trivial_limit(at (x:real^M) within s)` THENL
3420    [ASM_REWRITE_TAC[LIM]; ASM_SIMP_TAC[NETLIMIT_WITHIN]]);;
3421
3422 let CONTINUOUS_AT = prove
3423  (`!f (x:real^N). f continuous (at x) <=> (f --> f(x)) (at x)`,
3424   ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
3425   REWRITE_TAC[CONTINUOUS_WITHIN; IN_UNIV]);;
3426
3427 let CONTINUOUS_AT_WITHIN = prove
3428  (`!f:real^M->real^N x s.
3429         f continuous (at x) ==> f continuous (at x within s)`,
3430   SIMP_TAC[LIM_AT_WITHIN; CONTINUOUS_AT; CONTINUOUS_WITHIN]);;
3431
3432 let CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL = prove
3433  (`!a s. closed s /\ ~(a IN s) ==> f continuous (at a within s)`,
3434   ASM_SIMP_TAC[continuous; LIM; LIM_WITHIN_CLOSED_TRIVIAL]);;
3435
3436 let CONTINUOUS_TRANSFORM_WITHIN = prove
3437  (`!f g:real^M->real^N s x d.
3438         &0 < d /\ x IN s /\
3439         (!x'. x' IN s /\ dist(x',x) < d ==> f(x') = g(x')) /\
3440         f continuous (at x within s)
3441         ==> g continuous (at x within s)`,
3442   REWRITE_TAC[CONTINUOUS_WITHIN] THEN
3443   MESON_TAC[LIM_TRANSFORM_WITHIN; DIST_REFL]);;
3444
3445 let CONTINUOUS_TRANSFORM_AT = prove
3446  (`!f g:real^M->real^N x d.
3447         &0 < d /\ (!x'. dist(x',x) < d ==> f(x') = g(x')) /\
3448         f continuous (at x)
3449         ==> g continuous (at x)`,
3450   REWRITE_TAC[CONTINUOUS_AT] THEN
3451   MESON_TAC[LIM_TRANSFORM_AT; DIST_REFL]);;
3452
3453 let CONTINUOUS_TRANSFORM_WITHIN_OPEN = prove
3454  (`!f g:real^M->real^N s a.
3455         open s /\ a IN s /\
3456         (!x. x IN s ==> f x = g x) /\
3457         f continuous at a
3458         ==> g continuous at a`,
3459   MESON_TAC[CONTINUOUS_AT; LIM_TRANSFORM_WITHIN_OPEN]);;
3460
3461 let CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN = prove
3462  (`!f g:real^M->real^N s t a.
3463         open_in (subtopology euclidean t) s /\ a IN s /\
3464         (!x. x IN s ==> f x = g x) /\
3465         f continuous (at a within t)
3466         ==> g continuous (at a within t)`,
3467   MESON_TAC[CONTINUOUS_WITHIN; LIM_TRANSFORM_WITHIN_OPEN_IN]);;
3468
3469 (* ------------------------------------------------------------------------- *)
3470 (* Derive the epsilon-delta forms, which we often use as "definitions"       *)
3471 (* ------------------------------------------------------------------------- *)
3472
3473 let continuous_within = prove
3474  (`f continuous (at x within s) <=>
3475         !e. &0 < e
3476             ==> ?d. &0 < d /\
3477                     !x'. x' IN s /\ dist(x',x) < d ==> dist(f(x'),f(x)) < e`,
3478   REWRITE_TAC[CONTINUOUS_WITHIN; LIM_WITHIN] THEN
3479   REWRITE_TAC[GSYM DIST_NZ] THEN MESON_TAC[DIST_REFL]);;
3480
3481 let continuous_at = prove
3482  (`f continuous (at x) <=>
3483         !e. &0 < e ==> ?d. &0 < d /\
3484                            !x'. dist(x',x) < d ==> dist(f(x'),f(x)) < e`,
3485   ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
3486   REWRITE_TAC[continuous_within; IN_UNIV]);;
3487
3488 (* ------------------------------------------------------------------------- *)
3489 (* Versions in terms of open balls.                                          *)
3490 (* ------------------------------------------------------------------------- *)
3491
3492 let CONTINUOUS_WITHIN_BALL = prove
3493  (`!f s x. f continuous (at x within s) <=>
3494                 !e. &0 < e
3495                     ==> ?d. &0 < d /\
3496                             IMAGE f (ball(x,d) INTER s) SUBSET ball(f x,e)`,
3497   SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_BALL; continuous_within; IN_INTER] THEN
3498   MESON_TAC[DIST_SYM]);;
3499
3500 let CONTINUOUS_AT_BALL = prove
3501  (`!f x. f continuous (at x) <=>
3502                 !e. &0 < e
3503                     ==> ?d. &0 < d /\
3504                             IMAGE f (ball(x,d)) SUBSET ball(f x,e)`,
3505   SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_BALL; continuous_at] THEN
3506   MESON_TAC[DIST_SYM]);;
3507
3508 (* ------------------------------------------------------------------------- *)
3509 (* For setwise continuity, just start from the epsilon-delta definitions.    *)
3510 (* ------------------------------------------------------------------------- *)
3511
3512 parse_as_infix ("continuous_on",(12,"right"));;
3513 parse_as_infix ("uniformly_continuous_on",(12,"right"));;
3514
3515 let continuous_on = new_definition
3516   `f continuous_on s <=>
3517         !x. x IN s ==> !e. &0 < e
3518                            ==> ?d. &0 < d /\
3519                                    !x'. x' IN s /\ dist(x',x) < d
3520                                         ==> dist(f(x'),f(x)) < e`;;
3521
3522 let uniformly_continuous_on = new_definition
3523   `f uniformly_continuous_on s <=>
3524         !e. &0 < e
3525             ==> ?d. &0 < d /\
3526                     !x x'. x IN s /\ x' IN s /\ dist(x',x) < d
3527                            ==> dist(f(x'),f(x)) < e`;;
3528
3529 (* ------------------------------------------------------------------------- *)
3530 (* Some simple consequential lemmas.                                         *)
3531 (* ------------------------------------------------------------------------- *)
3532
3533 let UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS = prove
3534  (`!f s. f uniformly_continuous_on s ==> f continuous_on s`,
3535   REWRITE_TAC[uniformly_continuous_on; continuous_on] THEN MESON_TAC[]);;
3536
3537 let CONTINUOUS_AT_IMP_CONTINUOUS_ON = prove
3538  (`!f s. (!x. x IN s ==> f continuous (at x)) ==> f continuous_on s`,
3539   REWRITE_TAC[continuous_at; continuous_on] THEN MESON_TAC[]);;
3540
3541 let CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN = prove
3542  (`!f s. f continuous_on s <=> !x. x IN s ==> f continuous (at x within s)`,
3543   REWRITE_TAC[continuous_on; continuous_within]);;
3544
3545 let CONTINUOUS_ON = prove
3546  (`!f (s:real^N->bool).
3547         f continuous_on s <=> !x. x IN s ==> (f --> f(x)) (at x within s)`,
3548   REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_WITHIN]);;
3549
3550 let CONTINUOUS_ON_EQ_CONTINUOUS_AT = prove
3551  (`!f:real^M->real^N s.
3552       open s ==> (f continuous_on s <=> (!x. x IN s ==> f continuous (at x)))`,
3553   SIMP_TAC[CONTINUOUS_ON; CONTINUOUS_AT; LIM_WITHIN_OPEN]);;
3554
3555 let CONTINUOUS_WITHIN_SUBSET = prove
3556  (`!f s t x. f continuous (at x within s) /\ t SUBSET s
3557              ==> f continuous (at x within t)`,
3558    REWRITE_TAC[CONTINUOUS_WITHIN] THEN MESON_TAC[LIM_WITHIN_SUBSET]);;
3559
3560 let CONTINUOUS_ON_SUBSET = prove
3561  (`!f s t. f continuous_on s /\ t SUBSET s ==> f continuous_on t`,
3562   REWRITE_TAC[CONTINUOUS_ON] THEN MESON_TAC[SUBSET; LIM_WITHIN_SUBSET]);;
3563
3564 let UNIFORMLY_CONTINUOUS_ON_SUBSET = prove
3565  (`!f s t. f uniformly_continuous_on s /\ t SUBSET s
3566            ==> f uniformly_continuous_on t`,
3567   REWRITE_TAC[uniformly_continuous_on] THEN
3568   MESON_TAC[SUBSET; LIM_WITHIN_SUBSET]);;
3569
3570 let CONTINUOUS_ON_INTERIOR = prove
3571  (`!f:real^M->real^N s x.
3572         f continuous_on s /\ x IN interior(s) ==> f continuous at x`,
3573   REWRITE_TAC[interior; IN_ELIM_THM] THEN
3574   MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; CONTINUOUS_ON_SUBSET]);;
3575
3576 let CONTINUOUS_ON_EQ = prove
3577  (`!f g s. (!x. x IN s ==> f(x) = g(x)) /\ f continuous_on s
3578            ==> g continuous_on s`,
3579   SIMP_TAC[continuous_on; IMP_CONJ]);;
3580
3581 let UNIFORMLY_CONTINUOUS_ON_EQ = prove
3582  (`!f g s.
3583         (!x. x IN s ==> f x = g x) /\ f uniformly_continuous_on s
3584         ==> g uniformly_continuous_on s`,
3585   SIMP_TAC[uniformly_continuous_on; IMP_CONJ]);;
3586
3587 let CONTINUOUS_ON_SING = prove
3588  (`!f:real^M->real^N a. f continuous_on {a}`,
3589   SIMP_TAC[continuous_on; IN_SING; FORALL_UNWIND_THM2; DIST_REFL] THEN
3590   MESON_TAC[]);;
3591
3592 let CONTINUOUS_ON_EMPTY = prove
3593  (`!f:real^M->real^N. f continuous_on {}`,
3594   MESON_TAC[CONTINUOUS_ON_SING; EMPTY_SUBSET; CONTINUOUS_ON_SUBSET]);;
3595
3596 let CONTINUOUS_ON_NO_LIMPT = prove
3597  (`!f:real^M->real^N s.
3598      ~(?x. x limit_point_of s) ==> f continuous_on s`,
3599   REWRITE_TAC[continuous_on; LIMPT_APPROACHABLE] THEN MESON_TAC[DIST_REFL]);;
3600
3601 let CONTINUOUS_ON_FINITE = prove
3602  (`!f:real^M->real^N s. FINITE s ==> f continuous_on s`,
3603   MESON_TAC[CONTINUOUS_ON_NO_LIMPT; LIMIT_POINT_FINITE]);;
3604
3605 let CONTRACTION_IMP_CONTINUOUS_ON = prove
3606  (`!f:real^M->real^N.
3607         (!x y. x IN s /\ y IN s ==> dist(f x,f y) <= dist(x,y))
3608         ==> f continuous_on s`,
3609   SIMP_TAC[continuous_on] THEN MESON_TAC[REAL_LET_TRANS]);;
3610
3611 let ISOMETRY_ON_IMP_CONTINUOUS_ON = prove
3612  (`!f:real^M->real^N.
3613         (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y))
3614         ==> f continuous_on s`,
3615   SIMP_TAC[CONTRACTION_IMP_CONTINUOUS_ON; REAL_LE_REFL]);;
3616
3617 (* ------------------------------------------------------------------------- *)
3618 (* Characterization of various kinds of continuity in terms of sequences.    *)
3619 (* ------------------------------------------------------------------------- *)
3620
3621 let CONTINUOUS_WITHIN_SEQUENTIALLY = prove
3622  (`!f a:real^N.
3623         f continuous (at a within s) <=>
3624                 !x. (!n. x(n) IN s) /\ (x --> a) sequentially
3625                      ==> ((f o x) --> f(a)) sequentially`,
3626   REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within] THEN EQ_TAC THENL
3627    [REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN MESON_TAC[]; ALL_TAC] THEN
3628   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
3629   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN
3630   DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
3631   DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `&1 / (&n + &1)`) THEN
3632   SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; REAL_OF_NUM_LE; REAL_POS; ARITH;
3633        REAL_ARITH `&0 <= n ==> &0 < n + &1`; NOT_FORALL_THM; SKOLEM_THM] THEN
3634   MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[NOT_IMP; FORALL_AND_THM] THEN
3635   X_GEN_TAC `y:num->real^N` THEN REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN
3636   STRIP_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LE_REFL]] THEN
3637   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FORALL_POS_MONO_1 THEN
3638   CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN
3639   X_GEN_TAC `n:num` THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN
3640   DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN
3641   EXISTS_TAC `&1 / (&m + &1)` THEN ASM_REWRITE_TAC[] THEN
3642   ASM_SIMP_TAC[REAL_LE_INV2; real_div; REAL_ARITH `&0 <= x ==> &0 < x + &1`;
3643                REAL_POS; REAL_MUL_LID; REAL_LE_RADD; REAL_OF_NUM_LE]);;
3644
3645 let CONTINUOUS_AT_SEQUENTIALLY = prove
3646  (`!f a:real^N.
3647         f continuous (at a) <=>
3648               !x. (x --> a) sequentially
3649                   ==> ((f o x) --> f(a)) sequentially`,
3650   ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
3651   REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY; IN_UNIV]);;
3652
3653 let CONTINUOUS_ON_SEQUENTIALLY = prove
3654  (`!f s:real^N->bool.
3655         f continuous_on s <=>
3656               !x a. a IN s /\ (!n. x(n) IN s) /\ (x --> a) sequentially
3657                     ==> ((f o x) --> f(a)) sequentially`,
3658   REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN;
3659               CONTINUOUS_WITHIN_SEQUENTIALLY] THEN MESON_TAC[]);;
3660
3661 let UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY = prove
3662  (`!f s:real^N->bool.
3663         f uniformly_continuous_on s <=>
3664               !x y. (!n. x(n) IN s) /\ (!n. y(n) IN s) /\
3665                     ((\n. x(n) - y(n)) --> vec 0) sequentially
3666                     ==> ((\n. f(x(n)) - f(y(n))) --> vec 0) sequentially`,
3667   REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on] THEN
3668   REWRITE_TAC[LIM_SEQUENTIALLY; dist; VECTOR_SUB_RZERO] THEN
3669   EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
3670   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
3671   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN
3672   DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
3673   DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `&1 / (&n + &1)`) THEN
3674   SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; REAL_OF_NUM_LE; REAL_POS; ARITH;
3675        REAL_ARITH `&0 <= n ==> &0 < n + &1`; NOT_FORALL_THM; SKOLEM_THM] THEN
3676   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:num->real^N` THEN
3677   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:num->real^N` THEN
3678   REWRITE_TAC[NOT_IMP; FORALL_AND_THM] THEN STRIP_TAC THEN
3679   ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN CONJ_TAC THENL
3680    [MATCH_MP_TAC FORALL_POS_MONO_1 THEN
3681     CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN
3682     X_GEN_TAC `n:num` THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN
3683     DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN
3684     EXISTS_TAC `&1 / (&m + &1)` THEN ASM_REWRITE_TAC[] THEN
3685     ASM_SIMP_TAC[REAL_LE_INV2; real_div; REAL_ARITH `&0 <= x ==> &0 < x + &1`;
3686                  REAL_POS; REAL_MUL_LID; REAL_LE_RADD; REAL_OF_NUM_LE];
3687     EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN
3688     EXISTS_TAC `\x:num. x` THEN ASM_REWRITE_TAC[LE_REFL]]);;
3689
3690 let LIM_CONTINUOUS_FUNCTION = prove
3691  (`!f net g l.
3692         f continuous (at l) /\ (g --> l) net ==> ((\x. f(g x)) --> f l) net`,
3693   REWRITE_TAC[tendsto; continuous_at; eventually] THEN MESON_TAC[]);;
3694
3695 (* ------------------------------------------------------------------------- *)
3696 (* Combination results for pointwise continuity.                             *)
3697 (* ------------------------------------------------------------------------- *)
3698
3699 let CONTINUOUS_CONST = prove
3700  (`!net c. (\x. c) continuous net`,
3701   REWRITE_TAC[continuous; LIM_CONST]);;
3702
3703 let CONTINUOUS_CMUL = prove
3704  (`!f c net. f continuous net ==> (\x. c % f(x)) continuous net`,
3705   REWRITE_TAC[continuous; LIM_CMUL]);;
3706
3707 let CONTINUOUS_NEG = prove
3708  (`!f net. f continuous net ==> (\x. --(f x)) continuous net`,
3709   REWRITE_TAC[continuous; LIM_NEG]);;
3710
3711 let CONTINUOUS_ADD = prove
3712  (`!f g net. f continuous net /\ g continuous net
3713            ==> (\x. f(x) + g(x)) continuous net`,
3714   REWRITE_TAC[continuous; LIM_ADD]);;
3715
3716 let CONTINUOUS_SUB = prove
3717  (`!f g net. f continuous net /\ g continuous net
3718            ==> (\x. f(x) - g(x)) continuous net`,
3719   REWRITE_TAC[continuous; LIM_SUB]);;
3720
3721 let CONTINUOUS_ABS = prove
3722  (`!(f:A->real^N) net.
3723         f continuous net
3724         ==> (\x. (lambda i. abs(f(x)$i)):real^N) continuous net`,
3725   REWRITE_TAC[continuous; LIM_ABS]);;
3726
3727 let CONTINUOUS_MAX = prove
3728  (`!(f:A->real^N) (g:A->real^N) net.
3729         f continuous net /\ g continuous net
3730         ==> (\x. (lambda i. max (f(x)$i) (g(x)$i)):real^N) continuous net`,
3731   REWRITE_TAC[continuous; LIM_MAX]);;
3732
3733 let CONTINUOUS_MIN = prove
3734  (`!(f:A->real^N) (g:A->real^N) net.
3735         f continuous net /\ g continuous net
3736         ==> (\x. (lambda i. min (f(x)$i) (g(x)$i)):real^N) continuous net`,
3737   REWRITE_TAC[continuous; LIM_MIN]);;
3738
3739 let CONTINUOUS_VSUM = prove
3740  (`!net f s. FINITE s /\ (!a. a IN s ==> (f a) continuous net)
3741              ==> (\x. vsum s (\a. f a x)) continuous net`,
3742   GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
3743   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
3744   SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; VSUM_CLAUSES;
3745            CONTINUOUS_CONST; CONTINUOUS_ADD; ETA_AX]);;
3746
3747 (* ------------------------------------------------------------------------- *)
3748 (* Same thing for setwise continuity.                                        *)
3749 (* ------------------------------------------------------------------------- *)
3750
3751 let CONTINUOUS_ON_CONST = prove
3752  (`!s c. (\x. c) continuous_on s`,
3753   SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_CONST]);;
3754
3755 let CONTINUOUS_ON_CMUL = prove
3756  (`!f c s. f continuous_on s ==> (\x. c % f(x)) continuous_on s`,
3757   SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_CMUL]);;
3758
3759 let CONTINUOUS_ON_NEG = prove
3760  (`!f s. f continuous_on s
3761          ==> (\x. --(f x)) continuous_on s`,
3762   SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_NEG]);;
3763
3764 let CONTINUOUS_ON_ADD = prove
3765  (`!f g s. f continuous_on s /\ g continuous_on s
3766            ==> (\x. f(x) + g(x)) continuous_on s`,
3767   SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_ADD]);;
3768
3769 let CONTINUOUS_ON_SUB = prove
3770  (`!f g s. f continuous_on s /\ g continuous_on s
3771            ==> (\x. f(x) - g(x)) continuous_on s`,
3772   SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_SUB]);;
3773
3774 let CONTINUOUS_ON_ABS = prove
3775  (`!f:real^M->real^N s.
3776         f continuous_on s
3777         ==> (\x. (lambda i. abs(f(x)$i)):real^N) continuous_on s`,
3778   SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_ABS]);;
3779
3780 let CONTINUOUS_ON_MAX = prove
3781  (`!f:real^M->real^N g:real^M->real^N s.
3782         f continuous_on s /\ g continuous_on s
3783         ==> (\x. (lambda i. max (f(x)$i) (g(x)$i)):real^N)
3784             continuous_on s`,
3785   SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_MAX]);;
3786
3787 let CONTINUOUS_ON_MIN = prove
3788  (`!f:real^M->real^N g:real^M->real^N s.
3789         f continuous_on s /\ g continuous_on s
3790         ==> (\x. (lambda i. min (f(x)$i) (g(x)$i)):real^N)
3791             continuous_on s`,
3792   SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_MIN]);;
3793
3794 let CONTINUOUS_ON_VSUM = prove
3795  (`!t f s. FINITE s /\ (!a. a IN s ==> (f a) continuous_on t)
3796              ==> (\x. vsum s (\a. f a x)) continuous_on t`,
3797   SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_VSUM]);;
3798
3799 (* ------------------------------------------------------------------------- *)
3800 (* Same thing for uniform continuity, using sequential formulations.         *)
3801 (* ------------------------------------------------------------------------- *)
3802
3803 let UNIFORMLY_CONTINUOUS_ON_CONST = prove
3804  (`!s c. (\x. c) uniformly_continuous_on s`,
3805   REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY; o_DEF;
3806               VECTOR_SUB_REFL; LIM_CONST]);;
3807
3808 let LINEAR_UNIFORMLY_CONTINUOUS_ON = prove
3809  (`!f:real^M->real^N s. linear f ==> f uniformly_continuous_on s`,
3810   REPEAT STRIP_TAC THEN
3811   ASM_SIMP_TAC[uniformly_continuous_on; dist; GSYM LINEAR_SUB] THEN
3812   FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o
3813         MATCH_MP LINEAR_BOUNDED_POS) THEN
3814   X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e / B:real` THEN
3815   ASM_SIMP_TAC[REAL_LT_DIV] THEN
3816   MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN
3817   MATCH_MP_TAC REAL_LET_TRANS THEN
3818   EXISTS_TAC `B * norm(y - x:real^M)` THEN ASM_REWRITE_TAC[] THEN
3819   ASM_MESON_TAC[REAL_LT_RDIV_EQ; REAL_MUL_SYM]);;
3820
3821 let UNIFORMLY_CONTINUOUS_ON_COMPOSE = prove
3822  (`!f g s. f uniformly_continuous_on s /\
3823            g uniformly_continuous_on (IMAGE f s)
3824            ==> (g o f) uniformly_continuous_on s`,
3825   let lemma = prove
3826    (`(!y. ((?x. (y = f x) /\ P x) /\ Q y ==> R y)) <=>
3827      (!x. P x /\ Q (f x) ==> R (f x))`,
3828     MESON_TAC[]) in
3829   REPEAT GEN_TAC THEN
3830   REWRITE_TAC[uniformly_continuous_on; o_THM; IN_IMAGE] THEN
3831   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[lemma] THEN
3832   ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN
3833   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[lemma] THEN
3834   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3835   MATCH_MP_TAC MONO_FORALL THEN
3836   X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
3837   ASM_MESON_TAC[]);;
3838
3839 let BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE = prove
3840  (`!f:real^M->real^N g (h:real^N->real^P->real^Q) s.
3841            f uniformly_continuous_on s /\ g uniformly_continuous_on s /\
3842            bilinear h /\ bounded(IMAGE f s) /\ bounded(IMAGE g s)
3843            ==> (\x. h (f x) (g x)) uniformly_continuous_on s`,
3844   REPEAT STRIP_TAC THEN REWRITE_TAC[uniformly_continuous_on; dist] THEN
3845   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
3846   SUBGOAL_THEN
3847    `!a b c d. (h:real^N->real^P->real^Q) a b - h c d =
3848               h (a - c) b + h c (b - d)`
3849    (fun th -> ONCE_REWRITE_TAC[th])
3850   THENL
3851    [FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP BILINEAR_LSUB th]) THEN
3852     FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP BILINEAR_RSUB th]) THEN
3853     VECTOR_ARITH_TAC;
3854     ALL_TAC] THEN
3855   FIRST_X_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o
3856     MATCH_MP BILINEAR_BOUNDED_POS) THEN
3857   UNDISCH_TAC `bounded(IMAGE (g:real^M->real^P) s)` THEN
3858   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
3859   REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN
3860   DISCH_THEN(X_CHOOSE_THEN `B1:real` STRIP_ASSUME_TAC) THEN
3861   DISCH_THEN(X_CHOOSE_THEN `B2:real` STRIP_ASSUME_TAC) THEN
3862   UNDISCH_TAC `(g:real^M->real^P) uniformly_continuous_on s` THEN
3863   UNDISCH_TAC `(f:real^M->real^N) uniformly_continuous_on s` THEN
3864   REWRITE_TAC[uniformly_continuous_on] THEN
3865   DISCH_THEN(MP_TAC o SPEC `e / &2 / &2 / B / B2`) THEN
3866   ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; dist] THEN
3867   DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN
3868   DISCH_THEN(MP_TAC o SPEC `e / &2 / &2 / B / B1`) THEN
3869   ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; dist] THEN
3870   DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN
3871   EXISTS_TAC `min d1 d2` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
3872   MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN
3873   REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `y:real^M`])) THEN
3874   ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
3875   MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC
3876    `B * e / &2 / &2 / B / B2 * B2 + B * B1 * e / &2 / &2 / B / B1` THEN
3877   CONJ_TAC THENL
3878    [MATCH_MP_TAC(NORM_ARITH
3879      `norm(x) <= a /\ norm(y) <= b ==> norm(x + y:real^N) <= a + b`) THEN
3880     CONJ_TAC THEN
3881     FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH lhand th o lhand o snd)) THEN
3882     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
3883     MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN
3884     MATCH_MP_TAC REAL_LE_MUL2 THEN
3885     ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE];
3886     ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN
3887     ASM_REAL_ARITH_TAC]);;
3888
3889 let UNIFORMLY_CONTINUOUS_ON_MUL = prove
3890  (`!f g:real^M->real^N s.
3891         (lift o f) uniformly_continuous_on s /\ g uniformly_continuous_on s /\
3892         bounded(IMAGE (lift o f) s) /\ bounded(IMAGE g s)
3893         ==>  (\x. f x % g x) uniformly_continuous_on s`,
3894   REPEAT STRIP_TAC THEN
3895   MP_TAC(ISPECL
3896    [`lift o (f:real^M->real)`; `g:real^M->real^N`;
3897     `\c (v:real^N). drop c % v`; `s:real^M->bool`]
3898         BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE) THEN
3899   ASM_REWRITE_TAC[o_THM; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN
3900   REWRITE_TAC[bilinear; linear; DROP_ADD; DROP_CMUL] THEN VECTOR_ARITH_TAC);;
3901
3902 let UNIFORMLY_CONTINUOUS_ON_CMUL = prove
3903  (`!f c s. f uniformly_continuous_on s
3904            ==> (\x. c % f(x)) uniformly_continuous_on s`,
3905   REPEAT GEN_TAC THEN REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY] THEN
3906   REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
3907   DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
3908   ASM_REWRITE_TAC[] THEN
3909   DISCH_THEN(MP_TAC o MATCH_MP LIM_CMUL) THEN
3910   ASM_SIMP_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_RZERO]);;
3911
3912 let UNIFORMLY_CONTINUOUS_ON_VMUL = prove
3913  (`!s:real^M->bool c v:real^N.
3914       (lift o c) uniformly_continuous_on s
3915       ==> (\x. c x % v) uniformly_continuous_on s`,
3916   REPEAT GEN_TAC THEN
3917   DISCH_THEN(MP_TAC o ISPEC `\x. (drop x % v:real^N)` o MATCH_MP
3918    (REWRITE_RULE[IMP_CONJ] UNIFORMLY_CONTINUOUS_ON_COMPOSE)) THEN
3919   REWRITE_TAC[o_DEF; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN
3920   MATCH_MP_TAC LINEAR_UNIFORMLY_CONTINUOUS_ON THEN
3921   MATCH_MP_TAC LINEAR_VMUL_DROP THEN REWRITE_TAC[LINEAR_ID]);;
3922
3923 let UNIFORMLY_CONTINUOUS_ON_NEG = prove
3924  (`!f s. f uniformly_continuous_on s
3925          ==> (\x. --(f x)) uniformly_continuous_on s`,
3926   ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN
3927   REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_CMUL]);;
3928
3929 let UNIFORMLY_CONTINUOUS_ON_ADD = prove
3930  (`!f g s. f uniformly_continuous_on s /\ g uniformly_continuous_on s
3931            ==> (\x. f(x) + g(x)) uniformly_continuous_on s`,
3932   REPEAT GEN_TAC THEN REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY] THEN
3933   REWRITE_TAC[AND_FORALL_THM] THEN
3934   REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
3935   DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
3936   ASM_REWRITE_TAC[o_DEF] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN
3937   MATCH_MP_TAC EQ_IMP THEN
3938   REWRITE_TAC[VECTOR_ADD_LID] THEN AP_THM_TAC THEN BINOP_TAC THEN
3939   REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC);;
3940
3941 let UNIFORMLY_CONTINUOUS_ON_SUB = prove
3942  (`!f g s. f uniformly_continuous_on s /\ g uniformly_continuous_on s
3943            ==> (\x. f(x) - g(x)) uniformly_continuous_on s`,
3944   REWRITE_TAC[VECTOR_SUB] THEN
3945   SIMP_TAC[UNIFORMLY_CONTINUOUS_ON_NEG; UNIFORMLY_CONTINUOUS_ON_ADD]);;
3946
3947 let UNIFORMLY_CONTINUOUS_ON_VSUM = prove
3948  (`!t f s. FINITE s /\ (!a. a IN s ==> (f a) uniformly_continuous_on t)
3949              ==> (\x. vsum s (\a. f a x)) uniformly_continuous_on t`,
3950   GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
3951   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
3952   SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; VSUM_CLAUSES;
3953        UNIFORMLY_CONTINUOUS_ON_CONST; UNIFORMLY_CONTINUOUS_ON_ADD; ETA_AX]);;
3954
3955 (* ------------------------------------------------------------------------- *)
3956 (* Identity function is continuous in every sense.                           *)
3957 (* ------------------------------------------------------------------------- *)
3958
3959 let CONTINUOUS_WITHIN_ID = prove
3960  (`!a s. (\x. x) continuous (at a within s)`,
3961   REWRITE_TAC[continuous_within] THEN MESON_TAC[]);;
3962
3963 let CONTINUOUS_AT_ID = prove
3964  (`!a. (\x. x) continuous (at a)`,
3965   REWRITE_TAC[continuous_at] THEN MESON_TAC[]);;
3966
3967 let CONTINUOUS_ON_ID = prove
3968  (`!s. (\x. x) continuous_on s`,
3969   REWRITE_TAC[continuous_on] THEN MESON_TAC[]);;
3970
3971 let UNIFORMLY_CONTINUOUS_ON_ID = prove
3972  (`!s. (\x. x) uniformly_continuous_on s`,
3973   REWRITE_TAC[uniformly_continuous_on] THEN MESON_TAC[]);;
3974
3975 (* ------------------------------------------------------------------------- *)
3976 (* Continuity of all kinds is preserved under composition.                   *)
3977 (* ------------------------------------------------------------------------- *)
3978
3979 let CONTINUOUS_WITHIN_COMPOSE = prove
3980  (`!f g x s. f continuous (at x within s) /\
3981              g continuous (at (f x) within IMAGE f s)
3982              ==> (g o f) continuous (at x within s)`,
3983   REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within; o_THM; IN_IMAGE] THEN
3984   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3985   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
3986   ASM_MESON_TAC[]);;
3987
3988 let CONTINUOUS_AT_COMPOSE = prove
3989  (`!f g x. f continuous (at x) /\ g continuous (at (f x))
3990            ==> (g o f) continuous (at x)`,
3991   ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
3992   MESON_TAC[CONTINUOUS_WITHIN_COMPOSE; IN_IMAGE; CONTINUOUS_WITHIN_SUBSET;
3993             SUBSET_UNIV; IN_UNIV]);;
3994
3995 let CONTINUOUS_ON_COMPOSE = prove
3996  (`!f g s. f continuous_on s /\ g continuous_on (IMAGE f s)
3997            ==> (g o f) continuous_on s`,
3998   REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
3999   MESON_TAC[IN_IMAGE; CONTINUOUS_WITHIN_COMPOSE]);;
4000
4001 (* ------------------------------------------------------------------------- *)
4002 (* Continuity in terms of open preimages.                                    *)
4003 (* ------------------------------------------------------------------------- *)
4004
4005 let CONTINUOUS_WITHIN_OPEN = prove
4006  (`!f:real^M->real^N x u.
4007      f continuous (at x within u) <=>
4008         !t. open t /\ f(x) IN t
4009             ==> ?s. open s /\ x IN s /\
4010                     !x'. x' IN s /\ x' IN u ==> f(x') IN t`,
4011   REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within] THEN EQ_TAC THENL
4012    [DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN
4013     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
4014     GEN_REWRITE_TAC LAND_CONV [open_def] THEN
4015     DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN
4016     ASM_MESON_TAC[IN_BALL; DIST_SYM; OPEN_BALL; CENTRE_IN_BALL; DIST_SYM];
4017     DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
4018     FIRST_X_ASSUM(MP_TAC o SPEC `ball((f:real^M->real^N) x,e)`) THEN
4019     ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN
4020     MESON_TAC[open_def; IN_BALL; REAL_LT_TRANS; DIST_SYM]]);;
4021
4022 let CONTINUOUS_AT_OPEN = prove
4023  (`!f:real^M->real^N x.
4024      f continuous (at x) <=>
4025         !t. open t /\ f(x) IN t
4026             ==> ?s. open s /\ x IN s /\
4027                     !x'. x' IN s ==> f(x') IN t`,
4028   REPEAT GEN_TAC THEN REWRITE_TAC[continuous_at] THEN EQ_TAC THENL
4029    [DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN
4030     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
4031     GEN_REWRITE_TAC LAND_CONV [open_def] THEN
4032     DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN
4033     ASM_MESON_TAC[IN_BALL; DIST_SYM; OPEN_BALL; CENTRE_IN_BALL];
4034     DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
4035     FIRST_X_ASSUM(MP_TAC o SPEC `ball((f:real^M->real^N) x,e)`) THEN
4036     ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN
4037     MESON_TAC[open_def; IN_BALL; REAL_LT_TRANS; DIST_SYM]]);;
4038
4039 let CONTINUOUS_ON_OPEN_GEN = prove
4040  (`!f:real^M->real^N s t.
4041     IMAGE f s SUBSET t
4042     ==> (f continuous_on s <=>
4043          !u. open_in (subtopology euclidean t) u
4044              ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN u})`,
4045   REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_on] THEN EQ_TAC THENL
4046    [REWRITE_TAC[open_in; SUBSET; IN_ELIM_THM] THEN
4047     DISCH_TAC THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN
4048     CONJ_TAC THENL [ASM_MESON_TAC[DIST_REFL]; ALL_TAC] THEN
4049     X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
4050     FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN ASM SET_TAC[];
4051     DISCH_TAC THEN X_GEN_TAC `x:real^M` THEN
4052     DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
4053     FIRST_X_ASSUM(MP_TAC o
4054       SPEC `ball((f:real^M->real^N) x,e) INTER t`) THEN
4055     ANTS_TAC THENL
4056      [ASM_MESON_TAC[OPEN_IN_OPEN; INTER_COMM; OPEN_BALL]; ALL_TAC] THEN
4057     REWRITE_TAC[open_in; SUBSET; IN_INTER; IN_ELIM_THM; IN_BALL; IN_IMAGE] THEN
4058     REWRITE_TAC[AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
4059     RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN
4060     ASM_MESON_TAC[DIST_REFL; DIST_SYM]]);;
4061
4062 let CONTINUOUS_ON_OPEN = prove
4063  (`!f:real^M->real^N s.
4064       f continuous_on s <=>
4065         !t. open_in (subtopology euclidean (IMAGE f s)) t
4066             ==> open_in (subtopology euclidean s) {x | x IN s /\ f(x) IN t}`,
4067   REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_OPEN_GEN THEN
4068   REWRITE_TAC[SUBSET_REFL]);;
4069
4070 let CONTINUOUS_OPEN_IN_PREIMAGE_GEN = prove
4071  (`!f:real^M->real^N s t u.
4072         f continuous_on s /\ IMAGE f s SUBSET t /\
4073         open_in (subtopology euclidean t) u
4074         ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN u}`,
4075   MESON_TAC[CONTINUOUS_ON_OPEN_GEN]);;
4076
4077 let CONTINUOUS_ON_IMP_OPEN_IN = prove
4078  (`!f:real^M->real^N s t.
4079         f continuous_on s /\
4080         open_in (subtopology euclidean (IMAGE f s)) t
4081         ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`,
4082   MESON_TAC[CONTINUOUS_ON_OPEN]);;
4083
4084 (* ------------------------------------------------------------------------- *)
4085 (* Similarly in terms of closed sets.                                        *)
4086 (* ------------------------------------------------------------------------- *)
4087
4088 let CONTINUOUS_ON_CLOSED_GEN = prove
4089  (`!f:real^M->real^N s t.
4090     IMAGE f s SUBSET t
4091     ==> (f continuous_on s <=>
4092          !u. closed_in (subtopology euclidean t) u
4093              ==> closed_in (subtopology euclidean s)
4094                            {x | x IN s /\ f x IN u})`,
4095   REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th ->
4096     ONCE_REWRITE_TAC[MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) THEN
4097   EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `u:real^N->bool` THEN
4098   FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THENL
4099    [REWRITE_TAC[closed_in]; REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ]] THEN
4100   REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
4101   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
4102   ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN
4103   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);;
4104
4105 let CONTINUOUS_ON_CLOSED = prove
4106  (`!f:real^M->real^N s.
4107       f continuous_on s <=>
4108         !t. closed_in (subtopology euclidean (IMAGE f s)) t
4109             ==> closed_in (subtopology euclidean s) {x | x IN s /\ f(x) IN t}`,
4110   REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_CLOSED_GEN THEN
4111   REWRITE_TAC[SUBSET_REFL]);;
4112
4113 let CONTINUOUS_CLOSED_IN_PREIMAGE_GEN = prove
4114  (`!f:real^M->real^N s t u.
4115         f continuous_on s /\ IMAGE f s SUBSET t /\
4116         closed_in (subtopology euclidean t) u
4117         ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN u}`,
4118   MESON_TAC[CONTINUOUS_ON_CLOSED_GEN]);;
4119
4120 let CONTINUOUS_ON_IMP_CLOSED_IN = prove
4121  (`!f:real^M->real^N s t.
4122         f continuous_on s /\
4123         closed_in (subtopology euclidean (IMAGE f s)) t
4124         ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`,
4125   MESON_TAC[CONTINUOUS_ON_CLOSED]);;
4126
4127 (* ------------------------------------------------------------------------- *)
4128 (* Half-global and completely global cases.                                  *)
4129 (* ------------------------------------------------------------------------- *)
4130
4131 let CONTINUOUS_OPEN_IN_PREIMAGE = prove
4132  (`!f s t.
4133          f continuous_on s /\ open t
4134          ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`,
4135   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE
4136    `x IN s /\ f x IN t <=> x IN s /\ f x IN (t INTER IMAGE f s)`] THEN
4137   FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CONTINUOUS_ON_OPEN]) THEN
4138   ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN
4139   ASM_REWRITE_TAC[]);;
4140
4141 let CONTINUOUS_CLOSED_IN_PREIMAGE = prove
4142  (`!f s t.
4143          f continuous_on s /\ closed t
4144          ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`,
4145   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE
4146    `x IN s /\ f x IN t <=> x IN s /\ f x IN (t INTER IMAGE f s)`] THEN
4147   FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CONTINUOUS_ON_CLOSED]) THEN
4148   ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC CLOSED_IN_CLOSED_INTER THEN
4149   ASM_REWRITE_TAC[]);;
4150
4151 let CONTINUOUS_OPEN_PREIMAGE = prove
4152  (`!f:real^M->real^N s t.
4153      f continuous_on s /\ open s /\ open t
4154      ==> open {x | x IN s /\ f(x) IN t}`,
4155   REPEAT STRIP_TAC THEN
4156   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN
4157   REWRITE_TAC [OPEN_IN_OPEN] THEN
4158   DISCH_THEN(MP_TAC o SPEC `IMAGE (f:real^M->real^N) s INTER t`) THEN
4159   ANTS_TAC THENL
4160    [EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC [];
4161     STRIP_TAC THEN
4162     SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN t} =
4163                  s INTER t'` SUBST1_TAC THENL
4164     [ASM SET_TAC []; ASM_MESON_TAC [OPEN_INTER]]]);;
4165
4166 let CONTINUOUS_CLOSED_PREIMAGE = prove
4167  (`!f:real^M->real^N s t.
4168      f continuous_on s /\ closed s /\ closed t
4169      ==> closed {x | x IN s /\ f(x) IN t}`,
4170   REPEAT STRIP_TAC THEN
4171   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_CLOSED]) THEN
4172   REWRITE_TAC [CLOSED_IN_CLOSED] THEN
4173   DISCH_THEN(MP_TAC o SPEC `IMAGE (f:real^M->real^N) s INTER t`) THEN
4174   ANTS_TAC THENL
4175    [EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC [];
4176     STRIP_TAC THEN
4177     SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN t} =
4178                  s INTER t'` SUBST1_TAC THENL
4179     [ASM SET_TAC []; ASM_MESON_TAC [CLOSED_INTER]]]);;
4180
4181 let CONTINUOUS_OPEN_PREIMAGE_UNIV = prove
4182  (`!f:real^M->real^N s.
4183         (!x. f continuous (at x)) /\ open s ==> open {x | f(x) IN s}`,
4184   REPEAT STRIP_TAC THEN
4185   MP_TAC(SPECL [`f:real^M->real^N`; `(:real^M)`; `s:real^N->bool`]
4186     CONTINUOUS_OPEN_PREIMAGE) THEN
4187   ASM_SIMP_TAC[OPEN_UNIV; IN_UNIV; CONTINUOUS_AT_IMP_CONTINUOUS_ON]);;
4188
4189 let CONTINUOUS_CLOSED_PREIMAGE_UNIV = prove
4190  (`!f:real^M->real^N s.
4191         (!x. f continuous (at x)) /\ closed s ==> closed {x | f(x) IN s}`,
4192   REPEAT STRIP_TAC THEN
4193   MP_TAC(SPECL [`f:real^M->real^N`; `(:real^M)`; `s:real^N->bool`]
4194     CONTINUOUS_CLOSED_PREIMAGE) THEN
4195   ASM_SIMP_TAC[CLOSED_UNIV; IN_UNIV; CONTINUOUS_AT_IMP_CONTINUOUS_ON]);;
4196
4197 let CONTINUOUS_OPEN_IN_PREIMAGE_EQ = prove
4198  (`!f:real^M->real^N s.
4199     f continuous_on s <=>
4200     !t. open t ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`,
4201   REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CONTINUOUS_OPEN_IN_PREIMAGE] THEN
4202   REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN DISCH_TAC THEN
4203   X_GEN_TAC `t:real^N->bool` THEN GEN_REWRITE_TAC LAND_CONV [OPEN_IN_OPEN] THEN
4204   DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
4205   FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN
4206   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);;
4207
4208 let CONTINUOUS_CLOSED_IN_PREIMAGE_EQ = prove
4209  (`!f:real^M->real^N s.
4210     f continuous_on s <=>
4211     !t. closed t
4212         ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`,
4213   REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE] THEN
4214   REWRITE_TAC[CONTINUOUS_ON_CLOSED] THEN DISCH_TAC THEN
4215   X_GEN_TAC `t:real^N->bool` THEN
4216   GEN_REWRITE_TAC LAND_CONV [CLOSED_IN_CLOSED] THEN
4217   DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
4218   FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN
4219   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);;
4220
4221 (* ------------------------------------------------------------------------- *)
4222 (* Linear functions are (uniformly) continuous on any set.                   *)
4223 (* ------------------------------------------------------------------------- *)
4224
4225 let LINEAR_LIM_0 = prove
4226  (`!f. linear f ==> (f --> vec 0) (at (vec 0))`,
4227   REPEAT STRIP_TAC THEN REWRITE_TAC[LIM_AT] THEN
4228   FIRST_X_ASSUM(MP_TAC o MATCH_MP LINEAR_BOUNDED_POS) THEN
4229   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
4230   X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e / B` THEN
4231   ASM_SIMP_TAC[REAL_LT_DIV] THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO] THEN
4232   ASM_MESON_TAC[REAL_MUL_SYM; REAL_LET_TRANS; REAL_LT_RDIV_EQ]);;
4233
4234 let LINEAR_CONTINUOUS_AT = prove
4235  (`!f:real^M->real^N a. linear f ==> f continuous (at a)`,
4236   REPEAT STRIP_TAC THEN
4237   MP_TAC(ISPEC `\x. (f:real^M->real^N) (a + x) - f(a)` LINEAR_LIM_0) THEN
4238   ANTS_TAC THENL
4239    [POP_ASSUM MP_TAC THEN SIMP_TAC[linear] THEN
4240     REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC;
4241     ALL_TAC] THEN
4242   REWRITE_TAC[GSYM LIM_NULL; CONTINUOUS_AT] THEN
4243   GEN_REWRITE_TAC RAND_CONV [LIM_AT_ZERO] THEN SIMP_TAC[]);;
4244
4245 let LINEAR_CONTINUOUS_WITHIN = prove
4246  (`!f:real^M->real^N s x. linear f ==> f continuous (at x within s)`,
4247   SIMP_TAC[CONTINUOUS_AT_WITHIN; LINEAR_CONTINUOUS_AT]);;
4248
4249 let LINEAR_CONTINUOUS_ON = prove
4250  (`!f:real^M->real^N s. linear f ==> f continuous_on s`,
4251   MESON_TAC[LINEAR_CONTINUOUS_AT; CONTINUOUS_AT_IMP_CONTINUOUS_ON]);;
4252
4253 let LINEAR_CONTINUOUS_COMPOSE = prove
4254  (`!net f:A->real^N g:real^N->real^P.
4255         f continuous net /\ linear g ==> (\x. g(f x)) continuous net`,
4256   REWRITE_TAC[continuous; LIM_LINEAR]);;
4257
4258 let LINEAR_CONTINUOUS_ON_COMPOSE = prove
4259  (`!f:real^M->real^N g:real^N->real^P s.
4260         f continuous_on s /\ linear g ==> (\x. g(f x)) continuous_on s`,
4261   SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN;
4262            LINEAR_CONTINUOUS_COMPOSE]);;
4263
4264 let CONTINUOUS_LIFT_COMPONENT_COMPOSE = prove
4265  (`!net f:A->real^N i. f continuous net ==> (\x. lift(f x$i)) continuous net`,
4266   REPEAT GEN_TAC THEN
4267   SUBGOAL_THEN `linear(\x:real^N. lift (x$i))` MP_TAC THENL
4268    [REWRITE_TAC[LINEAR_LIFT_COMPONENT]; REWRITE_TAC[GSYM IMP_CONJ_ALT]] THEN
4269   REWRITE_TAC[LINEAR_CONTINUOUS_COMPOSE]);;
4270
4271 let CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE = prove
4272  (`!f:real^M->real^N s.
4273         f continuous_on s
4274         ==> (\x. lift (f x$i)) continuous_on s`,
4275   SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN;
4276            CONTINUOUS_LIFT_COMPONENT_COMPOSE]);;
4277
4278 (* ------------------------------------------------------------------------- *)
4279 (* Also bilinear functions, in composition form.                             *)
4280 (* ------------------------------------------------------------------------- *)
4281
4282 let BILINEAR_CONTINUOUS_COMPOSE = prove
4283  (`!net f:A->real^M g:A->real^N h:real^M->real^N->real^P.
4284         f continuous net /\ g continuous net /\ bilinear h
4285         ==> (\x. h (f x) (g x)) continuous net`,
4286   REWRITE_TAC[continuous; LIM_BILINEAR]);;
4287
4288 let BILINEAR_CONTINUOUS_ON_COMPOSE = prove
4289  (`!f g h s. f continuous_on s /\ g continuous_on s /\ bilinear h
4290              ==> (\x. h (f x) (g x)) continuous_on s`,
4291   SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN;
4292            BILINEAR_CONTINUOUS_COMPOSE]);;
4293
4294 let BILINEAR_DOT = prove
4295  (`bilinear (\x y:real^N. lift(x dot y))`,
4296   REWRITE_TAC[bilinear; linear; DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL] THEN
4297   REWRITE_TAC[LIFT_ADD; LIFT_CMUL]);;
4298
4299 let CONTINUOUS_LIFT_DOT2 = prove
4300  (`!net f g:A->real^N.
4301         f continuous net /\ g continuous net
4302         ==> (\x. lift(f x dot g x)) continuous net`,
4303   REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE
4304    [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`]
4305   BILINEAR_CONTINUOUS_COMPOSE) BILINEAR_DOT)) THEN REWRITE_TAC[]);;
4306
4307 let CONTINUOUS_ON_LIFT_DOT2 = prove
4308  (`!f:real^M->real^N g s.
4309         f continuous_on s /\ g continuous_on s
4310         ==> (\x. lift(f x dot g x)) continuous_on s`,
4311   REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE
4312    [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`]
4313   BILINEAR_CONTINUOUS_ON_COMPOSE) BILINEAR_DOT)) THEN REWRITE_TAC[]);;
4314
4315 (* ------------------------------------------------------------------------- *)
4316 (* Preservation of compactness and connectedness under continuous function.  *)
4317 (* ------------------------------------------------------------------------- *)
4318
4319 let COMPACT_CONTINUOUS_IMAGE = prove
4320  (`!f:real^M->real^N s.
4321         f continuous_on s /\ compact s ==> compact(IMAGE f s)`,
4322   REPEAT GEN_TAC THEN REWRITE_TAC[continuous_on; compact] THEN
4323   STRIP_TAC THEN X_GEN_TAC `y:num->real^N` THEN
4324   REWRITE_TAC[IN_IMAGE; SKOLEM_THM; FORALL_AND_THM] THEN
4325   DISCH_THEN(X_CHOOSE_THEN `x:num->real^M` STRIP_ASSUME_TAC) THEN
4326   FIRST_X_ASSUM(MP_TAC o SPEC `x:num->real^M`) THEN ASM_REWRITE_TAC[] THEN
4327   ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
4328   X_GEN_TAC `r:num->num` THEN
4329   DISCH_THEN(X_CHOOSE_THEN `l:real^M` STRIP_ASSUME_TAC) THEN
4330   EXISTS_TAC `(f:real^M->real^N) l` THEN ASM_REWRITE_TAC[] THEN
4331   CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
4332   REWRITE_TAC[LIM_SEQUENTIALLY] THEN
4333   FIRST_X_ASSUM(MP_TAC o SPEC `l:real^M`) THEN
4334   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
4335   DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
4336   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
4337   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN
4338   DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[o_THM] THEN
4339   ASM_MESON_TAC[]);;
4340
4341 let COMPACT_TRANSLATION = prove
4342  (`!s a:real^N. compact s ==> compact (IMAGE (\x. a + x) s)`,
4343   SIMP_TAC[COMPACT_CONTINUOUS_IMAGE; CONTINUOUS_ON_ADD;
4344            CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);;
4345
4346 let COMPACT_TRANSLATION_EQ = prove
4347  (`!a s. compact (IMAGE (\x:real^N. a + x) s) <=> compact s`,
4348   REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[COMPACT_TRANSLATION] THEN
4349   DISCH_THEN(MP_TAC o ISPEC `--a:real^N` o MATCH_MP COMPACT_TRANSLATION) THEN
4350   REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID;
4351               VECTOR_ARITH `--a + a + x:real^N = x`]);;
4352
4353 add_translation_invariants [COMPACT_TRANSLATION_EQ];;
4354
4355 let COMPACT_LINEAR_IMAGE = prove
4356  (`!f:real^M->real^N s. compact s /\ linear f ==> compact(IMAGE f s)`,
4357   SIMP_TAC[LINEAR_CONTINUOUS_ON; COMPACT_CONTINUOUS_IMAGE]);;
4358
4359 let COMPACT_LINEAR_IMAGE_EQ = prove
4360  (`!f s. linear f /\ (!x y. f x = f y ==> x = y)
4361          ==> (compact (IMAGE f s) <=> compact s)`,
4362   MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE COMPACT_LINEAR_IMAGE));;
4363
4364 add_linear_invariants [COMPACT_LINEAR_IMAGE_EQ];;
4365
4366 let CONNECTED_CONTINUOUS_IMAGE = prove
4367  (`!f:real^M->real^N s.
4368         f continuous_on s /\ connected s ==> connected(IMAGE f s)`,
4369   REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN
4370   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
4371   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
4372   REWRITE_TAC[CONNECTED_CLOPEN; NOT_FORALL_THM; NOT_IMP; DE_MORGAN_THM] THEN
4373   REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
4374   DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
4375   FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `t:real^N->bool` th) THEN
4376     MP_TAC(SPEC `IMAGE (f:real^M->real^N) s DIFF t` th)) THEN
4377   ASM_REWRITE_TAC[] THEN
4378   SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN IMAGE f s DIFF t} =
4379                 s DIFF {x | x IN s /\ f x IN t}`
4380   SUBST1_TAC THENL
4381    [UNDISCH_TAC `t SUBSET IMAGE (f:real^M->real^N) s` THEN
4382     REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DIFF; IN_ELIM_THM; SUBSET] THEN
4383     MESON_TAC[];
4384     REPEAT STRIP_TAC THEN
4385     EXISTS_TAC `{x | x IN s /\ (f:real^M->real^N) x IN t}` THEN
4386     ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN
4387     REWRITE_TAC[IN_IMAGE; SUBSET; IN_ELIM_THM; NOT_IN_EMPTY; EXTENSION] THEN
4388     MESON_TAC[]]);;
4389
4390 let CONNECTED_TRANSLATION = prove
4391  (`!a s. connected s ==> connected (IMAGE (\x:real^N. a + x) s)`,
4392   REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
4393   ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]);;
4394
4395 let CONNECTED_TRANSLATION_EQ = prove
4396  (`!a s. connected (IMAGE (\x:real^N. a + x) s) <=> connected s`,
4397   REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[CONNECTED_TRANSLATION] THEN
4398   DISCH_THEN(MP_TAC o ISPEC `--a:real^N` o MATCH_MP CONNECTED_TRANSLATION) THEN
4399   REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID;
4400               VECTOR_ARITH `--a + a + x:real^N = x`]);;
4401
4402 add_translation_invariants [CONNECTED_TRANSLATION_EQ];;
4403
4404 let CONNECTED_LINEAR_IMAGE = prove
4405  (`!f:real^M->real^N s. connected s /\ linear f ==> connected(IMAGE f s)`,
4406   SIMP_TAC[LINEAR_CONTINUOUS_ON; CONNECTED_CONTINUOUS_IMAGE]);;
4407
4408 let CONNECTED_LINEAR_IMAGE_EQ = prove
4409  (`!f s. linear f /\ (!x y. f x = f y ==> x = y)
4410          ==> (connected (IMAGE f s) <=> connected s)`,
4411   MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE CONNECTED_LINEAR_IMAGE));;
4412
4413 add_linear_invariants [CONNECTED_LINEAR_IMAGE_EQ];;
4414
4415 (* ------------------------------------------------------------------------- *)
4416 (* Preservation properties for pasted sets (Cartesian products).             *)
4417 (* ------------------------------------------------------------------------- *)
4418
4419 let BOUNDED_PCROSS_EQ = prove
4420  (`!s:real^M->bool t:real^N->bool.
4421         bounded (s PCROSS t) <=>
4422         s = {} \/ t = {} \/ bounded s /\ bounded t`,
4423   REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN
4424   ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
4425   ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
4426   REWRITE_TAC[SET_RULE `{f x y |x,y| F} = {}`; BOUNDED_EMPTY] THEN
4427   RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN
4428   REWRITE_TAC[bounded; FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN
4429   ASM_MESON_TAC[NORM_LE_PASTECART; REAL_LE_TRANS; NORM_PASTECART_LE;
4430                 REAL_LE_ADD2]);;
4431
4432 let BOUNDED_PCROSS = prove
4433  (`!s:real^M->bool t:real^N->bool.
4434      bounded s /\ bounded t ==> bounded (s PCROSS t)`,
4435   SIMP_TAC[BOUNDED_PCROSS_EQ]);;
4436
4437 let CLOSED_PCROSS_EQ = prove
4438  (`!s:real^M->bool t:real^N->bool.
4439         closed (s PCROSS t) <=>
4440         s = {} \/ t = {} \/ closed s /\ closed t`,
4441   REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN MAP_EVERY ASM_CASES_TAC
4442    [`s:real^M->bool = {}`; `t:real^N->bool = {}`] THEN
4443   ASM_REWRITE_TAC[NOT_IN_EMPTY; CLOSED_EMPTY; SET_RULE
4444    `{f x y |x,y| F} = {}`] THEN
4445   REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS; LIM_SEQUENTIALLY] THEN
4446   REWRITE_TAC[FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN
4447   REWRITE_TAC[IN_ELIM_THM; SKOLEM_THM; FORALL_AND_THM] THEN
4448   ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN
4449   REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN
4450   SIMP_TAC[TAUT `((p /\ q) /\ r) /\ s ==> t <=> r ==> p /\ q /\ s ==> t`] THEN
4451   ONCE_REWRITE_TAC[MESON[]
4452    `(!a b c d e. P a b c d e) <=> (!d e b c a. P a b c d e)`] THEN
4453   REWRITE_TAC[FORALL_UNWIND_THM2] THEN
4454   RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN EQ_TAC THENL
4455    [GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV)
4456      [TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`; FORALL_AND_THM] THEN
4457     MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
4458      [ALL_TAC; GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM]] THEN
4459     MATCH_MP_TAC MONO_FORALL THEN REPEAT STRIP_TAC THEN
4460     FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC(MESON[]
4461      `(?x. P x (\n. x)) ==> (?s x. P x s)`) THEN
4462     ASM_MESON_TAC[DIST_PASTECART_CANCEL];
4463     ONCE_REWRITE_TAC[MESON[]
4464      `(!x l. P x l) /\ (!y m. Q y m) <=> (!x y l m. P x l /\ Q y m)`] THEN
4465     REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
4466     REWRITE_TAC[dist; PASTECART_SUB] THEN
4467     ASM_MESON_TAC[NORM_LE_PASTECART; REAL_LET_TRANS]]);;
4468
4469 let CLOSED_PCROSS = prove
4470  (`!s:real^M->bool t:real^N->bool.
4471      closed s /\ closed t ==> closed (s PCROSS t)`,
4472   SIMP_TAC[CLOSED_PCROSS_EQ]);;
4473
4474 let COMPACT_PCROSS_EQ = prove
4475  (`!s:real^M->bool t:real^N->bool.
4476         compact (s PCROSS t) <=>
4477         s = {} \/ t = {} \/ compact s /\ compact t`,
4478   REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_PCROSS_EQ;
4479               BOUNDED_PCROSS_EQ] THEN
4480   MESON_TAC[]);;
4481
4482 let COMPACT_PCROSS = prove
4483  (`!s:real^M->bool t:real^N->bool.
4484      compact s /\ compact t ==> compact (s PCROSS t)`,
4485   SIMP_TAC[COMPACT_PCROSS_EQ]);;
4486
4487 let OPEN_PCROSS_EQ = prove
4488  (`!s:real^M->bool t:real^N->bool.
4489         open (s PCROSS t) <=>
4490         s = {} \/ t = {} \/ open s /\ open t`,
4491   REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN
4492   ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
4493   ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
4494   REWRITE_TAC[SET_RULE `{f x y |x,y| F} = {}`; OPEN_EMPTY] THEN
4495   RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN
4496   EQ_TAC THENL
4497    [REWRITE_TAC[open_def; FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN
4498     ASM_MESON_TAC[DIST_PASTECART_CANCEL];
4499     REWRITE_TAC[OPEN_CLOSED] THEN STRIP_TAC THEN
4500     SUBGOAL_THEN
4501      `UNIV DIFF {pastecart x y | x IN s /\ y IN t} =
4502       {pastecart x y | x IN ((:real^M) DIFF s) /\ y IN (:real^N)} UNION
4503       {pastecart x y | x IN (:real^M) /\ y IN ((:real^N) DIFF t)}`
4504     SUBST1_TAC THENL
4505      [REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNION; FORALL_PASTECART; IN_UNIV] THEN
4506       REWRITE_TAC[IN_ELIM_THM; PASTECART_EQ; FSTCART_PASTECART;
4507                   SNDCART_PASTECART] THEN MESON_TAC[];
4508       SIMP_TAC[GSYM PCROSS] THEN MATCH_MP_TAC CLOSED_UNION THEN CONJ_TAC THEN
4509       MATCH_MP_TAC CLOSED_PCROSS THEN ASM_REWRITE_TAC[CLOSED_UNIV]]]);;
4510
4511 let OPEN_PCROSS = prove
4512  (`!s:real^M->bool t:real^N->bool.
4513         open s /\ open t ==> open (s PCROSS t)`,
4514   SIMP_TAC[OPEN_PCROSS_EQ]);;
4515
4516 let OPEN_IN_PCROSS = prove
4517  (`!s s':real^M->bool t t':real^N->bool.
4518         open_in (subtopology euclidean s) s' /\
4519         open_in (subtopology euclidean t) t'
4520         ==> open_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t')`,
4521   REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN DISCH_THEN(CONJUNCTS_THEN2
4522    (X_CHOOSE_THEN `s'':real^M->bool` STRIP_ASSUME_TAC)
4523    (X_CHOOSE_THEN `t'':real^N->bool` STRIP_ASSUME_TAC)) THEN
4524   EXISTS_TAC `(s'':real^M->bool) PCROSS (t'':real^N->bool)` THEN
4525   ASM_SIMP_TAC[OPEN_PCROSS; EXTENSION; FORALL_PASTECART] THEN
4526   REWRITE_TAC[IN_INTER; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]);;
4527
4528 let PASTECART_IN_INTERIOR_SUBTOPOLOGY = prove
4529  (`!s t u x:real^M y:real^N.
4530      pastecart x y IN u /\ open_in (subtopology euclidean (s PCROSS t)) u
4531      ==> ?v w. open_in (subtopology euclidean s) v /\ x IN v /\
4532                open_in (subtopology euclidean t) w /\ y IN w /\
4533                (v PCROSS w) SUBSET u`,
4534   REWRITE_TAC[open_in; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
4535   REPEAT STRIP_TAC THEN
4536   FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `y:real^N`]) THEN
4537   ASM_REWRITE_TAC[] THEN
4538   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
4539   EXISTS_TAC `ball(x:real^M,e / &2) INTER s` THEN
4540   EXISTS_TAC `ball(y:real^N,e / &2) INTER t` THEN
4541   SUBGOAL_THEN `(x:real^M) IN s /\ (y:real^N) IN t` STRIP_ASSUME_TAC THENL
4542    [ASM_MESON_TAC[SUBSET; PASTECART_IN_PCROSS]; ALL_TAC] THEN
4543   ASM_SIMP_TAC[INTER_SUBSET; IN_INTER; CENTRE_IN_BALL; REAL_HALF] THEN
4544   REWRITE_TAC[IN_BALL] THEN REPEAT(CONJ_TAC THENL
4545    [MESON_TAC[REAL_SUB_LT; NORM_ARITH
4546      `dist(x,y) < e /\ dist(z,y) < e - dist(x,y)
4547       ==> dist(x:real^N,z) < e`];
4548     ALL_TAC]) THEN
4549   REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
4550   REWRITE_TAC[IN_BALL; IN_INTER] THEN REPEAT STRIP_TAC THEN
4551   FIRST_X_ASSUM MATCH_MP_TAC THEN
4552   ASM_REWRITE_TAC[dist; PASTECART_SUB] THEN
4553   W(MP_TAC o PART_MATCH lhand NORM_PASTECART_LE o lhand o snd) THEN
4554   REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] dist)] THEN
4555   ASM_REAL_ARITH_TAC);;
4556
4557 let OPEN_IN_PCROSS_EQ = prove
4558  (`!s s':real^M->bool t t':real^N->bool.
4559         open_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t') <=>
4560         s' = {} \/ t' = {} \/
4561         open_in (subtopology euclidean s) s' /\
4562         open_in (subtopology euclidean t) t'`,
4563   REPEAT GEN_TAC THEN
4564   ASM_CASES_TAC `s':real^M->bool = {}` THEN
4565   ASM_REWRITE_TAC[PCROSS_EMPTY; OPEN_IN_EMPTY] THEN
4566   ASM_CASES_TAC `t':real^N->bool = {}` THEN
4567   ASM_REWRITE_TAC[PCROSS_EMPTY; OPEN_IN_EMPTY] THEN
4568   EQ_TAC THEN REWRITE_TAC[OPEN_IN_PCROSS] THEN REPEAT STRIP_TAC THENL
4569    [ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
4570     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
4571     UNDISCH_TAC `~(t':real^N->bool = {})` THEN
4572     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
4573     DISCH_THEN(X_CHOOSE_TAC `y:real^N`);
4574     ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN
4575     X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
4576     UNDISCH_TAC `~(s':real^M->bool = {})` THEN
4577     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
4578     DISCH_THEN(X_CHOOSE_TAC `x:real^M`)] THEN
4579    MP_TAC(ISPECL
4580      [`s:real^M->bool`; `t:real^N->bool`;
4581       `(s':real^M->bool) PCROSS (t':real^N->bool)`;
4582       `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN
4583   ASM_REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
4584   MESON_TAC[]);;
4585
4586 let INTERIOR_PCROSS = prove
4587  (`!s:real^M->bool t:real^N->bool.
4588         interior (s PCROSS t) = (interior s) PCROSS (interior t)`,
4589   REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
4590    [REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
4591     MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN DISCH_TAC THEN
4592     MP_TAC(ISPECL [`(:real^M)`; `(:real^N)`;
4593          `interior((s:real^M->bool) PCROSS (t:real^N->bool))`;
4594          `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN
4595     REWRITE_TAC[UNIV_PCROSS_UNIV; SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN
4596     ASM_REWRITE_TAC[OPEN_INTERIOR] THEN STRIP_TAC THEN
4597     FIRST_ASSUM(MP_TAC o MATCH_MP (MESON[INTERIOR_SUBSET; SUBSET_TRANS]
4598       `s SUBSET interior t ==> s SUBSET t`)) THEN
4599     REWRITE_TAC[SUBSET_PCROSS] THEN
4600     ASM_MESON_TAC[NOT_IN_EMPTY; INTERIOR_MAXIMAL; SUBSET];
4601     MATCH_MP_TAC INTERIOR_MAXIMAL THEN
4602     SIMP_TAC[OPEN_PCROSS; OPEN_INTERIOR; PCROSS_MONO; INTERIOR_SUBSET]]);;
4603
4604 (* ------------------------------------------------------------------------- *)
4605 (* Quotient maps are occasionally useful.                                    *)
4606 (* ------------------------------------------------------------------------- *)
4607
4608 let QUASICOMPACT_OPEN_CLOSED = prove
4609  (`!f:real^M->real^N s t.
4610     IMAGE f s SUBSET t
4611     ==> ((!u. u SUBSET t
4612               ==> (open_in (subtopology euclidean s)
4613                            {x | x IN s /\ f x IN u}
4614                    ==> open_in (subtopology euclidean t) u)) <=>
4615          (!u. u SUBSET t
4616               ==> (closed_in (subtopology euclidean s)
4617                              {x | x IN s /\ f x IN u}
4618                    ==> closed_in (subtopology euclidean t) u)))`,
4619   SIMP_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
4620   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
4621   X_GEN_TAC `u:real^N->bool` THEN
4622   DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN
4623   ASM_SIMP_TAC[SET_RULE `u SUBSET t ==> t DIFF (t DIFF u) = u`] THEN
4624   (ANTS_TAC THENL [SET_TAC[]; REPEAT STRIP_TAC]) THEN
4625   FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[SUBSET_RESTRICT] THEN
4626   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
4627    `open_in top x ==> x = y ==> open_in top y`)) THEN
4628   ASM SET_TAC[]);;
4629
4630 let QUOTIENT_MAP_IMP_CONTINUOUS_OPEN = prove
4631  (`!f:real^M->real^N s t.
4632      IMAGE f s SUBSET t /\
4633      (!u. u SUBSET t
4634           ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
4635                open_in (subtopology euclidean t) u))
4636      ==> f continuous_on s`,
4637   MESON_TAC[OPEN_IN_IMP_SUBSET; CONTINUOUS_ON_OPEN_GEN]);;
4638
4639 let QUOTIENT_MAP_IMP_CONTINUOUS_CLOSED = prove
4640  (`!f:real^M->real^N s t.
4641      IMAGE f s SUBSET t /\
4642      (!u. u SUBSET t
4643           ==> (closed_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
4644                closed_in (subtopology euclidean t) u))
4645      ==> f continuous_on s`,
4646   MESON_TAC[CLOSED_IN_IMP_SUBSET; CONTINUOUS_ON_CLOSED_GEN]);;
4647
4648 let OPEN_MAP_IMP_QUOTIENT_MAP = prove
4649  (`!f:real^M->real^N s.
4650     f continuous_on s /\
4651     (!t. open_in (subtopology euclidean s) t
4652          ==> open_in (subtopology euclidean (IMAGE f s)) (IMAGE f t))
4653     ==> !t. t SUBSET IMAGE f s
4654             ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=>
4655                  open_in (subtopology euclidean (IMAGE f s)) t)`,
4656   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
4657    [SUBGOAL_THEN
4658      `t = IMAGE f {x | x IN s /\ (f:real^M->real^N) x IN t}`
4659     SUBST1_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[]];
4660     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN
4661     ASM_SIMP_TAC[]]);;
4662
4663 let CLOSED_MAP_IMP_QUOTIENT_MAP = prove
4664  (`!f:real^M->real^N s.
4665     f continuous_on s /\
4666     (!t. closed_in (subtopology euclidean s) t
4667          ==> closed_in (subtopology euclidean (IMAGE f s)) (IMAGE f t))
4668     ==> !t. t SUBSET IMAGE f s
4669             ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=>
4670                  open_in (subtopology euclidean (IMAGE f s)) t)`,
4671   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
4672    [FIRST_X_ASSUM(MP_TAC o SPEC
4673      `s DIFF {x | x IN s /\ (f:real^M->real^N) x IN t}`) THEN
4674     ANTS_TAC THENL
4675      [MATCH_MP_TAC CLOSED_IN_DIFF THEN
4676       ASM_SIMP_TAC[CLOSED_IN_SUBTOPOLOGY_REFL;
4677                    TOPSPACE_EUCLIDEAN; SUBSET_UNIV];
4678       REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
4679       DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC EQ_IMP THEN
4680       AP_TERM_TAC THEN ASM SET_TAC[]];
4681     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN
4682     ASM_SIMP_TAC[]]);;
4683
4684 let CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP = prove
4685  (`!f:real^M->real^N g s t.
4686         f continuous_on s /\ IMAGE f s SUBSET t /\
4687         g continuous_on t /\ IMAGE g t SUBSET s /\
4688         (!y. y IN t ==> f(g y) = y)
4689         ==> (!u. u SUBSET t
4690             ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
4691                  open_in (subtopology euclidean t) u))`,
4692   REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL
4693    [DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `(IMAGE (g:real^N->real^M) t)
4694        INTER
4695        {x | x IN s /\ (f:real^M->real^N) x IN u}`) THEN
4696     ANTS_TAC THENL
4697      [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
4698       REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN
4699       ASM SET_TAC[];
4700       MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]];
4701     DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
4702     SUBGOAL_THEN `IMAGE (f:real^M->real^N) s = t`
4703      (fun th -> ASM_REWRITE_TAC[th]) THEN
4704     ASM SET_TAC[]]);;
4705
4706 let CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP = prove
4707  (`!f:real^M->real^N g s.
4708         f continuous_on s /\ g continuous_on (IMAGE f s) /\
4709         (!x. x IN s ==> g(f x) = x)
4710         ==> (!u. u SUBSET (IMAGE f s)
4711             ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
4712                  open_in (subtopology euclidean (IMAGE f s)) u))`,
4713   REPEAT GEN_TAC THEN STRIP_TAC THEN
4714   MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN
4715   EXISTS_TAC `g:real^N->real^M` THEN
4716   ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);;
4717
4718 let QUOTIENT_MAP_OPEN_CLOSED = prove
4719  (`!f:real^M->real^N s t.
4720     IMAGE f s SUBSET t
4721     ==> ((!u. u SUBSET t
4722               ==> (open_in (subtopology euclidean s)
4723                            {x | x IN s /\ f x IN u} <=>
4724                    open_in (subtopology euclidean t) u)) <=>
4725          (!u. u SUBSET t
4726               ==> (closed_in (subtopology euclidean s)
4727                              {x | x IN s /\ f x IN u} <=>
4728                    closed_in (subtopology euclidean t) u)))`,
4729   SIMP_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
4730   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
4731   X_GEN_TAC `u:real^N->bool` THEN
4732   DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN
4733   ASM_SIMP_TAC[SET_RULE `u SUBSET t ==> t DIFF (t DIFF u) = u`] THEN
4734   (ANTS_TAC THENL [SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)]) THEN
4735   REWRITE_TAC[SUBSET_RESTRICT] THEN AP_TERM_TAC THEN ASM SET_TAC[]);;
4736
4737 let CONTINUOUS_ON_COMPOSE_QUOTIENT = prove
4738  (`!f:real^M->real^N g:real^N->real^P s t u.
4739       IMAGE f s SUBSET t /\ IMAGE g t SUBSET u /\
4740       (!v. v SUBSET t
4741            ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=>
4742                 open_in (subtopology euclidean t) v)) /\
4743       (g o f) continuous_on s
4744       ==> g continuous_on t`,
4745   REPEAT GEN_TAC THEN
4746   REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4747   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) THEN
4748   SUBGOAL_THEN
4749    `IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) s SUBSET u`
4750    (fun th -> REWRITE_TAC[MATCH_MP CONTINUOUS_ON_OPEN_GEN th])
4751   THENL [REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; DISCH_TAC] THEN
4752   X_GEN_TAC `v:real^P->bool` THEN DISCH_TAC THEN
4753   FIRST_X_ASSUM(MP_TAC o SPEC `v:real^P->bool`) THEN
4754   ASM_REWRITE_TAC[o_THM] THEN DISCH_TAC THEN
4755   FIRST_X_ASSUM(MP_TAC o SPEC `{x | x IN t /\ (g:real^N->real^P) x IN v}`) THEN
4756   ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
4757   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
4758    `open_in top s ==> s = t ==> open_in top t`)) THEN
4759   ASM SET_TAC[]);;
4760
4761 let LIFT_TO_QUOTIENT_SPACE = prove
4762  (`!f:real^M->real^N h:real^M->real^P s t u.
4763         IMAGE f s = t /\
4764         (!v. v SUBSET t
4765            ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=>
4766                 open_in (subtopology euclidean t) v)) /\
4767         h continuous_on s /\ IMAGE h s = u /\
4768         (!x y. x IN s /\ y IN s /\ f x = f y ==> h x = h y)
4769         ==> ?g. g continuous_on t /\ IMAGE g t = u /\
4770                 !x. x IN s ==> h(x) = g(f x)`,
4771   REPEAT GEN_TAC THEN
4772   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4773   REWRITE_TAC[FUNCTION_FACTORS_LEFT_GEN] THEN
4774   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^P` THEN
4775   DISCH_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
4776   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE_QUOTIENT THEN MAP_EVERY EXISTS_TAC
4777    [`f:real^M->real^N`; `s:real^M->bool`; `u:real^P->bool`] THEN
4778   ASM_SIMP_TAC[SUBSET_REFL] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
4779   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
4780     CONTINUOUS_ON_EQ)) THEN
4781   ASM_REWRITE_TAC[o_THM]);;
4782
4783 let QUOTIENT_MAP_COMPOSE = prove
4784  (`!f:real^M->real^N g:real^N->real^P s t u.
4785         IMAGE f s SUBSET t /\
4786         (!v. v SUBSET t
4787            ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=>
4788                 open_in (subtopology euclidean t) v)) /\
4789         (!v. v SUBSET u
4790            ==> (open_in (subtopology euclidean t) {x | x IN t /\ g x IN v} <=>
4791                 open_in (subtopology euclidean u) v))
4792         ==> !v. v SUBSET u
4793                 ==> (open_in (subtopology euclidean s)
4794                              {x | x IN s /\ (g o f) x IN v} <=>
4795                      open_in (subtopology euclidean u) v)`,
4796   REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM] THEN
4797   SUBGOAL_THEN
4798    `{x | x IN s /\ (g:real^N->real^P) ((f:real^M->real^N) x) IN v} =
4799     {x | x IN s /\ f x IN {x | x IN t /\ g x IN v}}`
4800   SUBST1_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[SUBSET_RESTRICT]]);;
4801
4802 let QUOTIENT_MAP_FROM_COMPOSITION = prove
4803  (`!f:real^M->real^N g:real^N->real^P s t u.
4804         f continuous_on s /\ IMAGE f s SUBSET t /\
4805         g continuous_on t /\ IMAGE g t SUBSET u /\
4806         (!v. v SUBSET u
4807              ==> (open_in (subtopology euclidean s)
4808                           {x | x IN s /\ (g o f) x IN v} <=>
4809                   open_in (subtopology euclidean u) v))
4810         ==> !v. v SUBSET u
4811                 ==> (open_in (subtopology euclidean t)
4812                               {x | x IN t /\ g x IN v} <=>
4813                      open_in (subtopology euclidean u) v)`,
4814   REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL
4815    [FIRST_X_ASSUM(MP_TAC o SPEC `v:real^P->bool`) THEN
4816     ASM_REWRITE_TAC[o_THM] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
4817     SUBGOAL_THEN
4818      `{x | x IN s /\ (g:real^N->real^P) ((f:real^M->real^N) x) IN v} =
4819       {x | x IN s /\ f x IN {x | x IN t /\ g x IN v}}`
4820     SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
4821     MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
4822     EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[];
4823     MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
4824     EXISTS_TAC `u:real^P->bool` THEN ASM_REWRITE_TAC[]]);;
4825
4826 let QUOTIENT_MAP_FROM_SUBSET = prove
4827  (`!f:real^M->real^N s t u.
4828         f continuous_on t /\ IMAGE f t SUBSET u /\
4829         s SUBSET t /\ IMAGE f s = u /\
4830         (!v. v SUBSET u
4831              ==> (open_in (subtopology euclidean s)
4832                           {x | x IN s /\ f x IN v} <=>
4833                   open_in (subtopology euclidean u) v))
4834         ==> !v. v SUBSET u
4835                 ==> (open_in (subtopology euclidean t)
4836                              {x | x IN t /\ f x IN v} <=>
4837                      open_in (subtopology euclidean u) v)`,
4838   REPEAT GEN_TAC THEN STRIP_TAC THEN
4839   MATCH_MP_TAC QUOTIENT_MAP_FROM_COMPOSITION THEN
4840   MAP_EVERY EXISTS_TAC [`\x:real^M. x`; `s:real^M->bool`] THEN
4841   ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID; o_THM]);;
4842
4843 let QUOTIENT_MAP_RESTRICT = prove
4844  (`!f:real^M->real^N s t c.
4845      IMAGE f s SUBSET t /\
4846      (!u. u SUBSET t
4847         ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
4848              open_in (subtopology euclidean t) u)) /\
4849      (open_in (subtopology euclidean t) c \/
4850       closed_in (subtopology euclidean t) c)
4851      ==> !u. u SUBSET c
4852              ==> (open_in (subtopology euclidean {x | x IN s /\ f x IN c})
4853                           {x | x IN {x | x IN s /\ f x IN c} /\ f x IN u} <=>
4854                   open_in (subtopology euclidean c) u)`,
4855   REPEAT GEN_TAC THEN
4856   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
4857   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
4858   DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC (MATCH_MP
4859    (REWRITE_RULE[IMP_CONJ_ALT] QUOTIENT_MAP_IMP_CONTINUOUS_OPEN) th)) THEN
4860   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
4861   SUBGOAL_THEN `IMAGE (f:real^M->real^N) {x | x IN s /\ f x IN c} SUBSET c`
4862   ASSUME_TAC THENL [SET_TAC[]; ALL_TAC] THEN
4863   FIRST_X_ASSUM DISJ_CASES_TAC THENL
4864    [FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET);
4865     ASM_SIMP_TAC[QUOTIENT_MAP_OPEN_CLOSED] THEN
4866     FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)] THEN
4867   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `u:real^N->bool` THEN
4868   DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
4869   (ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
4870   (MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL
4871     [MATCH_MP_TAC(MESON[] `t = s /\ (P s <=> Q s) ==> (P s <=> Q t)`) THEN
4872      CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_ELIM_THM]];
4873      ALL_TAC]) THEN
4874   (EQ_TAC THENL
4875     [MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] OPEN_IN_SUBSET_TRANS) ORELSE
4876      MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] CLOSED_IN_SUBSET_TRANS);
4877      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] OPEN_IN_TRANS) ORELSE
4878      MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CLOSED_IN_TRANS)]) THEN
4879   (MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN ORELSE
4880    MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN ORELSE ASM_SIMP_TAC[]) THEN
4881   ASM SET_TAC[]);;
4882
4883 let CONNECTED_MONOTONE_QUOTIENT_PREIMAGE = prove
4884  (`!f:real^M->real^N s t.
4885       f continuous_on s /\ IMAGE f s = t /\
4886       (!u. u SUBSET t
4887            ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
4888                 open_in (subtopology euclidean t) u)) /\
4889       (!y. y IN t ==> connected {x | x IN s /\ f x = y}) /\
4890       connected t
4891       ==> connected s`,
4892   REPEAT STRIP_TAC THEN REWRITE_TAC[connected; NOT_EXISTS_THM] THEN
4893   MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^M->bool`] THEN STRIP_TAC THEN
4894   UNDISCH_TAC `connected(t:real^N->bool)` THEN SIMP_TAC[CONNECTED_OPEN_IN] THEN
4895   MAP_EVERY EXISTS_TAC
4896    [`IMAGE (f:real^M->real^N) (s INTER u)`;
4897     `IMAGE (f:real^M->real^N) (s INTER v)`] THEN
4898   ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN
4899   SUBGOAL_THEN
4900    `IMAGE (f:real^M->real^N) (s INTER u) INTER IMAGE f (s INTER v) = {}`
4901   ASSUME_TAC THENL
4902    [REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN
4903     X_GEN_TAC `y:real^N` THEN STRIP_TAC  THEN
4904     FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN
4905     ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[connected]] THEN
4906     MAP_EVERY EXISTS_TAC [`u:real^M->bool`; `v:real^M->bool`] THEN
4907     ASM SET_TAC[];
4908     ALL_TAC] THEN
4909   ONCE_REWRITE_TAC[CONJ_ASSOC] THEN
4910   CONJ_TAC THENL [CONJ_TAC; ASM SET_TAC[]] THEN
4911   FIRST_X_ASSUM(fun th ->
4912    W(MP_TAC o PART_MATCH (rand o rand) th o snd)) THEN
4913   (ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)]) THEN
4914   MATCH_MP_TAC(MESON[]
4915    `{x | x IN s /\ f x IN IMAGE f u} = u /\ open_in top u
4916     ==> open_in top {x | x IN s /\ f x IN IMAGE f u}`) THEN
4917   ASM_SIMP_TAC[OPEN_IN_OPEN_INTER] THEN ASM SET_TAC[]);;
4918
4919 let CONNECTED_MONOTONE_QUOTIENT_PREIMAGE_GEN = prove
4920  (`!f:real^M->real^N s t c.
4921       IMAGE f s = t /\
4922       (!u. u SUBSET t
4923            ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
4924                 open_in (subtopology euclidean t) u)) /\
4925       (!y. y IN t ==> connected {x | x IN s /\ f x = y}) /\
4926       (open_in (subtopology euclidean t) c \/
4927        closed_in (subtopology euclidean t) c) /\
4928       connected c
4929       ==> connected {x | x IN s /\ f x IN c}`,
4930   REPEAT GEN_TAC THEN
4931   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
4932   MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ]
4933    (REWRITE_RULE[CONJ_ASSOC] CONNECTED_MONOTONE_QUOTIENT_PREIMAGE)) THEN
4934   SUBGOAL_THEN `(c:real^N->bool) SUBSET t` ASSUME_TAC THENL
4935    [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; CLOSED_IN_IMP_SUBSET]; ALL_TAC] THEN
4936   EXISTS_TAC `f:real^M->real^N` THEN REPEAT CONJ_TAC THENL
4937    [FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
4938       QUOTIENT_MAP_IMP_CONTINUOUS_OPEN)) THEN
4939     ASM_REWRITE_TAC[SUBSET_REFL] THEN
4940     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET) THEN
4941     REWRITE_TAC[SUBSET_RESTRICT];
4942     ASM SET_TAC[];
4943     MATCH_MP_TAC QUOTIENT_MAP_RESTRICT THEN
4944     ASM_MESON_TAC[SUBSET_REFL];
4945     X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
4946     FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN
4947     ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC EQ_IMP] THEN
4948     AP_TERM_TAC THEN ASM SET_TAC[]]);;
4949
4950 (* ------------------------------------------------------------------------- *)
4951 (* More properties of open and closed maps.                                  *)
4952 (* ------------------------------------------------------------------------- *)
4953
4954 let OPEN_MAP_RESTRICT = prove
4955  (`!f:real^M->real^N s t t'.
4956         (!u. open_in (subtopology euclidean s) u
4957              ==> open_in (subtopology euclidean t) (IMAGE f u)) /\
4958         t' SUBSET t
4959         ==> !u. open_in (subtopology euclidean {x | x IN s /\ f x IN t'}) u
4960                 ==> open_in (subtopology euclidean t') (IMAGE f u)`,
4961   REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN
4962   REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN
4963   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
4964   REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN
4965   REPEAT DISCH_TAC THEN X_GEN_TAC `c:real^M->bool` THEN
4966   DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN
4967   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);;
4968
4969 let CLOSED_MAP_RESTRICT = prove
4970  (`!f:real^M->real^N s t t'.
4971         (!u. closed_in (subtopology euclidean s) u
4972              ==> closed_in (subtopology euclidean t) (IMAGE f u)) /\
4973         t' SUBSET t
4974         ==> !u. closed_in (subtopology euclidean {x | x IN s /\ f x IN t'}) u
4975                 ==> closed_in (subtopology euclidean t') (IMAGE f u)`,
4976   REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN
4977   REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN
4978   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
4979   REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN
4980   REPEAT DISCH_TAC THEN X_GEN_TAC `c:real^M->bool` THEN
4981   DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN
4982   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);;
4983
4984 let QUOTIENT_MAP_OPEN_MAP_EQ = prove
4985  (`!f:real^M->real^N s t.
4986        IMAGE f s SUBSET t /\
4987        (!u. u SUBSET t
4988             ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
4989                  open_in (subtopology euclidean t) u))
4990        ==> ((!k. open_in (subtopology euclidean s) k
4991                  ==> open_in (subtopology euclidean t) (IMAGE f k)) <=>
4992             (!k. open_in (subtopology euclidean s) k
4993                  ==> open_in (subtopology euclidean s)
4994                                {x | x IN s /\ f x IN IMAGE f k}))`,
4995   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
4996   X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN
4997   FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
4998   FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (f:real^M->real^N) k`) THEN
4999   ASM_SIMP_TAC[IMAGE_SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);;
5000
5001 let QUOTIENT_MAP_CLOSED_MAP_EQ = prove
5002  (`!f:real^M->real^N s t.
5003        IMAGE f s SUBSET t /\
5004        (!u. u SUBSET t
5005             ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
5006                  open_in (subtopology euclidean t) u))
5007        ==> ((!k. closed_in (subtopology euclidean s) k
5008                  ==> closed_in (subtopology euclidean t) (IMAGE f k)) <=>
5009             (!k. closed_in (subtopology euclidean s) k
5010                  ==> closed_in (subtopology euclidean s)
5011                                {x | x IN s /\ f x IN IMAGE f k}))`,
5012   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
5013   ASM_SIMP_TAC[QUOTIENT_MAP_OPEN_CLOSED] THEN
5014   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
5015   X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN
5016   FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
5017   FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (f:real^M->real^N) k`) THEN
5018   ASM_SIMP_TAC[IMAGE_SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);;
5019
5020 let CLOSED_MAP_IMP_OPEN_MAP = prove
5021  (`!f:real^M->real^N s t.
5022         IMAGE f s = t /\
5023         (!u. closed_in (subtopology euclidean s) u
5024                 ==> closed_in (subtopology euclidean t) (IMAGE f u)) /\
5025         (!u. open_in (subtopology euclidean s) u
5026              ==> open_in (subtopology euclidean s)
5027                          {x | x IN s /\ f x IN IMAGE f u})
5028         ==> (!u. open_in (subtopology euclidean s) u
5029                  ==> open_in (subtopology euclidean t) (IMAGE f u))`,
5030   REPEAT STRIP_TAC THEN
5031   SUBGOAL_THEN
5032     `IMAGE (f:real^M->real^N) u =
5033      t DIFF IMAGE f (s DIFF {x | x IN s /\ f x IN IMAGE f u})`
5034   SUBST1_TAC THENL
5035    [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[];
5036     MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
5037     FIRST_X_ASSUM MATCH_MP_TAC THEN
5038     MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
5039     ASM_SIMP_TAC[CLOSED_IN_REFL]]);;
5040
5041 let OPEN_MAP_IMP_CLOSED_MAP = prove
5042  (`!f:real^M->real^N s t.
5043         IMAGE f s = t /\
5044         (!u. open_in (subtopology euclidean s) u
5045                 ==> open_in (subtopology euclidean t) (IMAGE f u)) /\
5046         (!u. closed_in (subtopology euclidean s) u
5047              ==> closed_in (subtopology euclidean s)
5048                          {x | x IN s /\ f x IN IMAGE f u})
5049         ==> (!u. closed_in (subtopology euclidean s) u
5050                  ==> closed_in (subtopology euclidean t) (IMAGE f u))`,
5051   REPEAT STRIP_TAC THEN
5052   SUBGOAL_THEN
5053     `IMAGE (f:real^M->real^N) u =
5054      t DIFF IMAGE f (s DIFF {x | x IN s /\ f x IN IMAGE f u})`
5055   SUBST1_TAC THENL
5056    [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN ASM SET_TAC[];
5057     MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN
5058     FIRST_X_ASSUM MATCH_MP_TAC THEN
5059     MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN
5060     ASM_SIMP_TAC[OPEN_IN_REFL]]);;
5061
5062 let OPEN_MAP_FROM_COMPOSITION_SURJECTIVE = prove
5063  (`!f:real^M->real^N g:real^N->real^P s t u.
5064         f continuous_on s /\ IMAGE f s = t /\ IMAGE g t SUBSET u /\
5065         (!k. open_in (subtopology euclidean s) k
5066              ==> open_in (subtopology euclidean u) (IMAGE (g o f) k))
5067         ==> (!k. open_in (subtopology euclidean t) k
5068                  ==> open_in (subtopology euclidean u) (IMAGE g k))`,
5069   REPEAT STRIP_TAC THEN SUBGOAL_THEN
5070    `IMAGE g k = IMAGE ((g:real^N->real^P) o (f:real^M->real^N))
5071                       {x | x IN s /\ f(x) IN k}`
5072   SUBST1_TAC THENL
5073    [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
5074     REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
5075     FIRST_X_ASSUM MATCH_MP_TAC THEN
5076     MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
5077     EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL]]);;
5078
5079 let CLOSED_MAP_FROM_COMPOSITION_SURJECTIVE = prove
5080  (`!f:real^M->real^N g:real^N->real^P s t u.
5081         f continuous_on s /\ IMAGE f s = t /\ IMAGE g t SUBSET u /\
5082         (!k. closed_in (subtopology euclidean s) k
5083              ==> closed_in (subtopology euclidean u) (IMAGE (g o f) k))
5084         ==> (!k. closed_in (subtopology euclidean t) k
5085                  ==> closed_in (subtopology euclidean u) (IMAGE g k))`,
5086   REPEAT STRIP_TAC THEN SUBGOAL_THEN
5087    `IMAGE g k = IMAGE ((g:real^N->real^P) o (f:real^M->real^N))
5088                       {x | x IN s /\ f(x) IN k}`
5089   SUBST1_TAC THENL
5090    [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
5091     REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
5092     FIRST_X_ASSUM MATCH_MP_TAC THEN
5093     MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN
5094     EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL]]);;
5095
5096 let OPEN_MAP_FROM_COMPOSITION_INJECTIVE = prove
5097  (`!f:real^M->real^N g:real^N->real^P s t u.
5098         IMAGE f s SUBSET t /\ IMAGE g t SUBSET u /\
5099         g continuous_on t /\ (!x y. x IN t /\ y IN t /\ g x = g y ==> x = y) /\
5100         (!k. open_in (subtopology euclidean s) k
5101              ==> open_in (subtopology euclidean u) (IMAGE (g o f) k))
5102         ==> (!k. open_in (subtopology euclidean s) k
5103                  ==> open_in (subtopology euclidean t) (IMAGE f k))`,
5104   REPEAT STRIP_TAC THEN SUBGOAL_THEN
5105    `IMAGE f k = {x | x IN t /\
5106                     g(x) IN IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) k}`
5107   SUBST1_TAC THENL
5108    [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
5109     REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
5110     MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
5111     EXISTS_TAC `u:real^P->bool` THEN ASM_SIMP_TAC[]]);;
5112
5113 let CLOSED_MAP_FROM_COMPOSITION_INJECTIVE = prove
5114  (`!f:real^M->real^N g:real^N->real^P s t u.
5115         IMAGE f s SUBSET t /\ IMAGE g t SUBSET u /\
5116         g continuous_on t /\ (!x y. x IN t /\ y IN t /\ g x = g y ==> x = y) /\
5117         (!k. closed_in (subtopology euclidean s) k
5118              ==> closed_in (subtopology euclidean u) (IMAGE (g o f) k))
5119         ==> (!k. closed_in (subtopology euclidean s) k
5120                  ==> closed_in (subtopology euclidean t) (IMAGE f k))`,
5121   REPEAT STRIP_TAC THEN SUBGOAL_THEN
5122    `IMAGE f k = {x | x IN t /\
5123                     g(x) IN IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) k}`
5124   SUBST1_TAC THENL
5125    [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
5126     REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
5127     MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN
5128     EXISTS_TAC `u:real^P->bool` THEN ASM_SIMP_TAC[]]);;
5129
5130 let OPEN_MAP_CLOSED_SUPERSET_PREIMAGE = prove
5131  (`!f:real^M->real^N s t u w.
5132         (!k. open_in (subtopology euclidean s) k
5133              ==> open_in (subtopology euclidean t) (IMAGE f k)) /\
5134         closed_in (subtopology euclidean s) u /\
5135         w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u
5136         ==> ?v. closed_in (subtopology euclidean t) v /\
5137                 w SUBSET v /\
5138                 {x | x IN s /\ f(x) IN v} SUBSET u`,
5139   REPEAT STRIP_TAC THEN
5140   EXISTS_TAC `t DIFF IMAGE (f:real^M->real^N) (s DIFF u)` THEN
5141   CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5142   MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN
5143   FIRST_X_ASSUM MATCH_MP_TAC THEN
5144   ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL]);;
5145
5146 let OPEN_MAP_CLOSED_SUPERSET_PREIMAGE_EQ = prove
5147  (`!f:real^M->real^N s t.
5148        IMAGE f s SUBSET t
5149        ==> ((!k. open_in (subtopology euclidean s) k
5150                  ==> open_in (subtopology euclidean t) (IMAGE f k)) <=>
5151             (!u w. closed_in (subtopology euclidean s) u /\
5152                    w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u
5153                    ==> ?v. closed_in (subtopology euclidean t) v /\
5154                            w SUBSET v /\ {x | x IN s /\ f(x) IN v} SUBSET u))`,
5155   REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN
5156   ASM_SIMP_TAC[OPEN_MAP_CLOSED_SUPERSET_PREIMAGE] THEN
5157   FIRST_X_ASSUM(MP_TAC o SPECL
5158    [`s DIFF k:real^M->bool`; `t DIFF IMAGE (f:real^M->real^N) k`]) THEN
5159   FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
5160   ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN
5161   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5162   DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
5163   SUBGOAL_THEN `IMAGE (f:real^M->real^N) k = t DIFF v` SUBST1_TAC THENL
5164    [ASM SET_TAC[]; ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL]]);;
5165
5166 let CLOSED_MAP_OPEN_SUPERSET_PREIMAGE = prove
5167  (`!f:real^M->real^N s t u w.
5168         (!k. closed_in (subtopology euclidean s) k
5169              ==> closed_in (subtopology euclidean t) (IMAGE f k)) /\
5170         open_in (subtopology euclidean s) u /\
5171         w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u
5172         ==> ?v. open_in (subtopology euclidean t) v /\
5173                 w SUBSET v /\
5174                 {x | x IN s /\ f(x) IN v} SUBSET u`,
5175   REPEAT STRIP_TAC THEN
5176   EXISTS_TAC `t DIFF IMAGE (f:real^M->real^N) (s DIFF u)` THEN
5177   CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5178   MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
5179   FIRST_X_ASSUM MATCH_MP_TAC THEN
5180   ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL]);;
5181
5182 let CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_EQ = prove
5183  (`!f:real^M->real^N s t.
5184        IMAGE f s SUBSET t
5185        ==> ((!k. closed_in (subtopology euclidean s) k
5186                  ==> closed_in (subtopology euclidean t) (IMAGE f k)) <=>
5187             (!u w. open_in (subtopology euclidean s) u /\
5188                    w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u
5189                    ==> ?v. open_in (subtopology euclidean t) v /\
5190                            w SUBSET v /\ {x | x IN s /\ f(x) IN v} SUBSET u))`,
5191   REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN
5192   ASM_SIMP_TAC[CLOSED_MAP_OPEN_SUPERSET_PREIMAGE] THEN
5193   FIRST_X_ASSUM(MP_TAC o SPECL
5194    [`s DIFF k:real^M->bool`; `t DIFF IMAGE (f:real^M->real^N) k`]) THEN
5195   FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
5196   ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN
5197   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5198   DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
5199   SUBGOAL_THEN `IMAGE (f:real^M->real^N) k = t DIFF v` SUBST1_TAC THENL
5200    [ASM SET_TAC[]; ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL]]);;
5201
5202 let CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_POINT = prove
5203  (`!f:real^M->real^N s t.
5204        IMAGE f s SUBSET t
5205        ==> ((!k. closed_in (subtopology euclidean s) k
5206                  ==> closed_in (subtopology euclidean t) (IMAGE f k)) <=>
5207             (!u y. open_in (subtopology euclidean s) u /\
5208                    y IN t /\ {x | x IN s /\ f(x) = y} SUBSET u
5209                    ==> ?v. open_in (subtopology euclidean t) v /\
5210                            y IN v /\ {x | x IN s /\ f(x) IN v} SUBSET u))`,
5211   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_EQ] THEN
5212   EQ_TAC THEN DISCH_TAC THENL
5213    [MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `y:real^N`] THEN
5214     STRIP_TAC THEN
5215     FIRST_X_ASSUM(MP_TAC o SPECL  [`u:real^M->bool`; `{y:real^N}`]) THEN
5216     ASM_REWRITE_TAC[SING_SUBSET; IN_SING];
5217     MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `w:real^N->bool`] THEN
5218     STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`) THEN
5219     GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
5220     REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
5221     X_GEN_TAC `vv:real^N->real^N->bool` THEN DISCH_TAC THEN
5222     EXISTS_TAC `UNIONS {(vv:real^N->real^N->bool) y | y IN w}` THEN
5223     CONJ_TAC THENL
5224      [MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN
5225       ASM SET_TAC[];
5226       REWRITE_TAC[UNIONS_GSPEC] THEN
5227       CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5228       REWRITE_TAC[SUBSET; IN_ELIM_THM; RIGHT_AND_EXISTS_THM;
5229                   LEFT_IMP_EXISTS_THM] THEN
5230       MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN STRIP_TAC THEN
5231       FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM SET_TAC[]]]);;
5232
5233 let CONNECTED_OPEN_MONOTONE_PREIMAGE = prove
5234  (`!f:real^M->real^N s t.
5235         f continuous_on s /\ IMAGE f s = t /\
5236         (!c. open_in (subtopology euclidean s) c
5237              ==> open_in (subtopology euclidean t) (IMAGE f c)) /\
5238         (!y. y IN t ==> connected {x | x IN s /\ f x = y})
5239         ==> !c. connected c /\ c SUBSET t
5240                 ==> connected {x | x IN s /\ f x IN c}`,
5241   REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `c:real^N->bool` o MATCH_MP
5242    (ONCE_REWRITE_RULE[IMP_CONJ] OPEN_MAP_RESTRICT)) THEN
5243   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL
5244    [`f:real^M->real^N`; `{x | x IN s /\ (f:real^M->real^N) x IN c}`]
5245    OPEN_MAP_IMP_QUOTIENT_MAP) THEN
5246   SUBGOAL_THEN `IMAGE f {x | x IN s /\ (f:real^M->real^N) x IN c} = c`
5247   ASSUME_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN ANTS_TAC THENL
5248    [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
5249       CONTINUOUS_ON_SUBSET)) THEN SET_TAC[];
5250     DISCH_TAC] THEN
5251   MATCH_MP_TAC CONNECTED_MONOTONE_QUOTIENT_PREIMAGE THEN
5252   MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `c:real^N->bool`] THEN
5253   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
5254    [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
5255       CONTINUOUS_ON_SUBSET)) THEN SET_TAC[];
5256     SIMP_TAC[SET_RULE
5257      `y IN c ==> {x | x IN {x | x IN s /\ f x IN c} /\ f x = y} =
5258                  {x | x IN s /\ f x = y}`] THEN
5259    ASM SET_TAC[]]);;
5260
5261 let CONNECTED_CLOSED_MONOTONE_PREIMAGE = prove
5262  (`!f:real^M->real^N s t.
5263         f continuous_on s /\ IMAGE f s = t /\
5264         (!c. closed_in (subtopology euclidean s) c
5265              ==> closed_in (subtopology euclidean t) (IMAGE f c)) /\
5266         (!y. y IN t ==> connected {x | x IN s /\ f x = y})
5267         ==> !c. connected c /\ c SUBSET t
5268                 ==> connected {x | x IN s /\ f x IN c}`,
5269   REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `c:real^N->bool` o MATCH_MP
5270    (ONCE_REWRITE_RULE[IMP_CONJ] CLOSED_MAP_RESTRICT)) THEN
5271   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL
5272    [`f:real^M->real^N`; `{x | x IN s /\ (f:real^M->real^N) x IN c}`]
5273    CLOSED_MAP_IMP_QUOTIENT_MAP) THEN
5274   SUBGOAL_THEN `IMAGE f {x | x IN s /\ (f:real^M->real^N) x IN c} = c`
5275   ASSUME_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN ANTS_TAC THENL
5276    [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
5277       CONTINUOUS_ON_SUBSET)) THEN SET_TAC[];
5278     DISCH_TAC] THEN
5279   MATCH_MP_TAC CONNECTED_MONOTONE_QUOTIENT_PREIMAGE THEN
5280   MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `c:real^N->bool`] THEN
5281   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
5282    [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
5283       CONTINUOUS_ON_SUBSET)) THEN SET_TAC[];
5284     SIMP_TAC[SET_RULE
5285      `y IN c ==> {x | x IN {x | x IN s /\ f x IN c} /\ f x = y} =
5286                  {x | x IN s /\ f x = y}`] THEN
5287    ASM SET_TAC[]]);;
5288
5289 (* ------------------------------------------------------------------------- *)
5290 (* Proper maps, including projections out of compact sets.                   *)
5291 (* ------------------------------------------------------------------------- *)
5292
5293 let PROPER_MAP = prove
5294  (`!f:real^M->real^N s t.
5295     IMAGE f s SUBSET t
5296     ==> ((!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) <=>
5297          (!k. closed_in (subtopology euclidean s) k
5298               ==> closed_in (subtopology euclidean t) (IMAGE f k)) /\
5299          (!a. a IN t ==> compact {x | x IN s /\ f x = a}))`,
5300   REPEAT STRIP_TAC THEN EQ_TAC THENL
5301    [REPEAT STRIP_TAC THENL
5302      [ALL_TAC;
5303       ONCE_REWRITE_TAC[SET_RULE `x = a <=> x IN {a}`] THEN
5304       FIRST_X_ASSUM MATCH_MP_TAC THEN
5305       ASM_REWRITE_TAC[SING_SUBSET; COMPACT_SING]] THEN
5306     FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
5307     REWRITE_TAC[CLOSED_IN_LIMPT] THEN
5308     CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `y:real^N`] THEN
5309     REWRITE_TAC[LIMPT_SEQUENTIAL_INJ; IN_DELETE] THEN
5310     REWRITE_TAC[IN_IMAGE; LEFT_AND_EXISTS_THM; SKOLEM_THM] THEN
5311     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
5312     REWRITE_TAC[GSYM CONJ_ASSOC; FORALL_AND_THM] THEN
5313     ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN
5314     REWRITE_TAC[UNWIND_THM2; FUN_EQ_THM] THEN
5315     DISCH_THEN(X_CHOOSE_THEN `x:num->real^M` STRIP_ASSUME_TAC) THEN
5316     SUBGOAL_THEN
5317      `~(INTERS {{a | a IN k /\
5318                      (f:real^M->real^N) a IN
5319                      (y INSERT IMAGE (\i. f(x(n + i))) (:num))} |
5320                 n IN (:num)} = {})`
5321     MP_TAC THENL
5322      [MATCH_MP_TAC COMPACT_FIP THEN CONJ_TAC THENL
5323        [REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `n:num` THEN
5324         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN
5325         DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN
5326         ASM_REWRITE_TAC[SET_RULE
5327          `{x | x IN s INTER k /\ P x} = k INTER {x | x IN s /\ P x}`] THEN
5328         MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_REWRITE_TAC[] THEN
5329         FIRST_X_ASSUM MATCH_MP_TAC THEN
5330         CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5331         MATCH_MP_TAC COMPACT_SEQUENCE_WITH_LIMIT THEN
5332         FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP SEQ_OFFSET) THEN
5333         REWRITE_TAC[ADD_SYM];
5334         REWRITE_TAC[SIMPLE_IMAGE; FORALL_FINITE_SUBSET_IMAGE] THEN
5335         X_GEN_TAC `i:num->bool` THEN STRIP_TAC THEN
5336         FIRST_ASSUM(MP_TAC o ISPEC `\n:num. n` o MATCH_MP
5337           UPPER_BOUND_FINITE_SET) THEN
5338         REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN
5339         REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; INTERS_IMAGE; IN_ELIM_THM] THEN
5340         EXISTS_TAC `(x:num->real^M) m` THEN
5341         X_GEN_TAC `p:num` THEN DISCH_TAC THEN
5342         CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5343         REWRITE_TAC[IN_INSERT; IN_IMAGE; IN_UNIV] THEN DISJ2_TAC THEN
5344         EXISTS_TAC `m - p:num` THEN
5345         ASM_MESON_TAC[ARITH_RULE `p <= m ==> p + m - p:num = m`]];
5346       REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN
5347       X_GEN_TAC `x:real^M` THEN
5348       REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN
5349       DISCH_THEN(fun th -> LABEL_TAC "*" th THEN MP_TAC(SPEC `0` th)) THEN
5350       REWRITE_TAC[ADD_CLAUSES; IN_INSERT; IN_IMAGE; IN_UNIV] THEN
5351       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (DISJ_CASES_THEN MP_TAC)) THEN
5352       ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `i:num`) THEN
5353       REMOVE_THEN "*" (MP_TAC o SPEC `i + 1`) THEN
5354       ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
5355       ASM_REWRITE_TAC[IN_INSERT; IN_IMAGE; IN_UNIV] THEN ARITH_TAC];
5356     STRIP_TAC THEN X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN
5357     REWRITE_TAC[COMPACT_EQ_HEINE_BOREL] THEN
5358     X_GEN_TAC `c:(real^M->bool)->bool` THEN STRIP_TAC THEN
5359     SUBGOAL_THEN
5360      `!a. a IN k
5361           ==> ?g. g SUBSET c /\ FINITE g /\
5362                   {x | x IN s /\ (f:real^M->real^N) x = a} SUBSET UNIONS g`
5363     MP_TAC THENL
5364      [X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN UNDISCH_THEN
5365        `!a. a IN t ==> compact {x | x IN s /\ (f:real^M->real^N) x = a}`
5366        (MP_TAC o SPEC `a:real^N`) THEN
5367       ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[COMPACT_EQ_HEINE_BOREL]] THEN
5368       DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
5369       GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
5370       REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
5371       X_GEN_TAC `uu:real^N->(real^M->bool)->bool` THEN
5372       DISCH_THEN(LABEL_TAC "*")] THEN
5373     SUBGOAL_THEN
5374      `!a. a IN k
5375           ==> ?v. open v /\ a IN v /\
5376                  {x | x IN s /\ (f:real^M->real^N) x IN v} SUBSET UNIONS(uu a)`
5377     MP_TAC THENL
5378      [REPEAT STRIP_TAC THEN
5379       UNDISCH_THEN
5380        `!k. closed_in (subtopology euclidean s) k
5381             ==> closed_in (subtopology euclidean t)
5382                           (IMAGE (f:real^M->real^N) k)`
5383        (MP_TAC o SPEC `(s:real^M->bool) DIFF UNIONS(uu(a:real^N))`) THEN
5384       SIMP_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ANTS_TAC THENL
5385        [CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
5386         REWRITE_TAC[SET_RULE `s DIFF (s DIFF t) = s INTER t`] THEN
5387         MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN
5388         MATCH_MP_TAC OPEN_UNIONS THEN ASM SET_TAC[];
5389         DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
5390         REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN
5391         X_GEN_TAC `v:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5392         REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `a:real^N`)) THEN
5393         ASM_REWRITE_TAC[] THEN REPEAT
5394          ((ANTS_TAC THENL [ASM SET_TAC[]; DISCH_TAC]) ORELSE STRIP_TAC)
5395         THENL [ALL_TAC; ASM SET_TAC[]] THEN
5396         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN
5397         DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM SET_TAC[]];
5398       GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
5399       REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
5400       X_GEN_TAC `vv:real^N->(real^N->bool)` THEN
5401       DISCH_THEN(LABEL_TAC "+")] THEN
5402     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL]) THEN
5403     DISCH_THEN(MP_TAC o SPEC `IMAGE (vv:real^N->(real^N->bool)) k`) THEN
5404     ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
5405     ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> q /\ p ==> r ==> s`] THEN
5406     REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN
5407     X_GEN_TAC `j:real^N->bool` THEN REPEAT STRIP_TAC THEN
5408     EXISTS_TAC `UNIONS(IMAGE (uu:real^N->(real^M->bool)->bool) j)` THEN
5409     REPEAT CONJ_TAC THENL
5410      [ASM SET_TAC[];
5411       ASM_SIMP_TAC[FINITE_UNIONS; FORALL_IN_IMAGE; FINITE_IMAGE] THEN
5412       ASM SET_TAC[];
5413       REWRITE_TAC[UNIONS_IMAGE; SUBSET; IN_UNIONS; IN_ELIM_THM] THEN
5414       ASM SET_TAC[]]]);;
5415
5416 let COMPACT_CONTINUOUS_IMAGE_EQ = prove
5417  (`!f:real^M->real^N s.
5418         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
5419         ==> (f continuous_on s <=>
5420              !t. compact t /\ t SUBSET s ==> compact(IMAGE f t))`,
5421   REPEAT STRIP_TAC THEN EQ_TAC THENL
5422    [MESON_TAC[COMPACT_CONTINUOUS_IMAGE; CONTINUOUS_ON_SUBSET]; DISCH_TAC] THEN
5423   FIRST_X_ASSUM(X_CHOOSE_TAC `g:real^N->real^M` o
5424     GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN
5425   REWRITE_TAC[CONTINUOUS_ON_CLOSED] THEN
5426   X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN
5427   MP_TAC(ISPECL [`g:real^N->real^M`; `IMAGE (f:real^M->real^N) s`;
5428                  `s:real^M->bool`] PROPER_MAP) THEN
5429   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5430   MATCH_MP_TAC(TAUT `(q ==> s) /\ p ==> (p <=> q /\ r) ==> s`) THEN
5431   REPEAT STRIP_TAC THENL
5432    [SUBGOAL_THEN
5433      `{x | x IN s /\ (f:real^M->real^N) x IN u} = IMAGE g u`
5434      (fun th -> ASM_MESON_TAC[th]);
5435     SUBGOAL_THEN
5436      `{x | x IN IMAGE f s /\ (g:real^N->real^M) x IN k} = IMAGE f k`
5437      (fun th -> ASM_SIMP_TAC[th])] THEN
5438   FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN ASM SET_TAC[]);;
5439
5440 let PROPER_MAP_FROM_COMPACT = prove
5441  (`!f:real^M->real^N s k.
5442         f continuous_on s /\ IMAGE f s SUBSET t /\ compact s /\
5443         closed_in (subtopology euclidean t) k
5444         ==> compact {x | x IN s /\ f x IN k}`,
5445   REPEAT STRIP_TAC THEN
5446   MATCH_MP_TAC CLOSED_IN_COMPACT THEN EXISTS_TAC `s:real^M->bool` THEN
5447   ASM_MESON_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_GEN]);;
5448
5449 let PROPER_MAP_COMPOSE = prove
5450  (`!f:real^M->real^N g:real^N->real^P s t u.
5451         IMAGE f s SUBSET t /\
5452         (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) /\
5453         (!k. k SUBSET u /\ compact k ==> compact {x | x IN t /\ g x IN k})
5454         ==> !k. k SUBSET u /\ compact k
5455                 ==> compact {x | x IN s /\ (g o f) x IN k}`,
5456   REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM] THEN
5457   FIRST_X_ASSUM(MP_TAC o SPEC `k:real^P->bool`) THEN
5458   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
5459   FIRST_X_ASSUM(MP_TAC o SPEC `{x | x IN t /\ (g:real^N->real^P) x IN k}`) THEN
5460   ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC EQ_IMP] THEN
5461   AP_TERM_TAC THEN ASM SET_TAC[]);;
5462
5463 let PROPER_MAP_FROM_COMPOSITION_LEFT = prove
5464  (`!f:real^M->real^N g:real^N->real^P s t u.
5465         f continuous_on s /\ IMAGE f s = t /\
5466         g continuous_on t /\ IMAGE g t SUBSET u /\
5467         (!k. k SUBSET u /\ compact k
5468              ==> compact {x | x IN s /\ (g o f) x IN k})
5469         ==> !k. k SUBSET u /\ compact k ==> compact {x | x IN t /\ g x IN k}`,
5470   REWRITE_TAC[o_THM] THEN REPEAT STRIP_TAC THEN
5471   FIRST_X_ASSUM(MP_TAC o SPEC `k:real^P->bool`) THEN ASM_REWRITE_TAC[] THEN
5472   DISCH_THEN(MP_TAC o ISPEC `f:real^M->real^N` o MATCH_MP
5473    (REWRITE_RULE[IMP_CONJ_ALT] COMPACT_CONTINUOUS_IMAGE)) THEN
5474   ANTS_TAC THENL
5475    [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
5476         CONTINUOUS_ON_SUBSET)) THEN SET_TAC[];
5477     MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]);;
5478
5479 let PROPER_MAP_FROM_COMPOSITION_RIGHT = prove
5480  (`!f:real^M->real^N g:real^N->real^P s t u.
5481         f continuous_on s /\ IMAGE f s SUBSET t /\
5482         g continuous_on t /\ IMAGE g t SUBSET u /\
5483         (!k. k SUBSET u /\ compact k
5484              ==> compact {x | x IN s /\ (g o f) x IN k})
5485         ==> !k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}`,
5486   let lemma = prove
5487    (`!s t. closed_in (subtopology euclidean s) t ==> compact s ==> compact t`,
5488     MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET;
5489               CLOSED_IN_CLOSED_EQ]) in
5490   REWRITE_TAC[o_THM] THEN REPEAT STRIP_TAC THEN
5491   FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (g:real^N->real^P) k`) THEN
5492   ANTS_TAC THENL
5493    [CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE] THEN
5494     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
5495     MATCH_MP_TAC lemma THEN
5496     MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN
5497     EXISTS_TAC `s:real^M->bool` THEN
5498     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5499     MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN
5500     EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN
5501     MATCH_MP_TAC CLOSED_SUBSET THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED]]);;
5502
5503 let PROPER_MAP_FSTCART = prove
5504  (`!s:real^M->bool t:real^N->bool k.
5505         compact t /\ k SUBSET s /\ compact k
5506         ==> compact {z | z IN s PCROSS t /\ fstcart z IN k}`,
5507   REPEAT STRIP_TAC THEN SUBGOAL_THEN
5508    `{z | z IN s PCROSS t /\ fstcart z IN k} =
5509     (k:real^M->bool) PCROSS (t:real^N->bool)`
5510    (fun th -> ASM_SIMP_TAC[th; COMPACT_PCROSS]) THEN
5511   REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM;
5512               PASTECART_IN_PCROSS; FSTCART_PASTECART] THEN
5513   ASM SET_TAC[]);;
5514
5515 let CLOSED_MAP_FSTCART = prove
5516  (`!s:real^M->bool t:real^N->bool c.
5517         compact t /\ closed_in (subtopology euclidean (s PCROSS t)) c
5518         ==> closed_in (subtopology euclidean s) (IMAGE fstcart c)`,
5519   REPEAT STRIP_TAC THEN
5520   MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`;
5521                  `(s:real^M->bool) PCROSS (t:real^N->bool)`;
5522                  `s:real^M->bool`]
5523         PROPER_MAP) THEN
5524   ASM_SIMP_TAC[PROPER_MAP_FSTCART; IMAGE_FSTCART_PCROSS] THEN
5525   ASM SET_TAC[]);;
5526
5527 let PROPER_MAP_SNDCART = prove
5528  (`!s:real^M->bool t:real^N->bool k.
5529         compact s /\ k SUBSET t /\ compact k
5530         ==> compact {z | z IN s PCROSS t /\ sndcart z IN k}`,
5531   REPEAT STRIP_TAC THEN SUBGOAL_THEN
5532    `{z | z IN s PCROSS t /\ sndcart z IN k} =
5533     (s:real^M->bool) PCROSS (k:real^N->bool)`
5534    (fun th -> ASM_SIMP_TAC[th; COMPACT_PCROSS]) THEN
5535   REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM;
5536               PASTECART_IN_PCROSS; SNDCART_PASTECART] THEN
5537   ASM SET_TAC[]);;
5538
5539 let CLOSED_MAP_SNDCART = prove
5540  (`!s:real^M->bool t:real^N->bool c.
5541         compact s /\ closed_in (subtopology euclidean (s PCROSS t)) c
5542         ==> closed_in (subtopology euclidean t) (IMAGE sndcart c)`,
5543   REPEAT STRIP_TAC THEN
5544   MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`;
5545                  `(s:real^M->bool) PCROSS (t:real^N->bool)`;
5546                  `t:real^N->bool`]
5547         PROPER_MAP) THEN
5548   ASM_SIMP_TAC[PROPER_MAP_SNDCART; IMAGE_SNDCART_PCROSS] THEN
5549   ASM SET_TAC[]);;
5550
5551 let CLOSED_IN_COMPACT_PROJECTION = prove
5552  (`!s:real^M->bool t:real^N->bool u.
5553     compact s /\ closed_in (subtopology euclidean (s PCROSS t)) u
5554     ==> closed_in (subtopology euclidean t)
5555                   {y | ?x. x IN s /\ pastecart x y IN u}`,
5556   REPEAT GEN_TAC THEN DISCH_TAC THEN
5557   FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_MAP_SNDCART) THEN
5558   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
5559   FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET o CONJUNCT2) THEN
5560   REWRITE_TAC[EXTENSION; SUBSET; IN_IMAGE; FORALL_PASTECART; EXISTS_PASTECART;
5561               PASTECART_IN_PCROSS; IN_ELIM_THM; SNDCART_PASTECART] THEN
5562   SET_TAC[]);;
5563
5564 let CLOSED_COMPACT_PROJECTION = prove
5565  (`!s:real^M->bool t:real^(M,N)finite_sum->bool.
5566       compact s /\ closed t ==> closed {y | ?x. x IN s /\ pastecart x y IN t}`,
5567   REPEAT STRIP_TAC THEN
5568   SUBGOAL_THEN
5569    `{y | ?x:real^M. x IN s /\ pastecart x y IN t} =
5570     {y | ?x. x IN s /\ pastecart x y IN ((s PCROSS (:real^N)) INTER t)}`
5571   SUBST1_TAC THENL
5572    [REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV; IN_INTER] THEN SET_TAC[];
5573     MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN
5574     EXISTS_TAC `(:real^N)` THEN REWRITE_TAC[CLOSED_UNIV] THEN
5575     MATCH_MP_TAC CLOSED_IN_COMPACT_PROJECTION THEN
5576     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_SUBSET THEN
5577     ASM_SIMP_TAC[CLOSED_INTER; CLOSED_UNIV; CLOSED_PCROSS; COMPACT_IMP_CLOSED;
5578                  INTER_SUBSET]]);;
5579
5580 let TUBE_LEMMA = prove
5581  (`!s:real^M->bool t:real^N->bool u a.
5582         compact s /\ ~(s = {}) /\ {pastecart x a | x IN s} SUBSET u /\
5583         open_in(subtopology euclidean (s PCROSS t)) u
5584         ==> ?v. open_in (subtopology euclidean t) v /\ a IN v /\
5585                 (s PCROSS v) SUBSET u`,
5586   REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN
5587   REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ] THEN
5588   REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
5589   REPEAT STRIP_TAC THEN
5590   FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT; PCROSS]
5591         CLOSED_IN_COMPACT_PROJECTION)) THEN
5592   ASM_REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_DIFF] THEN
5593   REWRITE_TAC[GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(MESON[]
5594    `(closed_in top t ==> s DIFF (s DIFF t) = t) /\
5595     s DIFF t SUBSET s /\ P(s DIFF t)
5596     ==> closed_in top t
5597         ==> ?v. v SUBSET s /\ closed_in top (s DIFF v) /\ P v`) THEN
5598   REWRITE_TAC[SET_RULE `s DIFF (s DIFF t) = t <=> t SUBSET s`] THEN
5599   REWRITE_TAC[SUBSET_DIFF] THEN
5600   SIMP_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
5601   REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN
5602   REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN
5603   CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
5604   REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET])) THEN
5605   REWRITE_TAC[FORALL_IN_GSPEC; IN_SING; FORALL_PASTECART] THEN
5606   REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY]);;
5607
5608 let TUBE_LEMMA_GEN = prove
5609  (`!s t t' u:real^(M,N)finite_sum->bool.
5610         compact s /\ ~(s = {}) /\ t SUBSET t' /\
5611         s PCROSS t SUBSET u /\
5612         open_in (subtopology euclidean (s PCROSS t')) u
5613         ==> ?v. open_in (subtopology euclidean t') v /\
5614                 t SUBSET v /\
5615                 s PCROSS v SUBSET u`,
5616   REPEAT STRIP_TAC THEN
5617   SUBGOAL_THEN
5618    `!a. a IN t ==> ?v. open_in (subtopology euclidean t') v /\ a IN v /\
5619                        (s:real^M->bool) PCROSS (v:real^N->bool) SUBSET u`
5620   MP_TAC THENL
5621    [REPEAT STRIP_TAC THEN MATCH_MP_TAC TUBE_LEMMA THEN
5622     ASM_REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN
5623     REPEAT STRIP_TAC THEN
5624     FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN
5625     ASM_REWRITE_TAC[PASTECART_IN_PCROSS];
5626     GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
5627     REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
5628     X_GEN_TAC `vv:real^N->real^N->bool` THEN DISCH_TAC THEN
5629     EXISTS_TAC `UNIONS (IMAGE (vv:real^N->real^N->bool) t)` THEN
5630     ASM_SIMP_TAC[OPEN_IN_UNIONS; FORALL_IN_IMAGE] THEN
5631     REWRITE_TAC[SUBSET; UNIONS_IMAGE; IN_ELIM_THM; FORALL_IN_PCROSS] THEN
5632     CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
5633     MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^N`] THEN
5634     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `c:real^N`)) THEN
5635     FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N`) THEN
5636     ASM_REWRITE_TAC[SUBSET; FORALL_IN_PCROSS] THEN ASM SET_TAC[]]);;
5637
5638 (* ------------------------------------------------------------------------- *)
5639 (* Pasting functions together on open sets.                                  *)
5640 (* ------------------------------------------------------------------------- *)
5641
5642 let PASTING_LEMMA = prove
5643  (`!f:A->real^M->real^N g t s k.
5644         (!i. i IN k
5645              ==> open_in (subtopology euclidean s) (t i) /\
5646                  (f i) continuous_on (t i)) /\
5647         (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j
5648                  ==> f i x = f j x) /\
5649         (!x. x IN s ==> ?j. j IN k /\ x IN t j /\ g x = f j x)
5650         ==> g continuous_on s`,
5651   REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_OPEN_IN_PREIMAGE_EQ] THEN
5652   STRIP_TAC THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN
5653   SUBGOAL_THEN
5654    `{x | x IN s /\ g x IN u} =
5655     UNIONS {{x | x IN (t i) /\ ((f:A->real^M->real^N) i x) IN u} |
5656             i IN k}`
5657   SUBST1_TAC THENL
5658    [SUBGOAL_THEN `!i. i IN k ==> ((t:A->real^M->bool) i) SUBSET s`
5659     ASSUME_TAC THENL
5660      [ASM_MESON_TAC[OPEN_IN_SUBSET; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY];
5661       REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]];
5662     MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN
5663     ASM_MESON_TAC[OPEN_IN_TRANS]]);;
5664
5665 let PASTING_LEMMA_EXISTS = prove
5666  (`!f:A->real^M->real^N t s k.
5667         s SUBSET UNIONS {t i | i IN k} /\
5668         (!i. i IN k
5669              ==> open_in (subtopology euclidean s) (t i) /\
5670                  (f i) continuous_on (t i)) /\
5671         (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j
5672                  ==> f i x = f j x)
5673         ==> ?g. g continuous_on s /\
5674                 (!x i. i IN k /\ x IN s INTER t i ==> g x = f i x)`,
5675   REPEAT STRIP_TAC THEN
5676   EXISTS_TAC `\x. (f:A->real^M->real^N)(@i. i IN k /\ x IN t i) x` THEN
5677   CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC PASTING_LEMMA THEN
5678   MAP_EVERY EXISTS_TAC
5679    [`f:A->real^M->real^N`; `t:A->real^M->bool`; `k:A->bool`] THEN
5680   ASM SET_TAC[]);;
5681
5682 let CONTINUOUS_ON_UNION_LOCAL_OPEN = prove
5683  (`!f:real^M->real^N s.
5684         open_in (subtopology euclidean (s UNION t)) s /\
5685         open_in (subtopology euclidean (s UNION t)) t /\
5686         f continuous_on s /\ f continuous_on t
5687         ==> f continuous_on (s UNION t)`,
5688   REPEAT STRIP_TAC THEN MP_TAC(ISPECL
5689    [`\i:(real^M->bool). (f:real^M->real^N)`; `f:real^M->real^N`;
5690     `\i:(real^M->bool). i`; `s UNION t:real^M->bool`; `{s:real^M->bool,t}`]
5691    PASTING_LEMMA) THEN DISCH_THEN MATCH_MP_TAC THEN
5692   ASM_REWRITE_TAC[FORALL_IN_INSERT; EXISTS_IN_INSERT; NOT_IN_EMPTY] THEN
5693   REWRITE_TAC[IN_UNION]);;
5694
5695 let CONTINUOUS_ON_UNION_OPEN = prove
5696  (`!f s t. open s /\ open t /\ f continuous_on s /\ f continuous_on t
5697            ==> f continuous_on (s UNION t)`,
5698   REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL_OPEN THEN
5699   ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC OPEN_OPEN_IN_TRANS THEN
5700   ASM_SIMP_TAC[OPEN_UNION] THEN SET_TAC[]);;
5701
5702 let CONTINUOUS_ON_CASES_LOCAL_OPEN = prove
5703  (`!P f g:real^M->real^N s t.
5704         open_in (subtopology euclidean (s UNION t)) s /\
5705         open_in (subtopology euclidean (s UNION t)) t /\
5706         f continuous_on s /\ g continuous_on t /\
5707         (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x)
5708         ==> (\x. if P x then f x else g x) continuous_on (s UNION t)`,
5709   REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL_OPEN THEN
5710   ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL
5711    [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^M->real^N`] THEN
5712   ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);;
5713
5714 let CONTINUOUS_ON_CASES_OPEN = prove
5715  (`!P f g s t.
5716            open s /\
5717            open t /\
5718            f continuous_on s /\
5719            g continuous_on t /\
5720            (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x)
5721            ==> (\x. if P x then f x else g x) continuous_on s UNION t`,
5722   REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL_OPEN THEN
5723   ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC OPEN_OPEN_IN_TRANS THEN
5724   ASM_SIMP_TAC[OPEN_UNION] THEN SET_TAC[]);;
5725
5726 (* ------------------------------------------------------------------------- *)
5727 (* Likewise on closed sets, with a finiteness assumption.                    *)
5728 (* ------------------------------------------------------------------------- *)
5729
5730 let PASTING_LEMMA_CLOSED = prove
5731  (`!f:A->real^M->real^N g t s k.
5732         FINITE k /\
5733         (!i. i IN k
5734              ==> closed_in (subtopology euclidean s) (t i) /\
5735                  (f i) continuous_on (t i)) /\
5736         (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j
5737                  ==> f i x = f j x) /\
5738         (!x. x IN s ==> ?j. j IN k /\ x IN t j /\ g x = f j x)
5739         ==> g continuous_on s`,
5740   REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_EQ] THEN
5741   STRIP_TAC THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN
5742   SUBGOAL_THEN
5743    `{x | x IN s /\ g x IN u} =
5744     UNIONS {{x | x IN (t i) /\ ((f:A->real^M->real^N) i x) IN u} |
5745             i IN k}`
5746   SUBST1_TAC THENL
5747    [SUBGOAL_THEN `!i. i IN k ==> ((t:A->real^M->bool) i) SUBSET s`
5748     ASSUME_TAC THENL
5749      [ASM_MESON_TAC[CLOSED_IN_SUBSET; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY];
5750       REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]];
5751     MATCH_MP_TAC CLOSED_IN_UNIONS THEN
5752     ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN
5753     ASM_MESON_TAC[CLOSED_IN_TRANS]]);;
5754
5755 let PASTING_LEMMA_EXISTS_CLOSED = prove
5756  (`!f:A->real^M->real^N t s k.
5757         FINITE k /\
5758         s SUBSET UNIONS {t i | i IN k} /\
5759         (!i. i IN k
5760              ==> closed_in (subtopology euclidean s) (t i) /\
5761                  (f i) continuous_on (t i)) /\
5762         (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j
5763                  ==> f i x = f j x)
5764         ==> ?g. g continuous_on s /\
5765                 (!x i. i IN k /\ x IN s INTER t i ==> g x = f i x)`,
5766   REPEAT STRIP_TAC THEN
5767   EXISTS_TAC `\x. (f:A->real^M->real^N)(@i. i IN k /\ x IN t i) x` THEN
5768   CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
5769   MATCH_MP_TAC PASTING_LEMMA_CLOSED THEN
5770   MAP_EVERY EXISTS_TAC
5771    [`f:A->real^M->real^N`; `t:A->real^M->bool`; `k:A->bool`] THEN
5772   ASM SET_TAC[]);;
5773
5774 (* ------------------------------------------------------------------------- *)
5775 (* Closure of halflines, halfspaces and hyperplanes.                         *)
5776 (* ------------------------------------------------------------------------- *)
5777
5778 let LIM_LIFT_DOT = prove
5779  (`!f:real^M->real^N a.
5780         (f --> l) net ==> ((lift o (\y. a dot f(y))) --> lift(a dot l)) net`,
5781   REPEAT GEN_TAC THEN ASM_CASES_TAC `a = vec 0:real^N` THENL
5782    [ASM_REWRITE_TAC[DOT_LZERO; LIFT_NUM; o_DEF; LIM_CONST]; ALL_TAC] THEN
5783   REWRITE_TAC[LIM] THEN MATCH_MP_TAC MONO_OR THEN REWRITE_TAC[] THEN
5784   DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5785   FIRST_X_ASSUM(MP_TAC o SPEC `e / norm(a:real^N)`) THEN
5786   ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; REAL_LT_RDIV_EQ] THEN
5787   REWRITE_TAC[dist; o_THM; GSYM LIFT_SUB; GSYM DOT_RSUB; NORM_LIFT] THEN
5788   ONCE_REWRITE_TAC[DOT_SYM] THEN
5789   MESON_TAC[NORM_CAUCHY_SCHWARZ_ABS; REAL_MUL_SYM; REAL_LET_TRANS]);;
5790
5791 let CONTINUOUS_AT_LIFT_DOT = prove
5792  (`!a:real^N x. (lift o (\y. a dot y)) continuous at x`,
5793   REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_AT; o_THM] THEN
5794   MATCH_MP_TAC LIM_LIFT_DOT THEN REWRITE_TAC[LIM_AT] THEN MESON_TAC[]);;
5795
5796 let CONTINUOUS_ON_LIFT_DOT = prove
5797  (`!s. (lift o (\y. a dot y)) continuous_on s`,
5798   SIMP_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_LIFT_DOT]);;
5799
5800 let CLOSED_INTERVAL_LEFT = prove
5801  (`!b:real^N.
5802      closed
5803         {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> x$i <= b$i}`,
5804   REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE; IN_ELIM_THM] THEN
5805   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN
5806   FIRST_X_ASSUM(MP_TAC o SPEC `(x:real^N)$i - (b:real^N)$i`) THEN
5807   ASM_REWRITE_TAC[REAL_SUB_LT] THEN
5808   DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN
5809   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5810   REWRITE_TAC[dist; REAL_NOT_LT] THEN
5811   MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((z - x :real^N)$i)` THEN
5812   ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN
5813   ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN
5814   ASM_SIMP_TAC[REAL_ARITH `z <= b /\ b < x ==> x - b <= abs(z - x)`]);;
5815
5816 let CLOSED_INTERVAL_RIGHT = prove
5817  (`!a:real^N.
5818      closed
5819         {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= x$i}`,
5820   REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE; IN_ELIM_THM] THEN
5821   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN
5822   FIRST_X_ASSUM(MP_TAC o SPEC `(a:real^N)$i - (x:real^N)$i`) THEN
5823   ASM_REWRITE_TAC[REAL_SUB_LT] THEN
5824   DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN
5825   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5826   REWRITE_TAC[dist; REAL_NOT_LT] THEN
5827   MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((z - x :real^N)$i)` THEN
5828   ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN
5829   ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN
5830   ASM_SIMP_TAC[REAL_ARITH `x < a /\ a <= z ==> a - x <= abs(z - x)`]);;
5831
5832 let CLOSED_HALFSPACE_LE = prove
5833  (`!a:real^N b. closed {x | a dot x <= b}`,
5834   REPEAT GEN_TAC THEN
5835   MP_TAC(ISPEC `(:real^N)` CONTINUOUS_ON_LIFT_DOT) THEN
5836   REWRITE_TAC[CONTINUOUS_ON_CLOSED; GSYM CLOSED_IN; SUBTOPOLOGY_UNIV] THEN
5837   DISCH_THEN(MP_TAC o SPEC
5838    `IMAGE lift {r | ?x:real^N. (a dot x = r) /\ r <= b}`) THEN
5839   ANTS_TAC THENL
5840    [ALL_TAC;
5841     MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
5842     REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_UNIV] THEN
5843     REWRITE_TAC[o_DEF] THEN MESON_TAC[LIFT_DROP]] THEN
5844   REWRITE_TAC[CLOSED_IN_CLOSED] THEN
5845   EXISTS_TAC `{x | !i. 1 <= i /\ i <= dimindex(:1)
5846                        ==> (x:real^1)$i <= (lift b)$i}` THEN
5847   REWRITE_TAC[CLOSED_INTERVAL_LEFT] THEN
5848   SIMP_TAC[EXTENSION; IN_IMAGE; IN_UNIV; IN_ELIM_THM; IN_INTER;
5849     VEC_COMPONENT; DIMINDEX_1; LAMBDA_BETA; o_THM] THEN
5850   SIMP_TAC[ARITH_RULE `1 <= i /\ i <= 1 <=> (i = 1)`] THEN
5851   REWRITE_TAC[GSYM drop; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN
5852   MESON_TAC[LIFT_DROP]);;
5853
5854 let CLOSED_HALFSPACE_GE = prove
5855  (`!a:real^N b. closed {x | a dot x >= b}`,
5856   REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`] THEN
5857   REWRITE_TAC[GSYM DOT_LNEG; CLOSED_HALFSPACE_LE]);;
5858
5859 let CLOSED_HYPERPLANE = prove
5860  (`!a b. closed {x | a dot x = b}`,
5861   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
5862   REWRITE_TAC[REAL_ARITH `b <= a dot x <=> a dot x >= b`] THEN
5863   REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN
5864   SIMP_TAC[CLOSED_INTER; CLOSED_HALFSPACE_LE; CLOSED_HALFSPACE_GE]);;
5865
5866 let CLOSED_STANDARD_HYPERPLANE = prove
5867  (`!k a. closed {x:real^N | x$k = a}`,
5868   REPEAT GEN_TAC THEN
5869   SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i`
5870   CHOOSE_TAC THENL
5871    [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
5872   MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSED_HYPERPLANE) THEN
5873   ASM_SIMP_TAC[DOT_BASIS]);;
5874
5875 let CLOSED_HALFSPACE_COMPONENT_LE = prove
5876  (`!a k. closed {x:real^N | x$k <= a}`,
5877   REPEAT GEN_TAC THEN
5878   SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i`
5879   CHOOSE_TAC THENL
5880    [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
5881   MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSED_HALFSPACE_LE) THEN
5882   ASM_SIMP_TAC[DOT_BASIS]);;
5883
5884 let CLOSED_HALFSPACE_COMPONENT_GE = prove
5885  (`!a k. closed {x:real^N | x$k >= a}`,
5886   REPEAT GEN_TAC THEN
5887   SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i`
5888   CHOOSE_TAC THENL
5889    [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
5890   MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSED_HALFSPACE_GE) THEN
5891   ASM_SIMP_TAC[DOT_BASIS]);;
5892
5893 (* ------------------------------------------------------------------------- *)
5894 (* Openness of halfspaces.                                                   *)
5895 (* ------------------------------------------------------------------------- *)
5896
5897 let OPEN_HALFSPACE_LT = prove
5898  (`!a b. open {x | a dot x < b}`,
5899   REWRITE_TAC[GSYM REAL_NOT_LE] THEN
5900   REWRITE_TAC[SET_RULE `{x | ~p x} = UNIV DIFF {x | p x}`] THEN
5901   REWRITE_TAC[GSYM closed; GSYM real_ge; CLOSED_HALFSPACE_GE]);;
5902
5903 let OPEN_HALFSPACE_COMPONENT_LT = prove
5904  (`!a k. open {x:real^N | x$k < a}`,
5905   REPEAT GEN_TAC THEN
5906   SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i`
5907   CHOOSE_TAC THENL
5908    [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
5909   MP_TAC(ISPECL [`basis i:real^N`; `a:real`] OPEN_HALFSPACE_LT) THEN
5910   ASM_SIMP_TAC[DOT_BASIS]);;
5911
5912 let OPEN_HALFSPACE_GT = prove
5913  (`!a b. open {x | a dot x > b}`,
5914   REWRITE_TAC[REAL_ARITH `x > y <=> ~(x <= y)`] THEN
5915   REWRITE_TAC[SET_RULE `{x | ~p x} = UNIV DIFF {x | p x}`] THEN
5916   REWRITE_TAC[GSYM closed; CLOSED_HALFSPACE_LE]);;
5917
5918 let OPEN_HALFSPACE_COMPONENT_GT = prove
5919  (`!a k. open {x:real^N | x$k > a}`,
5920   REPEAT GEN_TAC THEN
5921   SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i`
5922   CHOOSE_TAC THENL
5923    [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
5924   MP_TAC(ISPECL [`basis i:real^N`; `a:real`] OPEN_HALFSPACE_GT) THEN
5925   ASM_SIMP_TAC[DOT_BASIS]);;
5926
5927 let OPEN_POSITIVE_MULTIPLES = prove
5928  (`!s:real^N->bool. open s ==> open {c % x | &0 < c /\ x IN s}`,
5929   REWRITE_TAC[open_def; FORALL_IN_GSPEC] THEN GEN_TAC THEN DISCH_TAC THEN
5930   MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN STRIP_TAC THEN
5931   FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
5932   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
5933   EXISTS_TAC `c * e:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN
5934   X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN
5935   FIRST_X_ASSUM(MP_TAC o SPEC `inv(c) % y:real^N`) THEN ANTS_TAC THENL
5936    [SUBGOAL_THEN `x:real^N = inv c % c % x` SUBST1_TAC THENL
5937      [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID;
5938                    REAL_LT_IMP_NZ];
5939       ASM_SIMP_TAC[DIST_MUL; real_abs; REAL_LT_INV_EQ; REAL_LT_IMP_LE] THEN
5940       ONCE_REWRITE_TAC[REAL_ARITH `inv c * x:real = x / c`] THEN
5941       ASM_MESON_TAC[REAL_LT_LDIV_EQ; REAL_MUL_SYM]];
5942     DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN
5943     EXISTS_TAC `c:real` THEN EXISTS_TAC `inv(c) % y:real^N` THEN
5944     ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN
5945     VECTOR_ARITH_TAC]);;
5946
5947 (* ------------------------------------------------------------------------- *)
5948 (* Closures and interiors of halfspaces.                                     *)
5949 (* ------------------------------------------------------------------------- *)
5950
5951 let INTERIOR_HALFSPACE_LE = prove
5952  (`!a:real^N b.
5953         ~(a = vec 0) ==> interior {x | a dot x <= b} = {x | a dot x < b}`,
5954   REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_UNIQUE THEN
5955   SIMP_TAC[OPEN_HALFSPACE_LT; SUBSET; IN_ELIM_THM; REAL_LT_IMP_LE] THEN
5956   X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN
5957   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ASM_SIMP_TAC[REAL_LT_LE] THEN
5958   DISCH_TAC THEN
5959   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
5960   DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
5961   DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
5962   REWRITE_TAC[SUBSET; IN_CBALL] THEN
5963   DISCH_THEN(MP_TAC o SPEC `x + e / norm(a) % a:real^N`) THEN
5964   REWRITE_TAC[NORM_ARITH `dist(x:real^N,x + y) = norm y`] THEN
5965   ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL;
5966                NORM_EQ_0; REAL_ARITH `&0 < x ==> abs x <= x`] THEN
5967   DISCH_TAC THEN
5968   FIRST_X_ASSUM(MP_TAC o SPEC  `x + e / norm(a) % a:real^N`) THEN
5969   ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN
5970   MATCH_MP_TAC(REAL_ARITH `&0 < e ==> ~(b + e <= b)`) THEN
5971   ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; NORM_POS_LT; DOT_POS_LT]);;
5972
5973 let INTERIOR_HALFSPACE_GE = prove
5974  (`!a:real^N b.
5975         ~(a = vec 0) ==> interior {x | a dot x >= b} = {x | a dot x > b}`,
5976   REPEAT STRIP_TAC THEN
5977   ONCE_REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`;
5978                    REAL_ARITH `a > b <=> --a < --b`] THEN
5979   ASM_SIMP_TAC[GSYM DOT_LNEG; INTERIOR_HALFSPACE_LE; VECTOR_NEG_EQ_0]);;
5980
5981 let INTERIOR_HALFSPACE_COMPONENT_LE = prove
5982  (`!a k. interior {x:real^N | x$k <= a} = {x | x$k < a}`,
5983   REPEAT GEN_TAC THEN
5984   SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i`
5985   CHOOSE_TAC THENL
5986    [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
5987   MP_TAC(ISPECL [`basis i:real^N`; `a:real`] INTERIOR_HALFSPACE_LE) THEN
5988   ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);;
5989
5990 let INTERIOR_HALFSPACE_COMPONENT_GE = prove
5991  (`!a k. interior {x:real^N | x$k >= a} = {x | x$k > a}`,
5992   REPEAT GEN_TAC THEN
5993   SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i`
5994   CHOOSE_TAC THENL
5995    [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
5996   MP_TAC(ISPECL [`basis i:real^N`; `a:real`] INTERIOR_HALFSPACE_GE) THEN
5997   ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);;
5998
5999 let CLOSURE_HALFSPACE_LT = prove
6000  (`!a:real^N b.
6001         ~(a = vec 0) ==> closure {x | a dot x < b} = {x | a dot x <= b}`,
6002   REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSURE_INTERIOR] THEN
6003   REWRITE_TAC[SET_RULE `UNIV DIFF {x | P x} = {x | ~P x}`] THEN
6004   ASM_SIMP_TAC[REAL_ARITH `~(x < b) <=> x >= b`; INTERIOR_HALFSPACE_GE] THEN
6005   REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN REAL_ARITH_TAC);;
6006
6007 let CLOSURE_HALFSPACE_GT = prove
6008  (`!a:real^N b.
6009         ~(a = vec 0) ==> closure {x | a dot x > b} = {x | a dot x >= b}`,
6010   REPEAT STRIP_TAC THEN
6011   ONCE_REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`;
6012                    REAL_ARITH `a > b <=> --a < --b`] THEN
6013   ASM_SIMP_TAC[GSYM DOT_LNEG; CLOSURE_HALFSPACE_LT; VECTOR_NEG_EQ_0]);;
6014
6015 let CLOSURE_HALFSPACE_COMPONENT_LT = prove
6016  (`!a k. closure {x:real^N | x$k < a} = {x | x$k <= a}`,
6017   REPEAT GEN_TAC THEN
6018   SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i`
6019   CHOOSE_TAC THENL
6020    [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
6021   MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSURE_HALFSPACE_LT) THEN
6022   ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);;
6023
6024 let CLOSURE_HALFSPACE_COMPONENT_GT = prove
6025  (`!a k. closure {x:real^N | x$k > a} = {x | x$k >= a}`,
6026   REPEAT GEN_TAC THEN
6027   SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i`
6028   CHOOSE_TAC THENL
6029    [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
6030   MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSURE_HALFSPACE_GT) THEN
6031   ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);;
6032
6033 let INTERIOR_HYPERPLANE = prove
6034  (`!a b. ~(a = vec 0) ==> interior {x | a dot x = b} = {}`,
6035   REWRITE_TAC[REAL_ARITH `x = y <=> x <= y /\ x >= y`] THEN
6036   REWRITE_TAC[SET_RULE `{x | p x /\ q x} = {x | p x} INTER {x | q x}`] THEN
6037   REWRITE_TAC[INTERIOR_INTER] THEN
6038   ASM_SIMP_TAC[INTERIOR_HALFSPACE_LE; INTERIOR_HALFSPACE_GE] THEN
6039   REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN
6040   REAL_ARITH_TAC);;
6041
6042 let FRONTIER_HALFSPACE_LE = prove
6043  (`!a:real^N b. ~(a = vec 0 /\ b = &0)
6044                 ==> frontier {x | a dot x <= b} = {x | a dot x = b}`,
6045   REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN
6046   ASM_SIMP_TAC[DOT_LZERO] THENL
6047    [ASM_CASES_TAC `&0 <= b` THEN
6048     ASM_REWRITE_TAC[UNIV_GSPEC; FRONTIER_UNIV; EMPTY_GSPEC; FRONTIER_EMPTY];
6049     ASM_SIMP_TAC[frontier; INTERIOR_HALFSPACE_LE; CLOSURE_CLOSED;
6050                  CLOSED_HALFSPACE_LE] THEN
6051     REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN REAL_ARITH_TAC]);;
6052
6053 let FRONTIER_HALFSPACE_GE = prove
6054  (`!a:real^N b. ~(a = vec 0 /\ b = &0)
6055                 ==> frontier {x | a dot x >= b} = {x | a dot x = b}`,
6056   REPEAT STRIP_TAC THEN
6057   MP_TAC(ISPECL [`--a:real^N`; `--b:real`] FRONTIER_HALFSPACE_LE) THEN
6058   ASM_REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_NEG_EQ_0; DOT_LNEG] THEN
6059   REWRITE_TAC[REAL_LE_NEG2; REAL_EQ_NEG2; real_ge]);;
6060
6061 let FRONTIER_HALFSPACE_LT = prove
6062  (`!a:real^N b. ~(a = vec 0 /\ b = &0)
6063                 ==> frontier {x | a dot x < b} = {x | a dot x = b}`,
6064   REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN
6065   ASM_SIMP_TAC[DOT_LZERO] THENL
6066    [ASM_CASES_TAC `&0 < b` THEN
6067     ASM_REWRITE_TAC[UNIV_GSPEC; FRONTIER_UNIV; EMPTY_GSPEC; FRONTIER_EMPTY];
6068     ASM_SIMP_TAC[frontier; CLOSURE_HALFSPACE_LT; INTERIOR_OPEN;
6069                  OPEN_HALFSPACE_LT] THEN
6070     REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN REAL_ARITH_TAC]);;
6071
6072 let FRONTIER_HALFSPACE_GT = prove
6073  (`!a:real^N b. ~(a = vec 0 /\ b = &0)
6074                 ==> frontier {x | a dot x > b} = {x | a dot x = b}`,
6075   REPEAT STRIP_TAC THEN
6076   MP_TAC(ISPECL [`--a:real^N`; `--b:real`] FRONTIER_HALFSPACE_LT) THEN
6077   ASM_REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_NEG_EQ_0; DOT_LNEG] THEN
6078   REWRITE_TAC[REAL_LT_NEG2; REAL_EQ_NEG2; real_gt]);;
6079
6080 let INTERIOR_STANDARD_HYPERPLANE = prove
6081  (`!k a. interior {x:real^N | x$k = a} = {}`,
6082   REPEAT GEN_TAC THEN
6083   SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i`
6084   CHOOSE_TAC THENL
6085    [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
6086   MP_TAC(ISPECL [`basis i:real^N`; `a:real`] INTERIOR_HYPERPLANE) THEN
6087   ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);;
6088
6089 let EMPTY_INTERIOR_LOWDIM = prove
6090  (`!s:real^N->bool. dim(s) < dimindex(:N) ==> interior s = {}`,
6091   GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LOWDIM_SUBSET_HYPERPLANE) THEN
6092   DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
6093   MATCH_MP_TAC(SET_RULE
6094    `!t u. s SUBSET t /\ t SUBSET u /\ u = {} ==> s = {}`) THEN
6095   MAP_EVERY EXISTS_TAC
6096    [`interior(span(s):real^N->bool)`;
6097     `interior({x:real^N | a dot x = &0})`] THEN
6098   ASM_SIMP_TAC[SUBSET_INTERIOR; SPAN_INC; INTERIOR_HYPERPLANE]);;
6099
6100 (* ------------------------------------------------------------------------- *)
6101 (* Unboundedness of halfspaces.                                              *)
6102 (* ------------------------------------------------------------------------- *)
6103
6104 let UNBOUNDED_HALFSPACE_COMPONENT_LE = prove
6105  (`!a k. ~bounded {x:real^N | x$k <= a}`,
6106   REPEAT GEN_TAC THEN
6107   SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !z:real^N. z$k = z$i`
6108   CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
6109   ASM_REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN
6110   DISCH_THEN(X_CHOOSE_THEN `B:real` MP_TAC) THEN
6111   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN
6112   EXISTS_TAC `--(&1 + max (abs B) (abs a)) % basis i:real^N` THEN
6113   ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; BASIS_COMPONENT;
6114                VECTOR_MUL_COMPONENT] THEN
6115   REAL_ARITH_TAC);;
6116
6117 let UNBOUNDED_HALFSPACE_COMPONENT_GE = prove
6118  (`!a k. ~bounded {x:real^N | x$k >= a}`,
6119   REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_NEGATIONS) THEN
6120   MP_TAC(SPECL [`--a:real`; `k:num`] UNBOUNDED_HALFSPACE_COMPONENT_LE) THEN
6121   REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC EQ_IMP THEN
6122   AP_TERM_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL
6123    [MESON_TAC[VECTOR_NEG_NEG];
6124     REWRITE_TAC[IN_ELIM_THM; VECTOR_NEG_COMPONENT] THEN REAL_ARITH_TAC]);;
6125
6126 let UNBOUNDED_HALFSPACE_COMPONENT_LT = prove
6127  (`!a k. ~bounded {x:real^N | x$k < a}`,
6128   ONCE_REWRITE_TAC[GSYM BOUNDED_CLOSURE_EQ] THEN
6129   REWRITE_TAC[CLOSURE_HALFSPACE_COMPONENT_LT;
6130               UNBOUNDED_HALFSPACE_COMPONENT_LE]);;
6131
6132 let UNBOUNDED_HALFSPACE_COMPONENT_GT = prove
6133  (`!a k. ~bounded {x:real^N | x$k > a}`,
6134   ONCE_REWRITE_TAC[GSYM BOUNDED_CLOSURE_EQ] THEN
6135   REWRITE_TAC[CLOSURE_HALFSPACE_COMPONENT_GT;
6136               UNBOUNDED_HALFSPACE_COMPONENT_GE]);;
6137
6138 let BOUNDED_HALFSPACE_LE = prove
6139  (`!a:real^N b. bounded {x | a dot x <= b} <=> a = vec 0 /\ b < &0`,
6140   GEOM_BASIS_MULTIPLE_TAC 1 `a:real^N` THEN
6141   SIMP_TAC[DOT_LMUL; DOT_BASIS; VECTOR_MUL_EQ_0; DIMINDEX_GE_1; LE_REFL;
6142            BASIS_NONZERO] THEN
6143   X_GEN_TAC `a:real` THEN ASM_CASES_TAC `a = &0` THEN ASM_REWRITE_TAC[] THEN
6144   DISCH_TAC THEN X_GEN_TAC `b:real` THENL
6145    [REWRITE_TAC[REAL_MUL_LZERO; DOT_LZERO; GSYM REAL_NOT_LE] THEN
6146     ASM_CASES_TAC `&0 <= b` THEN
6147     ASM_REWRITE_TAC[BOUNDED_EMPTY; NOT_BOUNDED_UNIV;
6148                     SET_RULE `{x | T} = UNIV`; EMPTY_GSPEC];
6149     ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
6150     ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_LE;
6151                  UNBOUNDED_HALFSPACE_COMPONENT_LE]]);;
6152
6153 let BOUNDED_HALFSPACE_GE = prove
6154  (`!a:real^N b. bounded {x | a dot x >= b} <=> a = vec 0 /\ &0 < b`,
6155   REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`] THEN
6156   REWRITE_TAC[GSYM DOT_LNEG; BOUNDED_HALFSPACE_LE] THEN
6157   REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_ARITH `--b < &0 <=> &0 < b`]);;
6158
6159 let BOUNDED_HALFSPACE_LT = prove
6160  (`!a:real^N b. bounded {x | a dot x < b} <=> a = vec 0 /\ b <= &0`,
6161   REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN
6162   ASM_REWRITE_TAC[] THENL
6163    [REWRITE_TAC[DOT_LZERO; GSYM REAL_NOT_LE] THEN ASM_CASES_TAC `b <= &0` THEN
6164     ASM_REWRITE_TAC[BOUNDED_EMPTY; NOT_BOUNDED_UNIV;
6165                     SET_RULE `{x | T} = UNIV`; EMPTY_GSPEC];
6166     ONCE_REWRITE_TAC[GSYM BOUNDED_CLOSURE_EQ] THEN
6167     ASM_SIMP_TAC[CLOSURE_HALFSPACE_LT; BOUNDED_HALFSPACE_LE]]);;
6168
6169 let BOUNDED_HALFSPACE_GT = prove
6170  (`!a:real^N b. bounded {x | a dot x > b} <=> a = vec 0 /\ &0 <= b`,
6171   REWRITE_TAC[REAL_ARITH `a > b <=> --a < --b`] THEN
6172   REWRITE_TAC[GSYM DOT_LNEG; BOUNDED_HALFSPACE_LT] THEN
6173   REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_ARITH `--b <= &0 <=> &0 <= b`]);;
6174
6175 (* ------------------------------------------------------------------------- *)
6176 (* Equality of continuous functions on closure and related results.          *)
6177 (* ------------------------------------------------------------------------- *)
6178
6179 let FORALL_IN_CLOSURE = prove
6180  (`!f:real^M->real^N s t.
6181         closed t /\ f continuous_on (closure s) /\
6182         (!x. x IN s ==> f x IN t)
6183         ==> (!x. x IN closure s ==> f x IN t)`,
6184   REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=>
6185                         s SUBSET {x | x IN s /\ f x IN t}`] THEN
6186   REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN
6187   ASM_REWRITE_TAC[CLOSED_CLOSURE] THEN CONJ_TAC THENL
6188    [MP_TAC(ISPEC `s:real^M->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[];
6189     MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
6190     ASM_REWRITE_TAC[CLOSED_CLOSURE]]);;
6191
6192 let FORALL_IN_CLOSURE_EQ = prove
6193  (`!f s t.
6194          closed t /\ f continuous_on closure s
6195          ==> ((!x. x IN closure s ==> f x IN t) <=>
6196               (!x. x IN s ==> f x IN t))`,
6197   MESON_TAC[FORALL_IN_CLOSURE; CLOSURE_SUBSET; SUBSET]);;
6198
6199 let SUP_CLOSURE = prove
6200  (`!s. sup(IMAGE drop (closure s)) = sup(IMAGE drop s)`,
6201   GEN_TAC THEN MATCH_MP_TAC SUP_EQ THEN
6202   REWRITE_TAC[FORALL_IN_IMAGE] THEN GEN_TAC THEN
6203   ONCE_REWRITE_TAC[SET_RULE `drop x <= b <=> x IN {x | drop x <= b}`] THEN
6204   MATCH_MP_TAC FORALL_IN_CLOSURE_EQ THEN
6205   REWRITE_TAC[CONTINUOUS_ON_ID; drop; CLOSED_HALFSPACE_COMPONENT_LE]);;
6206
6207 let INF_CLOSURE = prove
6208  (`!s. inf(IMAGE drop (closure s)) = inf(IMAGE drop s)`,
6209   GEN_TAC THEN MATCH_MP_TAC INF_EQ THEN
6210   REWRITE_TAC[FORALL_IN_IMAGE] THEN GEN_TAC THEN
6211   ONCE_REWRITE_TAC[SET_RULE `b <= drop x <=> x IN {x | b <= drop x}`] THEN
6212   MATCH_MP_TAC FORALL_IN_CLOSURE_EQ THEN
6213   REWRITE_TAC[CONTINUOUS_ON_ID; drop; CLOSED_HALFSPACE_COMPONENT_GE;
6214               GSYM real_ge]);;
6215
6216 let CONTINUOUS_LE_ON_CLOSURE = prove
6217  (`!f:real^M->real s a.
6218         (lift o f) continuous_on closure(s) /\ (!x. x IN s ==> f(x) <= a)
6219         ==> !x. x IN closure(s) ==> f(x) <= a`,
6220   let lemma = prove
6221    (`x IN s ==> f x <= a <=> x IN s ==> (lift o f) x IN {y | y$1 <= a}`,
6222     REWRITE_TAC[IN_ELIM_THM; o_THM; GSYM drop; LIFT_DROP]) in
6223   REWRITE_TAC[lemma] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
6224   MATCH_MP_TAC FORALL_IN_CLOSURE THEN
6225   ASM_REWRITE_TAC[ETA_AX; CLOSED_HALFSPACE_COMPONENT_LE]);;
6226
6227 let CONTINUOUS_GE_ON_CLOSURE = prove
6228  (`!f:real^M->real s a.
6229         (lift o f) continuous_on closure(s) /\ (!x. x IN s ==> a <= f(x))
6230         ==> !x. x IN closure(s) ==> a <= f(x)`,
6231   let lemma = prove
6232    (`x IN s ==> a <= f x <=> x IN s ==> (lift o f) x IN {y | y$1 >= a}`,
6233     REWRITE_TAC[IN_ELIM_THM; o_THM; GSYM drop; real_ge; LIFT_DROP]) in
6234   REWRITE_TAC[lemma] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
6235   MATCH_MP_TAC FORALL_IN_CLOSURE THEN
6236   ASM_REWRITE_TAC[ETA_AX; CLOSED_HALFSPACE_COMPONENT_GE]);;
6237
6238 let CONTINUOUS_CONSTANT_ON_CLOSURE = prove
6239  (`!f:real^M->real^N s a.
6240         f continuous_on closure(s) /\ (!x. x IN s ==> f(x) = a)
6241         ==> !x. x IN closure(s) ==> f(x) = a`,
6242   REWRITE_TAC[SET_RULE
6243    `x IN s ==> f x = a <=> x IN s ==> f x IN {a}`] THEN
6244   REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC FORALL_IN_CLOSURE THEN
6245   ASM_REWRITE_TAC[CLOSED_SING]);;
6246
6247 let CONTINUOUS_AGREE_ON_CLOSURE = prove
6248  (`!g h:real^M->real^N.
6249         g continuous_on closure s /\ h continuous_on closure s /\
6250         (!x. x IN s ==> g x = h x)
6251         ==> !x. x IN closure s ==> g x = h x`,
6252   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN STRIP_TAC THEN
6253   MATCH_MP_TAC CONTINUOUS_CONSTANT_ON_CLOSURE THEN
6254   ASM_SIMP_TAC[CONTINUOUS_ON_SUB]);;
6255
6256 let CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT = prove
6257  (`!f:real^M->real^N s a.
6258         f continuous_on s
6259         ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x = a}`,
6260   REPEAT STRIP_TAC THEN
6261   ONCE_REWRITE_TAC[SET_RULE
6262    `{x | x IN s /\ f(x) = a} = {x | x IN s /\ f(x) IN {a}}`] THEN
6263   MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN
6264   ASM_REWRITE_TAC[CLOSED_SING]);;
6265
6266 let CONTINUOUS_CLOSED_PREIMAGE_CONSTANT = prove
6267  (`!f:real^M->real^N s.
6268       f continuous_on s /\ closed s ==> closed {x | x IN s /\ f(x) = a}`,
6269   REPEAT STRIP_TAC THEN
6270   ASM_CASES_TAC `{x | x IN s /\ (f:real^M->real^N)(x) = a} = {}` THEN
6271   ASM_REWRITE_TAC[CLOSED_EMPTY] THEN ONCE_REWRITE_TAC[SET_RULE
6272    `{x | x IN s /\ f(x) = a} = {x | x IN s /\ f(x) IN {a}}`] THEN
6273   MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
6274   ASM_REWRITE_TAC[CLOSED_SING] THEN ASM SET_TAC[]);;
6275
6276 (* ------------------------------------------------------------------------- *)
6277 (* Theorems relating continuity and uniform continuity to closures.          *)
6278 (* ------------------------------------------------------------------------- *)
6279
6280 let CONTINUOUS_ON_CLOSURE = prove
6281  (`!f:real^M->real^N s.
6282         f continuous_on closure s <=>
6283         !x e. x IN closure s /\ &0 < e
6284               ==> ?d. &0 < d /\
6285                       !y. y IN s /\ dist(y,x) < d ==> dist(f y,f x) < e`,
6286   REPEAT GEN_TAC THEN REWRITE_TAC[continuous_on] THEN
6287   EQ_TAC THENL [MESON_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET]; ALL_TAC] THEN
6288   DISCH_TAC THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
6289   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
6290   FIRST_ASSUM(MP_TAC o SPECL [`x:real^M`; `e / &2`]) THEN
6291   ANTS_TAC THENL [ASM_REWRITE_TAC[REAL_HALF]; ALL_TAC] THEN
6292   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
6293   EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN
6294   X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN
6295   FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^M`; `e / &2`]) THEN
6296   ASM_REWRITE_TAC[REAL_HALF] THEN
6297   DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN
6298   MP_TAC(ISPECL [`y:real^M`; `s:real^M->bool`] CLOSURE_APPROACHABLE) THEN
6299   ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `min k (d / &2)`) THEN
6300   ASM_REWRITE_TAC[REAL_HALF; REAL_LT_MIN] THEN
6301   ASM_MESON_TAC[DIST_SYM; NORM_ARITH
6302     `dist(a,b) < e / &2 /\ dist(b,c) < e / &2 ==> dist(a,c) < e`]);;
6303
6304 let CONTINUOUS_ON_CLOSURE_SEQUENTIALLY = prove
6305  (`!f:real^M->real^N s.
6306         f continuous_on closure s <=>
6307         !x a. a IN closure s /\ (!n. x n IN s) /\ (x --> a) sequentially
6308               ==> ((f o x) --> f a) sequentially`,
6309   REWRITE_TAC[CONTINUOUS_ON_CLOSURE] THEN
6310   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
6311   REWRITE_TAC[IMP_IMP; GSYM continuous_within] THEN
6312   REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY] THEN MESON_TAC[]);;
6313
6314 let UNIFORMLY_CONTINUOUS_ON_CLOSURE = prove
6315  (`!f:real^M->real^N s.
6316         f uniformly_continuous_on s /\ f continuous_on closure s
6317         ==> f uniformly_continuous_on closure s`,
6318   REPEAT GEN_TAC THEN
6319   REWRITE_TAC[uniformly_continuous_on] THEN STRIP_TAC THEN
6320   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
6321   FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN
6322   ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
6323   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
6324   EXISTS_TAC `d / &3` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
6325   MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN
6326   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_on]) THEN
6327   DISCH_THEN(fun th ->
6328     MP_TAC(SPEC `y:real^M` th) THEN MP_TAC(SPEC `x:real^M` th)) THEN
6329   ASM_REWRITE_TAC[] THEN
6330   DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN
6331   ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
6332   DISCH_THEN(X_CHOOSE_THEN `d1:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
6333   MP_TAC(ISPECL [`x:real^M`; `s:real^M->bool`] CLOSURE_APPROACHABLE) THEN
6334   ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `min d1 (d / &3)`) THEN
6335   ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_LT_MIN]] THEN
6336   DISCH_THEN(X_CHOOSE_THEN `x':real^M` STRIP_ASSUME_TAC) THEN
6337   DISCH_THEN(MP_TAC o SPEC `x':real^M`) THEN
6338   ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN DISCH_TAC THEN
6339   DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN
6340   ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
6341   DISCH_THEN(X_CHOOSE_THEN `d2:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
6342   MP_TAC(ISPECL [`y:real^M`; `s:real^M->bool`] CLOSURE_APPROACHABLE) THEN
6343   ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `min d2 (d / &3)`) THEN
6344   ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_LT_MIN]] THEN
6345   DISCH_THEN(X_CHOOSE_THEN `y':real^M` STRIP_ASSUME_TAC) THEN
6346   DISCH_THEN(MP_TAC o SPEC `y':real^M`) THEN
6347   ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN DISCH_TAC THEN
6348   FIRST_X_ASSUM(MP_TAC o SPECL [`x':real^M`; `y':real^M`]) THEN
6349   ASM_MESON_TAC[DIST_SYM; NORM_ARITH
6350    `dist(y,x) < d / &3 /\ dist(x',x) < d / &3 /\ dist(y',y) < d / &3
6351     ==> dist(y',x') < d`]);;
6352
6353 (* ------------------------------------------------------------------------- *)
6354 (* Continuity properties for square roots. We get other forms of this        *)
6355 (* later (transcendentals.ml and realanalysis.ml) but it's nice to have      *)
6356 (* them around earlier.                                                      *)
6357 (* ------------------------------------------------------------------------- *)
6358
6359 let CONTINUOUS_AT_SQRT = prove
6360  (`!a s. &0 < drop a ==>  (lift o sqrt o drop) continuous (at a)`,
6361   REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_at; o_THM; DIST_LIFT] THEN
6362   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
6363   EXISTS_TAC `min (drop a) (e * sqrt(drop a))` THEN
6364   ASM_SIMP_TAC[REAL_LT_MIN; SQRT_POS_LT; REAL_LT_MUL; DIST_REAL] THEN
6365   X_GEN_TAC `b:real^1` THEN REWRITE_TAC[GSYM drop] THEN STRIP_TAC THEN
6366   FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REAL_ARITH
6367    `abs(b - a) < a ==> &0 < b`)) THEN
6368   SUBGOAL_THEN
6369    `sqrt(drop b) - sqrt(drop a) =
6370     (drop b - drop a) / (sqrt(drop a) + sqrt(drop b))`
6371   SUBST1_TAC THENL
6372    [MATCH_MP_TAC(REAL_FIELD
6373      `sa pow 2 = a /\ sb pow 2 = b /\ &0 < sa /\ &0 < sb
6374       ==> sb - sa = (b - a) / (sa + sb)`) THEN
6375     ASM_SIMP_TAC[SQRT_POS_LT; SQRT_POW_2; REAL_LT_IMP_LE];
6376     ASM_SIMP_TAC[REAL_ABS_DIV; SQRT_POS_LT; REAL_LT_ADD; REAL_LT_LDIV_EQ;
6377                  REAL_ARITH `&0 < x ==> abs x = x`] THEN
6378     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
6379         REAL_LTE_TRANS)) THEN
6380     ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LE_ADDR; SQRT_POS_LE;
6381                  REAL_LT_IMP_LE]]);;
6382
6383 let CONTINUOUS_WITHIN_LIFT_SQRT = prove
6384  (`!a s. (!x. x IN s ==> &0 <= drop x)
6385          ==> (lift o sqrt o drop) continuous (at a within s)`,
6386   REPEAT STRIP_TAC THEN
6387   REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
6388    (REAL_ARITH `drop a < &0 \/ drop a = &0 \/ &0 < drop a`)
6389   THENL
6390    [MATCH_MP_TAC CONTINUOUS_WITHIN_SUBSET THEN
6391     EXISTS_TAC `{x | &0 <= drop x}` THEN
6392     ASM_SIMP_TAC[SUBSET; IN_ELIM_THM] THEN
6393     MATCH_MP_TAC CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL THEN
6394     ASM_REWRITE_TAC[IN_ELIM_THM; REAL_NOT_LE] THEN
6395     REWRITE_TAC[drop; REWRITE_RULE[real_ge] CLOSED_HALFSPACE_COMPONENT_GE];
6396     RULE_ASSUM_TAC(REWRITE_RULE[GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM]) THEN
6397     ASM_REWRITE_TAC[continuous_within; o_THM; DROP_VEC; SQRT_0; LIFT_NUM] THEN
6398     REWRITE_TAC[DIST_0; NORM_LIFT; NORM_REAL; GSYM drop] THEN
6399     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
6400     EXISTS_TAC `(e:real) pow 2` THEN ASM_SIMP_TAC[REAL_POW_LT] THEN
6401     X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN
6402     ASM_SIMP_TAC[real_abs; SQRT_POS_LE] THEN
6403     SUBGOAL_THEN `e = sqrt(e pow 2)` SUBST1_TAC THENL
6404      [ASM_SIMP_TAC[POW_2_SQRT; REAL_LT_IMP_LE];
6405       MATCH_MP_TAC SQRT_MONO_LT THEN ASM_SIMP_TAC[] THEN ASM_REAL_ARITH_TAC];
6406     MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN
6407     MATCH_MP_TAC CONTINUOUS_AT_SQRT THEN ASM_REWRITE_TAC[]]);;
6408
6409 let CONTINUOUS_WITHIN_SQRT_COMPOSE = prove
6410  (`!f s a:real^N.
6411         (\x. lift(f x)) continuous (at a within s) /\
6412         (&0 < f a \/ !x. x IN s ==> &0 <= f x)
6413         ==> (\x. lift(sqrt(f x))) continuous (at a within s)`,
6414   REPEAT GEN_TAC THEN
6415   SUBGOAL_THEN
6416    `(\x:real^N. lift(sqrt(f x))) = (lift o sqrt o drop) o (lift o f)`
6417   SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN
6418   REPEAT STRIP_TAC THEN
6419   (MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN
6420    CONJ_TAC THENL [ASM_REWRITE_TAC[o_DEF]; ALL_TAC])
6421   THENL
6422    [MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN
6423     MATCH_MP_TAC CONTINUOUS_AT_SQRT THEN ASM_REWRITE_TAC[o_DEF; LIFT_DROP];
6424     MATCH_MP_TAC CONTINUOUS_WITHIN_LIFT_SQRT THEN
6425     ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_DEF; LIFT_DROP]]);;
6426
6427 let CONTINUOUS_AT_SQRT_COMPOSE = prove
6428  (`!f a:real^N.
6429         (\x. lift(f x)) continuous (at a) /\ (&0 < f a \/ !x. &0 <= f x)
6430         ==> (\x. lift(sqrt(f x))) continuous (at a)`,
6431   REPEAT GEN_TAC THEN
6432   MP_TAC(ISPECL [`f:real^N->real`; `(:real^N)`; `a:real^N`]
6433         CONTINUOUS_WITHIN_SQRT_COMPOSE) THEN
6434   REWRITE_TAC[WITHIN_UNIV; IN_UNIV]);;
6435
6436 let CONTINUOUS_ON_LIFT_SQRT = prove
6437  (`!s. (!x. x IN s ==> &0 <= drop x)
6438        ==> (lift o sqrt o drop) continuous_on s`,
6439   SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_WITHIN_LIFT_SQRT]);;
6440
6441 let CONTINUOUS_ON_LIFT_SQRT_COMPOSE = prove
6442  (`!f:real^N->real s.
6443         (lift o f) continuous_on s /\ (!x. x IN s ==> &0 <= f x)
6444         ==> (\x. lift(sqrt(f x))) continuous_on s`,
6445   REPEAT STRIP_TAC THEN
6446   SUBGOAL_THEN
6447    `(\x:real^N. lift(sqrt(f x))) = (lift o sqrt o drop) o (lift o f)`
6448   SUBST1_TAC THENL
6449    [REWRITE_TAC[o_DEF; LIFT_DROP];
6450     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
6451     MATCH_MP_TAC CONTINUOUS_ON_LIFT_SQRT THEN
6452     ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP]]);;
6453
6454 (* ------------------------------------------------------------------------- *)
6455 (* Cauchy continuity, and the extension of functions to closures.            *)
6456 (* ------------------------------------------------------------------------- *)
6457
6458 let UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS = prove
6459  (`!f:real^M->real^N s.
6460         f uniformly_continuous_on s
6461         ==> (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x))`,
6462   REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on; cauchy; o_DEF] THEN
6463   MESON_TAC[]);;
6464
6465 let CONTINUOUS_CLOSED_IMP_CAUCHY_CONTINUOUS = prove
6466  (`!f:real^M->real^N s.
6467         f continuous_on s /\ closed s
6468         ==> (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x))`,
6469   REWRITE_TAC[GSYM COMPLETE_EQ_CLOSED; CONTINUOUS_ON_SEQUENTIALLY] THEN
6470   REWRITE_TAC[complete] THEN MESON_TAC[CONVERGENT_IMP_CAUCHY]);;
6471
6472 let CAUCHY_CONTINUOUS_UNIQUENESS_LEMMA = prove
6473  (`!f:real^M->real^N s.
6474         (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x))
6475         ==> !a x. (!n. (x n) IN s) /\ (x --> a) sequentially
6476                   ==> ?l. ((f o x) --> l) sequentially /\
6477                           !y. (!n. (y n) IN s) /\ (y --> a) sequentially
6478                               ==> ((f o y) --> l) sequentially`,
6479   REPEAT STRIP_TAC THEN
6480   FIRST_ASSUM(MP_TAC o SPEC `x:num->real^M`) THEN
6481   ANTS_TAC THENL [ASM_MESON_TAC[CONVERGENT_IMP_CAUCHY]; ALL_TAC] THEN
6482   REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN MATCH_MP_TAC MONO_EXISTS THEN
6483   X_GEN_TAC `l:real^N` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
6484   X_GEN_TAC `y:num->real^M` THEN STRIP_TAC THEN
6485   FIRST_ASSUM(MP_TAC o SPEC `y:num->real^M`) THEN
6486   ANTS_TAC THENL [ASM_MESON_TAC[CONVERGENT_IMP_CAUCHY]; ALL_TAC] THEN
6487   REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN
6488   DISCH_THEN(X_CHOOSE_THEN `m:real^N` STRIP_ASSUME_TAC) THEN
6489   SUBGOAL_THEN `l:real^N = m` (fun th -> ASM_REWRITE_TAC[th]) THEN
6490   ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN
6491   MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
6492   EXISTS_TAC `\n:num. (f:real^M->real^N)(x n) - f(y n)` THEN
6493   RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN
6494   ASM_SIMP_TAC[LIM_SUB; TRIVIAL_LIMIT_SEQUENTIALLY] THEN
6495   FIRST_X_ASSUM(MP_TAC o SPEC
6496    `\n. if EVEN n then x(n DIV 2):real^M else y(n DIV 2)`) THEN
6497   REWRITE_TAC[cauchy; o_THM; LIM_SEQUENTIALLY] THEN ANTS_TAC THENL
6498    [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
6499     X_GEN_TAC `e:real` THEN DISCH_TAC THEN MAP_EVERY UNDISCH_TAC
6500      [`((y:num->real^M) --> a) sequentially`;
6501       `((x:num->real^M) --> a) sequentially`] THEN
6502     REPEAT(FIRST_X_ASSUM(K ALL_TAC o check (is_forall o concl))) THEN
6503     REWRITE_TAC[LIM_SEQUENTIALLY] THEN
6504     DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
6505     DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN
6506     DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
6507     DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN
6508     EXISTS_TAC `2 * (N1 + N2)` THEN
6509     MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN
6510     REPEAT(FIRST_X_ASSUM(fun th ->
6511       MP_TAC(SPEC `m DIV 2` th) THEN MP_TAC(SPEC `n DIV 2` th))) THEN
6512     REPEAT(ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_TAC]) THEN
6513     REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
6514     REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LE])) THEN
6515     CONV_TAC NORM_ARITH;
6516     MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
6517     ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
6518     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN
6519     X_GEN_TAC `n:num` THEN DISCH_TAC THEN
6520     FIRST_X_ASSUM(MP_TAC o SPECL [`2 * n`; `2 * n + 1`]) THEN
6521     ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
6522     REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH_EVEN] THEN
6523     REWRITE_TAC[ARITH_RULE `(2 * n) DIV 2 = n /\ (2 * n + 1) DIV 2 = n`] THEN
6524     REWRITE_TAC[dist; VECTOR_SUB_RZERO]]);;
6525
6526 let CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE = prove
6527  (`!f:real^M->real^N s.
6528         (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x))
6529         ==> ?g. g continuous_on closure s /\ (!x. x IN s ==> g x = f x)`,
6530   REPEAT STRIP_TAC THEN
6531   SUBGOAL_THEN
6532    `!a:real^M. ?x.
6533        a IN closure s ==> (!n. x n IN s) /\ (x --> a) sequentially`
6534   MP_TAC THENL [MESON_TAC[CLOSURE_SEQUENTIAL]; ALL_TAC] THEN
6535   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
6536   X_GEN_TAC `X:real^M->num->real^M` THEN DISCH_TAC THEN
6537   FIRST_ASSUM(MP_TAC o MATCH_MP CAUCHY_CONTINUOUS_UNIQUENESS_LEMMA) THEN
6538   DISCH_THEN(MP_TAC o GEN `a:real^M` o
6539    SPECL [`a:real^M`; `(X:real^M->num->real^M) a`]) THEN
6540   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
6541    `(!a. P a ==> Q a) ==> ((!a. P a ==> R a) ==> p)
6542     ==> ((!a. Q a ==> R a) ==> p)`)) THEN
6543   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
6544   REWRITE_TAC[SKOLEM_THM] THEN
6545   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN
6546   STRIP_TAC THEN
6547   MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL
6548    [X_GEN_TAC `a:real^M` THEN DISCH_TAC THEN
6549     FIRST_X_ASSUM(MP_TAC o SPEC `a:real^M`) THEN
6550     ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN
6551     DISCH_THEN(MP_TAC o SPEC `(\n. a):num->real^M` o CONJUNCT2) THEN
6552     ASM_SIMP_TAC[LIM_CONST_EQ; o_DEF; TRIVIAL_LIMIT_SEQUENTIALLY];
6553     STRIP_TAC] THEN
6554   ASM_SIMP_TAC[CONTINUOUS_ON_CLOSURE_SEQUENTIALLY] THEN
6555   MAP_EVERY X_GEN_TAC [`x:num->real^M`; `a:real^M`] THEN STRIP_TAC THEN
6556   MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN
6557   EXISTS_TAC `(f:real^M->real^N) o (x:num->real^M)` THEN ASM_SIMP_TAC[] THEN
6558   MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM_SIMP_TAC[o_THM]);;
6559
6560 let UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE = prove
6561  (`!f:real^M->real^N s.
6562    f uniformly_continuous_on s
6563    ==> ?g. g uniformly_continuous_on closure s /\ (!x. x IN s ==> g x = f x) /\
6564            !h. h continuous_on closure s /\ (!x. x IN s ==> h x = f x)
6565                ==> !x. x IN closure s ==> h x = g x`,
6566   REPEAT STRIP_TAC THEN
6567   FIRST_ASSUM(MP_TAC o MATCH_MP CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE o
6568    MATCH_MP UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS) THEN
6569   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN
6570   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
6571    [ASM_MESON_TAC[UNIFORMLY_CONTINUOUS_ON_CLOSURE; UNIFORMLY_CONTINUOUS_ON_EQ];
6572     ASM_MESON_TAC[CONTINUOUS_AGREE_ON_CLOSURE]]);;
6573
6574 let CAUCHY_CONTINUOUS_IMP_CONTINUOUS = prove
6575  (`!f:real^M->real^N s.
6576         (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x))
6577         ==> f continuous_on s`,
6578   REPEAT STRIP_TAC THEN
6579   FIRST_ASSUM(CHOOSE_TAC o MATCH_MP CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN
6580   ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; CLOSURE_SUBSET; CONTINUOUS_ON_EQ]);;
6581
6582 let BOUNDED_UNIFORMLY_CONTINUOUS_IMAGE = prove
6583  (`!f:real^M->real^N s.
6584         f uniformly_continuous_on s /\ bounded s ==> bounded(IMAGE f s)`,
6585   REPEAT STRIP_TAC THEN FIRST_ASSUM
6586    (MP_TAC o MATCH_MP UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN
6587   DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
6588   MATCH_MP_TAC BOUNDED_SUBSET THEN
6589   EXISTS_TAC `IMAGE (g:real^M->real^N) (closure s)` THEN CONJ_TAC THENL
6590    [ASM_MESON_TAC[COMPACT_CLOSURE; UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS;
6591                   COMPACT_IMP_BOUNDED; COMPACT_CONTINUOUS_IMAGE];
6592     MP_TAC(ISPEC `s:real^M->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]]);;
6593
6594 (* ------------------------------------------------------------------------- *)
6595 (* Occasionally useful invariance properties.                                *)
6596 (* ------------------------------------------------------------------------- *)
6597
6598 let CONTINUOUS_AT_COMPOSE_EQ = prove
6599  (`!f:real^M->real^N g:real^M->real^M h:real^M->real^M.
6600         g continuous at x /\ h continuous at (g x) /\
6601         (!y. g(h y) = y) /\ h(g x) = x
6602         ==> (f continuous at (g x) <=> (\x. f(g x)) continuous at x)`,
6603   REPEAT STRIP_TAC THEN EQ_TAC THEN
6604   ASM_SIMP_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_COMPOSE] THEN
6605   DISCH_TAC THEN
6606   SUBGOAL_THEN
6607    `((f:real^M->real^N) o (g:real^M->real^M) o (h:real^M->real^M))
6608      continuous at (g(x:real^M))`
6609   MP_TAC THENL
6610    [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN
6611     ASM_REWRITE_TAC[o_DEF];
6612
6613     ASM_REWRITE_TAC[o_DEF; ETA_AX]]);;
6614
6615 let CONTINUOUS_AT_TRANSLATION = prove
6616  (`!a z f:real^M->real^N.
6617       f continuous at (a + z) <=> (\x. f(a + x)) continuous at z`,
6618   REPEAT GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE_EQ THEN
6619   EXISTS_TAC `\x:real^M. x - a` THEN
6620   SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_SUB;
6621            CONTINUOUS_AT_ID; CONTINUOUS_CONST] THEN
6622   VECTOR_ARITH_TAC);;
6623
6624 add_translation_invariants [CONTINUOUS_AT_TRANSLATION];;
6625
6626 let CONTINUOUS_AT_LINEAR_IMAGE = prove
6627  (`!h:real^M->real^M z f:real^M->real^N.
6628         linear h /\ (!x. norm(h x) = norm x)
6629         ==> (f continuous at (h z) <=> (\x. f(h x)) continuous at z)`,
6630   REPEAT GEN_TAC THEN DISCH_TAC THEN
6631   FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I
6632    [GSYM ORTHOGONAL_TRANSFORMATION]) THEN
6633   FIRST_ASSUM(X_CHOOSE_TAC `g:real^M->real^M` o MATCH_MP
6634     ORTHOGONAL_TRANSFORMATION_INVERSE) THEN
6635   MATCH_MP_TAC CONTINUOUS_AT_COMPOSE_EQ THEN
6636   EXISTS_TAC `g:real^M->real^M` THEN
6637   RULE_ASSUM_TAC(REWRITE_RULE[ORTHOGONAL_TRANSFORMATION]) THEN
6638   ASM_SIMP_TAC[LINEAR_CONTINUOUS_AT]);;
6639
6640 add_linear_invariants [CONTINUOUS_AT_LINEAR_IMAGE];;
6641
6642 (* ------------------------------------------------------------------------- *)
6643 (* Interior of an injective image.                                           *)
6644 (* ------------------------------------------------------------------------- *)
6645
6646 let INTERIOR_IMAGE_SUBSET = prove
6647  (`!f:real^M->real^N s.
6648        (!x. f continuous at x) /\ (!x y. f x = f y ==> x = y)
6649        ==> interior(IMAGE f s) SUBSET IMAGE f (interior s)`,
6650   REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN
6651   REWRITE_TAC[interior; IN_ELIM_THM] THEN
6652   X_GEN_TAC `y:real^N` THEN
6653   DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
6654   REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN
6655   SUBGOAL_THEN `y IN IMAGE (f:real^M->real^N) s` MP_TAC THENL
6656    [ASM SET_TAC[]; ALL_TAC] THEN
6657   REWRITE_TAC[IN_IMAGE] THEN
6658   MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN
6659   ASM_REWRITE_TAC[IN_ELIM_THM] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN
6660   EXISTS_TAC `{x | (f:real^M->real^N)(x) IN t}` THEN
6661   REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN CONJ_TAC THENL
6662    [MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE_UNIV THEN ASM_MESON_TAC[];
6663     ASM SET_TAC[]]);;
6664
6665 (* ------------------------------------------------------------------------- *)
6666 (* Making a continuous function avoid some value in a neighbourhood.         *)
6667 (* ------------------------------------------------------------------------- *)
6668
6669 let CONTINUOUS_WITHIN_AVOID = prove
6670  (`!f:real^M->real^N x s a.
6671         f continuous (at x within s) /\ x IN s /\  ~(f x = a)
6672         ==> ?e. &0 < e /\ !y. y IN s /\ dist(x,y) < e ==> ~(f y = a)`,
6673   REPEAT STRIP_TAC THEN
6674   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_within]) THEN
6675   DISCH_THEN(MP_TAC o SPEC `norm((f:real^M->real^N) x - a)`) THEN
6676   ASM_REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN
6677   MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN
6678   REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN
6679   GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[] THEN NORM_ARITH_TAC);;
6680
6681 let CONTINUOUS_AT_AVOID = prove
6682  (`!f:real^M->real^N x a.
6683         f continuous (at x) /\ ~(f x = a)
6684         ==> ?e. &0 < e /\ !y. dist(x,y) < e ==> ~(f y = a)`,
6685   MP_TAC CONTINUOUS_WITHIN_AVOID THEN
6686   REPLICATE_TAC 2 (MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
6687   DISCH_THEN(MP_TAC o SPEC `(:real^M)`) THEN
6688   MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
6689   REWRITE_TAC[WITHIN_UNIV; IN_UNIV]);;
6690
6691 let CONTINUOUS_ON_AVOID = prove
6692  (`!f:real^M->real^N x s a.
6693         f continuous_on s /\ x IN s /\ ~(f x = a)
6694         ==> ?e. &0 < e /\ !y. y IN s /\ dist(x,y) < e ==> ~(f y = a)`,
6695   REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
6696   REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_WITHIN_AVOID THEN
6697   ASM_SIMP_TAC[]);;
6698
6699 let CONTINUOUS_ON_OPEN_AVOID = prove
6700  (`!f:real^M->real^N x s a.
6701         f continuous_on s /\ open s /\ x IN s /\ ~(f x = a)
6702         ==> ?e. &0 < e /\ !y. dist(x,y) < e ==> ~(f y = a)`,
6703   REPEAT GEN_TAC THEN ASM_CASES_TAC `open(s:real^M->bool)` THEN
6704   ASM_SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT] THEN
6705   REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_AVOID THEN
6706   ASM_SIMP_TAC[]);;
6707
6708 (* ------------------------------------------------------------------------- *)
6709 (* Proving a function is constant by proving open-ness of level set.         *)
6710 (* ------------------------------------------------------------------------- *)
6711
6712 let CONTINUOUS_LEVELSET_OPEN_IN_CASES = prove
6713  (`!f:real^M->real^N s a.
6714         connected s /\
6715         f continuous_on s /\
6716         open_in (subtopology euclidean s) {x | x IN s /\ f x = a}
6717         ==> (!x. x IN s ==> ~(f x = a)) \/ (!x. x IN s ==> f x = a)`,
6718   REWRITE_TAC[SET_RULE `(!x. x IN s ==> ~(f x = a)) <=>
6719                         {x | x IN s /\ f x = a} = {}`;
6720               SET_RULE `(!x. x IN s ==> f x = a) <=>
6721                         {x | x IN s /\ f x = a} = s`] THEN
6722   REWRITE_TAC[CONNECTED_CLOPEN] THEN REPEAT STRIP_TAC THEN
6723   FIRST_X_ASSUM MATCH_MP_TAC THEN
6724   ASM_SIMP_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT]);;
6725
6726 let CONTINUOUS_LEVELSET_OPEN_IN = prove
6727  (`!f:real^M->real^N s a.
6728         connected s /\
6729         f continuous_on s /\
6730         open_in (subtopology euclidean s) {x | x IN s /\ f x = a} /\
6731         (?x. x IN s /\ f x = a)
6732         ==> (!x. x IN s ==> f x = a)`,
6733   MESON_TAC[CONTINUOUS_LEVELSET_OPEN_IN_CASES]);;
6734
6735 let CONTINUOUS_LEVELSET_OPEN = prove
6736  (`!f:real^M->real^N s a.
6737         connected s /\
6738         f continuous_on s /\
6739         open {x | x IN s /\ f x = a} /\
6740         (?x. x IN s /\ f x = a)
6741         ==> (!x. x IN s ==> f x = a)`,
6742   REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
6743   MATCH_MP_TAC CONTINUOUS_LEVELSET_OPEN_IN THEN
6744   ASM_REWRITE_TAC[OPEN_IN_OPEN] THEN
6745   EXISTS_TAC `{x | x IN s /\ (f:real^M->real^N) x = a}` THEN
6746   ASM_REWRITE_TAC[] THEN SET_TAC[]);;
6747
6748 (* ------------------------------------------------------------------------- *)
6749 (* Some arithmetical combinations (more to prove).                           *)
6750 (* ------------------------------------------------------------------------- *)
6751
6752 let OPEN_SCALING = prove
6753  (`!s:real^N->bool c. ~(c = &0) /\ open s ==> open(IMAGE (\x. c % x) s)`,
6754   REPEAT GEN_TAC THEN REWRITE_TAC[open_def; FORALL_IN_IMAGE] THEN
6755   STRIP_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
6756   FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
6757   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6758   EXISTS_TAC `e * abs(c)` THEN ASM_SIMP_TAC[REAL_LT_MUL; GSYM REAL_ABS_NZ] THEN
6759   X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE] THEN
6760   EXISTS_TAC `inv(c) % y:real^N` THEN
6761   ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID] THEN
6762   FIRST_X_ASSUM MATCH_MP_TAC THEN
6763   SUBGOAL_THEN `x = inv(c) % c % x:real^N` SUBST1_TAC THENL
6764    [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID];
6765     REWRITE_TAC[dist; GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN
6766     ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_ABS_INV] THEN
6767     ASM_SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ; GSYM REAL_ABS_NZ] THEN
6768     ASM_REWRITE_TAC[GSYM dist]]);;
6769
6770 let OPEN_NEGATIONS = prove
6771  (`!s:real^N->bool. open s ==> open (IMAGE (--) s)`,
6772   SUBGOAL_THEN `(--) = \x:real^N. --(&1) % x`
6773    (fun th -> SIMP_TAC[th; OPEN_SCALING; REAL_ARITH `~(--(&1) = &0)`]) THEN
6774   REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC);;
6775
6776 let OPEN_TRANSLATION = prove
6777  (`!s a:real^N. open s ==> open(IMAGE (\x. a + x) s)`,
6778   REPEAT STRIP_TAC THEN
6779   MP_TAC(ISPECL [`\x:real^N. x - a`; `s:real^N->bool`]
6780          CONTINUOUS_OPEN_PREIMAGE_UNIV) THEN
6781   ASM_SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_AT_ID; CONTINUOUS_CONST] THEN
6782   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
6783   REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_UNIV] THEN
6784   ASM_MESON_TAC[VECTOR_ARITH `(a + x) - a = x:real^N`;
6785                 VECTOR_ARITH `a + (x - a) = x:real^N`]);;
6786
6787 let OPEN_TRANSLATION_EQ = prove
6788  (`!a s. open (IMAGE (\x:real^N. a + x) s) <=> open s`,
6789   REWRITE_TAC[open_def] THEN GEOM_TRANSLATE_TAC[]);;
6790
6791 add_translation_invariants [OPEN_TRANSLATION_EQ];;
6792
6793 let OPEN_AFFINITY = prove
6794  (`!s a:real^N c.
6795         open s /\ ~(c = &0) ==> open (IMAGE (\x. a + c % x) s)`,
6796   REPEAT STRIP_TAC THEN
6797   SUBGOAL_THEN `(\x:real^N. a + c % x) = (\x. a + x) o (\x. c % x)`
6798   SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN
6799   ASM_SIMP_TAC[IMAGE_o; OPEN_TRANSLATION; OPEN_SCALING]);;
6800
6801 let INTERIOR_TRANSLATION = prove
6802  (`!a:real^N s.
6803     interior (IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (interior s)`,
6804   REWRITE_TAC[interior] THEN GEOM_TRANSLATE_TAC[]);;
6805
6806 add_translation_invariants [INTERIOR_TRANSLATION];;
6807
6808 let OPEN_SUMS = prove
6809  (`!s t:real^N->bool.
6810         open s \/ open t ==> open {x + y | x IN s /\ y IN t}`,
6811   REPEAT GEN_TAC THEN REWRITE_TAC[open_def] THEN STRIP_TAC THEN
6812   REWRITE_TAC[FORALL_IN_GSPEC] THEN
6813   MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THENL
6814    [FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`);
6815     FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`)] THEN
6816   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
6817   X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
6818   X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN
6819   ASM_MESON_TAC[VECTOR_ADD_SYM; VECTOR_ARITH `(z - y) + y:real^N = z`;
6820                 NORM_ARITH `dist(z:real^N,x + y) < e ==> dist(z - y,x) < e`]);;
6821
6822 (* ------------------------------------------------------------------------- *)
6823 (* Upper and lower hemicontinuous functions, relation in the case of         *)
6824 (* preimage map to open and closed maps, and fact that upper and lower       *)
6825 (* hemicontinuity together imply continuity in the sense of the Hausdorff    *)
6826 (* metric (at points where the function gives a bounded and nonempty set).   *)
6827 (* ------------------------------------------------------------------------- *)
6828
6829 let UPPER_HEMICONTINUOUS = prove
6830  (`!f:real^M->real^N->bool t s.
6831         (!x. x IN s ==> f(x) SUBSET t)
6832         ==> ((!u. open_in (subtopology euclidean t) u
6833                   ==> open_in (subtopology euclidean s)
6834                               {x | x IN s /\ f(x) SUBSET u}) <=>
6835              (!u. closed_in (subtopology euclidean t) u
6836                   ==> closed_in (subtopology euclidean s)
6837                                 {x | x IN s /\ ~(f(x) INTER u = {})}))`,
6838   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN GEN_TAC THEN
6839   FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN
6840   MATCH_MP_TAC MONO_IMP THEN
6841   SIMP_TAC[OPEN_IN_DIFF; CLOSED_IN_DIFF; OPEN_IN_REFL; CLOSED_IN_REFL] THENL
6842    [REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ]; REWRITE_TAC[closed_in]] THEN
6843   REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_RESTRICT] THEN
6844   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);;
6845
6846 let LOWER_HEMICONTINUOUS = prove
6847  (`!f:real^M->real^N->bool t s.
6848         (!x. x IN s ==> f(x) SUBSET t)
6849         ==> ((!u. closed_in (subtopology euclidean t) u
6850                   ==> closed_in (subtopology euclidean s)
6851                                 {x | x IN s /\ f(x) SUBSET u}) <=>
6852              (!u. open_in (subtopology euclidean t) u
6853                   ==> open_in (subtopology euclidean s)
6854                               {x | x IN s /\ ~(f(x) INTER u = {})}))`,
6855   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN GEN_TAC THEN
6856   FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN
6857   MATCH_MP_TAC MONO_IMP THEN
6858   SIMP_TAC[OPEN_IN_DIFF; CLOSED_IN_DIFF; OPEN_IN_REFL; CLOSED_IN_REFL] THENL
6859    [REWRITE_TAC[closed_in]; REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ]] THEN
6860   REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_RESTRICT] THEN
6861   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);;
6862
6863 let OPEN_MAP_IFF_LOWER_HEMICONTINUOUS_PREIMAGE = prove
6864  (`!f:real^M->real^N s t.
6865         IMAGE f s SUBSET t
6866         ==> ((!u. open_in (subtopology euclidean s) u
6867                   ==> open_in (subtopology euclidean t) (IMAGE f u)) <=>
6868              (!u. closed_in (subtopology euclidean s) u
6869                       ==> closed_in (subtopology euclidean t)
6870                                     {y | y IN t /\
6871                                          {x | x IN s /\ f x = y} SUBSET u}))`,
6872   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
6873    [X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN
6874     FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN
6875     ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN
6876     REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
6877     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
6878     FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
6879     MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[];
6880     X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN
6881     FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN
6882     ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN
6883     FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
6884     REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
6885     DISCH_THEN(fun th -> CONJ_TAC THENL [ASM SET_TAC[]; MP_TAC th]) THEN
6886     MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]);;
6887
6888 let CLOSED_MAP_IFF_UPPER_HEMICONTINUOUS_PREIMAGE = prove
6889  (`!f:real^M->real^N s t.
6890         IMAGE f s SUBSET t
6891         ==> ((!u. closed_in (subtopology euclidean s) u
6892                   ==> closed_in (subtopology euclidean t) (IMAGE f u)) <=>
6893              (!u. open_in (subtopology euclidean s) u
6894                   ==> open_in (subtopology euclidean t)
6895                               {y | y IN t /\
6896                                    {x | x IN s /\ f x = y} SUBSET u}))`,
6897   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
6898    [X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN
6899     FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN
6900     ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN
6901     REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
6902     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
6903     FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
6904     MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[];
6905     X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN
6906     FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN
6907     ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN
6908     FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
6909     REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
6910     DISCH_THEN(fun th -> CONJ_TAC THENL [ASM SET_TAC[]; MP_TAC th]) THEN
6911     MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]);;
6912
6913 let UPPER_LOWER_HEMICONTINUOUS_EXPLICIT = prove
6914  (`!f:real^M->real^N->bool t s.
6915       (!x. x IN s ==> f(x) SUBSET t) /\
6916       (!u. open_in (subtopology euclidean t) u
6917            ==> open_in (subtopology euclidean s)
6918                        {x | x IN s /\ f(x) SUBSET u}) /\
6919       (!u. closed_in (subtopology euclidean t) u
6920            ==> closed_in (subtopology euclidean s)
6921                          {x | x IN s /\ f(x) SUBSET u})
6922       ==> !x e. x IN s /\ &0 < e /\ bounded(f x) /\ ~(f x = {})
6923                 ==> ?d. &0 < d /\
6924                         !x'. x' IN s /\ dist(x,x') < d
6925                              ==> (!y. y IN f x
6926                                       ==> ?y'. y' IN f x' /\ dist(y,y') < e) /\
6927                                  (!y'. y' IN f x'
6928                                        ==> ?y. y IN f x /\ dist(y',y) < e)`,
6929   REPEAT STRIP_TAC THEN
6930   UNDISCH_TAC
6931    `!u. open_in (subtopology euclidean t) u
6932         ==> open_in (subtopology euclidean s)
6933                     {x | x IN s /\ (f:real^M->real^N->bool)(x) SUBSET u}` THEN
6934   DISCH_THEN(MP_TAC o SPEC
6935    `t INTER
6936     {a + b | a IN (f:real^M->real^N->bool) x /\ b IN ball(vec 0,e)}`) THEN
6937   SIMP_TAC[OPEN_SUMS; OPEN_BALL; OPEN_IN_OPEN_INTER] THEN
6938   REWRITE_TAC[open_in; SUBSET_RESTRICT] THEN
6939   DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
6940   ASM_SIMP_TAC[IN_ELIM_THM; SUBSET_INTER] THEN ANTS_TAC THENL
6941    [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
6942     ASM_MESON_TAC[CENTRE_IN_BALL; VECTOR_ADD_RID];
6943     DISCH_THEN(X_CHOOSE_THEN `d1:real`
6944      (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1")))] THEN
6945   UNDISCH_TAC
6946    `!u. closed_in (subtopology euclidean t) u
6947         ==> closed_in (subtopology euclidean s)
6948                     {x | x IN s /\ (f:real^M->real^N->bool)(x) SUBSET u}` THEN
6949   ASM_SIMP_TAC[LOWER_HEMICONTINUOUS] THEN DISCH_THEN(MP_TAC o
6950     GEN `a:real^N` o SPEC `t INTER ball(a:real^N,e / &2)`) THEN
6951   SIMP_TAC[OPEN_BALL; OPEN_IN_OPEN_INTER] THEN
6952
6953   MP_TAC(SPEC `closure((f:real^M->real^N->bool) x)`
6954     COMPACT_EQ_HEINE_BOREL) THEN
6955   ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN DISCH_THEN(MP_TAC o SPEC
6956    `{ball(a:real^N,e / &2) | a IN (f:real^M->real^N->bool) x}`) THEN
6957   REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; OPEN_BALL] THEN
6958   ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
6959   REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN ANTS_TAC THENL
6960    [REWRITE_TAC[CLOSURE_APPROACHABLE; SUBSET; UNIONS_IMAGE; IN_ELIM_THM] THEN
6961     REWRITE_TAC[IN_BALL] THEN ASM_SIMP_TAC[REAL_HALF];
6962     ALL_TAC] THEN
6963   DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN
6964   DISCH_TAC THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP
6965    (MESON[CLOSURE_SUBSET; SUBSET_TRANS]
6966         `closure s SUBSET t ==> s SUBSET t`)) THEN
6967   SUBGOAL_THEN
6968    `open_in (subtopology euclidean s)
6969       (INTERS {{x | x IN s /\
6970           ~((f:real^M->real^N->bool) x INTER t INTER ball(a,e / &2) = {})} |
6971      a IN c})`
6972   MP_TAC THENL
6973    [MATCH_MP_TAC OPEN_IN_INTERS THEN
6974     ASM_SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; FINITE_IMAGE] THEN
6975     ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN ASM SET_TAC[];
6976     ALL_TAC] THEN
6977   REWRITE_TAC[open_in] THEN
6978   DISCH_THEN(MP_TAC o SPEC `x:real^M` o CONJUNCT2) THEN ANTS_TAC THENL
6979    [REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM] THEN
6980     X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
6981     ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
6982     EXISTS_TAC `a:real^N` THEN
6983     ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_HALF] THEN
6984     ASM SET_TAC[];
6985     DISCH_THEN(X_CHOOSE_THEN `d2:real`
6986      (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2")))] THEN
6987   EXISTS_TAC `min d1 d2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
6988   X_GEN_TAC `x':real^M` THEN STRIP_TAC THEN CONJ_TAC THENL
6989    [ALL_TAC;
6990     REMOVE_THEN "1" (MP_TAC o SPEC `x':real^M`) THEN
6991     ASM_REWRITE_TAC[] THEN
6992     ANTS_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN
6993     REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_BALL] THEN
6994     REWRITE_TAC[VECTOR_ARITH `x:real^N = a + b <=> x - a = b`;
6995                 DIST_0; ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN
6996     REWRITE_TAC[dist]] THEN
6997   REMOVE_THEN "2" (MP_TAC o SPEC `x':real^M`) THEN
6998   ASM_REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM] THEN
6999   ANTS_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN
7000   DISCH_THEN(LABEL_TAC "3") THEN
7001   X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
7002   UNDISCH_TAC `(f:real^M->real^N->bool) x SUBSET
7003                UNIONS (IMAGE (\a. ball (a,e / &2)) c)` THEN
7004   REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN
7005   ASM_REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; IN_BALL] THEN
7006   DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
7007   REMOVE_THEN "3" (MP_TAC o SPEC `a:real^N`) THEN
7008   ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_BALL] THEN
7009   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN
7010   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
7011   ASM_MESON_TAC[DIST_TRIANGLE_HALF_L; DIST_SYM]);;
7012
7013 (* ------------------------------------------------------------------------- *)
7014 (* Connected components, considered as a "connectedness" relation or a set.  *)
7015 (* ------------------------------------------------------------------------- *)
7016
7017 let connected_component = new_definition
7018  `connected_component s x y <=>
7019         ?t. connected t /\ t SUBSET s /\ x IN t /\ y IN t`;;
7020
7021 let CONNECTED_COMPONENT_IN = prove
7022  (`!s x y. connected_component s x y ==> x IN s /\ y IN s`,
7023   REWRITE_TAC[connected_component] THEN SET_TAC[]);;
7024
7025 let CONNECTED_COMPONENT_REFL = prove
7026  (`!s x:real^N. x IN s ==> connected_component s x x`,
7027   REWRITE_TAC[connected_component] THEN REPEAT STRIP_TAC THEN
7028   EXISTS_TAC `{x:real^N}` THEN REWRITE_TAC[CONNECTED_SING] THEN
7029   ASM SET_TAC[]);;
7030
7031 let CONNECTED_COMPONENT_REFL_EQ = prove
7032  (`!s x:real^N. connected_component s x x <=> x IN s`,
7033   REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL] THEN
7034   REWRITE_TAC[connected_component] THEN SET_TAC[]);;
7035
7036 let CONNECTED_COMPONENT_SYM = prove
7037  (`!s x y:real^N. connected_component s x y ==> connected_component s y x`,
7038   REWRITE_TAC[connected_component] THEN MESON_TAC[]);;
7039
7040 let CONNECTED_COMPONENT_TRANS = prove
7041  (`!s x y:real^N.
7042     connected_component s x y /\ connected_component s y z
7043     ==> connected_component s x z`,
7044   REPEAT GEN_TAC THEN REWRITE_TAC[connected_component] THEN
7045   DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `t:real^N->bool`)
7046                              (X_CHOOSE_TAC `u:real^N->bool`)) THEN
7047   EXISTS_TAC `t UNION u:real^N->bool` THEN
7048   ASM_REWRITE_TAC[IN_UNION; UNION_SUBSET] THEN
7049   MATCH_MP_TAC CONNECTED_UNION THEN ASM SET_TAC[]);;
7050
7051 let CONNECTED_COMPONENT_OF_SUBSET = prove
7052  (`!s t x. s SUBSET t /\ connected_component s x y
7053            ==> connected_component t x y`,
7054   REWRITE_TAC[connected_component] THEN SET_TAC[]);;
7055
7056 let CONNECTED_COMPONENT_SET = prove
7057  (`!s x. connected_component s x =
7058             { y | ?t. connected t /\ t SUBSET s /\ x IN t /\ y IN t}`,
7059   REWRITE_TAC[IN_ELIM_THM; EXTENSION] THEN
7060   REWRITE_TAC[IN; connected_component] THEN MESON_TAC[]);;
7061
7062 let CONNECTED_COMPONENT_UNIONS = prove
7063  (`!s x. connected_component s x =
7064                 UNIONS {t | connected t /\ x IN t /\ t SUBSET s}`,
7065   REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);;
7066
7067 let CONNECTED_COMPONENT_SUBSET = prove
7068  (`!s x. (connected_component s x) SUBSET s`,
7069   REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);;
7070
7071 let CONNECTED_CONNECTED_COMPONENT_SET = prove
7072  (`!s. connected s <=> !x:real^N. x IN s ==> connected_component s x = s`,
7073   GEN_TAC THEN REWRITE_TAC[CONNECTED_COMPONENT_UNIONS] THEN EQ_TAC THENL
7074    [SET_TAC[]; ALL_TAC] THEN
7075   ASM_CASES_TAC `s:real^N->bool = {}` THEN
7076   ASM_REWRITE_TAC[CONNECTED_EMPTY] THEN
7077   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
7078   DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
7079   DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN
7080   DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC CONNECTED_UNIONS THEN
7081   ASM SET_TAC[]);;
7082
7083 let CONNECTED_COMPONENT_EQ_SELF = prove
7084  (`!s x. connected s /\ x IN s ==> connected_component s x = s`,
7085   MESON_TAC[CONNECTED_CONNECTED_COMPONENT_SET]);;
7086
7087 let CONNECTED_IFF_CONNECTED_COMPONENT = prove
7088  (`!s. connected s <=>
7089           !x y. x IN s /\ y IN s ==> connected_component s x y`,
7090   REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT_SET] THEN
7091   REWRITE_TAC[EXTENSION] THEN MESON_TAC[IN; CONNECTED_COMPONENT_IN]);;
7092
7093 let CONNECTED_COMPONENT_MAXIMAL = prove
7094  (`!s t x:real^N.
7095         x IN t /\ connected t /\ t SUBSET s
7096         ==> t SUBSET (connected_component s x)`,
7097   REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);;
7098
7099 let CONNECTED_COMPONENT_MONO = prove
7100  (`!s t x. s SUBSET t
7101            ==> (connected_component s x) SUBSET (connected_component t x)`,
7102   REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);;
7103
7104 let CONNECTED_CONNECTED_COMPONENT = prove
7105  (`!s x. connected(connected_component s x)`,
7106   REWRITE_TAC[CONNECTED_COMPONENT_UNIONS] THEN
7107   REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_UNIONS THEN SET_TAC[]);;
7108
7109 let CONNECTED_COMPONENT_EQ_EMPTY = prove
7110  (`!s x:real^N. connected_component s x = {} <=> ~(x IN s)`,
7111   REPEAT GEN_TAC THEN EQ_TAC THENL
7112    [REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN
7113     DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
7114     REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ];
7115     REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]]);;
7116
7117 let CONNECTED_COMPONENT_EMPTY = prove
7118  (`!x. connected_component {} x = {}`,
7119   REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY; NOT_IN_EMPTY]);;
7120
7121 let CONNECTED_COMPONENT_EQ = prove
7122  (`!s x y. y IN connected_component s x
7123            ==> (connected_component s y = connected_component s x)`,
7124   REWRITE_TAC[EXTENSION; IN] THEN
7125   MESON_TAC[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS]);;
7126
7127 let CLOSED_CONNECTED_COMPONENT = prove
7128  (`!s x:real^N. closed s ==> closed(connected_component s x)`,
7129   REPEAT STRIP_TAC THEN
7130   ASM_CASES_TAC `(x:real^N) IN s` THENL
7131    [ALL_TAC; ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY; CLOSED_EMPTY]] THEN
7132   REWRITE_TAC[GSYM CLOSURE_EQ] THEN
7133   MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[CLOSURE_SUBSET] THEN
7134   MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
7135   SIMP_TAC[CONNECTED_CLOSURE; CONNECTED_CONNECTED_COMPONENT] THEN
7136   CONJ_TAC THENL
7137    [MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN
7138     ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ];
7139     MATCH_MP_TAC CLOSURE_MINIMAL THEN
7140     ASM_REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]]);;
7141
7142 let CONNECTED_COMPONENT_DISJOINT = prove
7143  (`!s a b. DISJOINT (connected_component s a) (connected_component s b) <=>
7144              ~(a IN connected_component s b)`,
7145   REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN
7146   REWRITE_TAC[IN] THEN
7147   MESON_TAC[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS]);;
7148
7149 let CONNECTED_COMPONENT_NONOVERLAP = prove
7150  (`!s a b:real^N.
7151         (connected_component s a) INTER (connected_component s b) = {} <=>
7152         ~(a IN s) \/ ~(b IN s) \/
7153         ~(connected_component s a = connected_component s b)`,
7154   REPEAT GEN_TAC THEN
7155   ASM_CASES_TAC `(a:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN
7156   RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONNECTED_COMPONENT_EQ_EMPTY]) THEN
7157   ASM_REWRITE_TAC[INTER_EMPTY] THEN
7158   ASM_CASES_TAC `(b:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN
7159   RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONNECTED_COMPONENT_EQ_EMPTY]) THEN
7160   ASM_REWRITE_TAC[INTER_EMPTY] THEN ASM_CASES_TAC
7161    `connected_component s (a:real^N) = connected_component s b` THEN
7162   ASM_REWRITE_TAC[INTER_IDEMPOT; CONNECTED_COMPONENT_EQ_EMPTY] THEN
7163   FIRST_X_ASSUM(MP_TAC o check(is_neg o concl)) THEN
7164   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
7165   REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN
7166   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM DISJOINT]) THEN
7167   REWRITE_TAC[CONNECTED_COMPONENT_DISJOINT]);;
7168
7169 let CONNECTED_COMPONENT_OVERLAP = prove
7170  (`!s a b:real^N.
7171         ~((connected_component s a) INTER (connected_component s b) = {}) <=>
7172         a IN s /\ b IN s /\
7173         connected_component s a = connected_component s b`,
7174   REWRITE_TAC[CONNECTED_COMPONENT_NONOVERLAP; DE_MORGAN_THM]);;
7175
7176 let CONNECTED_COMPONENT_SYM_EQ = prove
7177  (`!s x y. connected_component s x y <=> connected_component s y x`,
7178   MESON_TAC[CONNECTED_COMPONENT_SYM]);;
7179
7180 let CONNECTED_COMPONENT_EQ_EQ = prove
7181  (`!s x y:real^N.
7182         connected_component s x = connected_component s y <=>
7183            ~(x IN s) /\ ~(y IN s) \/
7184            x IN s /\ y IN s /\ connected_component s x y`,
7185   REPEAT GEN_TAC THEN ASM_CASES_TAC `(y:real^N) IN s` THENL
7186    [ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THENL
7187      [REWRITE_TAC[FUN_EQ_THM] THEN
7188       ASM_MESON_TAC[CONNECTED_COMPONENT_TRANS; CONNECTED_COMPONENT_REFL;
7189                     CONNECTED_COMPONENT_SYM];
7190       ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]];
7191     RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONNECTED_COMPONENT_EQ_EMPTY]) THEN
7192     ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY] THEN
7193     ONCE_REWRITE_TAC[CONNECTED_COMPONENT_SYM_EQ] THEN
7194     ASM_REWRITE_TAC[EMPTY] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]]);;
7195
7196 let CONNECTED_EQ_CONNECTED_COMPONENT_EQ = prove
7197  (`!s. connected s <=>
7198        !x y. x IN s /\ y IN s
7199              ==> connected_component s x = connected_component s y`,
7200   SIMP_TAC[CONNECTED_COMPONENT_EQ_EQ] THEN
7201   REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT]);;
7202
7203 let CONNECTED_COMPONENT_IDEMP = prove
7204  (`!s x:real^N. connected_component (connected_component s x) x =
7205                 connected_component s x`,
7206   REWRITE_TAC[FUN_EQ_THM; connected_component] THEN
7207   REPEAT GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN EQ_TAC THEN
7208   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
7209   ASM_MESON_TAC[CONNECTED_COMPONENT_MAXIMAL; SUBSET_TRANS;
7210                 CONNECTED_COMPONENT_SUBSET]);;
7211
7212 let CONNECTED_COMPONENT_UNIQUE = prove
7213  (`!s c x:real^N.
7214         x IN c /\ c SUBSET s /\ connected c /\
7215         (!c'. x IN c' /\ c' SUBSET s /\ connected c'
7216               ==> c' SUBSET c)
7217         ==> connected_component s x = c`,
7218   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
7219    [FIRST_X_ASSUM MATCH_MP_TAC THEN
7220     REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_CONNECTED_COMPONENT] THEN
7221     REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
7222     ASM SET_TAC[];
7223     MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[]]);;
7224
7225 let JOINABLE_CONNECTED_COMPONENT_EQ = prove
7226  (`!s t x y:real^N.
7227         connected t /\ t SUBSET s /\
7228         ~(connected_component s x INTER t = {}) /\
7229         ~(connected_component s y INTER t = {})
7230         ==> connected_component s x = connected_component s y`,
7231   REPEAT GEN_TAC THEN
7232   REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
7233   REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN DISCH_THEN(CONJUNCTS_THEN2
7234    (X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC)
7235    (X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC)) THEN
7236   REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN
7237   REWRITE_TAC[IN] THEN
7238   MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN
7239   EXISTS_TAC `z:real^N` THEN CONJ_TAC THENL [ASM_MESON_TAC[IN]; ALL_TAC] THEN
7240   MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN
7241   EXISTS_TAC `w:real^N` THEN CONJ_TAC THENL
7242    [REWRITE_TAC[connected_component] THEN
7243     EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[];
7244     ASM_MESON_TAC[IN; CONNECTED_COMPONENT_SYM]]);;
7245
7246 let CONNECTED_COMPONENT_TRANSLATION = prove
7247  (`!a s x. connected_component (IMAGE (\x. a + x) s) (a + x) =
7248                 IMAGE (\x. a + x) (connected_component s x)`,
7249   REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN GEOM_TRANSLATE_TAC[]);;
7250
7251 add_translation_invariants [CONNECTED_COMPONENT_TRANSLATION];;
7252
7253 let CONNECTED_COMPONENT_LINEAR_IMAGE = prove
7254  (`!f s x. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
7255            ==> connected_component (IMAGE f s) (f x) =
7256                IMAGE f (connected_component s x)`,
7257   REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN
7258   GEOM_TRANSFORM_TAC[]);;
7259
7260 add_linear_invariants [CONNECTED_COMPONENT_LINEAR_IMAGE];;
7261
7262 let UNIONS_CONNECTED_COMPONENT = prove
7263  (`!s:real^N->bool. UNIONS {connected_component s x |x| x IN s} = s`,
7264   GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
7265   REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC; CONNECTED_COMPONENT_SUBSET] THEN
7266   REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM] THEN
7267   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `x:real^N` THEN
7268   ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN] THEN
7269   ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ]);;
7270
7271 let COMPLEMENT_CONNECTED_COMPONENT_UNIONS = prove
7272  (`!s x:real^N.
7273      s DIFF connected_component s x =
7274      UNIONS({connected_component s y | y | y IN s} DELETE
7275             (connected_component s x))`,
7276   REPEAT GEN_TAC THEN
7277   GEN_REWRITE_TAC (LAND_CONV o LAND_CONV)
7278     [GSYM UNIONS_CONNECTED_COMPONENT] THEN
7279   MATCH_MP_TAC(SET_RULE
7280    `(!x. x IN s DELETE a ==> DISJOINT a x)
7281      ==> UNIONS s DIFF a = UNIONS (s DELETE a)`) THEN
7282   REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC; IN_DELETE] THEN
7283   SIMP_TAC[CONNECTED_COMPONENT_DISJOINT; CONNECTED_COMPONENT_EQ_EQ] THEN
7284   MESON_TAC[IN; SUBSET; CONNECTED_COMPONENT_SUBSET]);;
7285
7286 let CLOSED_IN_CONNECTED_COMPONENT = prove
7287  (`!s x:real^N. closed_in (subtopology euclidean s) (connected_component s x)`,
7288   REPEAT GEN_TAC THEN
7289   ASM_CASES_TAC `connected_component s (x:real^N) = {}` THEN
7290   ASM_REWRITE_TAC[CLOSED_IN_EMPTY] THEN
7291   RULE_ASSUM_TAC(REWRITE_RULE[CONNECTED_COMPONENT_EQ_EMPTY]) THEN
7292   REWRITE_TAC[CLOSED_IN_CLOSED] THEN
7293   EXISTS_TAC `closure(connected_component s x):real^N->bool` THEN
7294   REWRITE_TAC[CLOSED_CLOSURE] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
7295   REWRITE_TAC[SUBSET_INTER; CONNECTED_COMPONENT_SUBSET; CLOSURE_SUBSET] THEN
7296   MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN REWRITE_TAC[INTER_SUBSET] THEN
7297   CONJ_TAC THENL
7298    [ASM_REWRITE_TAC[IN_INTER] THEN
7299     MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN
7300     ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ];
7301     MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
7302     EXISTS_TAC `connected_component s (x:real^N)` THEN
7303     REWRITE_TAC[INTER_SUBSET; CONNECTED_CONNECTED_COMPONENT;
7304                 SUBSET_INTER; CONNECTED_COMPONENT_SUBSET; CLOSURE_SUBSET]]);;
7305
7306 let OPEN_IN_CONNECTED_COMPONENT = prove
7307  (`!s x:real^N.
7308         FINITE {connected_component s x |x| x IN s}
7309         ==> open_in (subtopology euclidean s) (connected_component s x)`,
7310   REPEAT STRIP_TAC THEN
7311   SUBGOAL_THEN
7312    `connected_component s (x:real^N) =
7313         s DIFF (UNIONS {connected_component s y |y| y IN s} DIFF
7314                 connected_component s x)`
7315   SUBST1_TAC THENL
7316    [REWRITE_TAC[UNIONS_CONNECTED_COMPONENT] THEN
7317     MATCH_MP_TAC(SET_RULE `t SUBSET s ==> t = s DIFF (s DIFF t)`) THEN
7318     REWRITE_TAC[CONNECTED_COMPONENT_SUBSET];
7319     MATCH_MP_TAC OPEN_IN_DIFF THEN
7320     REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN
7321     REWRITE_TAC[UNIONS_DIFF] THEN
7322     MATCH_MP_TAC CLOSED_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN
7323     ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN
7324     X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
7325     SUBGOAL_THEN
7326      `connected_component s y DIFF connected_component s x =
7327       connected_component s y \/
7328       connected_component s (y:real^N) DIFF connected_component s x = {}`
7329      (DISJ_CASES_THEN SUBST1_TAC)
7330     THENL
7331      [MATCH_MP_TAC(SET_RULE
7332        `(~(s INTER t = {}) ==> s = t) ==> s DIFF t = s \/ s DIFF t = {}`) THEN
7333       SIMP_TAC[CONNECTED_COMPONENT_OVERLAP];
7334       REWRITE_TAC[CLOSED_IN_CONNECTED_COMPONENT];
7335       REWRITE_TAC[CLOSED_IN_EMPTY]]]);;
7336
7337 let CONNECTED_COMPONENT_EQUIVALENCE_RELATION = prove
7338  (`!R s:real^N->bool.
7339         (!x y. R x y ==> R y x) /\
7340         (!x y z. R x y /\ R y z ==> R x z) /\
7341         (!a. a IN s
7342              ==> ?t. open_in (subtopology euclidean s) t /\ a IN t /\
7343                      !x. x IN t ==> R a x)
7344         ==> !a b. connected_component s a b ==> R a b`,
7345   REPEAT STRIP_TAC THEN
7346   MP_TAC(ISPECL [`R:real^N->real^N->bool`; `connected_component s (a:real^N)`]
7347     CONNECTED_EQUIVALENCE_RELATION) THEN
7348   ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN ANTS_TAC THENL
7349    [X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN
7350     FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N`) THEN ANTS_TAC THENL
7351      [ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN
7352     DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
7353     EXISTS_TAC `t INTER connected_component s (a:real^N)` THEN
7354     ASM_SIMP_TAC[IN_INTER; OPEN_IN_OPEN] THEN
7355     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
7356     MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN
7357     MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`]
7358         CONNECTED_COMPONENT_SUBSET) THEN
7359     SET_TAC[];
7360     DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN] THEN
7361     REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
7362     ASM_MESON_TAC[CONNECTED_COMPONENT_IN]]);;
7363
7364 let CONNECTED_COMPONENT_INTERMEDIATE_SUBSET = prove
7365  (`!t u a:real^N.
7366         connected_component u a SUBSET t /\ t SUBSET u
7367         ==> connected_component t a = connected_component u a`,
7368   REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN u` THENL
7369    [REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_UNIQUE THEN
7370     ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN
7371     CONJ_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_REFL; IN]; ALL_TAC] THEN
7372     REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
7373     ASM SET_TAC[];
7374     ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY; SUBSET]]);;
7375
7376 (* ------------------------------------------------------------------------- *)
7377 (* The set of connected components of a set.                                 *)
7378 (* ------------------------------------------------------------------------- *)
7379
7380 let components = new_definition
7381   `components s = {connected_component s x | x | x:real^N IN s}`;;
7382
7383 let COMPONENTS_TRANSLATION = prove
7384  (`!a s. components(IMAGE (\x. a + x) s) =
7385    IMAGE (IMAGE (\x. a + x)) (components s)`,
7386   REWRITE_TAC[components] THEN GEOM_TRANSLATE_TAC[] THEN SET_TAC[]);;
7387
7388 add_translation_invariants [COMPONENTS_TRANSLATION];;
7389
7390 let COMPONENTS_LINEAR_IMAGE = prove
7391  (`!f s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
7392            ==> components(IMAGE f s) = IMAGE (IMAGE f) (components s)`,
7393   REWRITE_TAC[components] THEN GEOM_TRANSFORM_TAC[] THEN SET_TAC[]);;
7394
7395 add_linear_invariants [COMPONENTS_LINEAR_IMAGE];;
7396
7397 let IN_COMPONENTS = prove
7398  (`!u:real^N->bool s. s IN components u
7399     <=> ?x. x IN u /\ s = connected_component u x`,
7400   REPEAT GEN_TAC THEN REWRITE_TAC[components] THEN EQ_TAC
7401   THENL [SET_TAC[];STRIP_TAC THEN ASM_SIMP_TAC[] THEN
7402   UNDISCH_TAC `x:real^N IN u` THEN SET_TAC[]]);;
7403
7404 let UNIONS_COMPONENTS = prove
7405  (`!u:real^N->bool. u = UNIONS (components u)`,
7406   REWRITE_TAC[EXTENSION] THEN REPEAT GEN_TAC THEN EQ_TAC
7407   THENL[DISCH_TAC THEN REWRITE_TAC[IN_UNIONS] THEN
7408   EXISTS_TAC `connected_component (u:real^N->bool) x` THEN CONJ_TAC THENL
7409   [REWRITE_TAC[components] THEN SET_TAC[ASSUME `x:real^N IN u`];
7410   REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SUBGOAL_THEN
7411   `?s:real^N->bool. connected s /\ s SUBSET u /\ x IN s` MP_TAC
7412   THENL[EXISTS_TAC `{x:real^N}` THEN ASM_REWRITE_TAC[CONNECTED_SING] THEN
7413   POP_ASSUM MP_TAC THEN SET_TAC[]; SET_TAC[]]];
7414   REWRITE_TAC[IN_UNIONS] THEN STRIP_TAC THEN
7415   MATCH_MP_TAC (SET_RULE `!x:real^N s u. x IN s /\ s SUBSET u ==> x IN u`) THEN
7416   EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN STRIP_ASSUME_TAC
7417   (MESON[IN_COMPONENTS;ASSUME `t:real^N->bool IN components u`]
7418   `?y. t:real^N->bool = connected_component u y`) THEN
7419    ASM_REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]]);;
7420
7421 let PAIRWISE_DISJOINT_COMPONENTS = prove
7422  (`!u:real^N->bool. pairwise DISJOINT (components u)`,
7423   GEN_TAC THEN REWRITE_TAC[pairwise;DISJOINT] THEN
7424   MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN STRIP_TAC THEN
7425   ASSERT_TAC `(?a. s:real^N->bool = connected_component u a) /\
7426   ?b. t:real^N->bool = connected_component u b`
7427   THENL [ASM_MESON_TAC[IN_COMPONENTS];
7428   ASM_MESON_TAC[CONNECTED_COMPONENT_NONOVERLAP]]);;
7429
7430 let IN_COMPONENTS_NONEMPTY = prove
7431  (`!s c. c IN components s ==> ~(c = {})`,
7432   REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN
7433   STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY]);;
7434
7435 let IN_COMPONENTS_SUBSET = prove
7436  (`!s c. c IN components s ==> c SUBSET s`,
7437   REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN
7438   STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]);;
7439
7440 let IN_COMPONENTS_CONNECTED = prove
7441  (`!s c. c IN components s ==> connected c`,
7442   REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN
7443   STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT]);;
7444
7445 let IN_COMPONENTS_MAXIMAL = prove
7446  (`!s c:real^N->bool.
7447         c IN components s <=>
7448         ~(c = {}) /\ c SUBSET s /\ connected c /\
7449         !c'. ~(c' = {}) /\ c SUBSET c' /\ c' SUBSET s /\ connected c'
7450              ==> c' = c`,
7451   REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN EQ_TAC THENL
7452    [DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN
7453     ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY; CONNECTED_COMPONENT_SUBSET;
7454                     CONNECTED_CONNECTED_COMPONENT] THEN
7455     REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
7456     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
7457     ASM_MESON_TAC[CONNECTED_COMPONENT_REFL; IN; SUBSET];
7458     STRIP_TAC THEN
7459     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
7460     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN
7461     DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
7462     MATCH_MP_TAC(GSYM CONNECTED_COMPONENT_UNIQUE) THEN
7463     ASM_REWRITE_TAC[] THEN X_GEN_TAC `c':real^N->bool` THEN STRIP_TAC THEN
7464     REWRITE_TAC[SET_RULE `c' SUBSET c <=> c' UNION c = c`] THEN
7465     FIRST_X_ASSUM MATCH_MP_TAC THEN
7466     REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
7467     MATCH_MP_TAC CONNECTED_UNION THEN ASM SET_TAC[]]);;
7468
7469 let JOINABLE_COMPONENTS_EQ = prove
7470  (`!s t c1 c2.
7471         connected t /\ t SUBSET s /\
7472         c1 IN components s /\ c2 IN components s /\
7473         ~(c1 INTER t = {}) /\ ~(c2 INTER t = {})
7474         ==> c1 = c2`,
7475   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; components; FORALL_IN_GSPEC] THEN
7476   MESON_TAC[JOINABLE_CONNECTED_COMPONENT_EQ]);;
7477
7478 let CLOSED_IN_COMPONENT = prove
7479  (`!s c:real^N->bool.
7480         c IN components s ==> closed_in (subtopology euclidean s) c`,
7481   REWRITE_TAC[components; FORALL_IN_GSPEC; CLOSED_IN_CONNECTED_COMPONENT]);;
7482
7483 let CLOSED_COMPONENTS = prove
7484  (`!s c. closed s /\ c IN components s ==> closed c`,
7485   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; components; FORALL_IN_GSPEC] THEN
7486   SIMP_TAC[CLOSED_CONNECTED_COMPONENT]);;
7487
7488 let COMPACT_COMPONENTS = prove
7489  (`!s c:real^N->bool. compact s /\ c IN components s ==> compact c`,
7490   REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN
7491   MESON_TAC[CLOSED_COMPONENTS; IN_COMPONENTS_SUBSET; BOUNDED_SUBSET]);;
7492
7493 let CONTINUOUS_ON_COMPONENTS_GEN = prove
7494  (`!f:real^M->real^N s.
7495         (!c. c IN components s
7496              ==> open_in (subtopology euclidean s) c /\ f continuous_on c)
7497         ==> f continuous_on s`,
7498   REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_OPEN_IN_PREIMAGE_EQ] THEN
7499   DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_TAC THEN
7500   SUBGOAL_THEN
7501    `{x | x IN s /\ (f:real^M->real^N) x IN t} =
7502     UNIONS {{x | x IN c /\ f x IN t} | c IN components s}`
7503   SUBST1_TAC THENL
7504    [CONV_TAC(LAND_CONV(SUBS_CONV
7505      [ISPEC `s:real^M->bool` UNIONS_COMPONENTS])) THEN
7506     REWRITE_TAC[UNIONS_GSPEC; IN_UNIONS] THEN SET_TAC[];
7507     MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN
7508     ASM_MESON_TAC[OPEN_IN_TRANS]]);;
7509
7510 let CONTINUOUS_ON_COMPONENTS_FINITE = prove
7511  (`!f:real^M->real^N s.
7512         FINITE(components s) /\
7513         (!c. c IN components s ==> f continuous_on c)
7514         ==> f continuous_on s`,
7515   REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_EQ] THEN
7516   DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_TAC THEN
7517   SUBGOAL_THEN
7518    `{x | x IN s /\ (f:real^M->real^N) x IN t} =
7519     UNIONS {{x | x IN c /\ f x IN t} | c IN components s}`
7520   SUBST1_TAC THENL
7521    [CONV_TAC(LAND_CONV(SUBS_CONV
7522      [ISPEC `s:real^M->bool` UNIONS_COMPONENTS])) THEN
7523     REWRITE_TAC[UNIONS_GSPEC; IN_UNIONS] THEN SET_TAC[];
7524     MATCH_MP_TAC CLOSED_IN_UNIONS THEN
7525     ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN
7526     ASM_MESON_TAC[CLOSED_IN_TRANS; CLOSED_IN_COMPONENT]]);;
7527
7528 let COMPONENTS_NONOVERLAP = prove
7529  (`!s c c'. c IN components s /\ c' IN components s
7530             ==> (c INTER c' = {} <=> ~(c = c'))`,
7531   REWRITE_TAC[components; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
7532   ASM_SIMP_TAC[CONNECTED_COMPONENT_NONOVERLAP]);;
7533
7534 let COMPONENTS_EQ = prove
7535  (`!s c c'. c IN components s /\ c' IN components s
7536             ==> (c = c' <=> ~(c INTER c' = {}))`,
7537   MESON_TAC[COMPONENTS_NONOVERLAP]);;
7538
7539 let COMPONENTS_EQ_EMPTY = prove
7540  (`!s. components s = {} <=> s = {}`,
7541   GEN_TAC THEN REWRITE_TAC[EXTENSION] THEN
7542   REWRITE_TAC[components; connected_component; IN_ELIM_THM] THEN
7543   SET_TAC[]);;
7544
7545 let COMPONENTS_EMPTY = prove
7546  (`components {} = {}`,
7547   REWRITE_TAC[COMPONENTS_EQ_EMPTY]);;
7548
7549 let CONNECTED_EQ_CONNECTED_COMPONENTS_EQ = prove
7550  (`!s. connected s <=>
7551        !c c'. c IN components s /\ c' IN components s ==> c = c'`,
7552   REWRITE_TAC[components; IN_ELIM_THM] THEN
7553   MESON_TAC[CONNECTED_EQ_CONNECTED_COMPONENT_EQ]);;
7554
7555 let COMPONENTS_EQ_SING,COMPONENTS_EQ_SING_EXISTS = (CONJ_PAIR o prove)
7556  (`(!s:real^N->bool. components s = {s} <=> connected s /\ ~(s = {})) /\
7557    (!s:real^N->bool. (?a. components s = {a}) <=> connected s /\ ~(s = {}))`,
7558   REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `s:real^N->bool` THEN
7559   MATCH_MP_TAC(TAUT `(p ==> q) /\ (q ==> r) /\ (r ==> p)
7560                      ==> (p <=> r) /\ (q <=> r)`) THEN
7561   REPEAT CONJ_TAC THENL
7562    [MESON_TAC[];
7563     STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENTS_EQ] THEN
7564     ASM_MESON_TAC[IN_SING; COMPONENTS_EQ_EMPTY; NOT_INSERT_EMPTY];
7565     STRIP_TAC THEN ONCE_REWRITE_TAC[EXTENSION] THEN
7566     REWRITE_TAC[IN_SING] THEN
7567     REWRITE_TAC[components; IN_ELIM_THM] THEN
7568     ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT_SET; MEMBER_NOT_EMPTY]]);;
7569
7570 let CONNECTED_EQ_COMPONENTS_SUBSET_SING = prove
7571  (`!s:real^N->bool. connected s <=> components s SUBSET {s}`,
7572   GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
7573   ASM_REWRITE_TAC[COMPONENTS_EMPTY; CONNECTED_EMPTY; EMPTY_SUBSET] THEN
7574   REWRITE_TAC[SET_RULE `s SUBSET {a} <=> s = {} \/ s = {a}`] THEN
7575   ASM_REWRITE_TAC[COMPONENTS_EQ_EMPTY; COMPONENTS_EQ_SING]);;
7576
7577 let CONNECTED_EQ_COMPONENTS_SUBSET_SING_EXISTS = prove
7578  (`!s:real^N->bool. connected s <=> ?a. components s SUBSET {a}`,
7579   GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
7580   ASM_REWRITE_TAC[COMPONENTS_EMPTY; CONNECTED_EMPTY; EMPTY_SUBSET] THEN
7581   REWRITE_TAC[SET_RULE `s SUBSET {a} <=> s = {} \/ s = {a}`] THEN
7582   ASM_REWRITE_TAC[COMPONENTS_EQ_EMPTY; COMPONENTS_EQ_SING_EXISTS]);;
7583
7584 let IN_COMPONENTS_SELF = prove
7585  (`!s:real^N->bool. s IN components s <=> connected s /\ ~(s = {})`,
7586   GEN_TAC THEN EQ_TAC THENL
7587    [MESON_TAC[IN_COMPONENTS_NONEMPTY; IN_COMPONENTS_CONNECTED];
7588     SIMP_TAC[GSYM COMPONENTS_EQ_SING; IN_SING]]);;
7589
7590 let COMPONENTS_MAXIMAL = prove
7591  (`!s t c:real^N->bool.
7592      c IN components s /\ connected t /\ t SUBSET s /\ ~(c INTER t = {})
7593      ==> t SUBSET c`,
7594   REWRITE_TAC[IMP_CONJ; components; FORALL_IN_GSPEC] THEN
7595   REPEAT STRIP_TAC THEN
7596   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
7597   REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM] THEN
7598   X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN
7599   FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP CONNECTED_COMPONENT_EQ) THEN
7600   MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[]);;
7601
7602 let COMPONENTS_UNIQUE = prove
7603  (`!s:real^N->bool k.
7604         UNIONS k = s /\
7605         (!c. c IN k
7606              ==> connected c /\ ~(c = {}) /\
7607                  !c'. connected c' /\ c SUBSET c' /\ c' SUBSET s ==> c' = c)
7608         ==> components s = k`,
7609   REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN
7610   X_GEN_TAC `c:real^N->bool` THEN REWRITE_TAC[IN_COMPONENTS] THEN
7611   EQ_TAC THENL
7612    [DISCH_THEN(X_CHOOSE_THEN `x:real^N`
7613      (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN
7614     FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [EXTENSION]) THEN
7615     REWRITE_TAC[IN_UNIONS] THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
7616     X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN
7617     SUBGOAL_THEN `connected_component s (x:real^N) = c`
7618      (fun th -> ASM_REWRITE_TAC[th]) THEN
7619     MATCH_MP_TAC CONNECTED_COMPONENT_UNIQUE THEN
7620     FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN
7621     ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
7622     CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
7623     X_GEN_TAC `c':real^N->bool` THEN STRIP_TAC THEN
7624     REWRITE_TAC[SET_RULE `c' SUBSET c <=> c' UNION c = c`] THEN
7625     FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL
7626      [MATCH_MP_TAC CONNECTED_UNION; ASM SET_TAC[]] THEN
7627     ASM SET_TAC[];
7628     DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN
7629     ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
7630     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
7631     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
7632     CONJ_TAC THENL [ASM SET_TAC[]; CONV_TAC SYM_CONV] THEN
7633     FIRST_X_ASSUM MATCH_MP_TAC THEN
7634     REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; CONNECTED_COMPONENT_SUBSET] THEN
7635     MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
7636     ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);;
7637
7638 let COMPONENTS_UNIQUE_EQ = prove
7639  (`!s:real^N->bool k.
7640         components s = k <=>
7641         UNIONS k = s /\
7642         (!c. c IN k
7643              ==> connected c /\ ~(c = {}) /\
7644                  !c'. connected c' /\ c SUBSET c' /\ c' SUBSET s ==> c' = c)`,
7645   REPEAT GEN_TAC THEN EQ_TAC THENL
7646    [DISCH_THEN(SUBST1_TAC o SYM); REWRITE_TAC[COMPONENTS_UNIQUE]] THEN
7647   REWRITE_TAC[GSYM UNIONS_COMPONENTS] THEN
7648   X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL
7649    [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED];
7650     ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY];
7651     RULE_ASSUM_TAC(REWRITE_RULE[IN_COMPONENTS_MAXIMAL]) THEN
7652     ASM_MESON_TAC[SUBSET_EMPTY]]);;
7653
7654 let EXISTS_COMPONENT_SUPERSET = prove
7655  (`!s t:real^N->bool.
7656         t SUBSET s /\ ~(s = {}) /\ connected t
7657         ==> ?c. c IN components s /\ t SUBSET c`,
7658   REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL
7659    [ASM_REWRITE_TAC[EMPTY_SUBSET] THEN
7660     ASM_MESON_TAC[COMPONENTS_EQ_EMPTY; MEMBER_NOT_EMPTY];
7661     FIRST_X_ASSUM(X_CHOOSE_TAC `a:real^N` o
7662       GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
7663     EXISTS_TAC `connected_component s (a:real^N)` THEN
7664     REWRITE_TAC[IN_COMPONENTS] THEN CONJ_TAC THENL
7665      [ASM SET_TAC[]; ASM_MESON_TAC[CONNECTED_COMPONENT_MAXIMAL]]]);;
7666
7667 let COMPONENTS_INTERMEDIATE_SUBSET = prove
7668  (`!s t u:real^N->bool.
7669         s IN components u /\ s SUBSET t /\ t SUBSET u
7670         ==> s IN components t`,
7671   REPEAT GEN_TAC THEN REWRITE_TAC[IN_COMPONENTS; LEFT_AND_EXISTS_THM] THEN
7672   MESON_TAC[CONNECTED_COMPONENT_INTERMEDIATE_SUBSET; SUBSET;
7673             CONNECTED_COMPONENT_REFL; IN; CONNECTED_COMPONENT_SUBSET]);;
7674
7675 let IN_COMPONENTS_UNIONS_COMPLEMENT = prove
7676  (`!s c:real^N->bool.
7677         c IN components s
7678         ==> s DIFF c = UNIONS(components s DELETE c)`,
7679   REWRITE_TAC[components; FORALL_IN_GSPEC;
7680               COMPLEMENT_CONNECTED_COMPONENT_UNIONS]);;
7681
7682 let CONNECTED_SUBSET_CLOPEN = prove
7683  (`!u s c:real^N->bool.
7684         closed_in (subtopology euclidean u) s /\
7685         open_in (subtopology euclidean u) s /\
7686         connected c /\ c SUBSET u /\ ~(c INTER s = {})
7687         ==> c SUBSET s`,
7688   REPEAT STRIP_TAC THEN
7689   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_CLOSED_IN]) THEN
7690   REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o
7691     SPECL [`c INTER s:real^N->bool`; `c DIFF s:real^N->bool`]) THEN
7692   ASM_REWRITE_TAC[CONJ_ASSOC; SET_RULE `c DIFF s = {} <=> c SUBSET s`] THEN
7693   MATCH_MP_TAC(TAUT `p ==> ~(p /\ ~q) ==> q`) THEN
7694   REPLICATE_TAC 2 (CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN
7695   CONJ_TAC THENL
7696    [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]);
7697     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN])] THEN
7698   DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
7699   REWRITE_TAC[OPEN_IN_OPEN; CLOSED_IN_CLOSED] THENL
7700    [EXISTS_TAC `t:real^N->bool`; EXISTS_TAC `(:real^N) DIFF t`] THEN
7701   ASM_REWRITE_TAC[GSYM OPEN_CLOSED] THEN ASM SET_TAC[]);;
7702
7703 let CLOPEN_UNIONS_COMPONENTS = prove
7704  (`!u s:real^N->bool.
7705         closed_in (subtopology euclidean u) s /\
7706         open_in (subtopology euclidean u) s
7707         ==> ?k. k SUBSET components u /\ s = UNIONS k`,
7708   REPEAT STRIP_TAC THEN
7709   EXISTS_TAC `{c:real^N->bool | c IN components u /\ ~(c INTER s = {})}` THEN
7710   REWRITE_TAC[SUBSET_RESTRICT] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
7711   CONJ_TAC THENL
7712    [MP_TAC(ISPEC `u:real^N->bool` UNIONS_COMPONENTS) THEN
7713     FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SET_TAC[];
7714     REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN
7715     REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_SUBSET_CLOPEN THEN
7716     EXISTS_TAC `u:real^N->bool` THEN
7717     ASM_MESON_TAC[IN_COMPONENTS_CONNECTED; IN_COMPONENTS_SUBSET]]);;
7718
7719 let CLOPEN_IN_COMPONENTS = prove
7720  (`!u s:real^N->bool.
7721         closed_in (subtopology euclidean u) s /\
7722         open_in (subtopology euclidean u) s /\
7723         connected s /\ ~(s = {})
7724         ==> s IN components u`,
7725   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN
7726   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
7727   FIRST_ASSUM(MP_TAC o MATCH_MP CLOPEN_UNIONS_COMPONENTS) THEN
7728   DISCH_THEN(X_CHOOSE_THEN `k:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
7729   ASM_CASES_TAC `k:(real^N->bool)->bool = {}` THEN
7730   ASM_REWRITE_TAC[UNIONS_0] THEN
7731   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
7732   DISCH_THEN(X_CHOOSE_TAC `c:real^N->bool`) THEN
7733   ASM_CASES_TAC `k = {c:real^N->bool}` THENL
7734    [ASM_MESON_TAC[UNIONS_1; GSYM SING_SUBSET]; ALL_TAC] THEN
7735   MATCH_MP_TAC(TAUT `~p ==> p /\ q ==> r`) THEN
7736   SUBGOAL_THEN `?c':real^N->bool. c' IN k /\ ~(c = c')` STRIP_ASSUME_TAC THENL
7737    [ASM_MESON_TAC[SET_RULE
7738      `a IN s /\ ~(s = {a}) ==> ?b. b IN s /\ ~(b = a)`];
7739     REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENTS_EQ] THEN
7740     DISCH_THEN(MP_TAC o SPECL [`c:real^N->bool`; `c':real^N->bool`]) THEN
7741     ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THEN
7742     MATCH_MP_TAC COMPONENTS_INTERMEDIATE_SUBSET THEN
7743     EXISTS_TAC `u:real^N->bool` THEN
7744     MP_TAC(ISPEC `u:real^N->bool` UNIONS_COMPONENTS) THEN ASM SET_TAC[]]);;
7745
7746 (* ------------------------------------------------------------------------- *)
7747 (* Continuity implies uniform continuity on a compact domain.                *)
7748 (* ------------------------------------------------------------------------- *)
7749
7750 let COMPACT_UNIFORMLY_EQUICONTINUOUS = prove
7751  (`!(fs:(real^M->real^N)->bool) s.
7752      (!x e. x IN s /\ &0 < e
7753             ==> ?d. &0 < d /\
7754                     (!f x'. f IN fs /\ x' IN s /\ dist (x',x) < d
7755                             ==> dist (f x',f x) < e)) /\
7756      compact s
7757      ==> !e. &0 < e
7758              ==> ?d. &0 < d /\
7759                      !f x x'. f IN fs /\ x IN s /\ x' IN s /\ dist (x',x) < d
7760                               ==> dist(f x',f x) < e`,
7761   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
7762   GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
7763   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
7764   X_GEN_TAC `d:real^M->real->real` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN
7765   DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP HEINE_BOREL_LEMMA) THEN
7766   DISCH_THEN(MP_TAC o SPEC
7767     `{ ball(x:real^M,d x (e / &2)) | x IN s}`) THEN
7768   SIMP_TAC[FORALL_IN_GSPEC; OPEN_BALL; UNIONS_GSPEC; SUBSET; IN_ELIM_THM] THEN
7769   ANTS_TAC THENL [ASM_MESON_TAC[CENTRE_IN_BALL; REAL_HALF]; ALL_TAC] THEN
7770   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real` THEN STRIP_TAC THEN
7771   ASM_REWRITE_TAC[] THEN
7772   MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `u:real^M`; `v:real^M`] THEN
7773   STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `v:real^M` th) THEN
7774     ASM_REWRITE_TAC[] THEN DISCH_THEN(CHOOSE_THEN MP_TAC)) THEN
7775   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
7776   DISCH_THEN(fun th ->
7777     MP_TAC(SPEC `u:real^M` th) THEN MP_TAC(SPEC `v:real^M` th)) THEN
7778   ASM_REWRITE_TAC[DIST_REFL] THEN
7779   FIRST_X_ASSUM(X_CHOOSE_THEN `w:real^M` (CONJUNCTS_THEN2 ASSUME_TAC
7780     SUBST_ALL_TAC)) THEN
7781   ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN ASM_REWRITE_TAC[IN_BALL] THEN
7782   ONCE_REWRITE_TAC[DIST_SYM] THEN REPEAT STRIP_TAC THEN
7783   FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^M`; `e / &2`]) THEN
7784   ASM_REWRITE_TAC[REAL_HALF] THEN
7785   DISCH_THEN(MP_TAC o SPEC `f:real^M->real^N` o CONJUNCT2) THEN
7786   DISCH_THEN(fun th -> MP_TAC(SPEC `u:real^M` th) THEN
7787                         MP_TAC(SPEC `v:real^M` th)) THEN
7788   ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH);;
7789
7790 let COMPACT_UNIFORMLY_CONTINUOUS = prove
7791  (`!f:real^M->real^N s.
7792         f continuous_on s /\ compact s ==> f uniformly_continuous_on s`,
7793   REPEAT GEN_TAC THEN REWRITE_TAC[continuous_on; uniformly_continuous_on] THEN
7794   STRIP_TAC THEN
7795   MP_TAC(ISPECL [`{f:real^M->real^N}`; `s:real^M->bool`]
7796         COMPACT_UNIFORMLY_EQUICONTINUOUS) THEN
7797   REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; IN_SING; FORALL_UNWIND_THM2] THEN
7798   ASM_MESON_TAC[]);;
7799
7800 (* ------------------------------------------------------------------------- *)
7801 (* A uniformly convergent limit of continuous functions is continuous.       *)
7802 (* ------------------------------------------------------------------------- *)
7803
7804 let CONTINUOUS_UNIFORM_LIMIT = prove
7805  (`!net f:A->real^M->real^N g s.
7806         ~(trivial_limit net) /\
7807         eventually (\n. (f n) continuous_on s) net /\
7808         (!e. &0 < e
7809              ==> eventually (\n. !x. x IN s ==> norm(f n x - g x) < e) net)
7810         ==> g continuous_on s`,
7811   REWRITE_TAC[continuous_on] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
7812   X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN
7813   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
7814   FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN
7815   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
7816   FIRST_X_ASSUM(fun th -> MP_TAC th THEN REWRITE_TAC[IMP_IMP] THEN
7817         GEN_REWRITE_TAC LAND_CONV [GSYM EVENTUALLY_AND]) THEN
7818   DISCH_THEN(MP_TAC o MATCH_MP EVENTUALLY_HAPPENS) THEN
7819   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:A` THEN
7820   DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `x:real^M`) ASSUME_TAC) THEN
7821   ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN
7822   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
7823   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN
7824   MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN
7825   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^M` THEN
7826   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
7827   FIRST_X_ASSUM(fun th ->
7828    MP_TAC(SPEC `x:real^M` th) THEN MP_TAC(SPEC `y:real^M` th)) THEN
7829   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH
7830    `w <= x + y + z
7831     ==> x < e / &3 ==> y < e / &3 ==> z < e / &3 ==> w < e`) THEN
7832   REWRITE_TAC[dist] THEN
7833   SUBST1_TAC(VECTOR_ARITH
7834    `(g:real^M->real^N) y - g x =
7835     --(f (a:A) y - g y) + (f a x - g x) + (f a y - f a x)`) THEN
7836   MATCH_MP_TAC NORM_TRIANGLE_LE THEN REWRITE_TAC[NORM_NEG; REAL_LE_LADD] THEN
7837   MATCH_MP_TAC NORM_TRIANGLE_LE THEN REWRITE_TAC[NORM_NEG; REAL_LE_REFL]);;
7838
7839 (* ------------------------------------------------------------------------- *)
7840 (* Topological stuff lifted from and dropped to R                            *)
7841 (* ------------------------------------------------------------------------- *)
7842
7843 let OPEN_LIFT = prove
7844  (`!s. open(IMAGE lift s) <=>
7845         !x. x IN s ==> ?e. &0 < e /\ !x'. abs(x' - x) < e ==> x' IN s`,
7846   REWRITE_TAC[open_def; FORALL_LIFT; LIFT_IN_IMAGE_LIFT; DIST_LIFT]);;
7847
7848 let LIMPT_APPROACHABLE_LIFT = prove
7849  (`!x s. (lift x) limit_point_of (IMAGE lift s) <=>
7850          !e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ abs(x' - x) < e`,
7851   REWRITE_TAC[LIMPT_APPROACHABLE; EXISTS_LIFT; LIFT_IN_IMAGE_LIFT;
7852               LIFT_EQ; DIST_LIFT]);;
7853
7854 let CLOSED_LIFT = prove
7855  (`!s. closed (IMAGE lift s) <=>
7856         !x. (!e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ abs(x' - x) < e)
7857             ==> x IN s`,
7858   GEN_TAC THEN REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE] THEN
7859   ONCE_REWRITE_TAC[FORALL_LIFT] THEN
7860   REWRITE_TAC[LIMPT_APPROACHABLE_LIFT; LIFT_EQ; DIST_LIFT;
7861               EXISTS_LIFT; LIFT_IN_IMAGE_LIFT]);;
7862
7863 let CONTINUOUS_AT_LIFT_RANGE = prove
7864  (`!f x. (lift o f) continuous (at x) <=>
7865                 !e. &0 < e
7866                     ==> ?d. &0 < d /\
7867                             (!x'. norm(x' - x) < d
7868                                   ==> abs(f x' - f x) < e)`,
7869   REWRITE_TAC[continuous_at; o_THM; DIST_LIFT] THEN REWRITE_TAC[dist]);;
7870
7871 let CONTINUOUS_ON_LIFT_RANGE = prove
7872  (`!f s. (lift o f) continuous_on s <=>
7873          !x. x IN s
7874              ==> !e. &0 < e
7875                      ==> ?d. &0 < d /\
7876                              (!x'. x' IN s /\ norm(x' - x) < d
7877                                    ==> abs(f x' - f x) < e)`,
7878   REWRITE_TAC[continuous_on; o_THM; DIST_LIFT] THEN REWRITE_TAC[dist]);;
7879
7880 let CONTINUOUS_LIFT_NORM_COMPOSE = prove
7881  (`!net f:A->real^N.
7882         f continuous net
7883         ==> (\x. lift(norm(f x))) continuous net`,
7884   REPEAT GEN_TAC THEN REWRITE_TAC[continuous; tendsto] THEN
7885   MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
7886   REWRITE_TAC[] THEN
7887   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
7888   REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP] THEN
7889   NORM_ARITH_TAC);;
7890
7891 let CONTINUOUS_ON_LIFT_NORM_COMPOSE = prove
7892  (`!f:real^M->real^N s.
7893         f continuous_on s
7894         ==> (\x. lift(norm(f x))) continuous_on s`,
7895   SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_LIFT_NORM_COMPOSE]);;
7896
7897 let CONTINUOUS_AT_LIFT_NORM = prove
7898  (`!x. (lift o norm) continuous (at x)`,
7899   REWRITE_TAC[CONTINUOUS_AT_LIFT_RANGE; NORM_LIFT] THEN
7900   MESON_TAC[REAL_ABS_SUB_NORM; REAL_LET_TRANS]);;
7901
7902 let CONTINUOUS_ON_LIFT_NORM = prove
7903  (`!s. (lift o norm) continuous_on s`,
7904   REWRITE_TAC[CONTINUOUS_ON_LIFT_RANGE; NORM_LIFT] THEN
7905   MESON_TAC[REAL_ABS_SUB_NORM; REAL_LET_TRANS]);;
7906
7907 let CONTINUOUS_AT_LIFT_COMPONENT = prove
7908  (`!i a. 1 <= i /\ i <= dimindex(:N)
7909          ==> (\x:real^N. lift(x$i)) continuous (at a)`,
7910   SIMP_TAC[continuous_at; DIST_LIFT; GSYM VECTOR_SUB_COMPONENT] THEN
7911   MESON_TAC[dist; REAL_LET_TRANS; COMPONENT_LE_NORM]);;
7912
7913 let CONTINUOUS_ON_LIFT_COMPONENT = prove
7914  (`!i s. 1 <= i /\ i <= dimindex(:N)
7915          ==> (\x:real^N. lift(x$i)) continuous_on s`,
7916   SIMP_TAC[continuous_on; DIST_LIFT; GSYM VECTOR_SUB_COMPONENT] THEN
7917   MESON_TAC[dist; REAL_LET_TRANS; COMPONENT_LE_NORM]);;
7918
7919 let CONTINUOUS_AT_LIFT_INFNORM = prove
7920  (`!x:real^N. (lift o infnorm) continuous (at x)`,
7921   REWRITE_TAC[CONTINUOUS_AT; LIM_AT; o_THM; DIST_LIFT] THEN
7922   MESON_TAC[REAL_LET_TRANS; dist; REAL_ABS_SUB_INFNORM; INFNORM_LE_NORM]);;
7923
7924 let CONTINUOUS_AT_LIFT_DIST = prove
7925  (`!a:real^N x. (lift o (\x. dist(a,x))) continuous (at x)`,
7926   REWRITE_TAC[CONTINUOUS_AT_LIFT_RANGE] THEN
7927   MESON_TAC[NORM_ARITH `abs(dist(a:real^N,x) - dist(a,y)) <= norm(x - y)`;
7928             REAL_LET_TRANS]);;
7929
7930 let CONTINUOUS_ON_LIFT_DIST = prove
7931  (`!a s. (lift o (\x. dist(a,x))) continuous_on s`,
7932   REWRITE_TAC[CONTINUOUS_ON_LIFT_RANGE] THEN
7933   MESON_TAC[NORM_ARITH `abs(dist(a:real^N,x) - dist(a,y)) <= norm(x - y)`;
7934             REAL_LET_TRANS]);;
7935
7936 (* ------------------------------------------------------------------------- *)
7937 (* Hence some handy theorems on distance, diameter etc. of/from a set.       *)
7938 (* ------------------------------------------------------------------------- *)
7939
7940 let COMPACT_ATTAINS_SUP = prove
7941  (`!s. compact (IMAGE lift s) /\ ~(s = {})
7942        ==> ?x. x IN s /\ !y. y IN s ==> y <= x`,
7943   REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN REPEAT STRIP_TAC THEN
7944   MP_TAC(SPEC `s:real->bool` BOUNDED_HAS_SUP) THEN ASM_REWRITE_TAC[] THEN
7945   STRIP_TAC THEN EXISTS_TAC `sup s` THEN ASM_REWRITE_TAC[] THEN
7946   ASM_MESON_TAC[CLOSED_LIFT; REAL_ARITH `s <= s - e <=> ~(&0 < e)`;
7947                 REAL_ARITH `x <= s /\ ~(x <= s - e) ==> abs(x - s) < e`]);;
7948
7949 let COMPACT_ATTAINS_INF = prove
7950  (`!s. compact (IMAGE lift s) /\ ~(s = {})
7951        ==> ?x. x IN s /\ !y. y IN s ==> x <= y`,
7952   REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN REPEAT STRIP_TAC THEN
7953   MP_TAC(SPEC `s:real->bool` BOUNDED_HAS_INF) THEN ASM_REWRITE_TAC[] THEN
7954   STRIP_TAC THEN EXISTS_TAC `inf s` THEN ASM_REWRITE_TAC[] THEN
7955   ASM_MESON_TAC[CLOSED_LIFT; REAL_ARITH `s + e <= s <=> ~(&0 < e)`;
7956                 REAL_ARITH `s <= x /\ ~(s + e <= x) ==> abs(x - s) < e`]);;
7957
7958 let CONTINUOUS_ATTAINS_SUP = prove
7959  (`!f:real^N->real s.
7960         compact s /\ ~(s = {}) /\ (lift o f) continuous_on s
7961         ==> ?x. x IN s /\ !y. y IN s ==> f(y) <= f(x)`,
7962   REPEAT STRIP_TAC THEN
7963   MP_TAC(SPEC `IMAGE (f:real^N->real) s` COMPACT_ATTAINS_SUP) THEN
7964   ASM_SIMP_TAC[GSYM IMAGE_o; COMPACT_CONTINUOUS_IMAGE; IMAGE_EQ_EMPTY] THEN
7965   MESON_TAC[IN_IMAGE]);;
7966
7967 let CONTINUOUS_ATTAINS_INF = prove
7968  (`!f:real^N->real s.
7969         compact s /\ ~(s = {}) /\ (lift o f) continuous_on s
7970         ==> ?x. x IN s /\ !y. y IN s ==> f(x) <= f(y)`,
7971   REPEAT STRIP_TAC THEN
7972   MP_TAC(SPEC `IMAGE (f:real^N->real) s` COMPACT_ATTAINS_INF) THEN
7973   ASM_SIMP_TAC[GSYM IMAGE_o; COMPACT_CONTINUOUS_IMAGE; IMAGE_EQ_EMPTY] THEN
7974   MESON_TAC[IN_IMAGE]);;
7975
7976 let DISTANCE_ATTAINS_SUP = prove
7977  (`!s a. compact s /\ ~(s = {})
7978          ==> ?x. x IN s /\ !y. y IN s ==> dist(a,y) <= dist(a,x)`,
7979   REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ATTAINS_SUP THEN
7980   ASM_REWRITE_TAC[CONTINUOUS_ON_LIFT_RANGE] THEN REWRITE_TAC[dist] THEN
7981   ASM_MESON_TAC[REAL_LET_TRANS; REAL_ABS_SUB_NORM; NORM_NEG;
7982                 VECTOR_ARITH `(a - x) - (a - y) = --(x - y):real^N`]);;
7983
7984 (* ------------------------------------------------------------------------- *)
7985 (* For *minimal* distance, we only need closure, not compactness.            *)
7986 (* ------------------------------------------------------------------------- *)
7987
7988 let DISTANCE_ATTAINS_INF = prove
7989  (`!s a:real^N.
7990         closed s /\ ~(s = {})
7991         ==> ?x. x IN s /\ !y. y IN s ==> dist(a,x) <= dist(a,y)`,
7992   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
7993   REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
7994   DISCH_THEN(X_CHOOSE_TAC `b:real^N`) THEN
7995   MP_TAC(ISPECL [`\x:real^N. dist(a,x)`; `cball(a:real^N,dist(b,a)) INTER s`]
7996                 CONTINUOUS_ATTAINS_INF) THEN
7997   ANTS_TAC THENL
7998    [ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTER; BOUNDED_INTER;
7999                  BOUNDED_CBALL; CLOSED_CBALL; GSYM MEMBER_NOT_EMPTY] THEN
8000     REWRITE_TAC[dist; CONTINUOUS_ON_LIFT_RANGE; IN_INTER; IN_CBALL] THEN
8001     ASM_MESON_TAC[REAL_LET_TRANS; REAL_ABS_SUB_NORM; NORM_NEG; REAL_LE_REFL;
8002             NORM_SUB; VECTOR_ARITH `(a - x) - (a - y) = --(x - y):real^N`];
8003     MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[IN_INTER; IN_CBALL] THEN
8004     ASM_MESON_TAC[DIST_SYM; REAL_LE_TOTAL; REAL_LE_TRANS]]);;
8005
8006 (* ------------------------------------------------------------------------- *)
8007 (* We can now extend limit compositions to consider the scalar multiplier.   *)
8008 (* ------------------------------------------------------------------------- *)
8009
8010 let LIM_MUL = prove
8011  (`!net:(A)net f l:real^N c d.
8012         ((lift o c) --> lift d) net /\ (f --> l) net
8013         ==> ((\x. c(x) % f(x)) --> (d % l)) net`,
8014   REPEAT STRIP_TAC THEN
8015   MP_TAC(ISPECL [`net:(A)net`; `\x (y:real^N). drop x % y`;
8016   `lift o (c:A->real)`; `f:A->real^N`; `lift d`; `l:real^N`] LIM_BILINEAR) THEN
8017   ASM_REWRITE_TAC[LIFT_DROP; o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN
8018   REWRITE_TAC[bilinear; linear; DROP_ADD; DROP_CMUL] THEN
8019   REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;
8020
8021 let LIM_VMUL = prove
8022  (`!net:(A)net c d v:real^N.
8023         ((lift o c) --> lift d) net ==> ((\x. c(x) % v) --> d % v) net`,
8024   REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_MUL THEN ASM_REWRITE_TAC[LIM_CONST]);;
8025
8026 let CONTINUOUS_VMUL = prove
8027  (`!net c v. (lift o c) continuous net ==> (\x. c(x) % v) continuous net`,
8028   REWRITE_TAC[continuous; LIM_VMUL; o_THM]);;
8029
8030 let CONTINUOUS_MUL = prove
8031  (`!net f c. (lift o c) continuous net /\ f continuous net
8032              ==> (\x. c(x) % f(x)) continuous net`,
8033   REWRITE_TAC[continuous; LIM_MUL; o_THM]);;
8034
8035 let CONTINUOUS_ON_VMUL = prove
8036  (`!s c v. (lift o c) continuous_on s ==> (\x. c(x) % v) continuous_on s`,
8037   REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
8038   SIMP_TAC[CONTINUOUS_VMUL]);;
8039
8040 let CONTINUOUS_ON_MUL = prove
8041  (`!s c f. (lift o c) continuous_on s /\ f continuous_on s
8042            ==> (\x. c(x) % f(x)) continuous_on s`,
8043   REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
8044   SIMP_TAC[CONTINUOUS_MUL]);;
8045
8046 let CONTINUOUS_LIFT_POW = prove
8047  (`!net f:A->real n.
8048         (\x. lift(f x)) continuous net
8049         ==> (\x. lift(f x pow n)) continuous net`,
8050   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN
8051   INDUCT_TAC THEN ASM_REWRITE_TAC[LIFT_CMUL; real_pow; CONTINUOUS_CONST] THEN
8052   MATCH_MP_TAC CONTINUOUS_MUL THEN ASM_REWRITE_TAC[o_DEF]);;
8053
8054 let CONTINUOUS_ON_LIFT_POW = prove
8055  (`!f:real^N->real s n.
8056         (\x. lift(f x)) continuous_on s
8057         ==> (\x. lift(f x pow n)) continuous_on s`,
8058   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN
8059   DISCH_TAC THEN INDUCT_TAC THEN
8060   ASM_REWRITE_TAC[LIFT_CMUL; real_pow; CONTINUOUS_ON_CONST] THEN
8061   MATCH_MP_TAC CONTINUOUS_ON_MUL THEN ASM_REWRITE_TAC[o_DEF]);;
8062
8063 let CONTINUOUS_LIFT_PRODUCT = prove
8064  (`!net:(A)net f (t:B->bool).
8065         FINITE t /\
8066         (!i. i IN t ==> (\x. lift(f x i)) continuous net)
8067         ==> (\x. lift(product t (f x))) continuous net`,
8068   GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
8069   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES] THEN
8070   REWRITE_TAC[CONTINUOUS_CONST; LIFT_CMUL; FORALL_IN_INSERT] THEN
8071   REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN
8072   ASM_SIMP_TAC[o_DEF]);;
8073
8074 let CONTINUOUS_ON_LIFT_PRODUCT = prove
8075  (`!f:real^N->A->real s t.
8076         FINITE t /\
8077
8078         (!i. i IN t ==> (\x. lift(f x i)) continuous_on s)
8079         ==> (\x. lift(product t (f x))) continuous_on s`,
8080   SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_LIFT_PRODUCT]);;
8081
8082 (* ------------------------------------------------------------------------- *)
8083 (* And so we have continuity of inverse.                                     *)
8084 (* ------------------------------------------------------------------------- *)
8085
8086 let LIM_INV = prove
8087  (`!net:(A)net f l.
8088         ((lift o f) --> lift l) net /\ ~(l = &0)
8089         ==> ((lift o inv o f) --> lift(inv l)) net`,
8090   REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN
8091   ASM_CASES_TAC `trivial_limit(net:(A)net)` THEN ASM_REWRITE_TAC[] THEN
8092   REWRITE_TAC[o_THM; DIST_LIFT] THEN STRIP_TAC THEN
8093   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
8094   FIRST_X_ASSUM(MP_TAC o SPEC `min (abs(l) / &2) ((l pow 2 * e) / &2)`) THEN
8095   REWRITE_TAC[REAL_LT_MIN] THEN ANTS_TAC THENL
8096    [ASM_SIMP_TAC[GSYM REAL_ABS_NZ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
8097     MATCH_MP_TAC REAL_LT_DIV THEN REWRITE_TAC[REAL_OF_NUM_LT; ARITH] THEN
8098     ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN
8099     ASM_SIMP_TAC[REAL_LT_MUL; GSYM REAL_ABS_NZ; REAL_POW_LT];
8100     ALL_TAC] THEN
8101   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:A` THEN
8102   MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN
8103   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `b:A` THEN
8104   MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
8105   SIMP_TAC[REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN STRIP_TAC THEN
8106   FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REAL_ARITH
8107    `abs(x - l) * &2 < abs l ==> ~(x = &0)`)) THEN
8108   ASM_SIMP_TAC[REAL_SUB_INV; REAL_ABS_DIV; REAL_LT_LDIV_EQ;
8109                GSYM REAL_ABS_NZ; REAL_ENTIRE] THEN
8110   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
8111    `abs(x - y) * &2 < b * c ==> c * b <= d * &2 ==> abs(y - x) < d`)) THEN
8112   ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_LE_LMUL_EQ] THEN
8113   ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
8114   ASM_SIMP_TAC[REAL_ABS_MUL; REAL_POW_2; REAL_MUL_ASSOC; GSYM REAL_ABS_NZ;
8115                REAL_LE_RMUL_EQ] THEN
8116   ASM_SIMP_TAC[REAL_ARITH `abs(x - y) * &2 < abs y ==> abs y <= &2 * abs x`]);;
8117
8118 let CONTINUOUS_INV = prove
8119  (`!net f. (lift o f) continuous net /\ ~(f(netlimit net) = &0)
8120            ==> (lift o inv o f) continuous net`,
8121   REWRITE_TAC[continuous; LIM_INV; o_THM]);;
8122
8123 let CONTINUOUS_AT_WITHIN_INV = prove
8124  (`!f s a:real^N.
8125         (lift o f) continuous (at a within s) /\ ~(f a = &0)
8126         ==> (lift o inv o f) continuous (at a within s)`,
8127   REPEAT GEN_TAC THEN
8128   ASM_CASES_TAC `trivial_limit (at (a:real^N) within s)` THENL
8129    [ASM_REWRITE_TAC[continuous; LIM];
8130     ASM_SIMP_TAC[NETLIMIT_WITHIN; CONTINUOUS_INV]]);;
8131
8132 let CONTINUOUS_AT_INV = prove
8133  (`!f a. (lift o f) continuous at a /\ ~(f a = &0)
8134          ==> (lift o inv o f) continuous at a`,
8135   ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
8136   REWRITE_TAC[CONTINUOUS_AT_WITHIN_INV]);;
8137
8138 let CONTINUOUS_ON_INV = prove
8139  (`!f s. (lift o f) continuous_on s /\ (!x. x IN s ==> ~(f x = &0))
8140          ==> (lift o inv o f) continuous_on s`,
8141   SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_AT_WITHIN_INV]);;
8142
8143 (* ------------------------------------------------------------------------- *)
8144 (* More preservation properties for pasted sets (Cartesian products).        *)
8145 (* ------------------------------------------------------------------------- *)
8146
8147 let LIM_PASTECART = prove
8148  (`!net f:A->real^M g:A->real^N.
8149         (f --> a) net /\ (g --> b) net
8150         ==> ((\x. pastecart (f x) (g x)) --> pastecart a b) net`,
8151   REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN
8152   ASM_CASES_TAC `trivial_limit(net:(A)net)` THEN ASM_REWRITE_TAC[] THEN
8153   REWRITE_TAC[AND_FORALL_THM] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN
8154   DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
8155   ASM_REWRITE_TAC[REAL_HALF] THEN
8156   DISCH_THEN(MP_TAC o MATCH_MP NET_DILEMMA) THEN
8157   MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN
8158   REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
8159   MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
8160   REWRITE_TAC[dist; PASTECART_SUB] THEN
8161   MATCH_MP_TAC(REAL_ARITH
8162     `z <= x + y ==> x < e / &2 /\ y < e / &2 ==> z < e`) THEN
8163   REWRITE_TAC[NORM_PASTECART_LE]);;
8164
8165 let LIM_PASTECART_EQ = prove
8166  (`!net f:A->real^M g:A->real^N.
8167         ((\x. pastecart (f x) (g x)) --> pastecart a b) net <=>
8168         (f --> a) net /\ (g --> b) net`,
8169   REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[LIM_PASTECART] THEN
8170   REPEAT STRIP_TAC THENL
8171    [FIRST_ASSUM(MP_TAC o ISPEC `fstcart:real^(M,N)finite_sum->real^M` o
8172         MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_LINEAR)) THEN
8173     REWRITE_TAC[LINEAR_FSTCART; FSTCART_PASTECART; ETA_AX];
8174     FIRST_ASSUM(MP_TAC o ISPEC `sndcart:real^(M,N)finite_sum->real^N` o
8175         MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_LINEAR)) THEN
8176     REWRITE_TAC[LINEAR_SNDCART; SNDCART_PASTECART; ETA_AX]]);;
8177
8178 let CONTINUOUS_PASTECART = prove
8179  (`!net f:A->real^M g:A->real^N.
8180         f continuous net /\ g continuous net
8181         ==> (\x. pastecart (f x) (g x)) continuous net`,
8182   REWRITE_TAC[continuous; LIM_PASTECART]);;
8183
8184 let CONTINUOUS_ON_PASTECART = prove
8185  (`!f:real^M->real^N g:real^M->real^P s.
8186         f continuous_on s /\ g continuous_on s
8187         ==> (\x. pastecart (f x) (g x)) continuous_on s`,
8188   SIMP_TAC[CONTINUOUS_ON; LIM_PASTECART]);;
8189
8190 let CONNECTED_PCROSS = prove
8191  (`!s:real^M->bool t:real^N->bool.
8192         connected s /\ connected t
8193         ==> connected (s PCROSS t)`,
8194   REPEAT GEN_TAC THEN
8195   REWRITE_TAC[PCROSS; CONNECTED_IFF_CONNECTED_COMPONENT] THEN
8196   DISCH_TAC THEN REWRITE_TAC[FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN
8197   MAP_EVERY X_GEN_TAC [`x1:real^M`; `y1:real^N`; `x2:real^M`; `y2:real^N`] THEN
8198   STRIP_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN2
8199    (MP_TAC o SPECL [`x1:real^M`; `x2:real^M`])
8200    (MP_TAC o SPECL [`y1:real^N`; `y2:real^N`])) THEN
8201   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; connected_component] THEN
8202   X_GEN_TAC `c2:real^N->bool` THEN STRIP_TAC THEN
8203   X_GEN_TAC `c1:real^M->bool` THEN STRIP_TAC THEN
8204   EXISTS_TAC
8205    `IMAGE (\x:real^M. pastecart x y1) c1 UNION
8206     IMAGE (\y:real^N. pastecart x2 y) c2` THEN
8207   REWRITE_TAC[IN_UNION] THEN REPEAT CONJ_TAC THENL
8208    [MATCH_MP_TAC CONNECTED_UNION THEN
8209     ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE; CONTINUOUS_ON_PASTECART;
8210                  CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
8211     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; EXISTS_IN_IMAGE] THEN
8212     EXISTS_TAC `x2:real^M` THEN ASM SET_TAC[];
8213     REWRITE_TAC[SUBSET; IN_UNION; FORALL_AND_THM; FORALL_IN_IMAGE;
8214                 TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN
8215     ASM SET_TAC[];
8216     ASM SET_TAC[];
8217     ASM SET_TAC[]]);;
8218
8219 let CONNECTED_PCROSS_EQ = prove
8220  (`!s:real^M->bool t:real^N->bool.
8221         connected (s PCROSS t) <=>
8222         s = {} \/ t = {} \/ connected s /\ connected t`,
8223   REPEAT GEN_TAC THEN
8224   ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
8225   ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
8226   REWRITE_TAC[PCROSS_EMPTY; CONNECTED_EMPTY] THEN
8227   EQ_TAC THEN SIMP_TAC[CONNECTED_PCROSS] THEN
8228   REWRITE_TAC[PCROSS] THEN REPEAT STRIP_TAC THENL
8229    [SUBGOAL_THEN `connected (IMAGE fstcart
8230                      {pastecart (x:real^M) (y:real^N) | x IN s /\ y IN t})`
8231     MP_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE; ALL_TAC];
8232     SUBGOAL_THEN `connected (IMAGE sndcart
8233                      {pastecart (x:real^M) (y:real^N) | x IN s /\ y IN t})`
8234     MP_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE; ALL_TAC]] THEN
8235   ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN
8236   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
8237   REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; IN_ELIM_PASTECART_THM;
8238               FSTCART_PASTECART; SNDCART_PASTECART] THEN
8239   ASM SET_TAC[]);;
8240
8241 let CLOSURE_PCROSS = prove
8242  (`!s:real^M->bool t:real^N->bool.
8243         closure (s PCROSS t) = (closure s) PCROSS (closure t)`,
8244   REWRITE_TAC[EXTENSION; PCROSS; FORALL_PASTECART] THEN REPEAT GEN_TAC THEN
8245   REWRITE_TAC[CLOSURE_APPROACHABLE; EXISTS_PASTECART; FORALL_PASTECART] THEN
8246   REWRITE_TAC[IN_ELIM_PASTECART_THM; PASTECART_INJ] THEN
8247   REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN
8248   REWRITE_TAC[dist; PASTECART_SUB] THEN EQ_TAC THENL
8249    [MESON_TAC[NORM_LE_PASTECART; REAL_LET_TRANS]; DISCH_TAC] THEN
8250   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
8251   FIRST_X_ASSUM(CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`)) THEN
8252   ASM_MESON_TAC[REAL_HALF; NORM_PASTECART_LE; REAL_ARITH
8253     `z <= x + y /\ x < e / &2 /\ y < e / &2 ==> z < e`]);;
8254
8255 let LIMPT_PCROSS = prove
8256  (`!s:real^M->bool t:real^N->bool x y.
8257         x limit_point_of s /\ y limit_point_of t
8258         ==> (pastecart x y) limit_point_of (s PCROSS t)`,
8259   REPEAT GEN_TAC THEN
8260   REWRITE_TAC[PCROSS; LIMPT_APPROACHABLE; EXISTS_PASTECART] THEN
8261   REWRITE_TAC[IN_ELIM_PASTECART_THM; PASTECART_INJ; dist; PASTECART_SUB] THEN
8262   DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
8263   FIRST_X_ASSUM(CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`)) THEN
8264   ASM_MESON_TAC[REAL_HALF; NORM_PASTECART_LE; REAL_ARITH
8265     `z <= x + y /\ x < e / &2 /\ y < e / &2 ==> z < e`]);;
8266
8267 let CLOSED_IN_PCROSS = prove
8268  (`!s:real^M->bool s' t:real^N->bool t'.
8269         closed_in (subtopology euclidean s) s' /\
8270         closed_in (subtopology euclidean t) t'
8271         ==> closed_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t')`,
8272   REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN
8273   DISCH_THEN(CONJUNCTS_THEN2
8274    (X_CHOOSE_THEN `s'':real^M->bool` STRIP_ASSUME_TAC)
8275    (X_CHOOSE_THEN `t'':real^N->bool` STRIP_ASSUME_TAC)) THEN
8276   EXISTS_TAC `(s'':real^M->bool) PCROSS (t'':real^N->bool)` THEN
8277   ASM_SIMP_TAC[CLOSED_PCROSS; EXTENSION; FORALL_PASTECART] THEN
8278   REWRITE_TAC[IN_INTER; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]);;
8279
8280 let CLOSED_IN_PCROSS_EQ = prove
8281  (`!s s':real^M->bool t t':real^N->bool.
8282         closed_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t') <=>
8283         s' = {} \/ t' = {} \/
8284         closed_in (subtopology euclidean s) s' /\
8285         closed_in (subtopology euclidean t) t'`,
8286   REPEAT GEN_TAC THEN
8287   ASM_CASES_TAC `s':real^M->bool = {}` THEN
8288   ASM_REWRITE_TAC[PCROSS_EMPTY; CLOSED_IN_EMPTY] THEN
8289   ASM_CASES_TAC `t':real^N->bool = {}` THEN
8290   ASM_REWRITE_TAC[PCROSS_EMPTY; CLOSED_IN_EMPTY] THEN
8291   EQ_TAC THEN REWRITE_TAC[CLOSED_IN_PCROSS] THEN
8292   ASM_REWRITE_TAC[CLOSED_IN_INTER_CLOSURE; CLOSURE_PCROSS; INTER_PCROSS;
8293                   PCROSS_EQ; PCROSS_EQ_EMPTY]);;
8294
8295 let FRONTIER_PCROSS = prove
8296  (`!s:real^M->bool t:real^N->bool.
8297         frontier(s PCROSS t) = frontier s PCROSS closure t UNION
8298                                closure s PCROSS frontier t`,
8299   REPEAT GEN_TAC THEN
8300   REWRITE_TAC[frontier; CLOSURE_PCROSS; INTERIOR_PCROSS; PCROSS_DIFF] THEN
8301   REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_DIFF; IN_UNION;
8302               PASTECART_IN_PCROSS] THEN
8303   ASM SET_TAC[]);;
8304
8305 (* ------------------------------------------------------------------------- *)
8306 (* Hence some useful properties follow quite easily.                         *)
8307 (* ------------------------------------------------------------------------- *)
8308
8309 let CONNECTED_SCALING = prove
8310  (`!s:real^N->bool c. connected s ==> connected (IMAGE (\x. c % x) s)`,
8311   REPEAT STRIP_TAC THEN
8312   MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
8313   MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
8314   REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
8315   REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);;
8316
8317 let CONNECTED_NEGATIONS = prove
8318  (`!s:real^N->bool. connected s ==> connected (IMAGE (--) s)`,
8319   REPEAT STRIP_TAC THEN
8320   MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
8321   MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
8322   REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
8323   REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);;
8324
8325 let CONNECTED_SUMS = prove
8326  (`!s t:real^N->bool.
8327         connected s /\ connected t ==> connected {x + y | x IN s /\ y IN t}`,
8328   REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_PCROSS) THEN
8329   DISCH_THEN(MP_TAC o ISPEC
8330    `\z. (fstcart z + sndcart z:real^N)` o
8331     MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] CONNECTED_CONTINUOUS_IMAGE)) THEN
8332   SIMP_TAC[CONTINUOUS_ON_ADD; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART;
8333            LINEAR_SNDCART; PCROSS] THEN
8334   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
8335   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; EXISTS_PASTECART] THEN
8336   REWRITE_TAC[PASTECART_INJ; FSTCART_PASTECART; SNDCART_PASTECART] THEN
8337   MESON_TAC[]);;
8338
8339 let COMPACT_SCALING = prove
8340  (`!s:real^N->bool c. compact s ==> compact (IMAGE (\x. c % x) s)`,
8341   REPEAT STRIP_TAC THEN
8342   MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
8343   MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
8344   REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
8345   REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);;
8346
8347 let COMPACT_NEGATIONS = prove
8348  (`!s:real^N->bool. compact s ==> compact (IMAGE (--) s)`,
8349   REPEAT STRIP_TAC THEN
8350   MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
8351   MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
8352   REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
8353   REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);;
8354
8355 let COMPACT_SUMS = prove
8356  (`!s:real^N->bool t.
8357         compact s /\ compact t ==> compact {x + y | x IN s /\ y IN t}`,
8358   REPEAT STRIP_TAC THEN
8359   SUBGOAL_THEN `{x + y | x IN s /\ y IN t} =
8360                 IMAGE (\z. fstcart z + sndcart z :real^N) (s PCROSS t)`
8361   SUBST1_TAC THENL
8362    [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; PCROSS] THEN
8363     GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
8364     ASM_MESON_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_FST_SND];
8365     ALL_TAC] THEN
8366   MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
8367   ASM_SIMP_TAC[COMPACT_PCROSS] THEN
8368   MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
8369   REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN
8370   REWRITE_TAC[linear; FSTCART_ADD; FSTCART_CMUL; SNDCART_ADD;
8371               SNDCART_CMUL] THEN
8372   CONJ_TAC THEN VECTOR_ARITH_TAC);;
8373
8374 let COMPACT_DIFFERENCES = prove
8375  (`!s:real^N->bool t.
8376         compact s /\ compact t ==> compact {x - y | x IN s /\ y IN t}`,
8377   REPEAT STRIP_TAC THEN
8378   SUBGOAL_THEN `{x - y | x:real^N IN s /\ y IN t} =
8379                 {x + y | x IN s /\ y IN (IMAGE (--) t)}`
8380     (fun th -> ASM_SIMP_TAC[th; COMPACT_SUMS; COMPACT_NEGATIONS]) THEN
8381   REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN
8382   ONCE_REWRITE_TAC[VECTOR_ARITH `(x:real^N = --y) <=> (y = --x)`] THEN
8383   SIMP_TAC[VECTOR_SUB; GSYM CONJ_ASSOC; UNWIND_THM2] THEN
8384   MESON_TAC[VECTOR_NEG_NEG]);;
8385
8386 let COMPACT_AFFINITY = prove
8387  (`!s a:real^N c.
8388         compact s ==> compact (IMAGE (\x. a + c % x) s)`,
8389   REPEAT STRIP_TAC THEN
8390   SUBGOAL_THEN `(\x:real^N. a + c % x) = (\x. a + x) o (\x. c % x)`
8391   SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN
8392   ASM_SIMP_TAC[IMAGE_o; COMPACT_TRANSLATION; COMPACT_SCALING]);;
8393
8394 (* ------------------------------------------------------------------------- *)
8395 (* Hence we get the following.                                               *)
8396 (* ------------------------------------------------------------------------- *)
8397
8398 let COMPACT_SUP_MAXDISTANCE = prove
8399  (`!s:real^N->bool.
8400         compact s /\ ~(s = {})
8401         ==> ?x y. x IN s /\ y IN s /\
8402                   !u v. u IN s /\ v IN s ==> norm(u - v) <= norm(x - y)`,
8403   REPEAT STRIP_TAC THEN
8404   MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN s}`; `vec 0:real^N`]
8405                 DISTANCE_ATTAINS_SUP) THEN
8406   ANTS_TAC THENL
8407    [ASM_SIMP_TAC[COMPACT_DIFFERENCES] THEN
8408     REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN
8409     ASM_MESON_TAC[MEMBER_NOT_EMPTY];
8410     REWRITE_TAC[IN_ELIM_THM; dist; VECTOR_SUB_RZERO; VECTOR_SUB_LZERO;
8411                 NORM_NEG] THEN
8412     MESON_TAC[]]);;
8413
8414 (* ------------------------------------------------------------------------- *)
8415 (* We can state this in terms of diameter of a set.                          *)
8416 (* ------------------------------------------------------------------------- *)
8417
8418 let diameter = new_definition
8419   `diameter s =
8420         if s = {} then &0
8421         else sup {norm(x - y) | x IN s /\ y IN s}`;;
8422
8423 let DIAMETER_BOUNDED = prove
8424  (`!s. bounded s
8425        ==> (!x:real^N y. x IN s /\ y IN s ==> norm(x - y) <= diameter s) /\
8426            (!d. &0 <= d /\ d < diameter s
8427                 ==> ?x y. x IN s /\ y IN s /\ norm(x - y) > d)`,
8428   GEN_TAC THEN DISCH_TAC THEN
8429   ASM_CASES_TAC `s:real^N->bool = {}` THEN
8430   ASM_REWRITE_TAC[diameter; NOT_IN_EMPTY; REAL_LET_ANTISYM] THEN
8431   MP_TAC(SPEC `{norm(x - y:real^N) | x IN s /\ y IN s}` SUP) THEN
8432   ABBREV_TAC `b = sup {norm(x - y:real^N) | x IN s /\ y IN s}` THEN
8433   REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN
8434   REWRITE_TAC[NOT_IN_EMPTY; real_gt] THEN ANTS_TAC THENL
8435    [CONJ_TAC THENL [ASM_MESON_TAC[MEMBER_NOT_EMPTY]; ALL_TAC];
8436     MESON_TAC[REAL_NOT_LE]] THEN
8437   SIMP_TAC[VECTOR_SUB; LEFT_IMP_EXISTS_THM] THEN
8438   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN
8439   MESON_TAC[REAL_ARITH `x <= y + z /\ y <= b /\ z<= b ==> x <= b + b`;
8440             NORM_TRIANGLE; NORM_NEG]);;
8441
8442 let DIAMETER_BOUNDED_BOUND = prove
8443  (`!s x y. bounded s /\ x IN s /\ y IN s ==> norm(x - y) <= diameter s`,
8444   MESON_TAC[DIAMETER_BOUNDED]);;
8445
8446 let DIAMETER_COMPACT_ATTAINED = prove
8447  (`!s:real^N->bool.
8448         compact s /\ ~(s = {})
8449         ==> ?x y. x IN s /\ y IN s /\ (norm(x - y) = diameter s)`,
8450   GEN_TAC THEN DISCH_TAC THEN
8451   FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_SUP_MAXDISTANCE) THEN
8452   REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
8453   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
8454   MP_TAC(SPEC `s:real^N->bool` DIAMETER_BOUNDED) THEN
8455   RULE_ASSUM_TAC(REWRITE_RULE[COMPACT_EQ_BOUNDED_CLOSED]) THEN
8456   ASM_REWRITE_TAC[real_gt] THEN STRIP_TAC THEN
8457   REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
8458   ASM_MESON_TAC[NORM_POS_LE; REAL_NOT_LT]);;
8459
8460 let DIAMETER_TRANSLATION = prove
8461  (`!a s. diameter (IMAGE (\x. a + x) s) = diameter s`,
8462   REWRITE_TAC[diameter] THEN GEOM_TRANSLATE_TAC[]);;
8463
8464 add_translation_invariants [DIAMETER_TRANSLATION];;
8465
8466 let DIAMETER_LINEAR_IMAGE = prove
8467  (`!f:real^M->real^N s.
8468         linear f /\ (!x. norm(f x) = norm x)
8469         ==> diameter(IMAGE f s) = diameter s`,
8470   REWRITE_TAC[diameter] THEN
8471   REPEAT STRIP_TAC THEN REWRITE_TAC[diameter; IMAGE_EQ_EMPTY] THEN
8472   COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN
8473   REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN
8474   REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; EXISTS_IN_IMAGE] THEN
8475   ASM_MESON_TAC[LINEAR_SUB]);;
8476
8477 add_linear_invariants [DIAMETER_LINEAR_IMAGE];;
8478
8479 let DIAMETER_EMPTY = prove
8480  (`diameter {} = &0`,
8481   REWRITE_TAC[diameter]);;
8482
8483 let DIAMETER_SING = prove
8484  (`!a. diameter {a} = &0`,
8485   REWRITE_TAC[diameter; NOT_INSERT_EMPTY; IN_SING] THEN
8486   REWRITE_TAC[SET_RULE `{f x y | x = a /\ y = a} = {f a a }`] THEN
8487   REWRITE_TAC[SUP_SING; VECTOR_SUB_REFL; NORM_0]);;
8488
8489 let DIAMETER_POS_LE = prove
8490  (`!s:real^N->bool. bounded s ==> &0 <= diameter s`,
8491   REPEAT STRIP_TAC THEN REWRITE_TAC[diameter] THEN
8492   COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN
8493   MP_TAC(SPEC `{norm(x - y:real^N) | x IN s /\ y IN s}` SUP) THEN
8494   REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL
8495    [CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
8496     FIRST_X_ASSUM(X_CHOOSE_TAC `B:real` o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
8497     EXISTS_TAC `&2 * B` THEN
8498     ASM_SIMP_TAC[NORM_ARITH
8499       `norm x <= B /\ norm y <= B ==> norm(x - y) <= &2 * B`];
8500     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
8501     DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN
8502     DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `a:real^N`] o CONJUNCT1) THEN
8503     ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0]]);;
8504
8505 let DIAMETER_SUBSET = prove
8506  (`!s t:real^N->bool. s SUBSET t /\ bounded t ==> diameter s <= diameter t`,
8507   REPEAT STRIP_TAC THEN
8508   ASM_CASES_TAC `s:real^N->bool = {}` THEN
8509   ASM_SIMP_TAC[DIAMETER_EMPTY; DIAMETER_POS_LE] THEN
8510   ASM_REWRITE_TAC[diameter] THEN
8511   COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
8512   MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN
8513   REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
8514   REWRITE_TAC[FORALL_IN_GSPEC] THEN
8515   FIRST_X_ASSUM(X_CHOOSE_TAC `B:real` o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
8516   EXISTS_TAC `&2 * B` THEN
8517   ASM_SIMP_TAC[NORM_ARITH
8518     `norm x <= B /\ norm y <= B ==> norm(x - y) <= &2 * B`]);;
8519
8520 let DIAMETER_CLOSURE = prove
8521  (`!s:real^N->bool. bounded s ==> diameter(closure s) = diameter s`,
8522   REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN REPEAT STRIP_TAC THEN
8523   ASM_SIMP_TAC[DIAMETER_SUBSET; BOUNDED_CLOSURE; CLOSURE_SUBSET] THEN
8524   REWRITE_TAC[GSYM REAL_NOT_LT] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
8525   DISCH_TAC THEN MP_TAC(ISPEC `closure s:real^N->bool` DIAMETER_BOUNDED) THEN
8526   ABBREV_TAC `d = diameter(closure s) - diameter(s:real^N->bool)` THEN
8527   ASM_SIMP_TAC[BOUNDED_CLOSURE] THEN DISCH_THEN(MP_TAC o
8528     SPEC `diameter(closure(s:real^N->bool)) - d / &2` o CONJUNCT2) THEN
8529   REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; NOT_EXISTS_THM] THEN
8530   FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIAMETER_POS_LE) THEN
8531   REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
8532   MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
8533   REWRITE_TAC[CLOSURE_APPROACHABLE; CONJ_ASSOC; AND_FORALL_THM] THEN
8534   DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `d / &4`) ASSUME_TAC) THEN
8535   ASM_REWRITE_TAC[REAL_ARITH `&0 < d / &4 <=> &0 < d`] THEN
8536   DISCH_THEN(CONJUNCTS_THEN2
8537    (X_CHOOSE_THEN `u:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))
8538    (X_CHOOSE_THEN `v:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))) THEN
8539   FIRST_ASSUM(MP_TAC o MATCH_MP DIAMETER_BOUNDED) THEN
8540   DISCH_THEN(MP_TAC o SPECL [`u:real^N`; `v:real^N`] o CONJUNCT1) THEN
8541   ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);;
8542
8543 let DIAMETER_SUBSET_CBALL_NONEMPTY = prove
8544  (`!s:real^N->bool.
8545        bounded s /\ ~(s = {}) ==> ?z. z IN s /\ s SUBSET cball(z,diameter s)`,
8546    REPEAT STRIP_TAC THEN
8547    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
8548    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN
8549    DISCH_TAC THEN ASM_REWRITE_TAC[SUBSET] THEN X_GEN_TAC `b:real^N` THEN
8550    DISCH_TAC THEN REWRITE_TAC[IN_CBALL; dist] THEN
8551    ASM_MESON_TAC[DIAMETER_BOUNDED]);;
8552
8553 let DIAMETER_SUBSET_CBALL = prove
8554  (`!s:real^N->bool. bounded s ==> ?z. s SUBSET cball(z,diameter s)`,
8555   REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
8556   ASM_MESON_TAC[DIAMETER_SUBSET_CBALL_NONEMPTY; EMPTY_SUBSET]);;
8557
8558 let DIAMETER_EQ_0 = prove
8559  (`!s:real^N->bool.
8560         bounded s ==> (diameter s = &0 <=> s = {} \/ ?a. s = {a})`,
8561   REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN
8562   ASM_REWRITE_TAC[DIAMETER_EMPTY; DIAMETER_SING] THEN
8563   REWRITE_TAC[SET_RULE
8564    `s = {} \/ (?a. s = {a}) <=> !a b. a IN s /\ b IN s ==> a = b`] THEN
8565   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN
8566   MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `b:real^N`]
8567         DIAMETER_BOUNDED_BOUND) THEN
8568   ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);;
8569
8570 let DIAMETER_LE = prove
8571  (`!s:real^N->bool.
8572         (~(s = {}) \/ &0 <= d) /\
8573         (!x y. x IN s /\ y IN s ==> norm(x - y) <= d) ==> diameter s <= d`,
8574   GEN_TAC THEN REWRITE_TAC[diameter] THEN
8575   COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN
8576   STRIP_TAC THEN MATCH_MP_TAC REAL_SUP_LE THEN
8577   CONJ_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[FORALL_IN_GSPEC]]);;
8578
8579 let DIAMETER_CBALL = prove
8580  (`!a:real^N r. diameter(cball(a,r)) = if r < &0 then &0 else &2 * r`,
8581   REPEAT GEN_TAC THEN COND_CASES_TAC THENL
8582    [ASM_MESON_TAC[CBALL_EQ_EMPTY; DIAMETER_EMPTY]; ALL_TAC] THEN
8583   RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN
8584   REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL
8585    [MATCH_MP_TAC DIAMETER_LE THEN
8586     ASM_SIMP_TAC[CBALL_EQ_EMPTY; REAL_LE_MUL; REAL_POS; REAL_NOT_LT] THEN
8587     REWRITE_TAC[IN_CBALL] THEN NORM_ARITH_TAC;
8588     MATCH_MP_TAC REAL_LE_TRANS THEN
8589     EXISTS_TAC `norm((a + r % basis 1) - (a - r % basis 1):real^N)` THEN
8590     CONJ_TAC THENL
8591      [REWRITE_TAC[VECTOR_ARITH `(a + r % b) - (a - r % b:real^N) =
8592                                 (&2 * r) % b`] THEN
8593       SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
8594       ASM_REAL_ARITH_TAC;
8595       MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN
8596       REWRITE_TAC[BOUNDED_CBALL; IN_CBALL] THEN
8597       REWRITE_TAC[NORM_ARITH
8598        `dist(a:real^N,a + b) = norm b /\ dist(a,a - b) = norm b`] THEN
8599       SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
8600       ASM_REAL_ARITH_TAC]]);;
8601
8602 let DIAMETER_BALL = prove
8603  (`!a:real^N r. diameter(ball(a,r)) = if r < &0 then &0 else &2 * r`,
8604   REPEAT GEN_TAC THEN COND_CASES_TAC THENL
8605    [ASM_SIMP_TAC[BALL_EMPTY; REAL_LT_IMP_LE; DIAMETER_EMPTY]; ALL_TAC] THEN
8606   ASM_CASES_TAC `r = &0` THEN
8607   ASM_SIMP_TAC[BALL_EMPTY; REAL_LE_REFL; DIAMETER_EMPTY; REAL_MUL_RZERO] THEN
8608   MATCH_MP_TAC EQ_TRANS THEN
8609   EXISTS_TAC `diameter(cball(a:real^N,r))` THEN CONJ_TAC THENL
8610    [SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
8611     ASM_SIMP_TAC[GSYM CLOSURE_BALL; DIAMETER_CLOSURE; BOUNDED_BALL];
8612     ASM_SIMP_TAC[DIAMETER_CBALL]]);;
8613
8614 let DIAMETER_SUMS = prove
8615  (`!s t:real^N->bool.
8616         bounded s /\ bounded t
8617         ==> diameter {x + y | x IN s /\ y IN t} <= diameter s + diameter t`,
8618   REPEAT STRIP_TAC THEN
8619   ASM_CASES_TAC `s:real^N->bool = {}` THEN
8620   ASM_SIMP_TAC[NOT_IN_EMPTY; SET_RULE `{f x y |x,y| F} = {}`;
8621                DIAMETER_EMPTY; REAL_ADD_LID; DIAMETER_POS_LE] THEN
8622   ASM_CASES_TAC `t:real^N->bool = {}` THEN
8623   ASM_SIMP_TAC[NOT_IN_EMPTY; SET_RULE `{f x y |x,y| F} = {}`;
8624                DIAMETER_EMPTY; REAL_ADD_RID; DIAMETER_POS_LE] THEN
8625   MATCH_MP_TAC DIAMETER_LE THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
8626   REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_GSPEC] THEN
8627   REPEAT STRIP_TAC THEN MATCH_MP_TAC(NORM_ARITH
8628    `norm(x - x') <= s /\ norm(y - y') <= t
8629     ==> norm((x + y) - (x' + y'):real^N) <= s + t`) THEN
8630   ASM_SIMP_TAC[DIAMETER_BOUNDED_BOUND]);;
8631
8632 let LEBESGUE_COVERING_LEMMA = prove
8633  (`!s:real^N->bool c.
8634         compact s /\ ~(c = {}) /\ s SUBSET UNIONS c /\ (!b. b IN c ==> open b)
8635         ==> ?d. &0 < d /\
8636                 !t. t SUBSET s /\ diameter t <= d
8637                     ==> ?b. b IN c /\ t SUBSET b`,
8638   REPEAT STRIP_TAC THEN
8639   FIRST_ASSUM(MP_TAC o MATCH_MP HEINE_BOREL_LEMMA) THEN
8640   DISCH_THEN(MP_TAC o SPEC `c:(real^N->bool)->bool`) THEN ASM_SIMP_TAC[] THEN
8641   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `e:real` THEN
8642   STRIP_TAC THEN EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN
8643   X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
8644   ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN
8645   MP_TAC(ISPEC `t:real^N->bool` DIAMETER_SUBSET_CBALL_NONEMPTY) THEN
8646   ANTS_TAC THENL
8647    [ASM_MESON_TAC[BOUNDED_SUBSET; COMPACT_IMP_BOUNDED]; ALL_TAC] THEN
8648   DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN
8649   FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
8650   ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN
8651   X_GEN_TAC `b:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
8652   MATCH_MP_TAC SUBSET_TRANS THEN
8653   EXISTS_TAC `cball(x:real^N,diameter(t:real^N->bool))` THEN
8654   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN
8655   EXISTS_TAC `ball(x:real^N,e)` THEN ASM_REWRITE_TAC[] THEN
8656   REWRITE_TAC[SUBSET; IN_CBALL; IN_BALL] THEN
8657   MAP_EVERY UNDISCH_TAC [`&0 < e`; `diameter(t:real^N->bool) <= e / &2`] THEN
8658   NORM_ARITH_TAC);;
8659
8660 (* ------------------------------------------------------------------------- *)
8661 (* Related results with closure as the conclusion.                           *)
8662 (* ------------------------------------------------------------------------- *)
8663
8664 let CLOSED_SCALING = prove
8665  (`!s:real^N->bool c. closed s ==> closed (IMAGE (\x. c % x) s)`,
8666   REPEAT GEN_TAC THEN
8667   ASM_CASES_TAC `s :real^N->bool = {}` THEN
8668   ASM_REWRITE_TAC[CLOSED_EMPTY; IMAGE_CLAUSES] THEN
8669   ASM_CASES_TAC `c = &0` THENL
8670    [SUBGOAL_THEN `IMAGE (\x:real^N. c % x) s = {(vec 0)}`
8671      (fun th -> REWRITE_TAC[th; CLOSED_SING]) THEN
8672     ASM_REWRITE_TAC[EXTENSION; IN_IMAGE; IN_SING; VECTOR_MUL_LZERO] THEN
8673     ASM_MESON_TAC[MEMBER_NOT_EMPTY];
8674     ALL_TAC] THEN
8675   REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS; IN_IMAGE; SKOLEM_THM] THEN
8676   STRIP_TAC THEN X_GEN_TAC `x:num->real^N` THEN X_GEN_TAC `l:real^N` THEN
8677   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
8678   DISCH_THEN(X_CHOOSE_THEN `y:num->real^N` MP_TAC) THEN
8679   REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN
8680   EXISTS_TAC `inv(c) % l :real^N` THEN
8681   ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID] THEN
8682   FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `\n:num. inv(c) % x n:real^N` THEN
8683   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
8684    [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID];
8685     MATCH_MP_TAC LIM_CMUL THEN
8686     FIRST_ASSUM(fun th -> REWRITE_TAC[SYM(SPEC_ALL th)]) THEN
8687     ASM_REWRITE_TAC[ETA_AX]]);;
8688
8689 let CLOSED_NEGATIONS = prove
8690  (`!s:real^N->bool. closed s ==> closed (IMAGE (--) s)`,
8691   REPEAT GEN_TAC THEN
8692   SUBGOAL_THEN `IMAGE (--) s = IMAGE (\x:real^N. --(&1) % x) s`
8693   SUBST1_TAC THEN SIMP_TAC[CLOSED_SCALING] THEN
8694   REWRITE_TAC[VECTOR_ARITH `--(&1) % x = --x`] THEN REWRITE_TAC[ETA_AX]);;
8695
8696 let COMPACT_CLOSED_SUMS = prove
8697  (`!s:real^N->bool t.
8698         compact s /\ closed t ==> closed {x + y | x IN s /\ y IN t}`,
8699   REPEAT GEN_TAC THEN
8700   REWRITE_TAC[compact; IN_ELIM_THM; CLOSED_SEQUENTIAL_LIMITS] THEN
8701   STRIP_TAC THEN X_GEN_TAC `f:num->real^N` THEN X_GEN_TAC `l:real^N` THEN
8702   REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN
8703   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
8704   DISCH_THEN(X_CHOOSE_THEN `a:num->real^N` MP_TAC) THEN
8705   DISCH_THEN(X_CHOOSE_THEN `b:num->real^N` STRIP_ASSUME_TAC) THEN
8706   FIRST_X_ASSUM(MP_TAC o check(is_imp o concl) o SPEC `a:num->real^N`) THEN
8707   ASM_REWRITE_TAC[] THEN
8708   DISCH_THEN(X_CHOOSE_THEN `la:real^N` (X_CHOOSE_THEN `sub:num->num`
8709         STRIP_ASSUME_TAC)) THEN
8710   MAP_EVERY EXISTS_TAC [`la:real^N`; `l - la:real^N`] THEN
8711   ASM_REWRITE_TAC[VECTOR_ARITH `a + (b - a) = b:real^N`] THEN
8712   FIRST_X_ASSUM MATCH_MP_TAC THEN
8713   EXISTS_TAC `\n. (f o (sub:num->num)) n - (a o sub) n:real^N` THEN
8714   CONJ_TAC THENL [ASM_REWRITE_TAC[VECTOR_ADD_SUB; o_THM]; ALL_TAC] THEN
8715   MATCH_MP_TAC LIM_SUB THEN ASM_SIMP_TAC[LIM_SUBSEQUENCE; ETA_AX]);;
8716
8717 let CLOSED_COMPACT_SUMS = prove
8718  (`!s:real^N->bool t.
8719         closed s /\ compact t ==> closed {x + y | x IN s /\ y IN t}`,
8720   REPEAT GEN_TAC THEN
8721   SUBGOAL_THEN `{x + y:real^N | x IN s /\ y IN t} = {y + x | y IN t /\ x IN s}`
8722   SUBST1_TAC THEN  SIMP_TAC[COMPACT_CLOSED_SUMS] THEN
8723   REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_SYM]);;
8724
8725 let CLOSURE_SUMS = prove
8726  (`!s t:real^N->bool.
8727         bounded s \/ bounded t
8728         ==> closure {x + y | x IN s /\ y IN t} =
8729             {x + y | x IN closure s /\ y IN closure t}`,
8730   REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN
8731   REWRITE_TAC[FORALL_AND_THM] THEN
8732   GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SUMS_SYM] THEN
8733   MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN
8734   SIMP_TAC[] THEN
8735   REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; CLOSURE_SEQUENTIAL] THEN
8736   X_GEN_TAC `z:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN EQ_TAC THENL
8737    [REWRITE_TAC[IN_ELIM_THM; IN_DELETE; SKOLEM_THM; LEFT_AND_EXISTS_THM] THEN
8738     REWRITE_TAC[FORALL_AND_THM] THEN
8739     ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ r <=> q /\ p /\ r`] THEN
8740     ONCE_REWRITE_TAC[MESON[] `(?f x y. P f x y) <=> (?x y f. P f x y)`] THEN
8741     ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN
8742     REWRITE_TAC[ETA_AX; UNWIND_THM2] THEN
8743     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
8744     MAP_EVERY X_GEN_TAC [`a:num->real^N`; `b:num->real^N`] THEN
8745     STRIP_TAC THEN
8746     MP_TAC(ISPEC `closure s:real^N->bool` compact) THEN
8747     ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN
8748     DISCH_THEN(MP_TAC o SPEC `a:num->real^N`) THEN
8749     ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET; LEFT_IMP_EXISTS_THM] THEN
8750     MAP_EVERY X_GEN_TAC [`u:real^N`; `r:num->num`] THEN STRIP_TAC THEN
8751     EXISTS_TAC `z - u:real^N` THEN
8752     EXISTS_TAC `(a:num->real^N) o (r:num->num)` THEN EXISTS_TAC `u:real^N` THEN
8753     ASM_REWRITE_TAC[o_THM] THEN
8754     CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN
8755     EXISTS_TAC `(\n. ((\n. a n + b n) o (r:num->num)) n - (a o r) n)
8756                 :num->real^N` THEN
8757     CONJ_TAC THENL
8758      [ASM_REWRITE_TAC[o_DEF; VECTOR_ARITH `(a + b) - a:real^N = b`];
8759       MATCH_MP_TAC LIM_SUB THEN ASM_REWRITE_TAC[ETA_AX] THEN
8760       MATCH_MP_TAC LIM_SUBSEQUENCE THEN ASM_REWRITE_TAC[]];
8761     REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
8762     REWRITE_TAC[LEFT_IMP_EXISTS_THM; LEFT_AND_EXISTS_THM;
8763                 RIGHT_AND_EXISTS_THM] THEN
8764     MAP_EVERY X_GEN_TAC
8765      [`x:real^N`; `y:real^N`; `a:num->real^N`; `b:num->real^N`] THEN
8766     STRIP_TAC THEN EXISTS_TAC `(\n. a n + b n):num->real^N` THEN
8767     ASM_SIMP_TAC[LIM_ADD] THEN ASM_MESON_TAC[]]);;
8768
8769 let COMPACT_CLOSED_DIFFERENCES = prove
8770  (`!s:real^N->bool t.
8771         compact s /\ closed t ==> closed {x - y | x IN s /\ y IN t}`,
8772   REPEAT STRIP_TAC THEN
8773   SUBGOAL_THEN `{x - y | x:real^N IN s /\ y IN t} =
8774                 {x + y | x IN s /\ y IN (IMAGE (--) t)}`
8775     (fun th -> ASM_SIMP_TAC[th; COMPACT_CLOSED_SUMS; CLOSED_NEGATIONS]) THEN
8776   REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN
8777   ONCE_REWRITE_TAC[VECTOR_ARITH `(x:real^N = --y) <=> (y = --x)`] THEN
8778   SIMP_TAC[VECTOR_SUB; GSYM CONJ_ASSOC; UNWIND_THM2] THEN
8779   MESON_TAC[VECTOR_NEG_NEG]);;
8780
8781 let CLOSED_COMPACT_DIFFERENCES = prove
8782  (`!s:real^N->bool t.
8783         closed s /\ compact t ==> closed {x - y | x IN s /\ y IN t}`,
8784   REPEAT STRIP_TAC THEN
8785   SUBGOAL_THEN `{x - y | x:real^N IN s /\ y IN t} =
8786                 {x + y | x IN s /\ y IN (IMAGE (--) t)}`
8787     (fun th -> ASM_SIMP_TAC[th; CLOSED_COMPACT_SUMS; COMPACT_NEGATIONS]) THEN
8788   REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN
8789   ONCE_REWRITE_TAC[VECTOR_ARITH `(x:real^N = --y) <=> (y = --x)`] THEN
8790   SIMP_TAC[VECTOR_SUB; GSYM CONJ_ASSOC; UNWIND_THM2] THEN
8791   MESON_TAC[VECTOR_NEG_NEG]);;
8792
8793 let CLOSED_TRANSLATION_EQ = prove
8794  (`!a s. closed (IMAGE (\x:real^N. a + x) s) <=> closed s`,
8795   REWRITE_TAC[closed] THEN GEOM_TRANSLATE_TAC[]);;
8796
8797 let CLOSED_TRANSLATION = prove
8798  (`!s a:real^N. closed s ==> closed (IMAGE (\x. a + x) s)`,
8799   REWRITE_TAC[CLOSED_TRANSLATION_EQ]);;
8800
8801 add_translation_invariants [CLOSED_TRANSLATION_EQ];;
8802
8803 let COMPLETE_TRANSLATION_EQ = prove
8804  (`!a s. complete(IMAGE (\x:real^N. a + x) s) <=> complete s`,
8805   REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_TRANSLATION_EQ]);;
8806
8807 add_translation_invariants [COMPLETE_TRANSLATION_EQ];;
8808
8809 let TRANSLATION_UNIV = prove
8810  (`!a. IMAGE (\x. a + x) (:real^N) = (:real^N)`,
8811   CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN GEOM_TRANSLATE_TAC[]);;
8812
8813 let TRANSLATION_DIFF = prove
8814  (`!s t:real^N->bool.
8815         IMAGE (\x. a + x) (s DIFF t) =
8816         (IMAGE (\x. a + x) s) DIFF (IMAGE (\x. a + x) t)`,
8817   REWRITE_TAC[EXTENSION; IN_DIFF; IN_IMAGE] THEN
8818   ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = a + y <=> y = x - a`] THEN
8819   REWRITE_TAC[UNWIND_THM2]);;
8820
8821 let CLOSURE_TRANSLATION = prove
8822  (`!a s. closure(IMAGE (\x:real^N. a + x) s) = IMAGE (\x. a + x) (closure s)`,
8823   REWRITE_TAC[CLOSURE_INTERIOR] THEN GEOM_TRANSLATE_TAC[]);;
8824
8825 add_translation_invariants [CLOSURE_TRANSLATION];;
8826
8827 let FRONTIER_TRANSLATION = prove
8828  (`!a s. frontier(IMAGE (\x:real^N. a + x) s) = IMAGE (\x. a + x) (frontier s)`,
8829   REWRITE_TAC[frontier] THEN GEOM_TRANSLATE_TAC[]);;
8830
8831 add_translation_invariants [FRONTIER_TRANSLATION];;
8832
8833 (* ------------------------------------------------------------------------- *)
8834 (* Separation between points and sets.                                       *)
8835 (* ------------------------------------------------------------------------- *)
8836
8837 let SEPARATE_POINT_CLOSED = prove
8838  (`!s a:real^N.
8839         closed s /\ ~(a IN s)
8840         ==> ?d. &0 < d /\ !x. x IN s ==> d <= dist(a,x)`,
8841   REPEAT STRIP_TAC THEN
8842   ASM_CASES_TAC `s:real^N->bool = {}` THENL
8843    [EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; REAL_LT_01];
8844     ALL_TAC] THEN
8845   MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] DISTANCE_ATTAINS_INF) THEN
8846   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN
8847   STRIP_TAC THEN EXISTS_TAC `dist(a:real^N,b)` THEN
8848   ASM_MESON_TAC[DIST_POS_LT]);;
8849
8850 let SEPARATE_COMPACT_CLOSED = prove
8851  (`!s t:real^N->bool.
8852         compact s /\ closed t /\ s INTER t = {}
8853         ==> ?d. &0 < d /\ !x y. x IN s /\ y IN t ==> d <= dist(x,y)`,
8854   REPEAT STRIP_TAC THEN
8855   MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN t}`; `vec 0:real^N`]
8856                 SEPARATE_POINT_CLOSED) THEN
8857   ASM_SIMP_TAC[COMPACT_CLOSED_DIFFERENCES; IN_ELIM_THM] THEN
8858   REWRITE_TAC[VECTOR_ARITH `vec 0 = x - y <=> x = y`] THEN
8859   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
8860   MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN
8861   MESON_TAC[NORM_ARITH `dist(vec 0,x - y) = dist(x,y)`]);;
8862
8863 let SEPARATE_CLOSED_COMPACT = prove
8864  (`!s t:real^N->bool.
8865         closed s /\ compact t /\ s INTER t = {}
8866         ==> ?d. &0 < d /\ !x y. x IN s /\ y IN t ==> d <= dist(x,y)`,
8867   ONCE_REWRITE_TAC[DIST_SYM; INTER_COMM] THEN
8868   MESON_TAC[SEPARATE_COMPACT_CLOSED]);;
8869
8870 (* ------------------------------------------------------------------------- *)
8871 (* Representing sets as the union of a chain of compact sets.                *)
8872 (* ------------------------------------------------------------------------- *)
8873
8874 let CLOSED_UNION_COMPACT_SUBSETS = prove
8875  (`!s. closed s
8876        ==> ?f:num->real^N->bool.
8877                 (!n. compact(f n)) /\
8878                 (!n. (f n) SUBSET s) /\
8879                 (!n. (f n) SUBSET f(n + 1)) /\
8880                 UNIONS {f n | n IN (:num)} = s /\
8881                 (!k. compact k /\ k SUBSET s
8882                      ==> ?N. !n. n >= N ==> k SUBSET (f n))`,
8883   REPEAT STRIP_TAC THEN
8884   EXISTS_TAC `\n. s INTER cball(vec 0:real^N,&n)` THEN
8885   ASM_SIMP_TAC[INTER_SUBSET; COMPACT_CBALL; CLOSED_INTER_COMPACT] THEN
8886   REPEAT CONJ_TAC THENL
8887    [GEN_TAC THEN MATCH_MP_TAC(SET_RULE
8888      `t SUBSET u ==> s INTER t SUBSET s INTER u`) THEN
8889     REWRITE_TAC[SUBSET_BALLS; DIST_REFL; GSYM REAL_OF_NUM_ADD] THEN
8890     REAL_ARITH_TAC;
8891     REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV; IN_INTER] THEN
8892     X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_CBALL_0] THEN
8893     MESON_TAC[REAL_ARCH_SIMPLE];
8894     X_GEN_TAC `k:real^N->bool` THEN SIMP_TAC[SUBSET_INTER] THEN
8895     REPEAT STRIP_TAC THEN
8896     FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN DISCH_THEN
8897      (MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_CBALL) THEN
8898     DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
8899     MP_TAC(ISPEC `r:real` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN
8900     X_GEN_TAC `N:num` THEN REWRITE_TAC[GSYM REAL_OF_NUM_GE] THEN
8901
8902     REPEAT STRIP_TAC THEN
8903     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
8904         SUBSET_TRANS)) THEN
8905     REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC]);;
8906
8907 let OPEN_UNION_COMPACT_SUBSETS = prove
8908  (`!s. open s
8909        ==> ?f:num->real^N->bool.
8910                 (!n. compact(f n)) /\
8911                 (!n. (f n) SUBSET s) /\
8912                 (!n. (f n) SUBSET interior(f(n + 1))) /\
8913                 UNIONS {f n | n IN (:num)} = s /\
8914                 (!k. compact k /\ k SUBSET s
8915                      ==> ?N. !n. n >= N ==> k SUBSET (f n))`,
8916   GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL
8917    [DISCH_TAC THEN EXISTS_TAC `(\n. {}):num->real^N->bool` THEN
8918     ASM_SIMP_TAC[EMPTY_SUBSET; SUBSET_EMPTY; COMPACT_EMPTY] THEN
8919     REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; NOT_IN_EMPTY];
8920     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
8921     DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN STRIP_TAC] THEN
8922   MATCH_MP_TAC(MESON[]
8923    `(!f. p1 f /\ p3 f /\ p4 f ==> p5 f) /\
8924     (?f. p1 f /\ p2 f /\ p3 f /\ (p2 f ==> p4 f))
8925     ==> ?f. p1 f /\ p2 f /\ p3 f /\ p4 f /\ p5 f`) THEN
8926   CONJ_TAC THENL
8927    [X_GEN_TAC `f:num->real^N->bool` THEN STRIP_TAC THEN
8928     FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
8929     X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN
8930     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL]) THEN
8931     DISCH_THEN(MP_TAC o SPEC `{interior(f n):real^N->bool | n IN (:num)}`) THEN
8932     REWRITE_TAC[FORALL_IN_GSPEC; OPEN_INTERIOR] THEN ANTS_TAC THENL
8933      [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
8934         SUBSET_TRANS)) THEN
8935       REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM] THEN ASM SET_TAC[];
8936       ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
8937       REWRITE_TAC[SIMPLE_IMAGE; EXISTS_FINITE_SUBSET_IMAGE] THEN
8938       REWRITE_TAC[SUBSET_UNIV] THEN
8939       DISCH_THEN(X_CHOOSE_THEN `i:num->bool` STRIP_ASSUME_TAC) THEN
8940       FIRST_ASSUM(MP_TAC o SPEC `\n:num. n` o
8941         MATCH_MP UPPER_BOUND_FINITE_SET) THEN
8942       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
8943       REWRITE_TAC[GE] THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
8944       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
8945         SUBSET_TRANS)) THEN
8946       REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN
8947       X_GEN_TAC `m:num` THEN DISCH_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN
8948       EXISTS_TAC `(f:num->real^N->bool) m` THEN
8949       REWRITE_TAC[INTERIOR_SUBSET] THEN
8950       SUBGOAL_THEN `!m n. m <= n ==> (f:num->real^N->bool) m SUBSET f n`
8951        (fun th -> ASM_MESON_TAC[th; LE_TRANS]) THEN
8952       MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
8953       ASM_MESON_TAC[SUBSET; ADD1; INTERIOR_SUBSET]];
8954     EXISTS_TAC
8955      `\n. cball(a,&n) DIFF
8956          {x + e | x IN (:real^N) DIFF s /\ e IN ball(vec 0,inv(&n + &1))}` THEN
8957     REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
8958      [X_GEN_TAC `n:num` THEN MATCH_MP_TAC COMPACT_DIFF THEN
8959       SIMP_TAC[COMPACT_CBALL; OPEN_SUMS; OPEN_BALL];
8960       GEN_TAC THEN MATCH_MP_TAC(SET_RULE
8961        `(UNIV DIFF s) SUBSET t ==> c DIFF t SUBSET s`) THEN
8962       REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
8963       X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
8964       MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN
8965       ASM_REWRITE_TAC[VECTOR_ADD_RID; CENTRE_IN_BALL; REAL_LT_INV_EQ] THEN
8966       REAL_ARITH_TAC;
8967       GEN_TAC THEN REWRITE_TAC[INTERIOR_DIFF] THEN MATCH_MP_TAC(SET_RULE
8968        `s SUBSET s' /\ t' SUBSET t ==> (s DIFF t) SUBSET (s' DIFF t')`) THEN
8969       CONJ_TAC THENL
8970        [REWRITE_TAC[INTERIOR_CBALL; SUBSET; IN_BALL; IN_CBALL] THEN
8971         REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC;
8972         MATCH_MP_TAC SUBSET_TRANS THEN
8973         EXISTS_TAC `{x + e | x IN (:real^N) DIFF s /\
8974                              e IN cball(vec 0,inv(&n + &2))}` THEN
8975         CONJ_TAC THENL
8976          [MATCH_MP_TAC CLOSURE_MINIMAL THEN
8977           ASM_SIMP_TAC[CLOSED_COMPACT_SUMS; COMPACT_CBALL;
8978                        GSYM OPEN_CLOSED] THEN
8979           MATCH_MP_TAC(SET_RULE
8980            `t SUBSET t'
8981             ==> {f x y | x IN s /\ y IN t} SUBSET
8982                 {f x y | x IN s /\ y IN t'}`) THEN
8983           REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL; GSYM REAL_OF_NUM_ADD] THEN
8984           REAL_ARITH_TAC;
8985           MATCH_MP_TAC(SET_RULE
8986            `t SUBSET t'
8987             ==> {f x y | x IN s /\ y IN t} SUBSET
8988                 {f x y | x IN s /\ y IN t'}`) THEN
8989           REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL; GSYM REAL_OF_NUM_ADD] THEN
8990           GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH
8991            `a < b ==> x <= a ==> x < b`) THEN
8992           MATCH_MP_TAC REAL_LT_INV2 THEN REAL_ARITH_TAC]];
8993       DISCH_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
8994       ASM_REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN
8995       REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN
8996       X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_DIFF] THEN
8997       REWRITE_TAC[IN_ELIM_THM; IN_UNIV; IN_BALL_0] THEN
8998       REWRITE_TAC[VECTOR_ARITH `x:real^N = y + e <=> e = x - y`] THEN
8999       REWRITE_TAC[TAUT `(p /\ q) /\ r <=> r /\ p /\ q`; UNWIND_THM2] THEN
9000       REWRITE_TAC[MESON[] `~(?x. ~P x /\ Q x) <=> !x. Q x ==> P x`] THEN
9001       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN
9002       DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
9003       ASM_REWRITE_TAC[SUBSET; IN_BALL; dist] THEN
9004       DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
9005       FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN
9006       DISCH_THEN(X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC) THEN
9007       MP_TAC(ISPEC `norm(x - a:real^N)` REAL_ARCH_SIMPLE) THEN
9008       DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `N1 + N2:num` THEN
9009       CONJ_TAC THENL
9010        [REWRITE_TAC[IN_CBALL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN
9011         UNDISCH_TAC `norm(x - a:real^N) <= &N2` THEN
9012         REWRITE_TAC[dist; GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC;
9013         REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
9014         SUBGOAL_THEN `inv(&(N1 + N2) + &1) <= inv(&N1)` MP_TAC THENL
9015          [MATCH_MP_TAC REAL_LE_INV2 THEN
9016           ASM_SIMP_TAC[REAL_OF_NUM_LT; LE_1] THEN
9017           REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC;
9018           ASM_REAL_ARITH_TAC]]]]);;
9019
9020 (* ------------------------------------------------------------------------- *)
9021 (* Closed-graph characterization of continuity.                              *)
9022 (* ------------------------------------------------------------------------- *)
9023
9024 let CONTINUOUS_CLOSED_GRAPH_GEN = prove
9025  (`!f:real^M->real^N s t.
9026         f continuous_on s /\ IMAGE f s SUBSET t
9027         ==> closed_in (subtopology euclidean (s PCROSS t))
9028                       {pastecart x (f x) | x IN s}`,
9029   REPEAT STRIP_TAC THEN
9030   SUBGOAL_THEN
9031    `{pastecart (x:real^M) (f x:real^N) | x IN s} =
9032     {z | z IN s PCROSS t /\ f(fstcart z) - sndcart z IN {vec 0}}`
9033   SUBST1_TAC THENL
9034    [REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM; IN_SING;
9035                 PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART;
9036                 PASTECART_INJ; VECTOR_SUB_EQ] THEN
9037     ASM SET_TAC[];
9038     MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN
9039     REWRITE_TAC[CLOSED_SING] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
9040     SIMP_TAC[GSYM o_DEF; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
9041     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
9042     SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; IMAGE_FSTCART_PCROSS] THEN
9043     ASM_MESON_TAC[CONTINUOUS_ON_EMPTY]]);;
9044
9045 let CONTINUOUS_CLOSED_GRAPH_EQ = prove
9046  (`!f:real^M->real^N s t.
9047         compact t /\ IMAGE f s SUBSET t
9048         ==> (f continuous_on s <=>
9049              closed_in (subtopology euclidean (s PCROSS t))
9050                        {pastecart x (f x) | x IN s})`,
9051   REPEAT STRIP_TAC THEN EQ_TAC THEN
9052   ASM_SIMP_TAC[CONTINUOUS_CLOSED_GRAPH_GEN] THEN DISCH_TAC THEN
9053   FIRST_ASSUM(fun th ->
9054    REWRITE_TAC[MATCH_MP CONTINUOUS_ON_CLOSED_GEN th]) THEN
9055   X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN
9056   SUBGOAL_THEN
9057    `{x | x IN s /\ (f:real^M->real^N) x IN c} =
9058     IMAGE fstcart ({pastecart x (f x) | x IN s} INTER
9059                    (s PCROSS c))`
9060   SUBST1_TAC THENL
9061    [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; EXISTS_PASTECART;
9062                 FSTCART_PASTECART; IN_INTER; IN_ELIM_PASTECART_THM;
9063                 PASTECART_IN_PCROSS; PASTECART_INJ] THEN
9064     ASM SET_TAC[];
9065     MATCH_MP_TAC CLOSED_MAP_FSTCART THEN EXISTS_TAC `t:real^N->bool` THEN
9066     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IN_INTER THEN
9067     ASM_REWRITE_TAC[] THEN  MATCH_MP_TAC CLOSED_IN_PCROSS THEN
9068     ASM_REWRITE_TAC[CLOSED_IN_REFL]]);;
9069
9070 let CONTINUOUS_CLOSED_GRAPH = prove
9071  (`!f:real^M->real^N s.
9072         closed s /\ f continuous_on s ==> closed {pastecart x (f x) | x IN s}`,
9073   REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN
9074   EXISTS_TAC `(s:real^M->bool) PCROSS (:real^N)` THEN
9075   ASM_SIMP_TAC[CLOSED_PCROSS; CLOSED_UNIV] THEN
9076   MATCH_MP_TAC CONTINUOUS_CLOSED_GRAPH_GEN THEN
9077   ASM_REWRITE_TAC[SUBSET_UNIV]);;
9078
9079 let CONTINUOUS_FROM_CLOSED_GRAPH = prove
9080  (`!f:real^M->real^N s t.
9081         compact t /\ IMAGE f s SUBSET t /\
9082         closed {pastecart x (f x) | x IN s}
9083         ==> f continuous_on s`,
9084   REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN
9085   DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN
9086   FIRST_ASSUM(SUBST1_TAC o MATCH_MP CONTINUOUS_CLOSED_GRAPH_EQ) THEN
9087   MATCH_MP_TAC CLOSED_SUBSET THEN ASM_REWRITE_TAC[] THEN
9088   REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; PASTECART_IN_PCROSS] THEN
9089   ASM SET_TAC[]);;
9090
9091 (* ------------------------------------------------------------------------- *)
9092 (* A cute way of denoting open and closed intervals using overloading.       *)
9093 (* ------------------------------------------------------------------------- *)
9094
9095 let open_interval = new_definition
9096   `open_interval(a:real^N,b:real^N) =
9097         {x:real^N | !i. 1 <= i /\ i <= dimindex(:N)
9098                         ==> a$i < x$i /\ x$i < b$i}`;;
9099
9100 let closed_interval = new_definition
9101   `closed_interval(l:(real^N#real^N)list) =
9102          {x:real^N | !i. 1 <= i /\ i <= dimindex(:N)
9103                          ==> FST(HD l)$i <= x$i /\ x$i <= SND(HD l)$i}`;;
9104
9105 make_overloadable "interval" `:A`;;
9106
9107 overload_interface("interval",`open_interval`);;
9108 overload_interface("interval",`closed_interval`);;
9109
9110 let interval = prove
9111  (`(interval (a,b) = {x:real^N | !i. 1 <= i /\ i <= dimindex(:N)
9112                                      ==> a$i < x$i /\ x$i < b$i}) /\
9113    (interval [a,b] = {x:real^N | !i. 1 <= i /\ i <= dimindex(:N)
9114                                      ==> a$i <= x$i /\ x$i <= b$i})`,
9115   REWRITE_TAC[open_interval; closed_interval; HD; FST; SND]);;
9116
9117 let IN_INTERVAL = prove
9118  (`(!x:real^N.
9119         x IN interval (a,b) <=>
9120                 !i. 1 <= i /\ i <= dimindex(:N)
9121                     ==> a$i < x$i /\ x$i < b$i) /\
9122    (!x:real^N.
9123         x IN interval [a,b] <=>
9124                 !i. 1 <= i /\ i <= dimindex(:N)
9125                     ==> a$i <= x$i /\ x$i <= b$i)`,
9126   REWRITE_TAC[interval; IN_ELIM_THM]);;
9127
9128 let IN_INTERVAL_REFLECT = prove
9129  (`(!a b x. (--x) IN interval[--b,--a] <=> x IN interval[a,b]) /\
9130    (!a b x. (--x) IN interval(--b,--a) <=> x IN interval(a,b))`,
9131   SIMP_TAC[IN_INTERVAL; REAL_LT_NEG2; REAL_LE_NEG2; VECTOR_NEG_COMPONENT] THEN
9132   MESON_TAC[]);;
9133
9134 let REFLECT_INTERVAL = prove
9135  (`(!a b:real^N. IMAGE (--) (interval[a,b]) = interval[--b,--a]) /\
9136    (!a b:real^N. IMAGE (--) (interval(a,b)) = interval(--b,--a))`,
9137   REPEAT STRIP_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
9138   REWRITE_TAC[IN_INTERVAL_REFLECT] THEN MESON_TAC[VECTOR_NEG_NEG]);;
9139
9140 let INTERVAL_EQ_EMPTY = prove
9141  (`((interval [a:real^N,b] = {}) <=>
9142     ?i. 1 <= i /\ i <= dimindex(:N) /\ b$i < a$i) /\
9143    ((interval (a:real^N,b) = {}) <=>
9144     ?i. 1 <= i /\ i <= dimindex(:N) /\ b$i <= a$i)`,
9145   REWRITE_TAC[EXTENSION; IN_INTERVAL; NOT_IN_EMPTY] THEN
9146   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; GSYM CONJ_ASSOC] THEN
9147   CONJ_TAC THEN EQ_TAC THENL
9148    [MESON_TAC[REAL_LE_REFL; REAL_NOT_LE];
9149     MESON_TAC[REAL_LE_TRANS; REAL_NOT_LE];
9150     ALL_TAC;
9151     MESON_TAC[REAL_LT_TRANS; REAL_NOT_LT]] THEN
9152   SUBGOAL_THEN `!a b. ?c. a < b ==> a < c /\ c < b`
9153   (MP_TAC o REWRITE_RULE[SKOLEM_THM]) THENL
9154    [MESON_TAC[REAL_LT_BETWEEN]; ALL_TAC] THEN
9155   DISCH_THEN(X_CHOOSE_TAC `mid:real->real->real`) THEN
9156   DISCH_THEN(MP_TAC o SPEC
9157    `(lambda i. mid ((a:real^N)$i) ((b:real^N)$i)):real^N`) THEN
9158   ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a /\ b ==> ~c)`] THEN
9159   SIMP_TAC[LAMBDA_BETA] THEN ASM_MESON_TAC[REAL_NOT_LT]);;
9160
9161 let INTERVAL_NE_EMPTY = prove
9162  (`(~(interval [a:real^N,b] = {}) <=>
9163     !i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= b$i) /\
9164    (~(interval (a:real^N,b) = {}) <=>
9165     !i. 1 <= i /\ i <= dimindex(:N) ==> a$i < b$i)`,
9166   REWRITE_TAC[INTERVAL_EQ_EMPTY] THEN MESON_TAC[REAL_NOT_LE]);;
9167
9168 let SUBSET_INTERVAL_IMP = prove
9169  (`((!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i)
9170     ==> interval[c,d] SUBSET interval[a:real^N,b]) /\
9171    ((!i. 1 <= i /\ i <= dimindex(:N) ==> a$i < c$i /\ d$i < b$i)
9172     ==> interval[c,d] SUBSET interval(a:real^N,b)) /\
9173    ((!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i)
9174     ==> interval(c,d) SUBSET interval[a:real^N,b]) /\
9175    ((!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i)
9176     ==> interval(c,d) SUBSET interval(a:real^N,b))`,
9177   REWRITE_TAC[SUBSET; IN_INTERVAL] THEN REPEAT CONJ_TAC THEN
9178   DISCH_TAC THEN GEN_TAC THEN POP_ASSUM MP_TAC THEN
9179   REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN
9180   GEN_TAC THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
9181   ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);;
9182
9183 let INTERVAL_SING = prove
9184  (`interval[a,a] = {a} /\ interval(a,a) = {}`,
9185   REWRITE_TAC[EXTENSION; IN_SING; NOT_IN_EMPTY; IN_INTERVAL] THEN
9186   REWRITE_TAC[REAL_LE_ANTISYM; REAL_LT_ANTISYM; CART_EQ; EQ_SYM_EQ] THEN
9187   MESON_TAC[DIMINDEX_GE_1; LE_REFL]);;
9188
9189 let SUBSET_INTERVAL = prove
9190  (`(interval[c,d] SUBSET interval[a:real^N,b] <=>
9191         (!i. 1 <= i /\ i <= dimindex(:N) ==> c$i <= d$i)
9192         ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i)) /\
9193    (interval[c,d] SUBSET interval(a:real^N,b) <=>
9194         (!i. 1 <= i /\ i <= dimindex(:N) ==> c$i <= d$i)
9195         ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i < c$i /\ d$i < b$i)) /\
9196    (interval(c,d) SUBSET interval[a:real^N,b] <=>
9197         (!i. 1 <= i /\ i <= dimindex(:N) ==> c$i < d$i)
9198         ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i)) /\
9199    (interval(c,d) SUBSET interval(a:real^N,b) <=>
9200         (!i. 1 <= i /\ i <= dimindex(:N) ==> c$i < d$i)
9201         ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i))`,
9202   let lemma = prove
9203    (`(!x:real^N. (!i. 1 <= i /\ i <= dimindex(:N) ==> Q i (x$i))
9204                  ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> R i (x$i)))
9205      ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> ?y. Q i y)
9206          ==> !i y. 1 <= i /\ i <= dimindex(:N) /\ Q i y ==> R i y`,
9207     DISCH_TAC THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN
9208     DISCH_THEN(X_CHOOSE_THEN `f:num->real` STRIP_ASSUME_TAC) THEN
9209     REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o
9210      SPEC `(lambda j. if j = i then y else f j):real^N`) THEN
9211     SIMP_TAC[LAMBDA_BETA] THEN ASM_MESON_TAC[]) in
9212   REPEAT STRIP_TAC THEN
9213   (MATCH_MP_TAC(TAUT
9214     `(~q ==> p) /\ (q ==> (p <=> r)) ==> (p <=> q ==> r)`) THEN
9215    CONJ_TAC THENL
9216     [DISCH_TAC THEN MATCH_MP_TAC(SET_RULE `s = {} ==> s SUBSET t`) THEN
9217      REWRITE_TAC[INTERVAL_EQ_EMPTY] THEN ASM_MESON_TAC[REAL_NOT_LT];
9218      ALL_TAC] THEN
9219    DISCH_TAC THEN EQ_TAC THEN REWRITE_TAC[SUBSET_INTERVAL_IMP] THEN
9220    REWRITE_TAC[SUBSET; IN_INTERVAL] THEN
9221    DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN ANTS_TAC THENL
9222     [ASM_MESON_TAC[REAL_LT_BETWEEN; REAL_LE_BETWEEN]; ALL_TAC] THEN
9223    MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
9224    DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
9225    FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN
9226    ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(K ALL_TAC) THEN STRIP_TAC)
9227   THENL
9228    [ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL];
9229     ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL];
9230     ALL_TAC; ALL_TAC] THEN
9231   (REPEAT STRIP_TAC THENL
9232     [FIRST_X_ASSUM(MP_TAC o SPEC
9233       `((c:real^N)$i + min ((a:real^N)$i) ((d:real^N)$i)) / &2`) THEN
9234      POP_ASSUM MP_TAC THEN REAL_ARITH_TAC;
9235      FIRST_X_ASSUM(MP_TAC o SPEC
9236       `(max ((b:real^N)$i) ((c:real^N)$i) + (d:real^N)$i) / &2`) THEN
9237      POP_ASSUM MP_TAC THEN REAL_ARITH_TAC]));;
9238
9239 let DISJOINT_INTERVAL = prove
9240  (`!a b c d:real^N.
9241         (interval[a,b] INTER interval[c,d] = {} <=>
9242           ?i. 1 <= i /\ i <= dimindex(:N) /\
9243               (b$i < a$i \/ d$i < c$i \/ b$i < c$i \/ d$i < a$i)) /\
9244         (interval[a,b] INTER interval(c,d) = {} <=>
9245           ?i. 1 <= i /\ i <= dimindex(:N) /\
9246               (b$i < a$i \/ d$i <= c$i \/ b$i <= c$i \/ d$i <= a$i)) /\
9247         (interval(a,b) INTER interval[c,d] = {} <=>
9248           ?i. 1 <= i /\ i <= dimindex(:N) /\
9249               (b$i <= a$i \/ d$i < c$i \/ b$i <= c$i \/ d$i <= a$i)) /\
9250         (interval(a,b) INTER interval(c,d) = {} <=>
9251           ?i. 1 <= i /\ i <= dimindex(:N) /\
9252               (b$i <= a$i \/ d$i <= c$i \/ b$i <= c$i \/ d$i <= a$i))`,
9253   REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL; NOT_IN_EMPTY] THEN
9254   REWRITE_TAC[AND_FORALL_THM; NOT_FORALL_THM] THEN
9255   REWRITE_TAC[TAUT `~((p ==> q) /\ (p ==> r)) <=> p /\ (~q \/ ~r)`] THEN
9256   REWRITE_TAC[DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN
9257   (EQ_TAC THENL
9258     [DISCH_THEN(MP_TAC o SPEC
9259       `(lambda i. (max ((a:real^N)$i) ((c:real^N)$i) +
9260                    min ((b:real^N)$i) ((d:real^N)$i)) / &2):real^N`) THEN
9261      MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
9262      DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN
9263      ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC;
9264      DISCH_THEN(fun th -> GEN_TAC THEN MP_TAC th) THEN
9265      MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN SIMP_TAC[] THEN
9266      REAL_ARITH_TAC]));;
9267
9268 let ENDS_IN_INTERVAL = prove
9269  (`(!a b. a IN interval[a,b] <=> ~(interval[a,b] = {})) /\
9270    (!a b. b IN interval[a,b] <=> ~(interval[a,b] = {})) /\
9271    (!a b. ~(a IN interval(a,b))) /\
9272    (!a b. ~(b IN interval(a,b)))`,
9273   REWRITE_TAC[IN_INTERVAL; INTERVAL_NE_EMPTY] THEN
9274   REWRITE_TAC[REAL_LE_REFL; REAL_LT_REFL] THEN
9275   MESON_TAC[DIMINDEX_GE_1; LE_REFL]);;
9276
9277 let ENDS_IN_UNIT_INTERVAL = prove
9278  (`vec 0 IN interval[vec 0,vec 1] /\
9279    vec 1 IN interval[vec 0,vec 1] /\
9280    ~(vec 0 IN interval(vec 0,vec 1)) /\
9281    ~(vec 1 IN interval(vec 0,vec 1))`,
9282   REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY; VEC_COMPONENT] THEN
9283   REWRITE_TAC[REAL_POS]);;
9284
9285 let INTER_INTERVAL = prove
9286  (`interval[a,b] INTER interval[c,d] =
9287         interval[(lambda i. max (a$i) (c$i)),(lambda i. min (b$i) (d$i))]`,
9288   REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL] THEN
9289   SIMP_TAC[LAMBDA_BETA; REAL_MAX_LE; REAL_LE_MIN] THEN MESON_TAC[]);;
9290
9291 let INTERVAL_OPEN_SUBSET_CLOSED = prove
9292  (`!a b. interval(a,b) SUBSET interval[a,b]`,
9293   REWRITE_TAC[SUBSET; IN_INTERVAL] THEN MESON_TAC[REAL_LT_IMP_LE]);;
9294
9295 let OPEN_INTERVAL_LEMMA = prove
9296  (`!a b x. a < x /\ x < b
9297            ==> ?d. &0 < d /\ !x'. abs(x' - x) < d ==> a < x' /\ x' < b`,
9298   REPEAT STRIP_TAC THEN
9299   EXISTS_TAC `min (x - a) (b - x)` THEN REWRITE_TAC[REAL_LT_MIN] THEN
9300   ASM_REAL_ARITH_TAC);;
9301
9302 let OPEN_INTERVAL = prove
9303  (`!a:real^N b. open(interval (a,b))`,
9304   REPEAT GEN_TAC THEN REWRITE_TAC[open_def; interval; IN_ELIM_THM] THEN
9305   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
9306   SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N)
9307                     ==> ?d. &0 < d /\
9308                             !x'. abs(x' - (x:real^N)$i) < d
9309                                  ==> (a:real^N)$i < x' /\ x' < (b:real^N)$i`
9310   MP_TAC THENL [ASM_SIMP_TAC[OPEN_INTERVAL_LEMMA]; ALL_TAC] THEN
9311   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
9312   REWRITE_TAC[SKOLEM_THM] THEN
9313   DISCH_THEN(X_CHOOSE_THEN `d:num->real` STRIP_ASSUME_TAC) THEN
9314   EXISTS_TAC `inf (IMAGE d (1..dimindex(:N)))` THEN
9315   SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; FINITE_NUMSEG;
9316            IMAGE_EQ_EMPTY; NOT_INSERT_EMPTY; NUMSEG_EMPTY;
9317            ARITH_RULE `n < 1 <=> (n = 0)`; DIMINDEX_NONZERO] THEN
9318   REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG; dist] THEN
9319   ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LET_TRANS; VECTOR_SUB_COMPONENT]);;
9320
9321 let CLOSED_INTERVAL = prove
9322  (`!a:real^N b. closed(interval [a,b])`,
9323   REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE; IN_INTERVAL] THEN
9324   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THENL
9325    [FIRST_X_ASSUM(MP_TAC o SPEC `(a:real^N)$i - (x:real^N)$i`);
9326     FIRST_X_ASSUM(MP_TAC o SPEC `(x:real^N)$i - (b:real^N)$i`)] THEN
9327   ASM_REWRITE_TAC[REAL_SUB_LT] THEN
9328   DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN
9329   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
9330   REWRITE_TAC[dist; REAL_NOT_LT] THEN
9331   MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((z - x :real^N)$i)` THEN
9332   ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN
9333   ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN
9334   ASM_SIMP_TAC[REAL_ARITH `x < a /\ a <= z ==> a - x <= abs(z - x)`;
9335                REAL_ARITH `z <= b /\ b < x ==> x - b <= abs(z - x)`]);;
9336
9337 let INTERIOR_CLOSED_INTERVAL = prove
9338  (`!a:real^N b. interior(interval [a,b]) = interval (a,b)`,
9339   REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
9340    [ALL_TAC;
9341     MATCH_MP_TAC INTERIOR_MAXIMAL THEN
9342     REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED; OPEN_INTERVAL]] THEN
9343   REWRITE_TAC[interior; SUBSET; IN_INTERVAL; IN_ELIM_THM] THEN
9344   X_GEN_TAC `x:real^N` THEN
9345   DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN
9346   X_GEN_TAC `i:num` THEN STRIP_TAC THEN
9347   ASM_SIMP_TAC[REAL_LT_LE] THEN REPEAT STRIP_TAC THEN
9348   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_def]) THEN
9349   DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
9350   DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THENL
9351    [(let t = `x - (e / &2) % basis i :real^N` in
9352      DISCH_THEN(MP_TAC o SPEC t) THEN FIRST_X_ASSUM(MP_TAC o SPEC t));
9353     (let t = `x + (e / &2) % basis i :real^N` in
9354      DISCH_THEN(MP_TAC o SPEC t) THEN FIRST_X_ASSUM(MP_TAC o SPEC t))] THEN
9355   REWRITE_TAC[dist; VECTOR_ADD_SUB; VECTOR_ARITH `x - y - x = --y:real^N`] THEN
9356   ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; NORM_NEG; REAL_MUL_RID;
9357                REAL_ARITH `&0 < e ==> abs(e / &2) < e`] THEN
9358   MATCH_MP_TAC(TAUT `~b ==> (a ==> b) ==> ~a`) THEN
9359   REWRITE_TAC[NOT_FORALL_THM] THEN EXISTS_TAC `i:num` THEN
9360   ASM_SIMP_TAC[DE_MORGAN_THM; VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT] THENL
9361    [DISJ1_TAC THEN REWRITE_TAC[REAL_ARITH `a <= a - b <=> ~(&0 < b)`];
9362     DISJ2_TAC THEN REWRITE_TAC[REAL_ARITH `a + b <= a <=> ~(&0 < b)`]] THEN
9363   ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; basis; LAMBDA_BETA; REAL_MUL_RID] THEN
9364   ASM_REWRITE_TAC[REAL_HALF]);;
9365
9366 let INTERIOR_INTERVAL = prove
9367  (`(!a b. interior(interval[a,b]) = interval(a,b)) /\
9368    (!a b. interior(interval(a,b)) = interval(a,b))`,
9369   SIMP_TAC[INTERIOR_CLOSED_INTERVAL; INTERIOR_OPEN; OPEN_INTERVAL]);;
9370
9371 let BOUNDED_CLOSED_INTERVAL = prove
9372  (`!a b:real^N. bounded (interval [a,b])`,
9373   REPEAT STRIP_TAC THEN REWRITE_TAC[bounded; interval] THEN
9374   EXISTS_TAC `sum(1..dimindex(:N))
9375                  (\i. abs((a:real^N)$i) + abs((b:real^N)$i))` THEN
9376   X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN
9377   STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
9378   EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((x:real^N)$i))` THEN
9379   REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_LE THEN
9380   ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; REAL_ARITH
9381    `a <= x /\ x <= b ==> abs(x) <= abs(a) + abs(b)`]);;
9382
9383 let BOUNDED_INTERVAL = prove
9384  (`(!a b. bounded (interval [a,b])) /\ (!a b. bounded (interval (a,b)))`,
9385   MESON_TAC[BOUNDED_CLOSED_INTERVAL; BOUNDED_SUBSET;
9386             INTERVAL_OPEN_SUBSET_CLOSED]);;
9387
9388 let NOT_INTERVAL_UNIV = prove
9389  (`(!a b. ~(interval[a,b] = UNIV)) /\
9390    (!a b. ~(interval(a,b) = UNIV))`,
9391   MESON_TAC[BOUNDED_INTERVAL; NOT_BOUNDED_UNIV]);;
9392
9393 let COMPACT_INTERVAL = prove
9394  (`!a b. compact (interval [a,b])`,
9395   SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_INTERVAL; CLOSED_INTERVAL]);;
9396
9397 let OPEN_INTERVAL_MIDPOINT = prove
9398  (`!a b:real^N.
9399         ~(interval(a,b) = {}) ==> (inv(&2) % (a + b)) IN interval(a,b)`,
9400   REWRITE_TAC[INTERVAL_NE_EMPTY; IN_INTERVAL] THEN
9401   SIMP_TAC[VECTOR_MUL_COMPONENT; VECTOR_ADD_COMPONENT] THEN
9402   REPEAT GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
9403   MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN REAL_ARITH_TAC);;
9404
9405 let OPEN_CLOSED_INTERVAL_CONVEX = prove
9406  (`!a b x y:real^N e.
9407         x IN interval(a,b) /\ y IN interval[a,b] /\ &0 < e /\ e <= &1
9408         ==> (e % x + (&1 - e) % y) IN interval(a,b)`,
9409   REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT
9410    `(c /\ d ==> a /\ b ==> e) ==> a /\ b /\ c /\ d ==> e`) THEN
9411   STRIP_TAC THEN REWRITE_TAC[IN_INTERVAL; AND_FORALL_THM] THEN
9412   SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
9413   MATCH_MP_TAC MONO_FORALL THEN
9414   GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
9415   ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
9416   SUBST1_TAC(REAL_ARITH `(a:real^N)$i = e * a$i + (&1 - e) * a$i`) THEN
9417   SUBST1_TAC(REAL_ARITH `(b:real^N)$i = e * b$i + (&1 - e) * b$i`) THEN
9418   CONJ_TAC THEN MATCH_MP_TAC REAL_LTE_ADD2 THEN
9419   ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LE_LMUL; REAL_SUB_LE]);;
9420
9421 let CLOSURE_OPEN_INTERVAL = prove
9422  (`!a b:real^N.
9423      ~(interval(a,b) = {}) ==> closure(interval(a,b)) = interval[a,b]`,
9424   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
9425    [MATCH_MP_TAC CLOSURE_MINIMAL THEN
9426     REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED; CLOSED_INTERVAL];
9427     ALL_TAC] THEN
9428   REWRITE_TAC[SUBSET; closure; IN_UNION] THEN X_GEN_TAC `x:real^N` THEN
9429   DISCH_TAC THEN MATCH_MP_TAC(TAUT `(~b ==> c) ==> b \/ c`) THEN DISCH_TAC THEN
9430   REWRITE_TAC[IN_ELIM_THM; LIMPT_SEQUENTIAL] THEN
9431   ABBREV_TAC `(c:real^N) = inv(&2) % (a + b)` THEN
9432   EXISTS_TAC `\n. (x:real^N) + inv(&n + &1) % (c - x)` THEN CONJ_TAC THENL
9433    [X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_DELETE] THEN
9434     REWRITE_TAC[VECTOR_ARITH `x + a = x <=> a = vec 0`] THEN
9435     REWRITE_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0] THEN
9436     REWRITE_TAC[VECTOR_SUB_EQ; REAL_ARITH `~(&n + &1 = &0)`] THEN
9437     CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[OPEN_INTERVAL_MIDPOINT]] THEN
9438     REWRITE_TAC[VECTOR_ARITH `x + a % (y - x) = a % y + (&1 - a) % x`] THEN
9439     MATCH_MP_TAC OPEN_CLOSED_INTERVAL_CONVEX THEN
9440     CONJ_TAC THENL [ASM_MESON_TAC[OPEN_INTERVAL_MIDPOINT]; ALL_TAC] THEN
9441     ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
9442     MATCH_MP_TAC REAL_INV_LE_1 THEN REAL_ARITH_TAC;
9443     ALL_TAC] THEN
9444   GEN_REWRITE_TAC LAND_CONV [VECTOR_ARITH `x:real^N = x + &0 % (c - x)`] THEN
9445   MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST] THEN
9446   MATCH_MP_TAC LIM_VMUL THEN REWRITE_TAC[LIM_CONST] THEN
9447   REWRITE_TAC[LIM_SEQUENTIALLY; o_THM; DIST_LIFT; REAL_SUB_RZERO] THEN
9448   X_GEN_TAC `e:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN
9449   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
9450   STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
9451   REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
9452   EXISTS_TAC `inv(&N)` THEN ASM_REWRITE_TAC[] THEN
9453   MATCH_MP_TAC REAL_LE_INV2 THEN UNDISCH_TAC `N:num <= n` THEN
9454   UNDISCH_TAC `~(N = 0)` THEN
9455   REWRITE_TAC[GSYM LT_NZ; GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_LT] THEN
9456   REAL_ARITH_TAC);;
9457
9458 let CLOSURE_INTERVAL = prove
9459  (`(!a b. closure(interval[a,b]) = interval[a,b]) /\
9460    (!a b. closure(interval(a,b)) =
9461           if interval(a,b) = {} then {} else interval[a,b])`,
9462   SIMP_TAC[CLOSURE_CLOSED; CLOSED_INTERVAL] THEN REPEAT GEN_TAC THEN
9463   COND_CASES_TAC THEN ASM_SIMP_TAC[CLOSURE_OPEN_INTERVAL; CLOSURE_EMPTY]);;
9464
9465 let BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC = prove
9466  (`!s:real^N->bool. bounded s ==> ?a. s SUBSET interval(--a,a)`,
9467   REWRITE_TAC[BOUNDED_POS; LEFT_IMP_EXISTS_THM] THEN
9468   MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `B:real`] THEN STRIP_TAC THEN
9469   EXISTS_TAC `(lambda i. B + &1):real^N` THEN
9470   REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
9471   SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; REAL_BOUNDS_LT; VECTOR_NEG_COMPONENT] THEN
9472   ASM_MESON_TAC[COMPONENT_LE_NORM;
9473                 REAL_ARITH `x <= y ==> a <= x ==> a < y + &1`]);;
9474
9475 let BOUNDED_SUBSET_OPEN_INTERVAL = prove
9476  (`!s:real^N->bool. bounded s ==> ?a b. s SUBSET interval(a,b)`,
9477   MESON_TAC[BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC]);;
9478
9479 let BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC = prove
9480  (`!s:real^N->bool. bounded s ==> ?a. s SUBSET interval[--a,a]`,
9481   GEN_TAC THEN
9482   DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC) THEN
9483   MATCH_MP_TAC MONO_EXISTS THEN
9484   SIMP_TAC[IN_BALL; IN_INTERVAL; SUBSET; REAL_LT_IMP_LE]);;
9485
9486 let BOUNDED_SUBSET_CLOSED_INTERVAL = prove
9487  (`!s:real^N->bool. bounded s ==> ?a b. s SUBSET interval[a,b]`,
9488   MESON_TAC[BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC]);;
9489
9490 let FRONTIER_CLOSED_INTERVAL = prove
9491  (`!a b. frontier(interval[a,b]) = interval[a,b] DIFF interval(a,b)`,
9492   SIMP_TAC[frontier; INTERIOR_CLOSED_INTERVAL; CLOSURE_CLOSED;
9493            CLOSED_INTERVAL]);;
9494
9495 let FRONTIER_OPEN_INTERVAL = prove
9496  (`!a b. frontier(interval(a,b)) =
9497                 if interval(a,b) = {} then {}
9498                 else interval[a,b] DIFF interval(a,b)`,
9499   REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[FRONTIER_EMPTY] THEN
9500   ASM_SIMP_TAC[frontier; CLOSURE_OPEN_INTERVAL; INTERIOR_OPEN;
9501                OPEN_INTERVAL]);;
9502
9503 let INTER_INTERVAL_MIXED_EQ_EMPTY = prove
9504  (`!a b c d:real^N.
9505         ~(interval(c,d) = {})
9506         ==> (interval(a,b) INTER interval[c,d] = {} <=>
9507              interval(a,b) INTER interval(c,d) = {})`,
9508   SIMP_TAC[GSYM CLOSURE_OPEN_INTERVAL; OPEN_INTER_CLOSURE_EQ_EMPTY;
9509            OPEN_INTERVAL]);;
9510
9511 let INTERVAL_TRANSLATION = prove
9512  (`(!c a b. interval[c + a,c + b] = IMAGE (\x. c + x) (interval[a,b])) /\
9513    (!c a b. interval(c + a,c + b) = IMAGE (\x. c + x) (interval(a,b)))`,
9514   REWRITE_TAC[interval] THEN CONJ_TAC THEN GEOM_TRANSLATE_TAC[] THEN
9515   REWRITE_TAC[VECTOR_ADD_COMPONENT; REAL_LT_LADD; REAL_LE_LADD]);;
9516
9517 add_translation_invariants
9518  [CONJUNCT1 INTERVAL_TRANSLATION; CONJUNCT2 INTERVAL_TRANSLATION];;
9519
9520 let EMPTY_AS_INTERVAL = prove
9521  (`{} = interval[vec 1,vec 0]`,
9522   SIMP_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTERVAL; VEC_COMPONENT] THEN
9523   GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN
9524   REWRITE_TAC[LE_REFL; DIMINDEX_GE_1] THEN REAL_ARITH_TAC);;
9525
9526 let UNIT_INTERVAL_NONEMPTY = prove
9527  (`~(interval[vec 0:real^N,vec 1] = {}) /\
9528    ~(interval(vec 0:real^N,vec 1) = {})`,
9529   SIMP_TAC[INTERVAL_NE_EMPTY; VEC_COMPONENT; REAL_LT_01; REAL_POS]);;
9530
9531 let IMAGE_STRETCH_INTERVAL = prove
9532  (`!a b:real^N m.
9533     IMAGE (\x. lambda k. m(k) * x$k) (interval[a,b]) =
9534         if interval[a,b] = {} then {}
9535         else interval[(lambda k. min (m(k) * a$k) (m(k) * b$k)):real^N,
9536                       (lambda k. max (m(k) * a$k) (m(k) * b$k))]`,
9537   REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[IMAGE_CLAUSES] THEN
9538   ASM_SIMP_TAC[EXTENSION; IN_IMAGE; CART_EQ; IN_INTERVAL; AND_FORALL_THM;
9539                TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`;
9540                 LAMBDA_BETA; GSYM LAMBDA_SKOLEM] THEN
9541   X_GEN_TAC `x:real^N` THEN MATCH_MP_TAC(MESON[]
9542    `(!x. p x ==> (q x <=> r x))
9543     ==> ((!x. p x ==> q x) <=> (!x. p x ==> r x))`) THEN
9544   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY]) THEN
9545   MATCH_MP_TAC MONO_FORALL THEN
9546   X_GEN_TAC `k:num` THEN ASM_CASES_TAC `1 <= k /\ k <= dimindex(:N)` THEN
9547   ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(m:num->real) k = &0` THENL
9548    [ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MAX_ACI; REAL_MIN_ACI] THEN
9549     ASM_MESON_TAC[REAL_LE_ANTISYM; REAL_LE_REFL];
9550     ALL_TAC] THEN
9551   ASM_SIMP_TAC[REAL_FIELD `~(m = &0) ==> (x = m * y <=> y = x / m)`] THEN
9552   REWRITE_TAC[UNWIND_THM2] THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP
9553    (REAL_ARITH `~(z = &0) ==> &0 < z \/ &0 < --z`))
9554   THENL
9555    [ALL_TAC;
9556     ONCE_REWRITE_TAC[GSYM REAL_LE_NEG2] THEN
9557     ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
9558     REWRITE_TAC[REAL_ARITH `--(max a b) = min (--a) (--b)`;
9559                 REAL_ARITH `--(min a b) = max (--a) (--b)`; real_div;
9560                 GSYM REAL_MUL_RNEG; GSYM REAL_INV_NEG] THEN
9561     REWRITE_TAC[GSYM real_div]] THEN
9562   ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ] THEN
9563   ASM_SIMP_TAC[real_min; real_max; REAL_LE_LMUL_EQ; REAL_LE_RMUL_EQ] THEN
9564   REAL_ARITH_TAC);;
9565
9566 let INTERVAL_IMAGE_STRETCH_INTERVAL = prove
9567  (`!a b:real^N m. ?u v:real^N.
9568      IMAGE (\x. lambda k. m k * x$k) (interval[a,b]) = interval[u,v]`,
9569   REWRITE_TAC[IMAGE_STRETCH_INTERVAL] THEN MESON_TAC[EMPTY_AS_INTERVAL]);;
9570
9571 let CLOSED_INTERVAL_IMAGE_UNIT_INTERVAL = prove
9572  (`!a b:real^N.
9573         ~(interval[a,b] = {})
9574         ==> interval[a,b] = IMAGE (\x:real^N. a + x)
9575                                   (IMAGE (\x. (lambda i. (b$i - a$i) * x$i))
9576                                          (interval[vec 0:real^N,vec 1]))`,
9577   REWRITE_TAC[INTERVAL_NE_EMPTY] THEN REPEAT STRIP_TAC THEN
9578   REWRITE_TAC[IMAGE_STRETCH_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN
9579   REWRITE_TAC[GSYM INTERVAL_TRANSLATION] THEN
9580   REWRITE_TAC[EXTENSION; IN_INTERVAL] THEN
9581   SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VEC_COMPONENT] THEN
9582   GEN_TAC THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID] THEN
9583   MATCH_MP_TAC(MESON[] `(!x. P x <=> Q x) ==> ((!x. P x) <=> (!x. Q x))`) THEN
9584   POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
9585   ASM_CASES_TAC `1 <= i /\ i <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN
9586   REAL_ARITH_TAC);;
9587
9588 let SUMS_INTERVALS = prove
9589  (`(!a b c d:real^N.
9590         ~(interval[a,b] = {}) /\ ~(interval[c,d] = {})
9591         ==> {x + y | x IN interval[a,b] /\ y IN interval[c,d]} =
9592             interval[a+c,b+d]) /\
9593    (!a b c d:real^N.
9594         ~(interval(a,b) = {}) /\ ~(interval(c,d) = {})
9595         ==> {x + y | x IN interval(a,b) /\ y IN interval(c,d)} =
9596             interval(a+c,b+d))`,
9597   CONJ_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[INTERVAL_NE_EMPTY] THEN
9598   STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_INTERVAL; IN_ELIM_THM] THEN
9599   REWRITE_TAC[TAUT `(a /\ b) /\ c <=> c /\ a /\ b`] THEN
9600   REWRITE_TAC[VECTOR_ARITH `x:real^N = y + z <=> z = x - y`] THEN
9601   REWRITE_TAC[UNWIND_THM2; VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT] THEN
9602   (X_GEN_TAC `x:real^N` THEN EQ_TAC THENL
9603    [DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC);
9604     DISCH_TAC THEN
9605     REWRITE_TAC[AND_FORALL_THM; GSYM LAMBDA_SKOLEM;
9606                 TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN
9607     REWRITE_TAC[REAL_ARITH
9608      `((a <= y /\ y <= b) /\ c <= x - y /\ x - y <= d <=>
9609        max a (x - d) <= y /\ y <= min b (x - c)) /\
9610       ((a < y /\ y < b) /\ c < x - y /\ x - y < d <=>
9611        max a (x - d) < y /\ y < min b (x - c))`] THEN
9612     REWRITE_TAC[GSYM REAL_LE_BETWEEN; GSYM REAL_LT_BETWEEN]] THEN
9613   X_GEN_TAC `i:num` THEN STRIP_TAC THEN
9614   REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN
9615   ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC));;
9616
9617 let PCROSS_INTERVAL = prove
9618  (`!a b:real^M c d:real^N.
9619         interval[a,b] PCROSS interval[c,d] =
9620         interval[pastecart a c,pastecart b d]`,
9621   REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN
9622   REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN
9623   SIMP_TAC[IN_INTERVAL; pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM] THEN
9624   MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN EQ_TAC THEN STRIP_TAC THENL
9625    [X_GEN_TAC `i:num` THEN STRIP_TAC THEN
9626     COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN
9627     FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
9628     CONJ_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THENL
9629      [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN
9630       DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC;
9631       FIRST_X_ASSUM(MP_TAC o SPEC `i + dimindex(:M)`) THEN
9632       COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_SUB] THENL
9633        [ASM_ARITH_TAC;
9634         DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC]]]);;
9635
9636 let OPEN_CONTAINS_INTERVAL,OPEN_CONTAINS_OPEN_INTERVAL = (CONJ_PAIR o prove)
9637  (`(!s:real^N->bool.
9638         open s <=>
9639         !x. x IN s ==> ?a b. x IN interval(a,b) /\ interval[a,b] SUBSET s) /\
9640    (!s:real^N->bool.
9641         open s <=>
9642         !x. x IN s ==> ?a b. x IN interval(a,b) /\ interval(a,b) SUBSET s)`,
9643   REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN
9644   MATCH_MP_TAC(TAUT
9645    `(q ==> r) /\ (r ==> p) /\ (p ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN
9646   REPEAT CONJ_TAC THENL
9647    [MESON_TAC[SUBSET_TRANS; INTERVAL_OPEN_SUBSET_CLOSED];
9648     DISCH_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN
9649     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
9650     FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
9651     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9652     MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN
9653     MP_TAC(ISPEC `interval(a:real^N,b)` OPEN_CONTAINS_BALL) THEN
9654     REWRITE_TAC[OPEN_INTERVAL] THEN
9655     DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
9656     MATCH_MP_TAC MONO_EXISTS THEN
9657     REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
9658     ASM_MESON_TAC[SUBSET_TRANS; INTERVAL_OPEN_SUBSET_CLOSED];
9659     DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
9660     FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o
9661       GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
9662     ASM_REWRITE_TAC[] THEN
9663     DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
9664     EXISTS_TAC `x - e / &(dimindex(:N)) % vec 1:real^N` THEN
9665     EXISTS_TAC `x + e / &(dimindex(:N)) % vec 1:real^N` THEN
9666     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
9667      `b SUBSET s ==> x IN i /\ j SUBSET b ==> x IN i /\ j SUBSET s`)) THEN
9668     SIMP_TAC[IN_INTERVAL; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; IN_CBALL;
9669              VEC_COMPONENT; VECTOR_ADD_COMPONENT; SUBSET; REAL_MUL_RID] THEN
9670     REWRITE_TAC[REAL_ARITH `x - e < x /\ x < x + e <=> &0 < e`;
9671                 REAL_ARITH `x - e <= y /\ y <= x + e <=> abs(x - y) <= e`] THEN
9672     ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN
9673     X_GEN_TAC `y:real^N` THEN REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN
9674     DISCH_TAC THEN REWRITE_TAC[dist] THEN
9675     MATCH_MP_TAC REAL_LE_TRANS THEN
9676     EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((x - y:real^N)$i))` THEN
9677     REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_GEN THEN
9678     ASM_SIMP_TAC[CARD_NUMSEG_1; IN_NUMSEG; FINITE_NUMSEG] THEN
9679     REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1]]);;
9680
9681 let DIAMETER_INTERVAL = prove
9682  (`(!a b:real^N.
9683         diameter(interval[a,b]) =
9684         if interval[a,b] = {} then &0 else norm(b - a)) /\
9685    (!a b:real^N.
9686         diameter(interval(a,b)) =
9687         if interval(a,b) = {} then &0 else norm(b - a))`,
9688   REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
9689   ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL
9690    [ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET_EMPTY; DIAMETER_EMPTY];
9691     ASM_REWRITE_TAC[]] THEN
9692   MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
9693    [REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
9694     ASM_SIMP_TAC[DIAMETER_BOUNDED_BOUND;
9695                  ENDS_IN_INTERVAL; BOUNDED_INTERVAL] THEN
9696     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
9697      `diameter(cball(inv(&2) % (a + b):real^N,norm(b - a) / &2))` THEN
9698     CONJ_TAC THENL
9699      [MATCH_MP_TAC DIAMETER_SUBSET THEN REWRITE_TAC[BOUNDED_CBALL] THEN
9700       REWRITE_TAC[SUBSET; IN_INTERVAL; IN_CBALL] THEN
9701       GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[dist] THEN
9702       REWRITE_TAC[GSYM NORM_MUL; REAL_ARITH `x / &2 = abs(inv(&2)) * x`] THEN
9703       MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN
9704       X_GEN_TAC `i:num` THEN DISCH_TAC THEN
9705       FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN
9706       ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT;
9707                       VECTOR_MUL_COMPONENT] THEN
9708       REAL_ARITH_TAC;
9709       REWRITE_TAC[DIAMETER_CBALL] THEN NORM_ARITH_TAC];
9710     DISCH_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[DIAMETER_EMPTY] THEN
9711     SUBGOAL_THEN `interval[a:real^N,b] = closure(interval(a,b))`
9712     SUBST_ALL_TAC THEN ASM_REWRITE_TAC[CLOSURE_INTERVAL] THEN
9713     ASM_MESON_TAC[DIAMETER_CLOSURE; BOUNDED_INTERVAL]]);;
9714
9715 (* ------------------------------------------------------------------------- *)
9716 (* Some special cases for intervals in R^1.                                  *)
9717 (* ------------------------------------------------------------------------- *)
9718
9719 let INTERVAL_CASES_1 = prove
9720  (`!x:real^1. x IN interval[a,b] ==> x IN interval(a,b) \/ (x = a) \/ (x = b)`,
9721   REWRITE_TAC[CART_EQ; IN_INTERVAL; FORALL_DIMINDEX_1] THEN REAL_ARITH_TAC);;
9722
9723 let IN_INTERVAL_1 = prove
9724  (`!a b x:real^1.
9725         (x IN interval[a,b] <=> drop a <= drop x /\ drop x <= drop b) /\
9726         (x IN interval(a,b) <=> drop a < drop x /\ drop x < drop b)`,
9727   REWRITE_TAC[IN_INTERVAL; drop; CONJ_ASSOC; DIMINDEX_1; LE_ANTISYM] THEN
9728   MESON_TAC[]);;
9729
9730 let INTERVAL_EQ_EMPTY_1 = prove
9731  (`!a b:real^1.
9732         (interval[a,b] = {} <=> drop b < drop a) /\
9733         (interval(a,b) = {} <=> drop b <= drop a)`,
9734   REWRITE_TAC[INTERVAL_EQ_EMPTY; drop; CONJ_ASSOC; DIMINDEX_1; LE_ANTISYM] THEN
9735   MESON_TAC[]);;
9736
9737 let INTERVAL_NE_EMPTY_1 = prove
9738  (`(!a b:real^1. ~(interval[a,b] = {}) <=> drop a <= drop b) /\
9739    (!a b:real^1. ~(interval(a,b) = {}) <=> drop a < drop b)`,
9740   REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN REAL_ARITH_TAC);;
9741
9742 let SUBSET_INTERVAL_1 = prove
9743  (`!a b c d.
9744         (interval[a,b] SUBSET interval[c,d] <=>
9745                 drop b < drop a \/
9746                 drop c <= drop a /\ drop a <= drop b /\ drop b <= drop d) /\
9747         (interval[a,b] SUBSET interval(c,d) <=>
9748                 drop b < drop a \/
9749                 drop c < drop a /\ drop a <= drop b /\ drop b < drop d) /\
9750         (interval(a,b) SUBSET interval[c,d] <=>
9751                 drop b <= drop a \/
9752                 drop c <= drop a /\ drop a < drop b /\ drop b <= drop d) /\
9753         (interval(a,b) SUBSET interval(c,d) <=>
9754                 drop b <= drop a \/
9755                 drop c <= drop a /\ drop a < drop b /\ drop b <= drop d)`,
9756   REWRITE_TAC[SUBSET_INTERVAL; FORALL_1; DIMINDEX_1; drop] THEN
9757   REAL_ARITH_TAC);;
9758
9759 let EQ_INTERVAL_1 = prove
9760  (`!a b c d:real^1.
9761        (interval[a,b] = interval[c,d] <=>
9762           drop b < drop a /\ drop d < drop c \/
9763           drop a = drop c /\ drop b = drop d)`,
9764   REWRITE_TAC[SET_RULE `s = t <=> s SUBSET t /\ t SUBSET s`] THEN
9765   REWRITE_TAC[SUBSET_INTERVAL_1] THEN REAL_ARITH_TAC);;
9766
9767 let DISJOINT_INTERVAL_1 = prove
9768  (`!a b c d:real^1.
9769         (interval[a,b] INTER interval[c,d] = {} <=>
9770           drop b < drop a \/ drop d < drop c \/
9771           drop b < drop c \/ drop d < drop a) /\
9772         (interval[a,b] INTER interval(c,d) = {} <=>
9773           drop b < drop a \/ drop d <= drop c \/
9774           drop b <= drop c \/ drop d <= drop a) /\
9775         (interval(a,b) INTER interval[c,d] = {} <=>
9776           drop b <= drop a \/ drop d < drop c \/
9777           drop b <= drop c \/ drop d <= drop a) /\
9778         (interval(a,b) INTER interval(c,d) = {} <=>
9779           drop b <= drop a \/ drop d <= drop c \/
9780           drop b <= drop c \/ drop d <= drop a)`,
9781   REWRITE_TAC[DISJOINT_INTERVAL; CONJ_ASSOC; DIMINDEX_1; LE_ANTISYM;
9782               UNWIND_THM1; drop]);;
9783
9784 let OPEN_CLOSED_INTERVAL_1 = prove
9785  (`!a b:real^1. interval(a,b) = interval[a,b] DIFF {a,b}`,
9786   REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN
9787   REWRITE_TAC[GSYM DROP_EQ] THEN REAL_ARITH_TAC);;
9788
9789 let CLOSED_OPEN_INTERVAL_1 = prove
9790  (`!a b:real^1. drop a <= drop b ==> interval[a,b] = interval(a,b) UNION {a,b}`,
9791   REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN
9792   REWRITE_TAC[GSYM DROP_EQ] THEN REAL_ARITH_TAC);;
9793
9794 let BALL_1 = prove
9795  (`!x:real^1 r. cball(x,r) = interval[x - lift r,x + lift r] /\
9796                 ball(x,r) = interval(x - lift r,x + lift r)`,
9797   REWRITE_TAC[EXTENSION; IN_BALL; IN_CBALL; IN_INTERVAL_1] THEN
9798   REWRITE_TAC[dist; NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP; DROP_ADD] THEN
9799   REAL_ARITH_TAC);;
9800
9801 let SPHERE_1 = prove
9802  (`!a:real^1 r. sphere(a,r) = if r < &0 then {} else {a - lift r,a + lift r}`,
9803   REPEAT GEN_TAC THEN REWRITE_TAC[sphere] THEN COND_CASES_TAC THEN
9804   REWRITE_TAC[DIST_REAL; GSYM drop; FORALL_DROP] THEN
9805   REWRITE_TAC[EXTENSION; IN_INSERT; NOT_IN_EMPTY; IN_ELIM_THM] THEN
9806   REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_SUB; LIFT_DROP] THEN
9807   ASM_REAL_ARITH_TAC);;
9808
9809 let FINITE_SPHERE_1 = prove
9810  (`!a:real^1 r. FINITE(sphere(a,r))`,
9811   REPEAT GEN_TAC THEN REWRITE_TAC[SPHERE_1] THEN
9812   MESON_TAC[FINITE_INSERT; FINITE_EMPTY]);;
9813
9814 let FINITE_INTERVAL_1 = prove
9815  (`(!a b. FINITE(interval[a,b]) <=> drop b <= drop a) /\
9816    (!a b. FINITE(interval(a,b)) <=> drop b <= drop a)`,
9817   REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN
9818   REWRITE_TAC[SET_RULE `s DIFF {a,b} = s DELETE a DELETE b`] THEN
9819   REWRITE_TAC[FINITE_DELETE] THEN REPEAT GEN_TAC THEN
9820   SUBGOAL_THEN `interval[a,b] = IMAGE lift {x | drop a <= x /\ x <= drop b}`
9821   SUBST1_TAC THENL
9822    [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
9823     CONJ_TAC THENL [MESON_TAC[LIFT_DROP]; ALL_TAC] THEN
9824     REWRITE_TAC[IN_INTERVAL_1; IN_ELIM_THM; LIFT_DROP];
9825     SIMP_TAC[FINITE_IMAGE_INJ_EQ; LIFT_EQ; FINITE_REAL_INTERVAL]]);;
9826
9827 let BALL_INTERVAL = prove
9828  (`!x:real^1 e. ball(x,e) = interval(x - lift e,x + lift e)`,
9829   REWRITE_TAC[EXTENSION; IN_BALL; IN_INTERVAL_1; DIST_REAL] THEN
9830   REWRITE_TAC[GSYM drop; DROP_SUB; DROP_ADD; LIFT_DROP] THEN REAL_ARITH_TAC);;
9831
9832 let CBALL_INTERVAL = prove
9833  (`!x:real^1 e. cball(x,e) = interval[x - lift e,x + lift e]`,
9834   REWRITE_TAC[EXTENSION; IN_CBALL; IN_INTERVAL_1; DIST_REAL] THEN
9835   REWRITE_TAC[GSYM drop; DROP_SUB; DROP_ADD; LIFT_DROP] THEN REAL_ARITH_TAC);;
9836
9837 let BALL_INTERVAL_0 = prove
9838  (`!e. ball(vec 0:real^1,e) = interval(--lift e,lift e)`,
9839   GEN_TAC THEN REWRITE_TAC[BALL_INTERVAL] THEN AP_TERM_TAC THEN
9840   BINOP_TAC THEN VECTOR_ARITH_TAC);;
9841
9842 let CBALL_INTERVAL_0 = prove
9843  (`!e. cball(vec 0:real^1,e) = interval[--lift e,lift e]`,
9844   GEN_TAC THEN REWRITE_TAC[CBALL_INTERVAL] THEN AP_TERM_TAC THEN
9845   AP_THM_TAC THEN AP_TERM_TAC THEN BINOP_TAC THEN VECTOR_ARITH_TAC);;
9846
9847 let INTER_INTERVAL_1 = prove
9848  (`!a b c d:real^1.
9849         interval[a,b] INTER interval[c,d] =
9850         interval[lift(max (drop a) (drop c)),lift(min (drop b) (drop d))]`,
9851   REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL_1; real_max; real_min] THEN
9852   REPEAT GEN_TAC THEN
9853   REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[LIFT_DROP]) THEN
9854   ASM_REAL_ARITH_TAC);;
9855
9856 let CLOSED_DIFF_OPEN_INTERVAL_1 = prove
9857  (`!a b:real^1.
9858         interval[a,b] DIFF interval(a,b) =
9859         if interval[a,b] = {} then {} else {a,b}`,
9860   REWRITE_TAC[EXTENSION; IN_DIFF; INTERVAL_EQ_EMPTY_1; IN_INTERVAL_1] THEN
9861   REPEAT GEN_TAC THEN COND_CASES_TAC THEN
9862   ASM_REWRITE_TAC[NOT_IN_EMPTY; IN_INSERT; NOT_IN_EMPTY] THEN
9863   REWRITE_TAC[GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC);;
9864
9865 (* ------------------------------------------------------------------------- *)
9866 (* Intervals in general, including infinite and mixtures of open and closed. *)
9867 (* ------------------------------------------------------------------------- *)
9868
9869 let is_interval = new_definition
9870   `is_interval(s:real^N->bool) <=>
9871         !a b x. a IN s /\ b IN s /\
9872                 (!i. 1 <= i /\ i <= dimindex(:N)
9873                      ==> (a$i <= x$i /\ x$i <= b$i) \/
9874                          (b$i <= x$i /\ x$i <= a$i))
9875                 ==> x IN s`;;
9876
9877 let IS_INTERVAL_INTERVAL = prove
9878  (`!a:real^N b. is_interval(interval (a,b)) /\ is_interval(interval [a,b])`,
9879   REWRITE_TAC[is_interval; IN_INTERVAL] THEN
9880   MESON_TAC[REAL_LT_TRANS; REAL_LE_TRANS; REAL_LET_TRANS; REAL_LTE_TRANS]);;
9881
9882 let IS_INTERVAL_EMPTY = prove
9883  (`is_interval {}`,
9884   REWRITE_TAC[is_interval; NOT_IN_EMPTY]);;
9885
9886 let IS_INTERVAL_UNIV = prove
9887  (`is_interval(UNIV:real^N->bool)`,
9888   REWRITE_TAC[is_interval; IN_UNIV]);;
9889
9890 let IS_INTERVAL_TRANSLATION_EQ = prove
9891  (`!a:real^N s. is_interval(IMAGE (\x. a + x) s) <=> is_interval s`,
9892   REWRITE_TAC[is_interval] THEN GEOM_TRANSLATE_TAC[] THEN
9893   REWRITE_TAC[VECTOR_ADD_COMPONENT; REAL_LT_LADD; REAL_LE_LADD]);;
9894
9895 add_translation_invariants [IS_INTERVAL_TRANSLATION_EQ];;
9896
9897 let IS_INTERVAL_TRANSLATION = prove
9898  (`!s a:real^N. is_interval s ==> is_interval(IMAGE (\x. a + x) s)`,
9899   REWRITE_TAC[IS_INTERVAL_TRANSLATION_EQ]);;
9900
9901 let IS_INTERVAL_POINTWISE = prove
9902  (`!s:real^N->bool x.
9903         is_interval s /\
9904         (!i. 1 <= i /\ i <= dimindex(:N) ==> ?a. a IN s /\ a$i = x$i)
9905         ==> x IN s`,
9906   REWRITE_TAC[is_interval] THEN REPEAT STRIP_TAC THEN
9907   SUBGOAL_THEN
9908     `!n. ?y:real^N. (!i. 1 <= i /\ i <= n ==> y$i = (x:real^N)$i) /\ y IN s`
9909   MP_TAC THENL
9910    [INDUCT_TAC THEN REWRITE_TAC[ARITH_RULE `~(1 <= i /\ i <= 0)`] THENL
9911      [ASM_MESON_TAC[DIMINDEX_GE_1; LE_REFL]; ALL_TAC] THEN
9912     FIRST_X_ASSUM(X_CHOOSE_TAC `y:real^N`) THEN
9913     ASM_CASES_TAC `SUC n <= dimindex(:N)` THENL
9914      [FIRST_X_ASSUM(MP_TAC o SPEC `SUC n`) THEN
9915       ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
9916       DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN
9917       EXISTS_TAC
9918        `(lambda i. if i <= n then (y:real^N)$i else (z:real^N)$i):real^N` THEN
9919       CONJ_TAC THENL
9920        [X_GEN_TAC `i:num` THEN STRIP_TAC THEN
9921         SUBGOAL_THEN `i <= dimindex(:N)` ASSUME_TAC THENL
9922          [ASM_ARITH_TAC; ASM_SIMP_TAC[LAMBDA_BETA]] THEN
9923         COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
9924         SUBGOAL_THEN `i = SUC n` (fun th -> ASM_REWRITE_TAC[th]) THEN
9925         ASM_ARITH_TAC;
9926         FIRST_X_ASSUM(ASSUME_TAC o CONJUNCT2) THEN
9927         FIRST_X_ASSUM MATCH_MP_TAC THEN
9928         MAP_EVERY EXISTS_TAC [`y:real^N`; `z:real^N`] THEN
9929         ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC];
9930       EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[] THEN
9931       SUBGOAL_THEN `y:real^N = x` (fun th -> REWRITE_TAC[th]) THEN
9932       REWRITE_TAC[CART_EQ] THEN
9933       ASM_MESON_TAC[ARITH_RULE `i <= N /\ ~(SUC n <= N) ==> i <= n`]];
9934     DISCH_THEN(MP_TAC o SPEC `dimindex(:N)`) THEN
9935     REWRITE_TAC[GSYM CART_EQ] THEN MESON_TAC[]]);;
9936
9937 let IS_INTERVAL_COMPACT = prove
9938  (`!s:real^N->bool. is_interval s /\ compact s <=> ?a b. s = interval[a,b]`,
9939   GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN
9940   ASM_SIMP_TAC[IS_INTERVAL_INTERVAL; COMPACT_INTERVAL] THEN
9941   ASM_CASES_TAC `s:real^N->bool = {}` THENL
9942    [ASM_MESON_TAC[EMPTY_AS_INTERVAL]; ALL_TAC] THEN
9943   EXISTS_TAC `(lambda i. inf { (x:real^N)$i | x IN s}):real^N` THEN
9944   EXISTS_TAC `(lambda i. sup { (x:real^N)$i | x IN s}):real^N` THEN
9945   SIMP_TAC[EXTENSION; IN_INTERVAL; LAMBDA_BETA] THEN X_GEN_TAC `x:real^N` THEN
9946   EQ_TAC THENL
9947    [DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
9948     MP_TAC(ISPEC `{ (x:real^N)$i | x IN s}` INF) THEN
9949     MP_TAC(ISPEC `{ (x:real^N)$i | x IN s}` SUP) THEN
9950     ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
9951     ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN
9952     FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN
9953     REWRITE_TAC[bounded] THEN
9954     ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS; MEMBER_NOT_EMPTY;
9955                   REAL_ARITH `abs(x) <= B ==> --B <= x /\ x <= B`];
9956     DISCH_TAC THEN MATCH_MP_TAC IS_INTERVAL_POINTWISE THEN
9957     ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
9958     SUBGOAL_THEN
9959      `?a b:real^N. a IN s /\ b IN s /\ a$i <= (x:real^N)$i /\ x$i <= b$i`
9960     STRIP_ASSUME_TAC THENL
9961      [MP_TAC(ISPECL [`\x:real^N. x$i`; `s:real^N->bool`]
9962         CONTINUOUS_ATTAINS_INF) THEN
9963       ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT; o_DEF] THEN
9964       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN
9965       MP_TAC(ISPECL [`\x:real^N. x$i`; `s:real^N->bool`]
9966         CONTINUOUS_ATTAINS_SUP) THEN
9967       ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT; o_DEF] THEN
9968       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN
9969       ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL
9970        [EXISTS_TAC `inf {(x:real^N)$i | x IN s}` THEN ASM_SIMP_TAC[] THEN
9971         MATCH_MP_TAC REAL_LE_INF THEN ASM SET_TAC[];
9972         EXISTS_TAC `sup {(x:real^N)$i | x IN s}` THEN ASM_SIMP_TAC[] THEN
9973         MATCH_MP_TAC REAL_SUP_LE THEN ASM SET_TAC[]];
9974       EXISTS_TAC
9975        `(lambda j. if j = i then (x:real^N)$i else (a:real^N)$j):real^N` THEN
9976       ASM_SIMP_TAC[LAMBDA_BETA] THEN
9977       FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[is_interval]) THEN
9978       MAP_EVERY EXISTS_TAC
9979        [`a:real^N`;
9980         `(lambda j. if j = i then (b:real^N)$i else (a:real^N)$j):real^N`] THEN
9981       ASM_SIMP_TAC[LAMBDA_BETA] THEN CONJ_TAC THENL
9982        [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[is_interval]) THEN
9983         MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN
9984         ASM_SIMP_TAC[LAMBDA_BETA];
9985         ALL_TAC] THEN
9986       GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
9987       ASM_REAL_ARITH_TAC]]);;
9988
9989 let IS_INTERVAL_1 = prove
9990  (`!s:real^1->bool.
9991         is_interval s <=>
9992           !a b x. a IN s /\ b IN s /\ drop a <= drop x /\ drop x <= drop b
9993                   ==> x IN s`,
9994   REWRITE_TAC[is_interval; DIMINDEX_1; FORALL_1; GSYM drop] THEN
9995   REWRITE_TAC[FORALL_LIFT; LIFT_DROP] THEN MESON_TAC[]);;
9996
9997 let IS_INTERVAL_1_CASES = prove
9998  (`!s:real^1->bool.
9999         is_interval s <=>
10000         s = {} \/
10001         s = (:real^1) \/
10002         (?a. s = {x | a < drop x}) \/
10003         (?a. s = {x | a <= drop x}) \/
10004         (?b. s = {x | drop x <= b}) \/
10005         (?b. s = {x | drop x < b}) \/
10006         (?a b. s = {x | a < drop x /\ drop x < b}) \/
10007         (?a b. s = {x | a < drop x /\ drop x <= b}) \/
10008         (?a b. s = {x | a <= drop x /\ drop x < b}) \/
10009         (?a b. s = {x | a <= drop x /\ drop x <= b})`,
10010   GEN_TAC THEN REWRITE_TAC[IS_INTERVAL_1] THEN EQ_TAC THENL
10011    [DISCH_TAC;
10012     STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV; NOT_IN_EMPTY] THEN
10013     REAL_ARITH_TAC] THEN
10014   ASM_CASES_TAC `s:real^1->bool = {}` THEN ASM_REWRITE_TAC[] THEN
10015   MP_TAC(ISPEC `IMAGE drop s` SUP) THEN
10016   MP_TAC(ISPEC `IMAGE drop s` INF) THEN
10017   ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN
10018   ASM_CASES_TAC `?a. !x. x IN s ==> a <= drop x` THEN
10019   ASM_CASES_TAC `?b. !x. x IN s ==> drop x <= b` THEN
10020   ASM_REWRITE_TAC[] THENL
10021    [STRIP_TAC THEN STRIP_TAC THEN
10022     MAP_EVERY ASM_CASES_TAC
10023      [`inf(IMAGE drop s) IN IMAGE drop s`; `sup(IMAGE drop s) IN IMAGE drop s`]
10024     THENL
10025      [REPLICATE_TAC 8 DISJ2_TAC;
10026       REPLICATE_TAC 7 DISJ2_TAC THEN DISJ1_TAC;
10027       REPLICATE_TAC 6 DISJ2_TAC THEN DISJ1_TAC;
10028       REPLICATE_TAC 5 DISJ2_TAC THEN DISJ1_TAC] THEN
10029     MAP_EVERY EXISTS_TAC [`inf(IMAGE drop s)`; `sup(IMAGE drop s)`];
10030     STRIP_TAC THEN ASM_CASES_TAC `inf(IMAGE drop s) IN IMAGE drop s` THENL
10031      [REPLICATE_TAC 2 DISJ2_TAC THEN DISJ1_TAC;
10032       DISJ2_TAC THEN DISJ1_TAC] THEN
10033     EXISTS_TAC `inf(IMAGE drop s)`;
10034     STRIP_TAC THEN ASM_CASES_TAC `sup(IMAGE drop s) IN IMAGE drop s` THENL
10035      [REPLICATE_TAC 3 DISJ2_TAC THEN DISJ1_TAC;
10036       REPLICATE_TAC 4 DISJ2_TAC THEN DISJ1_TAC] THEN
10037     EXISTS_TAC `sup(IMAGE drop s)`;
10038     DISJ1_TAC] THEN
10039   REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV] THEN
10040   RULE_ASSUM_TAC(REWRITE_RULE[IN_IMAGE]) THEN
10041   REWRITE_TAC[GSYM REAL_NOT_LE] THEN
10042   ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_TOTAL; REAL_LE_ANTISYM]);;
10043
10044 let IS_INTERVAL_PCROSS = prove
10045  (`!s:real^M->bool t:real^N->bool.
10046         is_interval s /\ is_interval t ==> is_interval(s PCROSS t)`,
10047   REWRITE_TAC[is_interval; DIMINDEX_FINITE_SUM] THEN
10048   REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
10049   REPEAT GEN_TAC THEN
10050   MATCH_MP_TAC(MESON[]
10051    `(!a b a' b' x x'. P a b x /\ Q a' b' x' ==> R a b x a' b' x')
10052     ==> (!a b x. P a b x) /\ (!a' b' x'. Q a' b' x')
10053         ==> (!a a' b b' x x'. R a b x a' b' x')`) THEN
10054   REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
10055   ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THENL
10056    [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN
10057     ASM_SIMP_TAC[pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM;
10058                  ARITH_RULE `x:num <= m ==> x <= m + n`];
10059     FIRST_X_ASSUM(MP_TAC o SPEC `dimindex(:M) + i`) THEN
10060     ASM_SIMP_TAC[pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM;
10061                  ARITH_RULE `x:num <= n ==> m + x <= m + n`;
10062                  ARITH_RULE `1 <= x ==> 1 <= m + x`] THEN
10063     COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_SUB2] THEN ASM_ARITH_TAC]);;
10064
10065 let IS_INTERVAL_PCROSS_EQ = prove
10066  (`!s:real^M->bool t:real^N->bool.
10067         is_interval(s PCROSS t) <=>
10068         s = {} \/ t = {} \/ is_interval s /\ is_interval t`,
10069   REPEAT GEN_TAC THEN
10070   ASM_CASES_TAC `s:real^M->bool = {}` THEN
10071   ASM_REWRITE_TAC[PCROSS_EMPTY; IS_INTERVAL_EMPTY] THEN
10072   ASM_CASES_TAC `t:real^N->bool = {}` THEN
10073   ASM_REWRITE_TAC[PCROSS_EMPTY; IS_INTERVAL_EMPTY] THEN
10074   EQ_TAC THEN REWRITE_TAC[IS_INTERVAL_PCROSS] THEN
10075   REWRITE_TAC[is_interval] THEN
10076   REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN
10077   STRIP_TAC THEN CONJ_TAC THENL
10078    [MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`; `x:real^M`] THEN
10079     STRIP_TAC THEN UNDISCH_TAC `~(t:real^N->bool = {})` THEN
10080     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
10081     DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN
10082     FIRST_X_ASSUM(MP_TAC o SPECL
10083      [`a:real^M`; `y:real^N`; `b:real^M`;
10084       `y:real^N`; `x:real^M`; `y:real^N`]);
10085     MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN
10086     STRIP_TAC THEN UNDISCH_TAC `~(s:real^M->bool = {})` THEN
10087     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
10088     DISCH_THEN(X_CHOOSE_TAC `w:real^M`) THEN
10089     FIRST_X_ASSUM(MP_TAC o SPECL
10090      [`w:real^M`; `a:real^N`; `w:real^M`;
10091       `b:real^N`; `w:real^M`; `x:real^N`])] THEN
10092   ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN
10093   SIMP_TAC[pastecart; LAMBDA_BETA] THEN
10094   REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN
10095   ASM_MESON_TAC[DIMINDEX_FINITE_SUM; ARITH_RULE
10096       `1 <= i /\ i <= m + n /\ ~(i <= m) ==> 1 <= i - m /\ i - m <= n`]);;
10097
10098 let IS_INTERVAL_INTER = prove
10099  (`!s t:real^N->bool.
10100         is_interval s /\ is_interval t ==> is_interval(s INTER t)`,
10101   REWRITE_TAC[is_interval; IN_INTER] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
10102   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN
10103   REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
10104   MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN ASM_REWRITE_TAC[]);;
10105
10106 let INTERVAL_SUBSET_IS_INTERVAL = prove
10107  (`!s a b:real^N.
10108      is_interval s
10109      ==> (interval[a,b] SUBSET s <=> interval[a,b] = {} \/ a IN s /\ b IN s)`,
10110   REWRITE_TAC[is_interval] THEN REPEAT STRIP_TAC THEN
10111   ASM_CASES_TAC `interval[a:real^N,b] = {}` THEN
10112   ASM_REWRITE_TAC[EMPTY_SUBSET] THEN
10113   EQ_TAC THENL [ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET]; ALL_TAC] THEN
10114   REWRITE_TAC[SUBSET; IN_INTERVAL] THEN ASM_MESON_TAC[]);;
10115
10116 let INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD = prove
10117  (`!s x:real^N.
10118         is_interval s /\ x IN s
10119         ==> ?a b d. &0 < d /\ x IN interval[a,b] /\
10120                     interval[a,b] SUBSET s /\
10121                     ball(x,d) INTER s SUBSET interval[a,b]`,
10122   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_SUBSET_IS_INTERVAL] THEN
10123   SUBGOAL_THEN
10124    `!i. 1 <= i /\ i <= dimindex(:N)
10125         ==> ?a. (?y. y IN s /\ y$i = a) /\
10126                 (a < x$i \/ a = (x:real^N)$i /\
10127                             !y:real^N. y IN s ==> a <= y$i)`
10128   MP_TAC THENL [ASM_MESON_TAC[REAL_NOT_LT]; REWRITE_TAC[LAMBDA_SKOLEM]] THEN
10129   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN
10130   SUBGOAL_THEN
10131    `!i. 1 <= i /\ i <= dimindex(:N)
10132         ==> ?b. (?y. y IN s /\ y$i = b) /\
10133                 (x$i < b \/ b = (x:real^N)$i /\
10134                             !y:real^N. y IN s ==> y$i <= b)`
10135   MP_TAC THENL [ASM_MESON_TAC[REAL_NOT_LT]; REWRITE_TAC[LAMBDA_SKOLEM]] THEN
10136   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN
10137   EXISTS_TAC `min (inf (IMAGE (\i. if a$i < x$i
10138                                    then (x:real^N)$i - (a:real^N)$i else &1)
10139                               (1..dimindex(:N))))
10140                   (inf (IMAGE (\i. if x$i < b$i
10141                                    then (b:real^N)$i - x$i else &1)
10142                               (1..dimindex(:N))))` THEN
10143   REWRITE_TAC[REAL_LT_MIN; SUBSET; IN_BALL; IN_INTER] THEN
10144   SIMP_TAC[REAL_LT_INF_FINITE; IMAGE_EQ_EMPTY; FINITE_IMAGE;
10145            FINITE_NUMSEG; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN
10146   REWRITE_TAC[FORALL_IN_IMAGE; IN_INTERVAL] THEN REPEAT CONJ_TAC THENL
10147    [MESON_TAC[REAL_SUB_LT; REAL_LT_01];
10148     MESON_TAC[REAL_SUB_LT; REAL_LT_01];
10149     ASM_MESON_TAC[REAL_LE_LT];
10150     DISJ2_TAC THEN CONJ_TAC THEN MATCH_MP_TAC IS_INTERVAL_POINTWISE THEN
10151     ASM_MESON_TAC[];
10152     X_GEN_TAC `y:real^N` THEN
10153     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
10154     REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN
10155     X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
10156     ASM_REWRITE_TAC[IN_NUMSEG] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN
10157     (COND_CASES_TAC THENL [REWRITE_TAC[dist]; ASM_MESON_TAC[]]) THEN
10158     DISCH_TAC THEN MP_TAC(ISPECL [`x - y:real^N`; `i:num`]
10159       COMPONENT_LE_NORM) THEN
10160     ASM_REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN ASM_REAL_ARITH_TAC]);;
10161
10162 let IS_INTERVAL_SUMS = prove
10163  (`!s t:real^N->bool.
10164         is_interval s /\ is_interval t
10165         ==> is_interval {x + y | x IN s /\ y IN t}`,
10166   REPEAT GEN_TAC THEN REWRITE_TAC[is_interval] THEN
10167   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
10168   REWRITE_TAC[FORALL_IN_GSPEC] THEN
10169   REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
10170   REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN
10171   MAP_EVERY X_GEN_TAC
10172    [`a:real^N`; `a':real^N`; `b:real^N`; `b':real^N`; `y:real^N`] THEN
10173   DISCH_THEN(CONJUNCTS_THEN2
10174    (MP_TAC o SPECL [`a:real^N`; `b:real^N`]) MP_TAC) THEN
10175   DISCH_THEN(CONJUNCTS_THEN2
10176    (MP_TAC o SPECL [`a':real^N`; `b':real^N`]) STRIP_ASSUME_TAC) THEN
10177   ASM_REWRITE_TAC[IMP_IMP; IN_ELIM_THM] THEN  ONCE_REWRITE_TAC[CONJ_SYM] THEN
10178   ONCE_REWRITE_TAC[VECTOR_ARITH `z:real^N = x + y <=> y = z - x`] THEN
10179   REWRITE_TAC[UNWIND_THM2] THEN MATCH_MP_TAC(MESON[]
10180    `(?x. P x /\ Q(f x))
10181     ==> (!x. P x ==> x IN s) /\ (!x. Q x ==> x IN t)
10182         ==> ?x. x IN s /\ f x IN t`) THEN
10183   REWRITE_TAC[VECTOR_SUB_COMPONENT; AND_FORALL_THM;
10184               TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN
10185   REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN
10186   X_GEN_TAC `i:num` THEN STRIP_TAC THEN
10187   FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN
10188   ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT] THEN
10189   REWRITE_TAC[REAL_ARITH
10190    `c <= y - x /\ y - x <= d <=> y - d <= x /\ x <= y - c`] THEN
10191   REWRITE_TAC[REAL_ARITH
10192   `a <= x /\ x <= b \/ b <= x /\ x <= a <=> min a b <= x /\ x <= max a b`] THEN
10193   ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ (r /\ s) <=> (p /\ r) /\ (q /\ s)`] THEN
10194   REWRITE_TAC[GSYM REAL_LE_MIN; GSYM REAL_MAX_LE] THEN
10195   REWRITE_TAC[GSYM REAL_LE_BETWEEN] THEN REAL_ARITH_TAC);;
10196
10197 let IS_INTERVAL_SING = prove
10198  (`!a:real^N. is_interval {a}`,
10199   SIMP_TAC[is_interval; IN_SING; IMP_CONJ; CART_EQ; REAL_LE_ANTISYM]);;
10200
10201 let IS_INTERVAL_SCALING = prove
10202  (`!s:real^N->bool c. is_interval s ==> is_interval(IMAGE (\x. c % x) s)`,
10203   REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THENL
10204    [ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
10205     SUBGOAL_THEN `IMAGE ((\x. vec 0):real^N->real^N) s = {} \/
10206                   IMAGE ((\x. vec 0):real^N->real^N) s = {vec 0}`
10207     STRIP_ASSUME_TAC THENL
10208      [SET_TAC[];
10209       ASM_REWRITE_TAC[IS_INTERVAL_EMPTY];
10210       ASM_REWRITE_TAC[IS_INTERVAL_SING]];
10211     REWRITE_TAC[is_interval; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
10212     REWRITE_TAC[FORALL_IN_IMAGE] THEN
10213     GEN_REWRITE_TAC (BINOP_CONV o REDEPTH_CONV) [RIGHT_IMP_FORALL_THM] THEN
10214     REWRITE_TAC[IMP_IMP; VECTOR_MUL_COMPONENT] THEN
10215     MAP_EVERY (fun t -> MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC t)
10216      [`a:real^N`; `b:real^N`] THEN
10217     DISCH_THEN(fun th -> X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
10218                          MP_TAC(SPEC `inv(c) % x:real^N` th)) THEN
10219     ASM_REWRITE_TAC[VECTOR_MUL_COMPONENT; IN_IMAGE] THEN ANTS_TAC THENL
10220      [X_GEN_TAC `i:num` THEN STRIP_TAC THEN
10221       FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN
10222       ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN
10223       FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH
10224        `~(c = &0) ==> &0 < c \/ &0 < --c`)) THEN
10225       ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN
10226       GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_LE_NEG2] THEN
10227       ASM_SIMP_TAC[GSYM REAL_MUL_RNEG; GSYM REAL_LE_RDIV_EQ; GSYM
10228                    REAL_LE_LDIV_EQ] THEN
10229       REWRITE_TAC[real_div; REAL_INV_NEG] THEN REAL_ARITH_TAC;
10230       DISCH_TAC THEN EXISTS_TAC `inv c % x:real^N` THEN
10231       ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID]]]);;
10232
10233 let IS_INTERVAL_SCALING_EQ = prove
10234  (`!s:real^N->bool c.
10235         is_interval(IMAGE (\x. c % x) s) <=> c = &0 \/ is_interval s`,
10236   REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THENL
10237    [ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN
10238     SUBGOAL_THEN `IMAGE ((\x. vec 0):real^N->real^N) s = {} \/
10239                   IMAGE ((\x. vec 0):real^N->real^N) s = {vec 0}`
10240     STRIP_ASSUME_TAC THENL
10241      [SET_TAC[];
10242       ASM_REWRITE_TAC[IS_INTERVAL_EMPTY];
10243       ASM_REWRITE_TAC[IS_INTERVAL_SING]];
10244     ASM_REWRITE_TAC[] THEN EQ_TAC THEN REWRITE_TAC[IS_INTERVAL_SCALING] THEN
10245     DISCH_THEN(MP_TAC o SPEC `inv c:real` o MATCH_MP IS_INTERVAL_SCALING) THEN
10246     ASM_SIMP_TAC[GSYM IMAGE_o; VECTOR_MUL_ASSOC; o_DEF; REAL_MUL_LINV;
10247                  VECTOR_MUL_LID; IMAGE_ID]]);;
10248
10249 let lemma = prove
10250  (`!c. &0 < c
10251        ==> !s:real^N->bool. is_interval(IMAGE (\x. c % x) s) <=>
10252                             is_interval s`,
10253   SIMP_TAC[IS_INTERVAL_SCALING_EQ; REAL_LT_IMP_NZ]) in
10254 add_scaling_theorems [lemma];;
10255
10256 (* ------------------------------------------------------------------------- *)
10257 (* Line segments, with same open/closed overloading as for intervals.        *)
10258 (* ------------------------------------------------------------------------- *)
10259
10260 let closed_segment = define
10261  `closed_segment[a,b] = {(&1 - u) % a + u % b | &0 <= u /\ u <= &1}`;;
10262
10263 let open_segment = new_definition
10264  `open_segment(a,b) = closed_segment[a,b] DIFF {a,b}`;;
10265
10266 let OPEN_SEGMENT_ALT = prove
10267  (`!a b:real^N.
10268         ~(a = b)
10269         ==> open_segment(a,b) = {(&1 - u) % a + u % b | &0 < u /\ u < &1}`,
10270   REPEAT STRIP_TAC THEN REWRITE_TAC[open_segment; closed_segment] THEN
10271   REWRITE_TAC[EXTENSION; IN_DIFF; IN_INSERT; NOT_IN_EMPTY; IN_ELIM_THM] THEN
10272   X_GEN_TAC `x:real^N` THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
10273   AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
10274   X_GEN_TAC `u:real` THEN ASM_CASES_TAC `x:real^N = (&1 - u) % a + u % b` THEN
10275   ASM_REWRITE_TAC[REAL_LE_LT;
10276     VECTOR_ARITH `(&1 - u) % a + u % b = a <=> u % (b - a) = vec 0`;
10277     VECTOR_ARITH `(&1 - u) % a + u % b = b <=> (&1 - u) % (b - a) = vec 0`;
10278     VECTOR_MUL_EQ_0; REAL_SUB_0; VECTOR_SUB_EQ] THEN
10279   REAL_ARITH_TAC);;
10280
10281 make_overloadable "segment" `:A`;;
10282
10283 overload_interface("segment",`open_segment`);;
10284 overload_interface("segment",`closed_segment`);;
10285
10286 let segment = prove
10287  (`segment[a,b] = {(&1 - u) % a + u % b | &0 <= u /\ u <= &1} /\
10288    segment(a,b) = segment[a,b] DIFF {a,b}`,
10289   REWRITE_TAC[open_segment; closed_segment]);;
10290
10291 let SEGMENT_REFL = prove
10292  (`(!a. segment[a,a] = {a}) /\
10293    (!a. segment(a,a) = {})`,
10294   REWRITE_TAC[segment; VECTOR_ARITH `(&1 - u) % a + u % a = a`] THEN
10295   SET_TAC[REAL_POS]);;
10296
10297 let IN_SEGMENT = prove
10298  (`!a b x:real^N.
10299         (x IN segment[a,b] <=>
10300          ?u. &0 <= u /\ u <= &1 /\ x = (&1 - u) % a + u % b) /\
10301         (x IN segment(a,b) <=>
10302          ~(a = b) /\ ?u. &0 < u /\ u < &1 /\ x = (&1 - u) % a + u % b)`,
10303   REPEAT STRIP_TAC THENL
10304    [REWRITE_TAC[segment; IN_ELIM_THM; CONJ_ASSOC]; ALL_TAC] THEN
10305   ASM_CASES_TAC `a:real^N = b` THEN
10306   ASM_REWRITE_TAC[SEGMENT_REFL; NOT_IN_EMPTY] THEN
10307   ASM_SIMP_TAC[OPEN_SEGMENT_ALT; IN_ELIM_THM; CONJ_ASSOC]);;
10308
10309 let SEGMENT_SYM = prove
10310  (`(!a b:real^N. segment[a,b] = segment[b,a]) /\
10311    (!a b:real^N. segment(a,b) = segment(b,a))`,
10312   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN
10313   SIMP_TAC[open_segment] THEN
10314   CONJ_TAC THENL [ALL_TAC; SIMP_TAC[INSERT_AC]] THEN
10315   REWRITE_TAC[EXTENSION; IN_SEGMENT] THEN REPEAT GEN_TAC THEN EQ_TAC THEN
10316   DISCH_THEN(X_CHOOSE_TAC `u:real`) THEN EXISTS_TAC `&1 - u` THEN
10317   ASM_REWRITE_TAC[] THEN
10318   REPEAT CONJ_TAC THEN TRY ASM_ARITH_TAC THEN VECTOR_ARITH_TAC);;
10319
10320 let ENDS_IN_SEGMENT = prove
10321  (`!a b. a IN segment[a,b] /\ b IN segment[a,b]`,
10322   REPEAT STRIP_TAC THEN REWRITE_TAC[segment; IN_ELIM_THM] THENL
10323    [EXISTS_TAC `&0`; EXISTS_TAC `&1`] THEN
10324   (CONJ_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC]));;
10325
10326 let ENDS_NOT_IN_SEGMENT = prove
10327  (`!a b. ~(a IN segment(a,b)) /\ ~(b IN segment(a,b))`,
10328   REWRITE_TAC[open_segment] THEN SET_TAC[]);;
10329
10330 let SEGMENT_CLOSED_OPEN = prove
10331  (`!a b. segment[a,b] = segment(a,b) UNION {a,b}`,
10332   REPEAT GEN_TAC THEN REWRITE_TAC[open_segment] THEN MATCH_MP_TAC(SET_RULE
10333    `a IN s /\ b IN s ==> s = (s DIFF {a,b}) UNION {a,b}`) THEN
10334   REWRITE_TAC[ENDS_IN_SEGMENT]);;
10335
10336 let MIDPOINT_IN_SEGMENT = prove
10337  (`(!a b:real^N. midpoint(a,b) IN segment[a,b]) /\
10338    (!a b:real^N. midpoint(a,b) IN segment(a,b) <=> ~(a = b))`,
10339   REWRITE_TAC[IN_SEGMENT] THEN REPEAT STRIP_TAC THENL
10340    [ALL_TAC; ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[]] THEN
10341   EXISTS_TAC `&1 / &2` THEN REWRITE_TAC[midpoint] THEN
10342   CONV_TAC REAL_RAT_REDUCE_CONV THEN VECTOR_ARITH_TAC);;
10343
10344 let BETWEEN_IN_SEGMENT = prove
10345  (`!x a b:real^N. between x (a,b) <=> x IN segment[a,b]`,
10346   REPEAT GEN_TAC THEN REWRITE_TAC[between] THEN
10347   ASM_CASES_TAC `a:real^N = b` THEN
10348   ASM_REWRITE_TAC[SEGMENT_REFL; IN_SING] THENL [NORM_ARITH_TAC; ALL_TAC] THEN
10349   REWRITE_TAC[segment; IN_ELIM_THM] THEN EQ_TAC THENL
10350    [DISCH_THEN(ASSUME_TAC o SYM) THEN
10351     EXISTS_TAC `dist(a:real^N,x) / dist(a,b)` THEN
10352     ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; DIST_POS_LT] THEN CONJ_TAC
10353     THENL [FIRST_ASSUM(SUBST1_TAC o SYM) THEN NORM_ARITH_TAC; ALL_TAC] THEN
10354     MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN EXISTS_TAC `dist(a:real^N,b)` THEN
10355     ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_ADD_LDISTRIB; REAL_SUB_LDISTRIB;
10356                  REAL_DIV_LMUL; DIST_EQ_0] THEN
10357     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIST_TRIANGLE_EQ] o SYM) THEN
10358     FIRST_ASSUM(SUBST1_TAC o SYM) THEN
10359     REWRITE_TAC[dist; REAL_ARITH `(a + b) * &1 - a = b`] THEN
10360     VECTOR_ARITH_TAC;
10361     STRIP_TAC THEN ASM_REWRITE_TAC[dist] THEN
10362     REWRITE_TAC[VECTOR_ARITH `a - ((&1 - u) % a + u % b) = u % (a - b)`;
10363                 VECTOR_ARITH `((&1 - u) % a + u % b) - b = (&1 - u) % (a - b)`;
10364                 NORM_MUL; GSYM REAL_ADD_LDISTRIB] THEN
10365     REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD]);;
10366
10367 let IN_SEGMENT_COMPONENT = prove
10368  (`!a b x:real^N i.
10369         x IN segment[a,b] /\ 1 <= i /\ i <= dimindex(:N)
10370         ==> min (a$i) (b$i) <= x$i /\ x$i <= max (a$i) (b$i)`,
10371   REPEAT STRIP_TAC THEN
10372   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN
10373   DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
10374   FIRST_X_ASSUM(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN
10375   ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
10376   SIMP_TAC[REAL_ARITH `c <= u * a + t * b <=> u * --a + t * --b <= --c`] THEN
10377   MATCH_MP_TAC REAL_CONVEX_BOUND_LE THEN ASM_REAL_ARITH_TAC);;
10378
10379 let SEGMENT_1 = prove
10380  (`(!a b. segment[a,b] =
10381           if drop a <= drop b then interval[a,b] else interval[b,a]) /\
10382    (!a b. segment(a,b) =
10383           if drop a <= drop b then interval(a,b) else interval(b,a))`,
10384   CONJ_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[open_segment] THEN
10385   COND_CASES_TAC THEN
10386   REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY;
10387               EXTENSION; GSYM BETWEEN_IN_SEGMENT; between; IN_INTERVAL_1] THEN
10388   REWRITE_TAC[GSYM DROP_EQ; DIST_REAL; GSYM drop] THEN ASM_REAL_ARITH_TAC);;
10389
10390 let OPEN_SEGMENT_1 = prove
10391  (`!a b:real^1. open(segment(a,b))`,
10392   REPEAT GEN_TAC THEN REWRITE_TAC[SEGMENT_1] THEN
10393   COND_CASES_TAC THEN REWRITE_TAC[OPEN_INTERVAL]);;
10394
10395 let SEGMENT_TRANSLATION = prove
10396  (`(!c a b. segment[c + a,c + b] = IMAGE (\x. c + x) (segment[a,b])) /\
10397    (!c a b. segment(c + a,c + b) = IMAGE (\x. c + x) (segment(a,b)))`,
10398   REWRITE_TAC[EXTENSION; IN_SEGMENT; IN_IMAGE] THEN
10399   REWRITE_TAC[VECTOR_ARITH `(&1 - u) % (c + a) + u % (c + b) =
10400                             c + (&1 - u) % a + u % b`] THEN
10401   REWRITE_TAC[VECTOR_ARITH `c + a:real^N = c + b <=> a = b`] THEN
10402   MESON_TAC[]);;
10403
10404 add_translation_invariants
10405  [CONJUNCT1 SEGMENT_TRANSLATION; CONJUNCT2 SEGMENT_TRANSLATION];;
10406
10407 let CLOSED_SEGMENT_LINEAR_IMAGE = prove
10408  (`!f a b. linear f
10409            ==> segment[f a,f b] = IMAGE f (segment[a,b])`,
10410   REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_SEGMENT] THEN
10411   FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_CMUL th)]) THEN
10412   FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_ADD th)]) THEN
10413   MESON_TAC[]);;
10414
10415 add_linear_invariants [CLOSED_SEGMENT_LINEAR_IMAGE];;
10416
10417 let OPEN_SEGMENT_LINEAR_IMAGE = prove
10418  (`!f:real^M->real^N a b.
10419         linear f /\ (!x y. f x = f y ==> x = y)
10420         ==> segment(f a,f b) = IMAGE f (segment(a,b))`,
10421   REWRITE_TAC[open_segment] THEN GEOM_TRANSFORM_TAC[]);;
10422
10423 add_linear_invariants [OPEN_SEGMENT_LINEAR_IMAGE];;
10424
10425 let IN_OPEN_SEGMENT = prove
10426  (`!a b x:real^N.
10427         x IN segment(a,b) <=> x IN segment[a,b] /\ ~(x = a) /\ ~(x = b)`,
10428   REPEAT GEN_TAC THEN REWRITE_TAC[open_segment; IN_DIFF] THEN SET_TAC[]);;
10429
10430 let IN_OPEN_SEGMENT_ALT = prove
10431  (`!a b x:real^N.
10432         x IN segment(a,b) <=>
10433         x IN segment[a,b] /\ ~(x = a) /\ ~(x = b) /\ ~(a = b)`,
10434   REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN
10435   ASM_REWRITE_TAC[SEGMENT_REFL; IN_SING; NOT_IN_EMPTY] THEN
10436   ASM_MESON_TAC[IN_OPEN_SEGMENT]);;
10437
10438 let COLLINEAR_DIST_IN_CLOSED_SEGMENT = prove
10439  (`!a b x. collinear {x,a,b} /\
10440            dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b)
10441            ==> x IN segment[a,b]`,
10442   REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; COLLINEAR_DIST_BETWEEN]);;
10443
10444 let COLLINEAR_DIST_IN_OPEN_SEGMENT = prove
10445  (`!a b x. collinear {x,a,b} /\
10446            dist(x,a) < dist(a,b) /\ dist(x,b) < dist(a,b)
10447            ==> x IN segment(a,b)`,
10448   REWRITE_TAC[IN_OPEN_SEGMENT] THEN
10449   MESON_TAC[COLLINEAR_DIST_IN_CLOSED_SEGMENT; REAL_LT_LE; DIST_SYM]);;
10450
10451 let SEGMENT_SCALAR_MULTIPLE = prove
10452  (`(!a b v. segment[a % v,b % v] =
10453             {x % v:real^N | a <= x /\ x <= b \/ b <= x /\ x <= a}) /\
10454    (!a b v. ~(v = vec 0)
10455             ==> segment(a % v,b % v) =
10456                 {x % v:real^N | a < x /\ x < b \/ b < x /\ x < a})`,
10457   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN REPEAT STRIP_TAC THENL
10458    [REPEAT GEN_TAC THEN
10459     MP_TAC(SPECL [`a % basis 1:real^1`; `b % basis 1:real^1`]
10460      (CONJUNCT1 SEGMENT_1)) THEN
10461     REWRITE_TAC[segment; VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_RDISTRIB] THEN
10462     REWRITE_TAC[SET_RULE `{f x % b | p x} = IMAGE (\a. a % b) {f x | p x}`] THEN
10463     DISCH_TAC THEN AP_TERM_TAC THEN
10464     FIRST_X_ASSUM(MP_TAC o AP_TERM `IMAGE drop`) THEN
10465     REWRITE_TAC[GSYM IMAGE_o; o_DEF; DROP_CMUL] THEN
10466     SIMP_TAC[drop; BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN
10467     REWRITE_TAC[REAL_MUL_RID; IMAGE_ID] THEN DISCH_THEN SUBST1_TAC THEN
10468     MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
10469     CONJ_TAC THENL [MESON_TAC[LIFT_DROP]; ALL_TAC] THEN
10470     REWRITE_TAC[FORALL_LIFT; LIFT_DROP] THEN GEN_TAC THEN
10471     COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN
10472     SIMP_TAC[drop; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_GE_1;
10473              LE_REFL; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC;
10474     ASM_REWRITE_TAC[open_segment] THEN
10475     ASM_SIMP_TAC[VECTOR_MUL_RCANCEL; SET_RULE
10476      `(!x y. x % v = y % v <=> x = y)
10477       ==> {x % v | P x} DIFF {a % v,b % v} =
10478           {x % v | P x /\ ~(x = a) /\ ~(x = b)}`] THEN
10479     ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN AP_TERM_TAC THEN
10480     REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REAL_ARITH_TAC]);;
10481
10482 let FINITE_INTER_COLLINEAR_OPEN_SEGMENTS = prove
10483  (`!a b c d:real^N.
10484         collinear{a,b,c}
10485         ==> (FINITE(segment(a,b) INTER segment(c,d)) <=>
10486              segment(a,b) INTER segment(c,d) = {})`,
10487   REPEAT GEN_TAC THEN ABBREV_TAC `m:real^N = b - a` THEN POP_ASSUM MP_TAC THEN
10488   GEOM_NORMALIZE_TAC `m:real^N` THEN
10489   SIMP_TAC[VECTOR_SUB_EQ; SEGMENT_REFL; INTER_EMPTY; FINITE_EMPTY] THEN
10490   X_GEN_TAC `m:real^N` THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
10491   DISCH_THEN(SUBST_ALL_TAC o SYM) THEN POP_ASSUM MP_TAC THEN
10492   GEOM_ORIGIN_TAC `a:real^N` THEN GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN
10493   X_GEN_TAC `b:real` THEN DISCH_TAC THEN
10494   MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
10495   SIMP_TAC[VECTOR_SUB_RZERO; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
10496   ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN DISCH_THEN SUBST_ALL_TAC THEN
10497   POP_ASSUM(K ALL_TAC) THEN
10498   ASM_CASES_TAC `collinear{vec 0:real^N,&1 % basis 1,y}` THENL
10499    [POP_ASSUM MP_TAC THEN
10500     SIMP_TAC[COLLINEAR_LEMMA_ALT; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN
10501     MATCH_MP_TAC(TAUT
10502      `~a /\ (b ==> c ==> d) ==> a \/ b ==> a \/ c ==> d`) THEN
10503     CONJ_TAC THENL
10504      [SIMP_TAC[VECTOR_MUL_LID; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL];
10505       REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
10506     X_GEN_TAC `b:real` THEN DISCH_THEN SUBST_ALL_TAC THEN
10507     X_GEN_TAC `a:real` THEN DISCH_THEN SUBST_ALL_TAC THEN
10508     REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RID] THEN
10509     SUBST1_TAC(VECTOR_ARITH `vec 0:real^N = &0 % basis 1`) THEN
10510     SIMP_TAC[SEGMENT_SCALAR_MULTIPLE; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL;
10511      VECTOR_MUL_RCANCEL; IMAGE_EQ_EMPTY; FINITE_IMAGE_INJ_EQ; SET_RULE
10512      `(!x y. x % v = y % v <=> x = y)
10513       ==> {x % v | P x} INTER {x % v | Q x} =
10514           IMAGE (\x. x % v) {x | P x /\ Q x}`] THEN
10515     REWRITE_TAC[REAL_ARITH `(&0 < x /\ x < &1 \/ &1 < x /\ x < &0) /\
10516                             (b < x /\ x < a \/ a < x /\ x < b) <=>
10517                        max (&0) (min a b) < x /\ x < min (&1) (max a b)`] THEN
10518     SIMP_TAC[FINITE_REAL_INTERVAL; EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM] THEN
10519     SIMP_TAC[GSYM REAL_LT_BETWEEN; GSYM NOT_EXISTS_THM] THEN REAL_ARITH_TAC;
10520     DISCH_TAC THEN ASM_CASES_TAC
10521      `segment(vec 0:real^N,&1 % basis 1) INTER segment (x,y) = {}` THEN
10522     ASM_REWRITE_TAC[FINITE_EMPTY] THEN DISCH_THEN(K ALL_TAC) THEN
10523     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
10524     REWRITE_TAC[open_segment; IN_DIFF; NOT_IN_EMPTY;
10525                 DE_MORGAN_THM; IN_INTER; IN_INSERT] THEN
10526     DISCH_THEN(X_CHOOSE_THEN `p:real^N` STRIP_ASSUME_TAC) THEN
10527     UNDISCH_TAC `~collinear{vec 0:real^N,&1 % basis 1, y}` THEN
10528     RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_MUL_LID]) THEN
10529     REWRITE_TAC[VECTOR_MUL_LID] THEN
10530     MATCH_MP_TAC COLLINEAR_SUBSET THEN
10531     EXISTS_TAC `{p,x:real^N, y, vec 0, basis 1}` THEN
10532     CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
10533     MP_TAC(ISPECL [`{y:real^N,vec 0,basis 1}`; `p:real^N`; `x:real^N`]
10534         COLLINEAR_TRIPLES) THEN
10535     ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN
10536     REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN CONJ_TAC THENL
10537      [ONCE_REWRITE_TAC[SET_RULE `{p,x,y} = {x,p,y}`] THEN
10538       MATCH_MP_TAC BETWEEN_IMP_COLLINEAR THEN
10539       ASM_REWRITE_TAC[BETWEEN_IN_SEGMENT];
10540       ALL_TAC] THEN
10541     ASM_SIMP_TAC[GSYM COLLINEAR_4_3] THEN
10542     ONCE_REWRITE_TAC[SET_RULE `{p,x,z,w} = {w,z,p,x}`] THEN
10543     SIMP_TAC[COLLINEAR_4_3; BASIS_NONZERO; DIMINDEX_GE_1; ARITH] THEN
10544     REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR o
10545         GEN_REWRITE_RULE I [GSYM BETWEEN_IN_SEGMENT])) THEN
10546     REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[INSERT_AC]]);;
10547
10548 let DIST_IN_CLOSED_SEGMENT,DIST_IN_OPEN_SEGMENT = (CONJ_PAIR o prove)
10549  (`(!a b x:real^N.
10550     x IN segment[a,b] ==> dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b)) /\
10551    (!a b x:real^N.
10552     x IN segment(a,b) ==> dist(x,a) < dist(a,b) /\ dist(x,b) < dist(a,b))`,
10553   SIMP_TAC[IN_SEGMENT; RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM; dist;
10554            VECTOR_ARITH
10555     `((&1 - u) % a + u % b) - a:real^N = u % (b - a) /\
10556      ((&1 - u) % a + u % b) - b = --(&1 - u) % (b - a)`] THEN
10557   REWRITE_TAC[NORM_MUL; REAL_ABS_NEG; NORM_SUB] THEN CONJ_TAC THEN
10558   REPEAT GEN_TAC THEN STRIP_TAC THENL
10559    [REWRITE_TAC[REAL_ARITH `x * y <= y <=> x * y <= &1 * y`] THEN
10560     CONJ_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN
10561     REWRITE_TAC[NORM_POS_LE] THEN ASM_REAL_ARITH_TAC;
10562     REWRITE_TAC[REAL_ARITH `x * y < y <=> x * y < &1 * y`] THEN
10563     ASM_SIMP_TAC[REAL_LT_RMUL_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN
10564     ASM_REAL_ARITH_TAC]);;
10565
10566 let DIST_DECREASES_OPEN_SEGMENT = prove
10567  (`!a b c x:real^N.
10568       x IN segment(a,b) ==> dist(c,x) < dist(c,a) \/ dist(c,x) < dist(c,b)`,
10569   GEOM_ORIGIN_TAC `a:real^N` THEN GEOM_NORMALIZE_TAC `b:real^N` THEN
10570   REWRITE_TAC[SEGMENT_REFL; NOT_IN_EMPTY] THEN X_GEN_TAC `b:real^N` THEN
10571   GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN X_GEN_TAC `b:real` THEN
10572   SIMP_TAC[NORM_MUL; NORM_BASIS; real_abs; DIMINDEX_GE_1; LE_REFL;
10573            REAL_MUL_RID; VECTOR_MUL_LID] THEN
10574   REPEAT(DISCH_THEN(K ALL_TAC)) THEN REPEAT GEN_TAC THEN
10575   REWRITE_TAC[IN_SEGMENT; dist] THEN STRIP_TAC THEN
10576   ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN
10577   SUBGOAL_THEN
10578    `norm((c$1 - u) % basis 1:real^N) < norm((c:real^N)$1 % basis 1:real^N) \/
10579     norm((c$1 - u) % basis 1:real^N) < norm((c$1 - &1) % basis 1:real^N)`
10580   MP_TAC THENL
10581    [SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
10582     ASM_REAL_ARITH_TAC;
10583     ASM_SIMP_TAC[NORM_LT; DOT_LMUL; DOT_RMUL; DOT_BASIS; DIMINDEX_GE_1;
10584               DOT_LSUB; DOT_RSUB; LE_REFL; VECTOR_MUL_COMPONENT; VEC_COMPONENT;
10585               BASIS_COMPONENT; DOT_LZERO; DOT_RZERO; VECTOR_SUB_COMPONENT] THEN
10586     ASM_REAL_ARITH_TAC]);;
10587
10588 let DIST_DECREASES_CLOSED_SEGMENT = prove
10589  (`!a b c x:real^N.
10590       x IN segment[a,b] ==> dist(c,x) <= dist(c,a) \/ dist(c,x) <= dist(c,b)`,
10591   REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN
10592   ASM_MESON_TAC[DIST_DECREASES_OPEN_SEGMENT; REAL_LE_REFL; REAL_LT_IMP_LE]);;
10593
10594 (* ------------------------------------------------------------------------- *)
10595 (* Limit component bounds.                                                   *)
10596 (* ------------------------------------------------------------------------- *)
10597
10598 let LIM_COMPONENT_UBOUND = prove
10599  (`!net:(A)net f (l:real^N) b k.
10600         ~(trivial_limit net) /\ (f --> l) net /\
10601         eventually (\x. (f x)$k <= b) net /\
10602         1 <= k /\ k <= dimindex(:N)
10603         ==> l$k <= b`,
10604   REPEAT STRIP_TAC THEN MP_TAC(ISPECL
10605    [`net:(A)net`; `f:A->real^N`; `{y:real^N | basis k dot y <= b}`; `l:real^N`]
10606    LIM_IN_CLOSED_SET) THEN
10607   ASM_SIMP_TAC[CLOSED_HALFSPACE_LE; IN_ELIM_THM; DOT_BASIS]);;
10608
10609 let LIM_COMPONENT_LBOUND = prove
10610  (`!net:(A)net f (l:real^N) b k.
10611         ~(trivial_limit net) /\ (f --> l) net /\
10612         eventually (\x. b <= (f x)$k) net /\
10613         1 <= k /\ k <= dimindex(:N)
10614         ==> b <= l$k`,
10615   REPEAT STRIP_TAC THEN MP_TAC(ISPECL
10616    [`net:(A)net`; `f:A->real^N`; `{y:real^N | b <= basis k dot y}`; `l:real^N`]
10617    LIM_IN_CLOSED_SET) THEN
10618   ASM_SIMP_TAC[REWRITE_RULE[real_ge] CLOSED_HALFSPACE_GE;
10619                IN_ELIM_THM; DOT_BASIS]);;
10620
10621 let LIM_COMPONENT_EQ = prove
10622  (`!net f:A->real^N i l b.
10623         (f --> l) net /\ 1 <= i /\ i <= dimindex(:N) /\
10624         ~(trivial_limit net) /\ eventually (\x. f(x)$i = b) net
10625         ==> l$i = b`,
10626   REWRITE_TAC[GSYM REAL_LE_ANTISYM; EVENTUALLY_AND] THEN
10627   MESON_TAC[LIM_COMPONENT_UBOUND; LIM_COMPONENT_LBOUND]);;
10628
10629 let LIM_COMPONENT_LE = prove
10630  (`!net:(A)net f:A->real^N g:A->real^N k l m.
10631          ~(trivial_limit net) /\ (f --> l) net /\ (g --> m) net /\
10632         eventually (\x. (f x)$k <= (g x)$k) net /\
10633         1 <= k /\ k <= dimindex(:N)
10634         ==> l$k <= m$k`,
10635   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN
10636   REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT; LIM_COMPONENT_LBOUND] THEN
10637   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
10638   ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> b /\ a ==> c ==> d`] THEN
10639   DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN POP_ASSUM MP_TAC THEN
10640   REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; LIM_COMPONENT_LBOUND]);;
10641
10642 let LIM_DROP_LE = prove
10643  (`!net:(A)net f g l m.
10644          ~(trivial_limit net) /\ (f --> l) net /\ (g --> m) net /\
10645         eventually (\x. drop(f x) <= drop(g x)) net
10646         ==> drop l <= drop m`,
10647   REWRITE_TAC[drop] THEN REPEAT STRIP_TAC THEN
10648   MATCH_MP_TAC(ISPEC `net:(A)net` LIM_COMPONENT_LE) THEN
10649   MAP_EVERY EXISTS_TAC [`f:A->real^1`; `g:A->real^1`] THEN
10650   ASM_REWRITE_TAC[DIMINDEX_1; LE_REFL]);;
10651
10652 let LIM_DROP_UBOUND = prove
10653  (`!net f:A->real^1 l b.
10654         (f --> l) net /\
10655         ~(trivial_limit net) /\ eventually (\x. drop(f x) <= b) net
10656         ==> drop l <= b`,
10657   SIMP_TAC[drop] THEN REPEAT STRIP_TAC THEN
10658   MATCH_MP_TAC LIM_COMPONENT_UBOUND THEN
10659   REWRITE_TAC[LE_REFL; DIMINDEX_1] THEN ASM_MESON_TAC[]);;
10660
10661 let LIM_DROP_LBOUND = prove
10662  (`!net f:A->real^1 l b.
10663         (f --> l) net /\
10664         ~(trivial_limit net) /\ eventually (\x. b <= drop(f x)) net
10665         ==> b <= drop l`,
10666   SIMP_TAC[drop] THEN REPEAT STRIP_TAC THEN
10667   MATCH_MP_TAC LIM_COMPONENT_LBOUND THEN
10668   REWRITE_TAC[LE_REFL; DIMINDEX_1] THEN ASM_MESON_TAC[]);;
10669
10670 (* ------------------------------------------------------------------------- *)
10671 (* Also extending closed bounds to closures.                                 *)
10672 (* ------------------------------------------------------------------------- *)
10673
10674 let IMAGE_CLOSURE_SUBSET = prove
10675  (`!f (s:real^N->bool) (t:real^M->bool).
10676       f continuous_on closure s /\ closed t /\ IMAGE f s SUBSET t
10677       ==> IMAGE f (closure s) SUBSET t`,
10678   REPEAT STRIP_TAC THEN
10679   SUBGOAL_THEN `closure s SUBSET {x | (f:real^N->real^M) x IN t}` MP_TAC
10680   THENL [MATCH_MP_TAC SUBSET_TRANS; SET_TAC []]  THEN
10681   EXISTS_TAC `{x | x IN closure s /\ (f:real^N->real^M) x IN t}` THEN
10682   CONJ_TAC THENL
10683   [MATCH_MP_TAC CLOSURE_MINIMAL; SET_TAC[]] THEN
10684   ASM_SIMP_TAC[CONTINUOUS_CLOSED_PREIMAGE; CLOSED_CLOSURE] THEN
10685   MP_TAC (ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]);;
10686
10687 let CLOSURE_IMAGE_CLOSURE = prove
10688  (`!f:real^M->real^N s.
10689         f continuous_on closure s
10690         ==> closure(IMAGE f (closure s)) = closure(IMAGE f s)`,
10691   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
10692   SIMP_TAC[SUBSET_CLOSURE; IMAGE_SUBSET; CLOSURE_SUBSET] THEN
10693   SIMP_TAC[CLOSURE_MINIMAL_EQ; CLOSED_CLOSURE] THEN
10694   MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN
10695   ASM_REWRITE_TAC[CLOSED_CLOSURE; CLOSURE_SUBSET]);;
10696
10697 let CLOSURE_IMAGE_BOUNDED = prove
10698  (`!f:real^M->real^N s.
10699         f continuous_on closure s /\ bounded s
10700         ==> closure(IMAGE f s) = IMAGE f (closure s)`,
10701   REPEAT STRIP_TAC THEN
10702   TRANS_TAC EQ_TRANS `closure(IMAGE (f:real^M->real^N) (closure s))` THEN
10703   CONJ_TAC THENL [ASM_MESON_TAC[CLOSURE_IMAGE_CLOSURE]; ALL_TAC] THEN
10704   MATCH_MP_TAC CLOSURE_CLOSED THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
10705   MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
10706   ASM_REWRITE_TAC[COMPACT_CLOSURE]);;
10707
10708 let CONTINUOUS_ON_CLOSURE_NORM_LE = prove
10709  (`!f:real^N->real^M s x b.
10710       f continuous_on (closure s) /\
10711       (!y. y IN s ==> norm(f y) <= b) /\
10712       x IN (closure s)
10713       ==> norm(f x) <= b`,
10714   REWRITE_TAC [GSYM IN_CBALL_0] THEN REPEAT STRIP_TAC THEN
10715   SUBGOAL_THEN `IMAGE (f:real^N->real^M) (closure s) SUBSET cball(vec 0,b)`
10716     MP_TAC THENL
10717   [MATCH_MP_TAC IMAGE_CLOSURE_SUBSET; ASM SET_TAC []] THEN
10718   ASM_REWRITE_TAC [CLOSED_CBALL] THEN ASM SET_TAC []);;
10719
10720 let CONTINUOUS_ON_CLOSURE_COMPONENT_LE = prove
10721  (`!f:real^N->real^M s x b k.
10722       f continuous_on (closure s) /\
10723       (!y. y IN s ==> (f y)$k <= b) /\
10724       x IN (closure s)
10725       ==> (f x)$k <= b`,
10726   REWRITE_TAC [GSYM IN_CBALL_0] THEN REPEAT STRIP_TAC THEN
10727   SUBGOAL_THEN `IMAGE (f:real^N->real^M) (closure s) SUBSET {x | x$k <= b}`
10728   MP_TAC THENL
10729    [MATCH_MP_TAC IMAGE_CLOSURE_SUBSET; ASM SET_TAC []] THEN
10730   ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE] THEN ASM SET_TAC[]);;
10731
10732 let CONTINUOUS_ON_CLOSURE_COMPONENT_GE = prove
10733  (`!f:real^N->real^M s x b k.
10734       f continuous_on (closure s) /\
10735       (!y. y IN s ==> b <= (f y)$k) /\
10736       x IN (closure s)
10737       ==> b <= (f x)$k`,
10738   REWRITE_TAC [GSYM IN_CBALL_0] THEN REPEAT STRIP_TAC THEN
10739   SUBGOAL_THEN `IMAGE (f:real^N->real^M) (closure s) SUBSET {x | x$k >= b}`
10740   MP_TAC THENL
10741    [MATCH_MP_TAC IMAGE_CLOSURE_SUBSET; ASM SET_TAC [real_ge]] THEN
10742   ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_GE] THEN ASM SET_TAC[real_ge]);;
10743
10744 (* ------------------------------------------------------------------------- *)
10745 (* Limits relative to a union.                                               *)
10746 (* ------------------------------------------------------------------------- *)
10747
10748 let LIM_WITHIN_UNION = prove
10749  (`(f --> l) (at x within (s UNION t)) <=>
10750    (f --> l) (at x within s) /\ (f --> l) (at x within t)`,
10751   REWRITE_TAC[LIM_WITHIN; IN_UNION; AND_FORALL_THM] THEN
10752   AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN
10753   ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
10754   EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_THEN
10755    (CONJUNCTS_THEN2 (X_CHOOSE_TAC `d:real`) (X_CHOOSE_TAC `k:real`)) THEN
10756   EXISTS_TAC `min d k` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
10757   ASM_MESON_TAC[]);;
10758
10759 let CONTINUOUS_ON_UNION = prove
10760  (`!f s t. closed s /\ closed t /\ f continuous_on s /\ f continuous_on t
10761            ==> f continuous_on (s UNION t)`,
10762   REWRITE_TAC[CONTINUOUS_ON; CLOSED_LIMPT; IN_UNION; LIM_WITHIN_UNION] THEN
10763   MESON_TAC[LIM; TRIVIAL_LIMIT_WITHIN]);;
10764
10765 let CONTINUOUS_ON_CASES = prove
10766  (`!P f g:real^M->real^N s t.
10767         closed s /\ closed t /\ f continuous_on s /\ g continuous_on t /\
10768         (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x)
10769         ==> (\x. if P x then f x else g x) continuous_on (s UNION t)`,
10770   REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION THEN
10771   ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL
10772    [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^M->real^N`] THEN
10773   ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);;
10774
10775 let CONTINUOUS_ON_UNION_LOCAL = prove
10776  (`!f:real^M->real^N s.
10777         closed_in (subtopology euclidean (s UNION t)) s /\
10778         closed_in (subtopology euclidean (s UNION t)) t /\
10779         f continuous_on s /\ f continuous_on t
10780         ==> f continuous_on (s UNION t)`,
10781   REWRITE_TAC[CONTINUOUS_ON; CLOSED_IN_LIMPT; IN_UNION; LIM_WITHIN_UNION] THEN
10782   MESON_TAC[LIM; TRIVIAL_LIMIT_WITHIN]);;
10783
10784 let CONTINUOUS_ON_CASES_LOCAL = prove
10785  (`!P f g:real^M->real^N s t.
10786         closed_in (subtopology euclidean (s UNION t)) s /\
10787         closed_in (subtopology euclidean (s UNION t)) t /\
10788         f continuous_on s /\ g continuous_on t /\
10789         (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x)
10790         ==> (\x. if P x then f x else g x) continuous_on (s UNION t)`,
10791   REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL THEN
10792   ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL
10793    [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^M->real^N`] THEN
10794   ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);;
10795
10796 let CONTINUOUS_ON_CASES_LE = prove
10797  (`!f g:real^M->real^N h s a.
10798         f continuous_on {t | t IN s /\ h t <= a} /\
10799         g continuous_on {t | t IN s /\ a <= h t} /\
10800         (lift o h) continuous_on s /\
10801         (!t. t IN s /\ h t = a ==> f t = g t)
10802         ==> (\t. if h t <= a then f(t) else g(t)) continuous_on s`,
10803   REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC
10804    `{t | t IN s /\ (h:real^M->real) t <= a} UNION
10805     {t | t IN s /\ a <= h t}` THEN
10806   CONJ_TAC THENL
10807    [ALL_TAC; SIMP_TAC[SUBSET; IN_UNION; IN_ELIM_THM; REAL_LE_TOTAL]] THEN
10808   MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ASM_REWRITE_TAC[] THEN
10809   REWRITE_TAC[IN_ELIM_THM; GSYM CONJ_ASSOC; REAL_LE_ANTISYM] THEN
10810   REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
10811    [ALL_TAC; ASM_MESON_TAC[]] THEN
10812   CONJ_TAC THENL
10813    [SUBGOAL_THEN
10814      `{t | t IN s /\ (h:real^M->real) t <= a} =
10815       {t | t IN ({t | t IN s /\ h t <= a} UNION {t | t IN s /\ a <= h t}) /\
10816            (lift o h) t IN {x | x$1 <= a}}`
10817      (fun th -> GEN_REWRITE_TAC RAND_CONV [th])
10818     THENL
10819      [REWRITE_TAC[GSYM drop; o_THM; IN_ELIM_THM; LIFT_DROP; EXTENSION;
10820                   IN_UNION] THEN
10821       GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
10822       ASM_REAL_ARITH_TAC;
10823       MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN
10824       ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; ETA_AX] THEN
10825       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10826         CONTINUOUS_ON_SUBSET)) THEN
10827       SET_TAC[]];
10828     SUBGOAL_THEN
10829      `{t | t IN s /\ a <= (h:real^M->real) t} =
10830       {t | t IN ({t | t IN s /\ h t <= a} UNION {t | t IN s /\ a <= h t}) /\
10831            (lift o h) t IN {x | x$1 >= a}}`
10832      (fun th -> GEN_REWRITE_TAC RAND_CONV [th])
10833     THENL
10834      [REWRITE_TAC[GSYM drop; o_THM; IN_ELIM_THM; LIFT_DROP; EXTENSION;
10835                   IN_UNION] THEN
10836       GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
10837       ASM_REAL_ARITH_TAC;
10838       MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN
10839       ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_GE; ETA_AX] THEN
10840       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
10841         CONTINUOUS_ON_SUBSET)) THEN
10842       SET_TAC[]]]);;
10843
10844 let CONTINUOUS_ON_CASES_1 = prove
10845  (`!f g:real^1->real^N s a.
10846         f continuous_on {t | t IN s /\ drop t <= a} /\
10847         g continuous_on {t | t IN s /\ a <= drop t} /\
10848         (lift a IN s ==> f(lift a) = g(lift a))
10849         ==> (\t. if drop t <= a then f(t) else g(t)) continuous_on s`,
10850   REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN
10851   ASM_REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID] THEN
10852   REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN ASM_MESON_TAC[]);;
10853
10854 let EXTENSION_FROM_CLOPEN = prove
10855  (`!f:real^M->real^N s t u.
10856         open_in (subtopology euclidean s) t /\
10857         closed_in (subtopology euclidean s) t /\
10858         f continuous_on t /\ IMAGE f t SUBSET u /\ (u = {} ==> s = {})
10859         ==> ?g. g continuous_on s /\ IMAGE g s SUBSET u /\
10860                 !x. x IN t ==> g x = f x`,
10861   REPEAT GEN_TAC THEN ASM_CASES_TAC `u:real^N->bool = {}` THEN
10862   ASM_SIMP_TAC[CONTINUOUS_ON_EMPTY; IMAGE_CLAUSES; SUBSET_EMPTY;
10863                IMAGE_EQ_EMPTY; NOT_IN_EMPTY] THEN
10864   STRIP_TAC THEN
10865   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
10866   DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN
10867   EXISTS_TAC `\x. if x IN t then (f:real^M->real^N) x else a` THEN
10868   SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN
10869   CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
10870   FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
10871   SUBGOAL_THEN `s:real^M->bool = t UNION (s DIFF t)` SUBST1_TAC THENL
10872    [ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL] THEN
10873   ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> t UNION (s DIFF t) = s`] THEN
10874   REWRITE_TAC[CONTINUOUS_ON_CONST; IN_DIFF] THEN
10875   CONJ_TAC THENL [MATCH_MP_TAC CLOSED_IN_DIFF; MESON_TAC[]] THEN
10876   ASM_REWRITE_TAC[CLOSED_IN_REFL]);;
10877
10878 (* ------------------------------------------------------------------------- *)
10879 (* Componentwise limits and continuity.                                      *)
10880 (* ------------------------------------------------------------------------- *)
10881
10882 let LIM_COMPONENTWISE_LIFT = prove
10883  (`!net f:A->real^N.
10884         (f --> l) net <=>
10885         !i. 1 <= i /\ i <= dimindex(:N)
10886             ==> ((\x. lift((f x)$i)) --> lift(l$i)) net`,
10887   REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN EQ_TAC THENL
10888    [DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
10889     X_GEN_TAC `e:real` THEN
10890     DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN
10891     ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT] THEN
10892     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
10893     GEN_TAC THEN REWRITE_TAC[dist] THEN MATCH_MP_TAC(REAL_ARITH
10894      `y <= x ==> x < e ==> y < e`) THEN
10895     ASM_SIMP_TAC[COMPONENT_LE_NORM; GSYM LIFT_SUB; NORM_LIFT;
10896                  GSYM VECTOR_SUB_COMPONENT];
10897     GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_FORALL_THM] THEN
10898     ONCE_REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[IMP_CONJ_ALT] THEN
10899     ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
10900     REWRITE_TAC[GSYM IN_NUMSEG; RIGHT_FORALL_IMP_THM] THEN
10901     SIMP_TAC[FORALL_EVENTUALLY; FINITE_NUMSEG; NUMSEG_EMPTY;
10902              GSYM NOT_LE; DIMINDEX_GE_1] THEN
10903     REWRITE_TAC[DIST_LIFT; GSYM VECTOR_SUB_COMPONENT] THEN
10904     DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
10905     FIRST_X_ASSUM(MP_TAC o SPEC `e / &(dimindex(:N))`) THEN
10906     ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN
10907     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
10908     X_GEN_TAC `x:A` THEN SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; dist] THEN
10909     DISCH_TAC THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN
10910     MATCH_MP_TAC(REAL_ARITH `s < e ==> n <= s ==> n < e`) THEN
10911     MATCH_MP_TAC SUM_BOUND_LT_GEN THEN
10912     ASM_SIMP_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1;
10913                  CARD_NUMSEG_1; GSYM IN_NUMSEG]]);;
10914
10915 let CONTINUOUS_COMPONENTWISE_LIFT = prove
10916  (`!net f:A->real^N.
10917         f continuous net <=>
10918         !i. 1 <= i /\ i <= dimindex(:N)
10919             ==> (\x. lift((f x)$i)) continuous net`,
10920   REWRITE_TAC[continuous; GSYM LIM_COMPONENTWISE_LIFT]);;
10921
10922 let CONTINUOUS_ON_COMPONENTWISE_LIFT = prove
10923  (`!f:real^M->real^N s.
10924         f continuous_on s <=>
10925         !i. 1 <= i /\ i <= dimindex(:N)
10926             ==> (\x. lift((f x)$i)) continuous_on s`,
10927   REPEAT GEN_TAC THEN
10928   REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
10929   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
10930    [CONTINUOUS_COMPONENTWISE_LIFT] THEN
10931   MESON_TAC[]);;
10932
10933 (* ------------------------------------------------------------------------- *)
10934 (* Some more convenient intermediate-value theorem formulations.             *)
10935 (* ------------------------------------------------------------------------- *)
10936
10937 let CONNECTED_IVT_HYPERPLANE = prove
10938  (`!s x y:real^N a b.
10939         connected s /\
10940         x IN s /\ y IN s /\ a dot x <= b /\ b <= a dot y
10941         ==> ?z. z IN s /\ a dot z = b`,
10942   REPEAT STRIP_TAC THEN
10943   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [connected]) THEN
10944   REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL
10945    [`{x:real^N | a dot x < b}`; `{x:real^N | a dot x > b}`]) THEN
10946   REWRITE_TAC[OPEN_HALFSPACE_LT; OPEN_HALFSPACE_GT] THEN
10947   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN STRIP_TAC THEN
10948   REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; NOT_IN_EMPTY; SUBSET;
10949               IN_UNION; REAL_LT_LE; real_gt] THEN
10950   ASM_MESON_TAC[REAL_LE_TOTAL; REAL_LE_ANTISYM]);;
10951
10952 let CONNECTED_IVT_COMPONENT = prove
10953  (`!s x y:real^N a k.
10954         connected s /\ x IN s /\ y IN s /\
10955         1 <= k /\ k <= dimindex(:N) /\ x$k <= a /\ a <= y$k
10956         ==> ?z. z IN s /\ z$k = a`,
10957   REPEAT STRIP_TAC THEN MP_TAC(ISPECL
10958    [`s:real^N->bool`; `x:real^N`; `y:real^N`; `(basis k):real^N`;
10959     `a:real`] CONNECTED_IVT_HYPERPLANE) THEN
10960   ASM_SIMP_TAC[DOT_BASIS]);;
10961
10962 (* ------------------------------------------------------------------------- *)
10963 (* Rather trivial observation that we can map any connected set on segment.  *)
10964 (* ------------------------------------------------------------------------- *)
10965
10966 let MAPPING_CONNECTED_ONTO_SEGMENT = prove
10967  (`!s:real^M->bool a b:real^N.
10968         connected s /\ ~(?a. s SUBSET {a})
10969         ==> ?f. f continuous_on s /\ IMAGE f s = segment[a,b]`,
10970   REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
10971    `~(?a. s SUBSET {a}) ==> ?a b. a IN s /\ b IN s /\ ~(a = b)`)) THEN
10972   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
10973   MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN STRIP_TAC THEN EXISTS_TAC
10974    `\x:real^M. a + dist(u,x) / (dist(u,x) + dist(v,x)) % (b - a:real^N)` THEN
10975   CONJ_TAC THENL
10976    [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
10977     MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF; CONTINUOUS_ON_CONST];
10978     REWRITE_TAC[segment; VECTOR_ARITH
10979      `(&1 - u) % a + u % b:real^N = a + u % (b - a)`] THEN
10980     MATCH_MP_TAC(SET_RULE
10981      `IMAGE f s = {x | P x}
10982       ==> IMAGE (\x. a + f x % b) s = {a + u % b:real^N | P u}`) THEN
10983     REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_IMAGE] THEN
10984     ASM_SIMP_TAC[IN_ELIM_THM; REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ;
10985       NORM_ARITH `~(u:real^N = v) ==> &0 < dist(u,x) + dist(v,x)`] THEN
10986     CONJ_TAC THENL [CONV_TAC NORM_ARITH; REWRITE_TAC[IN_IMAGE]] THEN
10987     X_GEN_TAC `t:real` THEN STRIP_TAC THEN
10988     MP_TAC(ISPECL
10989      [`IMAGE (\x:real^M. lift(dist(u,x) / (dist(u,x) + dist(v,x)))) s`;
10990       `vec 0:real^1`; `vec 1:real^1`; `t:real`; `1`]
10991         CONNECTED_IVT_COMPONENT) THEN
10992     ASM_SIMP_TAC[VEC_COMPONENT; DIMINDEX_1; ARITH_LE] THEN
10993     REWRITE_TAC[EXISTS_IN_IMAGE; GSYM drop; LIFT_DROP] THEN
10994     ANTS_TAC THENL [REWRITE_TAC[IN_IMAGE]; MESON_TAC[]] THEN
10995     REPEAT CONJ_TAC THENL
10996      [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[];
10997       EXISTS_TAC `u:real^M` THEN ASM_REWRITE_TAC[DIST_REFL; real_div] THEN
10998       REWRITE_TAC[GSYM LIFT_NUM; LIFT_EQ] THEN REAL_ARITH_TAC;
10999       EXISTS_TAC `v:real^M` THEN ASM_REWRITE_TAC[DIST_REFL] THEN
11000       ASM_SIMP_TAC[REAL_DIV_REFL; DIST_EQ_0; REAL_ADD_RID] THEN
11001       REWRITE_TAC[GSYM LIFT_NUM; LIFT_EQ]]] THEN
11002   REWRITE_TAC[real_div; LIFT_CMUL] THEN
11003   MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
11004   REWRITE_TAC[CONTINUOUS_ON_LIFT_DIST] THEN
11005   MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
11006   ASM_SIMP_TAC[LIFT_ADD; NORM_ARITH
11007    `~(u:real^N = v) ==> ~(dist(u,x) + dist(v,x) = &0)`] THEN
11008   MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
11009   REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_DIST]);;
11010
11011 (* ------------------------------------------------------------------------- *)
11012 (* Also more convenient formulations of monotone convergence.                *)
11013 (* ------------------------------------------------------------------------- *)
11014
11015 let BOUNDED_INCREASING_CONVERGENT = prove
11016  (`!s:num->real^1.
11017         bounded {s n | n IN (:num)} /\ (!n. drop(s n) <= drop(s(SUC n)))
11018         ==> ?l. (s --> l) sequentially`,
11019   GEN_TAC THEN
11020   REWRITE_TAC[bounded; IN_ELIM_THM; ABS_DROP; LIM_SEQUENTIALLY; dist;
11021               DROP_SUB; IN_UNIV; GSYM EXISTS_DROP] THEN
11022   DISCH_TAC THEN MATCH_MP_TAC CONVERGENT_BOUNDED_MONOTONE THEN
11023   REWRITE_TAC[LEFT_EXISTS_AND_THM] THEN
11024   CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
11025   DISJ1_TAC THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
11026   ASM_REWRITE_TAC[REAL_LE_TRANS; REAL_LE_REFL]);;
11027
11028 let BOUNDED_DECREASING_CONVERGENT = prove
11029  (`!s:num->real^1.
11030         bounded {s n | n IN (:num)} /\ (!n. drop(s(SUC n)) <= drop(s(n)))
11031         ==> ?l. (s --> l) sequentially`,
11032   GEN_TAC THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN
11033   DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
11034   MP_TAC(ISPEC `\n. --((s:num->real^1) n)` BOUNDED_INCREASING_CONVERGENT) THEN
11035   ASM_SIMP_TAC[bounded; FORALL_IN_GSPEC; NORM_NEG; DROP_NEG; REAL_LE_NEG2] THEN
11036   GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [GSYM LIM_NEG_EQ] THEN
11037   REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX] THEN MESON_TAC[]);;
11038
11039 (* ------------------------------------------------------------------------- *)
11040 (* Since we'll use some cardinality reasoning, add invariance theorems.      *)
11041 (* ------------------------------------------------------------------------- *)
11042
11043 let card_translation_invariants = (CONJUNCTS o prove)
11044  (`(!a (s:real^N->bool) (t:A->bool).
11045      IMAGE (\x. a + x) s =_c t <=> s =_c t) /\
11046    (!a (s:A->bool) (t:real^N->bool).
11047      s =_c IMAGE (\x. a + x) t <=> s =_c t) /\
11048    (!a (s:real^N->bool) (t:A->bool).
11049      IMAGE (\x. a + x) s <_c t <=> s <_c t) /\
11050    (!a (s:A->bool) (t:real^N->bool).
11051      s <_c IMAGE (\x. a + x) t <=> s <_c t) /\
11052    (!a (s:real^N->bool) (t:A->bool).
11053      IMAGE (\x. a + x) s <=_c t <=> s <=_c t) /\
11054    (!a (s:A->bool) (t:real^N->bool).
11055      s <=_c IMAGE (\x. a + x) t <=> s <=_c t) /\
11056    (!a (s:real^N->bool) (t:A->bool).
11057      IMAGE (\x. a + x) s >_c t <=> s >_c t) /\
11058    (!a (s:A->bool) (t:real^N->bool).
11059      s >_c IMAGE (\x. a + x) t <=> s >_c t) /\
11060    (!a (s:real^N->bool) (t:A->bool).
11061      IMAGE (\x. a + x) s >=_c t <=> s >=_c t) /\
11062    (!a (s:A->bool) (t:real^N->bool).
11063      s >=_c IMAGE (\x. a + x) t <=> s >=_c t)`,
11064   REWRITE_TAC[gt_c; ge_c] THEN REPEAT STRIP_TAC THENL
11065    [MATCH_MP_TAC CARD_EQ_CONG;
11066     MATCH_MP_TAC CARD_EQ_CONG;
11067     MATCH_MP_TAC CARD_LT_CONG;
11068     MATCH_MP_TAC CARD_LT_CONG;
11069     MATCH_MP_TAC CARD_LE_CONG;
11070     MATCH_MP_TAC CARD_LE_CONG;
11071     MATCH_MP_TAC CARD_LT_CONG;
11072     MATCH_MP_TAC CARD_LT_CONG;
11073     MATCH_MP_TAC CARD_LE_CONG;
11074     MATCH_MP_TAC CARD_LE_CONG] THEN
11075   REWRITE_TAC[CARD_EQ_REFL] THEN MATCH_MP_TAC CARD_EQ_IMAGE THEN
11076   SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]) in
11077 add_translation_invariants card_translation_invariants;;
11078
11079 let card_linear_invariants = (CONJUNCTS o prove)
11080  (`(!(f:real^M->real^N) s (t:A->bool).
11081      linear f /\ (!x y. f x = f y ==> x = y)
11082      ==> (IMAGE f s =_c t <=> s =_c t)) /\
11083    (!(f:real^M->real^N) (s:A->bool) t.
11084      linear f /\ (!x y. f x = f y ==> x = y)
11085      ==> (s =_c IMAGE f t <=> s =_c t)) /\
11086    (!(f:real^M->real^N) s (t:A->bool).
11087      linear f /\ (!x y. f x = f y ==> x = y)
11088      ==> (IMAGE f s <_c t <=> s <_c t)) /\
11089    (!(f:real^M->real^N) (s:A->bool) t.
11090      linear f /\ (!x y. f x = f y ==> x = y)
11091      ==> (s <_c IMAGE f t <=> s <_c t)) /\
11092    (!(f:real^M->real^N) s (t:A->bool).
11093      linear f /\ (!x y. f x = f y ==> x = y)
11094      ==> (IMAGE f s <=_c t <=> s <=_c t)) /\
11095    (!(f:real^M->real^N) (s:A->bool) t.
11096      linear f /\ (!x y. f x = f y ==> x = y)
11097      ==> (s <=_c IMAGE f t <=> s <=_c t)) /\
11098    (!(f:real^M->real^N) s (t:A->bool).
11099      linear f /\ (!x y. f x = f y ==> x = y)
11100      ==> (IMAGE f s >_c t <=> s >_c t)) /\
11101    (!(f:real^M->real^N) (s:A->bool) t.
11102      linear f /\ (!x y. f x = f y ==> x = y)
11103      ==> (s >_c IMAGE f t <=> s >_c t)) /\
11104    (!(f:real^M->real^N) s (t:A->bool).
11105      linear f /\ (!x y. f x = f y ==> x = y)
11106      ==> (IMAGE f s >=_c t <=> s >=_c t)) /\
11107    (!(f:real^M->real^N) (s:A->bool) t.
11108      linear f /\ (!x y. f x = f y ==> x = y)
11109      ==> (s >=_c IMAGE f t <=> s >=_c t))`,
11110   REWRITE_TAC[gt_c; ge_c] THEN REPEAT STRIP_TAC THENL
11111    [MATCH_MP_TAC CARD_EQ_CONG;
11112     MATCH_MP_TAC CARD_EQ_CONG;
11113     MATCH_MP_TAC CARD_LT_CONG;
11114     MATCH_MP_TAC CARD_LT_CONG;
11115     MATCH_MP_TAC CARD_LE_CONG;
11116     MATCH_MP_TAC CARD_LE_CONG;
11117     MATCH_MP_TAC CARD_LT_CONG;
11118     MATCH_MP_TAC CARD_LT_CONG;
11119     MATCH_MP_TAC CARD_LE_CONG;
11120     MATCH_MP_TAC CARD_LE_CONG] THEN
11121   REWRITE_TAC[CARD_EQ_REFL] THEN MATCH_MP_TAC CARD_EQ_IMAGE THEN
11122   ASM_MESON_TAC[]) in
11123 add_linear_invariants card_linear_invariants;;
11124
11125 (* ------------------------------------------------------------------------- *)
11126 (* Basic homeomorphism definitions.                                          *)
11127 (* ------------------------------------------------------------------------- *)
11128
11129 let homeomorphism = new_definition
11130   `homeomorphism (s,t) (f,g) <=>
11131      (!x. x IN s ==> (g(f(x)) = x)) /\ (IMAGE f s = t) /\ f continuous_on s /\
11132      (!y. y IN t ==> (f(g(y)) = y)) /\ (IMAGE g t = s) /\ g continuous_on t`;;
11133
11134 parse_as_infix("homeomorphic",(12,"right"));;
11135
11136 let homeomorphic = new_definition
11137   `s homeomorphic t <=> ?f g. homeomorphism (s,t) (f,g)`;;
11138
11139 let HOMEOMORPHISM = prove
11140  (`!s:real^M->bool t:real^N->bool f g.
11141         homeomorphism (s,t) (f,g) <=>
11142          f continuous_on s /\ IMAGE f s SUBSET t /\
11143          g continuous_on t /\ IMAGE g t SUBSET s /\
11144          (!x. x IN s ==> g (f x) = x) /\
11145          (!y. y IN t ==> f (g y) = y)`,
11146   REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphism] THEN
11147   EQ_TAC THEN SIMP_TAC[] THEN SET_TAC[]);;
11148
11149 let HOMEOMORPHISM_OF_SUBSETS = prove
11150  (`!f g s t s' t'.
11151     homeomorphism (s,t) (f,g) /\ s' SUBSET s /\ t' SUBSET t /\ IMAGE f s' = t'
11152     ==> homeomorphism (s',t') (f,g)`,
11153   REWRITE_TAC[homeomorphism] THEN
11154   REPEAT STRIP_TAC THEN
11155   TRY(MATCH_MP_TAC CONTINUOUS_ON_SUBSET) THEN ASM SET_TAC[]);;
11156
11157 let HOMEOMORPHISM_ID = prove
11158  (`!s:real^N->bool. homeomorphism (s,s) ((\x. x),(\x. x))`,
11159   REWRITE_TAC[homeomorphism; IMAGE_ID; CONTINUOUS_ON_ID]);;
11160
11161 let HOMEOMORPHISM_I = prove
11162  (`!s:real^N->bool. homeomorphism (s,s) (I,I)`,
11163   REWRITE_TAC[I_DEF; HOMEOMORPHISM_ID]);;
11164
11165 let HOMEOMORPHIC_REFL = prove
11166  (`!s:real^N->bool. s homeomorphic s`,
11167   REWRITE_TAC[homeomorphic] THEN MESON_TAC[HOMEOMORPHISM_I]);;
11168
11169 let HOMEOMORPHISM_SYM = prove
11170  (`!f:real^M->real^N g s t.
11171         homeomorphism (s,t) (f,g) <=> homeomorphism (t,s) (g,f)`,
11172   REWRITE_TAC[homeomorphism] THEN MESON_TAC[]);;
11173
11174 let HOMEOMORPHIC_SYM = prove
11175  (`!s t. s homeomorphic t <=> t homeomorphic s`,
11176   REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; homeomorphism] THEN
11177   GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN
11178   REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN CONV_TAC TAUT);;
11179
11180 let HOMEOMORPHISM_COMPOSE = prove
11181  (`!f:real^M->real^N g h:real^N->real^P k s t u.
11182         homeomorphism (s,t) (f,g) /\ homeomorphism (t,u) (h,k)
11183         ==> homeomorphism (s,u) (h o f,g o k)`,
11184   SIMP_TAC[homeomorphism; CONTINUOUS_ON_COMPOSE; IMAGE_o; o_THM] THEN
11185   SET_TAC[]);;
11186
11187 let HOMEOMORPHIC_TRANS = prove
11188  (`!s:real^M->bool t:real^N->bool u:real^P->bool.
11189         s homeomorphic t /\ t homeomorphic u ==> s homeomorphic u`,
11190   REWRITE_TAC[homeomorphic] THEN MESON_TAC[HOMEOMORPHISM_COMPOSE]);;
11191
11192 let HOMEOMORPHIC_IMP_CARD_EQ = prove
11193  (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> s =_c t`,
11194   REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; homeomorphism; eq_c] THEN
11195   MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]);;
11196
11197 let HOMEOMORPHIC_EMPTY = prove
11198  (`(!s. (s:real^N->bool) homeomorphic ({}:real^M->bool) <=> s = {}) /\
11199    (!s. ({}:real^M->bool) homeomorphic (s:real^N->bool) <=> s = {})`,
11200   REWRITE_TAC[homeomorphic; homeomorphism; IMAGE_CLAUSES; IMAGE_EQ_EMPTY] THEN
11201   REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
11202   ASM_REWRITE_TAC[continuous_on; NOT_IN_EMPTY]);;
11203
11204 let HOMEOMORPHIC_MINIMAL = prove
11205  (`!s t. s homeomorphic t <=>
11206             ?f g. (!x. x IN s ==> f(x) IN t /\ (g(f(x)) = x)) /\
11207                   (!y. y IN t ==> g(y) IN s /\ (f(g(y)) = y)) /\
11208                   f continuous_on s /\ g continuous_on t`,
11209   REWRITE_TAC[homeomorphic; homeomorphism; EXTENSION; IN_IMAGE] THEN
11210   REPEAT GEN_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN MESON_TAC[]);;
11211
11212 let HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF = prove
11213  (`!f:real^M->real^N s.
11214         linear f /\ (!x y. f x = f y ==> x = y)
11215         ==> (IMAGE f s) homeomorphic s`,
11216   REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
11217   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_LEFT_INVERSE]) THEN
11218   MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN
11219   EXISTS_TAC `f:real^M->real^N` THEN
11220   ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; FORALL_IN_IMAGE; FUN_IN_IMAGE] THEN
11221   ASM_SIMP_TAC[continuous_on; IMP_CONJ; FORALL_IN_IMAGE] THEN
11222   X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
11223   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
11224   MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_BOUNDED_BELOW_POS) THEN
11225   ASM_REWRITE_TAC[] THEN
11226   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
11227   EXISTS_TAC `e * B:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN
11228   X_GEN_TAC `y:real^M` THEN ASM_SIMP_TAC[dist; GSYM LINEAR_SUB] THEN
11229   DISCH_TAC THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ] THEN
11230   MATCH_MP_TAC(REAL_ARITH `a <= b ==> b < x ==> a < x`) THEN
11231   ASM_SIMP_TAC[REAL_LE_RDIV_EQ]);;
11232
11233 let HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ = prove
11234  (`!f:real^M->real^N s t.
11235         linear f /\ (!x y. f x = f y ==> x = y)
11236         ==> ((IMAGE f s) homeomorphic t <=> s homeomorphic t)`,
11237   REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o SPEC `s:real^M->bool` o
11238     MATCH_MP HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF) THEN
11239   EQ_TAC THENL
11240    [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_SYM]);
11241     POP_ASSUM MP_TAC] THEN
11242   REWRITE_TAC[IMP_IMP; HOMEOMORPHIC_TRANS]);;
11243
11244 let HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ = prove
11245  (`!f:real^M->real^N s t.
11246         linear f /\ (!x y. f x = f y ==> x = y)
11247         ==> (s homeomorphic (IMAGE f t) <=> s homeomorphic t)`,
11248   ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
11249   REWRITE_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ]);;
11250
11251 add_linear_invariants
11252   [HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ;
11253    HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ];;
11254
11255 let HOMEOMORPHIC_TRANSLATION_SELF = prove
11256  (`!a:real^N s. (IMAGE (\x. a + x) s) homeomorphic s`,
11257   REPEAT GEN_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
11258   EXISTS_TAC `\x:real^N. x - a` THEN
11259   EXISTS_TAC `\x:real^N. a + x` THEN
11260   SIMP_TAC[FORALL_IN_IMAGE; CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID;
11261            CONTINUOUS_ON_CONST; CONTINUOUS_ON_ADD; VECTOR_ADD_SUB] THEN
11262   REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[]);;
11263
11264 let HOMEOMORPHIC_TRANSLATION_LEFT_EQ = prove
11265  (`!a:real^N s t.
11266       (IMAGE (\x. a + x) s) homeomorphic t <=> s homeomorphic t`,
11267   MESON_TAC[HOMEOMORPHIC_TRANSLATION_SELF;
11268             HOMEOMORPHIC_SYM; HOMEOMORPHIC_TRANS]);;
11269
11270 let HOMEOMORPHIC_TRANSLATION_RIGHT_EQ = prove
11271  (`!a:real^N s t.
11272       s homeomorphic (IMAGE (\x. a + x) t) <=> s homeomorphic t`,
11273   ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
11274   REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_LEFT_EQ]);;
11275
11276 add_translation_invariants
11277   [HOMEOMORPHIC_TRANSLATION_LEFT_EQ;
11278    HOMEOMORPHIC_TRANSLATION_RIGHT_EQ];;
11279
11280 let HOMEOMORPHISM_IMP_QUOTIENT_MAP = prove
11281  (`!f:real^M->real^N g s t.
11282     homeomorphism (s,t) (f,g)
11283     ==> !u. u SUBSET t
11284             ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=>
11285                  open_in (subtopology euclidean t) u)`,
11286   REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphism] THEN
11287   STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN
11288   EXISTS_TAC `g:real^N->real^M` THEN ASM_REWRITE_TAC[SUBSET_REFL]);;
11289
11290 let HOMEOMORPHIC_PCROSS = prove
11291  (`!s:real^M->bool t:real^N->bool s':real^P->bool t':real^Q->bool.
11292         s homeomorphic s' /\ t homeomorphic t'
11293         ==> (s PCROSS t) homeomorphic (s' PCROSS t')`,
11294   REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN
11295   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
11296   DISCH_THEN(CONJUNCTS_THEN2
11297    (X_CHOOSE_THEN `f:real^M->real^P`
11298      (X_CHOOSE_THEN `f':real^P->real^M` STRIP_ASSUME_TAC))
11299    (X_CHOOSE_THEN `g:real^N->real^Q`
11300      (X_CHOOSE_THEN `g':real^Q->real^N` STRIP_ASSUME_TAC))) THEN
11301   MAP_EVERY EXISTS_TAC
11302    [`(\z. pastecart (f(fstcart z)) (g(sndcart z)))
11303      :real^(M,N)finite_sum->real^(P,Q)finite_sum`;
11304     `(\z. pastecart (f'(fstcart z)) (g'(sndcart z)))
11305      :real^(P,Q)finite_sum->real^(M,N)finite_sum`] THEN
11306   ASM_SIMP_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART;
11307                SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN
11308   CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
11309   CONJ_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN
11310   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11311   SIMP_TAC[LINEAR_FSTCART; LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN
11312   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11313           CONTINUOUS_ON_SUBSET)) THEN
11314   REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS; SUBSET] THEN
11315   SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART]);;
11316
11317 let HOMEOMORPHIC_PCROSS_SYM = prove
11318  (`!s:real^M->bool t:real^N->bool. (s PCROSS t) homeomorphic (t PCROSS s)`,
11319   REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; homeomorphism] THEN
11320   EXISTS_TAC `(\z. pastecart (sndcart z) (fstcart z))
11321               :real^(M,N)finite_sum->real^(N,M)finite_sum` THEN
11322   EXISTS_TAC `(\z. pastecart (sndcart z) (fstcart z))
11323               :real^(N,M)finite_sum->real^(M,N)finite_sum` THEN
11324   REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_IMAGE] THEN
11325   SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON;
11326            LINEAR_FSTCART; LINEAR_SNDCART] THEN
11327   REWRITE_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART;
11328     IN_IMAGE; EXISTS_PASTECART; PASTECART_INJ; PASTECART_IN_PCROSS] THEN
11329   MESON_TAC[]);;
11330
11331 let HOMEOMORPHIC_PCROSS_ASSOC = prove
11332  (`!s:real^M->bool t:real^N->bool u:real^P->bool.
11333         (s PCROSS (t PCROSS u)) homeomorphic ((s PCROSS t) PCROSS u)`,
11334   REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN
11335   MAP_EVERY EXISTS_TAC
11336    [`\z:real^(M,(N,P)finite_sum)finite_sum.
11337         pastecart (pastecart (fstcart z) (fstcart(sndcart z)))
11338                   (sndcart(sndcart z))`;
11339     `\z:real^((M,N)finite_sum,P)finite_sum.
11340         pastecart (fstcart(fstcart z))
11341                   (pastecart (sndcart(fstcart z)) (sndcart z))`] THEN
11342   REWRITE_TAC[FORALL_IN_PCROSS; SUBSET; FORALL_IN_IMAGE;
11343               RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN
11344   SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS] THEN
11345   CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN
11346   REPEAT(MATCH_MP_TAC LINEAR_PASTECART THEN CONJ_TAC) THEN
11347   TRY(GEN_REWRITE_TAC RAND_CONV [GSYM o_DEF] THEN
11348       MATCH_MP_TAC LINEAR_COMPOSE) THEN
11349   REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);;
11350
11351 let HOMEOMORPHIC_SCALING_LEFT = prove
11352  (`!c. &0 < c
11353        ==> !s t. (IMAGE (\x. c % x) s) homeomorphic t <=> s homeomorphic t`,
11354   REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN
11355   MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ THEN
11356   ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ; LINEAR_SCALING]);;
11357
11358 let HOMEOMORPHIC_SCALING_RIGHT = prove
11359  (`!c. &0 < c
11360        ==> !s t. s homeomorphic (IMAGE (\x. c % x) t) <=> s homeomorphic t`,
11361   REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN
11362   MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ THEN
11363   ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ; LINEAR_SCALING]);;
11364
11365 let HOMEOMORPHIC_SUBSPACES = prove
11366  (`!s:real^M->bool t:real^N->bool.
11367         subspace s /\ subspace t /\ dim s = dim t ==> s homeomorphic t`,
11368   REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN
11369   DISCH_THEN(MP_TAC o MATCH_MP ISOMETRIES_SUBSPACES) THEN
11370   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN
11371   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN
11372   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTER; IN_CBALL_0] THEN
11373   SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]);;
11374
11375 let HOMEOMORPHIC_FINITE = prove
11376  (`!s:real^M->bool t:real^N->bool.
11377         FINITE s /\ FINITE t ==> (s homeomorphic t <=> CARD s = CARD t)`,
11378   REPEAT STRIP_TAC THEN EQ_TAC THENL
11379    [DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_CARD_EQ) THEN
11380     ASM_SIMP_TAC[CARD_EQ_CARD];
11381     STRIP_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN
11382     MP_TAC(ISPECL [`s:real^M->bool`; `t:real^N->bool`]
11383         CARD_EQ_BIJECTIONS) THEN
11384     ASM_REWRITE_TAC[] THEN
11385     REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
11386     ASM_SIMP_TAC[CONTINUOUS_ON_FINITE] THEN ASM SET_TAC[]]);;
11387
11388 let HOMEOMORPHIC_FINITE_STRONG = prove
11389  (`!s:real^M->bool t:real^N->bool.
11390         FINITE s \/ FINITE t
11391         ==> (s homeomorphic t <=> FINITE s /\ FINITE t /\ CARD s = CARD t)`,
11392   REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN
11393   SIMP_TAC[HOMEOMORPHIC_FINITE] THEN DISCH_TAC THEN
11394   FIRST_ASSUM(MP_TAC o MATCH_MP CARD_FINITE_CONG o MATCH_MP
11395     HOMEOMORPHIC_IMP_CARD_EQ) THEN
11396   FIRST_X_ASSUM DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
11397   ASM_MESON_TAC[HOMEOMORPHIC_FINITE]);;
11398
11399 let HOMEOMORPHIC_SING = prove
11400  (`!a:real^M b:real^N. {a} homeomorphic {b}`,
11401   SIMP_TAC[HOMEOMORPHIC_FINITE; FINITE_SING; CARD_SING]);;
11402
11403 let HOMEOMORPHIC_PCROSS_SING = prove
11404  (`(!s:real^M->bool a:real^N. s homeomorphic (s PCROSS {a})) /\
11405    (!s:real^M->bool a:real^N. s homeomorphic ({a} PCROSS s))`,
11406   MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN CONJ_TAC THENL
11407    [MESON_TAC[HOMEOMORPHIC_PCROSS_SYM; HOMEOMORPHIC_TRANS]; ALL_TAC] THEN
11408   REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN
11409   EXISTS_TAC `\x. (pastecart x a:real^(M,N)finite_sum)` THEN
11410   EXISTS_TAC `fstcart:real^(M,N)finite_sum->real^M` THEN
11411   SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
11412   SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_ON; SUBSET; FORALL_IN_IMAGE] THEN
11413   REWRITE_TAC[FORALL_IN_PCROSS; PASTECART_IN_PCROSS; IN_SING] THEN
11414   SIMP_TAC[FSTCART_PASTECART]);;
11415
11416 (* ------------------------------------------------------------------------- *)
11417 (* Inverse function property for open/closed maps.                           *)
11418 (* ------------------------------------------------------------------------- *)
11419
11420 let CONTINUOUS_ON_INVERSE_OPEN_MAP = prove
11421  (`!f:real^M->real^N g s t.
11422         f continuous_on s /\ IMAGE f s = t /\ (!x. x IN s ==> g(f x) = x) /\
11423         (!u. open_in (subtopology euclidean s) u
11424              ==> open_in (subtopology euclidean t) (IMAGE f u))
11425         ==> g continuous_on t`,
11426   REPEAT STRIP_TAC THEN
11427   MP_TAC(ISPECL [`g:real^N->real^M`; `t:real^N->bool`; `s:real^M->bool`]
11428         CONTINUOUS_ON_OPEN_GEN) THEN
11429   ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN
11430   X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN
11431   FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN
11432   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
11433   FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
11434   ASM SET_TAC[]);;
11435
11436 let CONTINUOUS_ON_INVERSE_CLOSED_MAP = prove
11437  (`!f:real^M->real^N g s t.
11438         f continuous_on s /\ IMAGE f s = t /\ (!x. x IN s ==> g(f x) = x) /\
11439         (!u. closed_in (subtopology euclidean s) u
11440              ==> closed_in (subtopology euclidean t) (IMAGE f u))
11441         ==> g continuous_on t`,
11442   REPEAT STRIP_TAC THEN
11443   MP_TAC(ISPECL [`g:real^N->real^M`; `t:real^N->bool`; `s:real^M->bool`]
11444         CONTINUOUS_ON_CLOSED_GEN) THEN
11445   ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN
11446   X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN
11447   FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN
11448   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
11449   FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [closed_in]) THEN
11450   REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM SET_TAC[]);;
11451
11452 let HOMEOMORPHISM_INJECTIVE_OPEN_MAP = prove
11453  (`!f:real^M->real^N s t.
11454         f continuous_on s /\ IMAGE f s = t /\
11455         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
11456         (!u. open_in (subtopology euclidean s) u
11457              ==> open_in (subtopology euclidean t) (IMAGE f u))
11458         ==> ?g. homeomorphism (s,t) (f,g)`,
11459   REPEAT STRIP_TAC THEN
11460   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN
11461   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN
11462   DISCH_TAC THEN ASM_SIMP_TAC[homeomorphism] THEN
11463   REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
11464   MATCH_MP_TAC CONTINUOUS_ON_INVERSE_OPEN_MAP THEN ASM_MESON_TAC[]);;
11465
11466 let HOMEOMORPHISM_INJECTIVE_CLOSED_MAP = prove
11467  (`!f:real^M->real^N s t.
11468         f continuous_on s /\ IMAGE f s = t /\
11469         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
11470         (!u. closed_in (subtopology euclidean s) u
11471              ==> closed_in (subtopology euclidean t) (IMAGE f u))
11472         ==> ?g. homeomorphism (s,t) (f,g)`,
11473   REPEAT STRIP_TAC THEN
11474   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN
11475   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN
11476   DISCH_TAC THEN ASM_SIMP_TAC[homeomorphism] THEN
11477   REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
11478   MATCH_MP_TAC CONTINUOUS_ON_INVERSE_CLOSED_MAP THEN ASM_MESON_TAC[]);;
11479
11480 let HOMEOMORPHISM_IMP_OPEN_MAP = prove
11481  (`!f:real^M->real^N g s t u.
11482         homeomorphism (s,t) (f,g) /\ open_in (subtopology euclidean s) u
11483         ==> open_in (subtopology euclidean t) (IMAGE f u)`,
11484   REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN
11485   SUBGOAL_THEN `IMAGE (f:real^M->real^N) u =
11486                  {y | y IN t /\ g(y) IN u}`
11487   SUBST1_TAC THENL
11488    [FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN
11489     ASM SET_TAC[];
11490     MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN ASM_REWRITE_TAC[]]);;
11491
11492 let HOMEOMORPHISM_IMP_CLOSED_MAP = prove
11493  (`!f:real^M->real^N g s t u.
11494         homeomorphism (s,t) (f,g) /\ closed_in (subtopology euclidean s) u
11495         ==> closed_in (subtopology euclidean t) (IMAGE f u)`,
11496   REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN
11497   SUBGOAL_THEN `IMAGE (f:real^M->real^N) u =
11498                  {y | y IN t /\ g(y) IN u}`
11499   SUBST1_TAC THENL
11500    [FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [closed_in]) THEN
11501     REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM SET_TAC[];
11502     MATCH_MP_TAC CONTINUOUS_ON_IMP_CLOSED_IN THEN ASM_REWRITE_TAC[]]);;
11503
11504 let HOMEOMORPHISM_INJECTIVE_OPEN_MAP_EQ = prove
11505  (`!f:real^M->real^N s t.
11506         f continuous_on s /\ IMAGE f s = t /\
11507         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
11508         ==> ((?g. homeomorphism (s,t) (f,g)) <=>
11509              !u. open_in (subtopology euclidean s) u
11510                  ==> open_in (subtopology euclidean t) (IMAGE f u))`,
11511   REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
11512    [MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN ASM_MESON_TAC[];
11513     MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN
11514     ASM_REWRITE_TAC[]]);;
11515
11516 let HOMEOMORPHISM_INJECTIVE_CLOSED_MAP_EQ = prove
11517  (`!f:real^M->real^N s t.
11518         f continuous_on s /\ IMAGE f s = t /\
11519         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
11520         ==> ((?g. homeomorphism (s,t) (f,g)) <=>
11521              !u. closed_in (subtopology euclidean s) u
11522                  ==> closed_in (subtopology euclidean t) (IMAGE f u))`,
11523   REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
11524    [MATCH_MP_TAC HOMEOMORPHISM_IMP_CLOSED_MAP THEN ASM_MESON_TAC[];
11525     MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_CLOSED_MAP THEN
11526     ASM_REWRITE_TAC[]]);;
11527
11528 let INJECTIVE_MAP_OPEN_IFF_CLOSED = prove
11529  (`!f:real^M->real^N s t.
11530         f continuous_on s /\ IMAGE f s = t /\
11531         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
11532         ==> ((!u. open_in (subtopology euclidean s) u
11533                   ==> open_in (subtopology euclidean t) (IMAGE f u)) <=>
11534              (!u. closed_in (subtopology euclidean s) u
11535                   ==> closed_in (subtopology euclidean t) (IMAGE f u)))`,
11536   REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
11537   EXISTS_TAC `?g:real^N->real^M. homeomorphism (s,t) (f,g)` THEN
11538   CONJ_TAC THENL
11539    [CONV_TAC SYM_CONV THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP_EQ;
11540     MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_CLOSED_MAP_EQ] THEN
11541   ASM_REWRITE_TAC[]);;
11542
11543 (* ------------------------------------------------------------------------- *)
11544 (* Relatively weak hypotheses if the domain of the function is compact.      *)
11545 (* ------------------------------------------------------------------------- *)
11546
11547 let CONTINUOUS_IMP_CLOSED_MAP = prove
11548  (`!f:real^M->real^N s t.
11549         f continuous_on s /\ IMAGE f s = t /\ compact s
11550         ==> !u. closed_in (subtopology euclidean s) u
11551                 ==> closed_in (subtopology euclidean t) (IMAGE f u)`,
11552   SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED] THEN
11553   REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_SUBSET THEN
11554   EXPAND_TAC "t" THEN ASM_SIMP_TAC[IMAGE_SUBSET] THEN
11555   MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
11556   MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
11557   ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_IN_CLOSED_TRANS;
11558                 BOUNDED_SUBSET; CONTINUOUS_ON_SUBSET]);;
11559
11560 let CONTINUOUS_IMP_QUOTIENT_MAP = prove
11561  (`!f:real^M->real^N s t.
11562         f continuous_on s /\ IMAGE f s = t /\ compact s
11563         ==> !u. u SUBSET t
11564                 ==> (open_in (subtopology euclidean s)
11565                              {x | x IN s /\ f x IN u} <=>
11566                      open_in (subtopology euclidean t) u)`,
11567   REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
11568   MATCH_MP_TAC CLOSED_MAP_IMP_QUOTIENT_MAP THEN
11569   ASM_REWRITE_TAC[] THEN
11570   MATCH_MP_TAC CONTINUOUS_IMP_CLOSED_MAP THEN
11571   ASM_REWRITE_TAC[]);;
11572
11573 let CONTINUOUS_ON_INVERSE = prove
11574  (`!f:real^M->real^N g s.
11575         f continuous_on s /\ compact s /\ (!x. x IN s ==> (g(f(x)) = x))
11576         ==> g continuous_on (IMAGE f s)`,
11577   REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_CLOSED] THEN
11578   SUBGOAL_THEN `IMAGE g (IMAGE (f:real^M->real^N) s) = s` SUBST1_TAC THENL
11579    [REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN
11580   X_GEN_TAC `t:real^M->bool` THEN DISCH_TAC THEN
11581   REWRITE_TAC[CLOSED_IN_CLOSED] THEN
11582   EXISTS_TAC `IMAGE (f:real^M->real^N) t` THEN CONJ_TAC THENL
11583    [MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
11584     MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
11585     FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET) THEN
11586     REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
11587     ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_IN_CLOSED_TRANS;
11588                   BOUNDED_SUBSET; CONTINUOUS_ON_SUBSET];
11589     REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; IN_IMAGE] THEN
11590     ASM_MESON_TAC[CLOSED_IN_SUBSET; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET]]);;
11591
11592 let HOMEOMORPHISM_COMPACT = prove
11593  (`!s f t. compact s /\ f continuous_on s /\ (IMAGE f s = t) /\
11594            (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y))
11595            ==> ?g. homeomorphism(s,t) (f,g)`,
11596   REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE] THEN REPEAT GEN_TAC THEN
11597   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
11598   MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[EXTENSION; homeomorphism] THEN
11599   FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
11600   ASM_MESON_TAC[CONTINUOUS_ON_INVERSE; IN_IMAGE]);;
11601
11602 let HOMEOMORPHIC_COMPACT = prove
11603  (`!s f t. compact s /\ f continuous_on s /\ (IMAGE f s = t) /\
11604            (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y))
11605            ==> s homeomorphic t`,
11606   REWRITE_TAC[homeomorphic] THEN MESON_TAC[HOMEOMORPHISM_COMPACT]);;
11607
11608 (* ------------------------------------------------------------------------- *)
11609 (* Lemmas about composition of homeomorphisms.                               *)
11610 (* ------------------------------------------------------------------------- *)
11611
11612 let HOMEOMORPHISM_FROM_COMPOSITION_SURJECTIVE = prove
11613  (`!f:real^M->real^N g:real^N->real^P s t u.
11614         f continuous_on s /\ IMAGE f s = t /\
11615         g continuous_on t /\ IMAGE g t SUBSET u /\
11616         (?h. homeomorphism (s,u) (g o f,h))
11617         ==> (?f'. homeomorphism (s,t) (f,f')) /\
11618             (?g'. homeomorphism (t,u) (g,g'))`,
11619   REPEAT GEN_TAC THEN STRIP_TAC THEN
11620   RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; o_THM]) THEN
11621   MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL
11622    [MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN
11623     REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
11624     MATCH_MP_TAC OPEN_MAP_FROM_COMPOSITION_SURJECTIVE THEN
11625     MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `s:real^M->bool`] THEN
11626     ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
11627     MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
11628     MAP_EVERY EXISTS_TAC [`h:real^P->real^M`; `s:real^M->bool`] THEN
11629     ASM_REWRITE_TAC[homeomorphism; o_THM];
11630     REWRITE_TAC[homeomorphism; o_THM] THEN
11631     DISCH_THEN(X_CHOOSE_THEN `g':real^P->real^N` STRIP_ASSUME_TAC) THEN
11632     EXISTS_TAC `(h:real^P->real^M) o (g:real^N->real^P)` THEN
11633     ASM_SIMP_TAC[o_THM; IMAGE_o] THEN
11634     CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
11635     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11636     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]);;
11637
11638 let HOMEOMORPHISM_FROM_COMPOSITION_INJECTIVE = prove
11639  (`!f:real^M->real^N g:real^N->real^P s t u.
11640         f continuous_on s /\ IMAGE f s SUBSET t /\
11641         g continuous_on t /\ IMAGE g t SUBSET u /\
11642         (!x y. x IN t /\ y IN t /\ g x = g y ==> x = y) /\
11643         (?h. homeomorphism (s,u) (g o f,h))
11644         ==> (?f'. homeomorphism (s,t) (f,f')) /\
11645             (?g'. homeomorphism (t,u) (g,g'))`,
11646   REPEAT GEN_TAC THEN STRIP_TAC THEN
11647   RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; o_THM]) THEN
11648   MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
11649    [MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN
11650     REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
11651     MATCH_MP_TAC OPEN_MAP_FROM_COMPOSITION_INJECTIVE THEN
11652     MAP_EVERY EXISTS_TAC [`g:real^N->real^P`; `u:real^P->bool`] THEN
11653     ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
11654     MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
11655     MAP_EVERY EXISTS_TAC [`h:real^P->real^M`; `s:real^M->bool`] THEN
11656     ASM_REWRITE_TAC[homeomorphism; o_THM];
11657     REWRITE_TAC[homeomorphism; o_THM] THEN
11658     DISCH_THEN(X_CHOOSE_THEN `f':real^N->real^M` STRIP_ASSUME_TAC) THEN
11659     EXISTS_TAC `(f:real^M->real^N) o (h:real^P->real^M)` THEN
11660     ASM_SIMP_TAC[o_THM; IMAGE_o] THEN
11661     REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
11662     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11663     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]);;
11664
11665 (* ------------------------------------------------------------------------- *)
11666 (* Preservation of topological properties.                                   *)
11667 (* ------------------------------------------------------------------------- *)
11668
11669 let HOMEOMORPHIC_COMPACTNESS = prove
11670  (`!s t. s homeomorphic t ==> (compact s <=> compact t)`,
11671   REWRITE_TAC[homeomorphic; homeomorphism] THEN
11672   MESON_TAC[COMPACT_CONTINUOUS_IMAGE]);;
11673
11674 let HOMEOMORPHIC_CONNECTEDNESS = prove
11675  (`!s t. s homeomorphic t ==> (connected s <=> connected t)`,
11676   REWRITE_TAC[homeomorphic; homeomorphism] THEN
11677   MESON_TAC[CONNECTED_CONTINUOUS_IMAGE]);;
11678
11679 (* ------------------------------------------------------------------------- *)
11680 (* Results on translation, scaling etc.                                      *)
11681 (* ------------------------------------------------------------------------- *)
11682
11683 let HOMEOMORPHIC_SCALING = prove
11684  (`!s:real^N->bool c. ~(c = &0) ==> s homeomorphic (IMAGE (\x. c % x) s)`,
11685   REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
11686   MAP_EVERY EXISTS_TAC [`\x:real^N. c % x`; `\x:real^N. inv(c) % x`] THEN
11687   ASM_SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; FORALL_IN_IMAGE] THEN
11688   ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RINV] THEN
11689   SIMP_TAC[VECTOR_MUL_LID; IN_IMAGE; REAL_MUL_LID] THEN MESON_TAC[]);;
11690
11691 let HOMEOMORPHIC_TRANSLATION = prove
11692  (`!s a:real^N. s homeomorphic (IMAGE (\x. a + x) s)`,
11693   REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
11694   MAP_EVERY EXISTS_TAC [`\x:real^N. a +  x`; `\x:real^N. --a + x`] THEN
11695   ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN
11696   SIMP_TAC[VECTOR_ADD_ASSOC; VECTOR_ADD_LINV; VECTOR_ADD_RINV;
11697            FORALL_IN_IMAGE; VECTOR_ADD_LID] THEN
11698   REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[]);;
11699
11700 let HOMEOMORPHIC_AFFINITY = prove
11701  (`!s a:real^N c. ~(c = &0) ==> s homeomorphic (IMAGE (\x. a + c % x) s)`,
11702   REPEAT STRIP_TAC THEN
11703   MATCH_MP_TAC HOMEOMORPHIC_TRANS THEN
11704   EXISTS_TAC `IMAGE (\x:real^N. c % x) s` THEN
11705   ASM_SIMP_TAC[HOMEOMORPHIC_SCALING] THEN
11706   SUBGOAL_THEN `(\x:real^N. a + c % x) = (\x. a + x) o (\x. c % x)`
11707   SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN
11708   REWRITE_TAC[IMAGE_o; HOMEOMORPHIC_TRANSLATION]);;
11709
11710 let [HOMEOMORPHIC_BALLS; HOMEOMORPHIC_CBALLS; HOMEOMORPHIC_SPHERES] =
11711   (CONJUNCTS o prove)
11712  (`(!a:real^N b:real^N d e.
11713       &0 < d /\ &0 < e ==> ball(a,d) homeomorphic ball(b,e)) /\
11714    (!a:real^N b:real^N d e.
11715       &0 < d /\ &0 < e ==> cball(a,d) homeomorphic cball(b,e)) /\
11716    (!a:real^N b:real^N d e.
11717       &0 < d /\ &0 < e ==> sphere(a,d) homeomorphic sphere(b,e))`,
11718   REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
11719   EXISTS_TAC `\x:real^N. b + (e / d) % (x - a)` THEN
11720   EXISTS_TAC `\x:real^N. a + (d / e) % (x - b)` THEN
11721   ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CMUL;
11722     CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID; IN_BALL; IN_CBALL; IN_SPHERE] THEN
11723   REWRITE_TAC[dist; VECTOR_ARITH `a - (a + b) = --b:real^N`; NORM_NEG] THEN
11724   REWRITE_TAC[real_div; VECTOR_ARITH
11725    `a + d % ((b + e % (x - a)) - b) = (&1 - d * e) % a + (d * e) % x`] THEN
11726   ONCE_REWRITE_TAC[REAL_ARITH
11727     `(e * d') * (d * e') = (d * d') * (e * e')`] THEN
11728   ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_MUL_LID; REAL_SUB_REFL] THEN
11729   REWRITE_TAC[NORM_MUL; VECTOR_MUL_LZERO; VECTOR_MUL_LID; VECTOR_ADD_LID] THEN
11730   ASM_SIMP_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ARITH
11731    `&0 < x ==> (abs x = x)`] THEN
11732   GEN_REWRITE_TAC(BINOP_CONV o BINDER_CONV o funpow 2 RAND_CONV)
11733         [GSYM REAL_MUL_RID] THEN
11734   ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * c = (a * c) * b`] THEN
11735   ASM_SIMP_TAC[REAL_LE_LMUL_EQ; GSYM real_div; REAL_LE_LDIV_EQ; REAL_MUL_LID;
11736     GSYM REAL_MUL_ASSOC; REAL_LT_LMUL_EQ; REAL_LT_LDIV_EQ; NORM_SUB] THEN
11737   ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; REAL_MUL_RID]);;
11738
11739 (* ------------------------------------------------------------------------- *)
11740 (* Homeomorphism of one-point compactifications.                             *)
11741 (* ------------------------------------------------------------------------- *)
11742
11743 let HOMEOMORPHIC_ONE_POINT_COMPACTIFICATIONS = prove
11744  (`!s:real^M->bool t:real^N->bool a b.
11745         compact s /\ compact t /\ a IN s /\ b IN t /\
11746         (s DELETE a) homeomorphic (t DELETE b)
11747         ==> s homeomorphic t`,
11748   REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN
11749   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
11750   REWRITE_TAC[HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN
11751   MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
11752   STRIP_TAC THEN
11753   EXISTS_TAC `\x. if x = a then b else (f:real^M->real^N) x` THEN
11754   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
11755   REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
11756   X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
11757   ASM_CASES_TAC `x:real^M = a` THEN ASM_REWRITE_TAC[] THENL
11758    [REWRITE_TAC[continuous_within] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
11759     MP_TAC(ISPECL [`b:real^N`; `e:real`] CENTRE_IN_BALL) THEN
11760     ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
11761     SUBGOAL_THEN
11762       `closed_in (subtopology euclidean s)
11763                  { x | x IN (s DELETE a) /\
11764                        (f:real^M->real^N)(x) IN t DIFF ball(b,e)}`
11765     MP_TAC THENL
11766      [MATCH_MP_TAC CLOSED_SUBSET THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
11767       MATCH_MP_TAC COMPACT_IMP_CLOSED THEN SUBGOAL_THEN
11768        `{x | x IN s DELETE a /\ f x IN t DIFF ball(b,e)} =
11769         IMAGE (g:real^N->real^M) (t DIFF ball (b,e))`
11770       SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
11771       MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
11772       ASM_SIMP_TAC[COMPACT_DIFF; OPEN_BALL] THEN
11773       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
11774         CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[];
11775       REWRITE_TAC[closed_in; open_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN
11776       DISCH_THEN(MP_TAC o SPEC `a:real^M` o last o CONJUNCTS) THEN
11777       ASM_REWRITE_TAC[IN_ELIM_THM; IN_DIFF; IN_DELETE] THEN
11778       SIMP_TAC[IMP_CONJ; DE_MORGAN_THM] THEN
11779       MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN
11780       ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN
11781       ASM_REWRITE_TAC[DIST_REFL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN
11782       RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL]) THEN ASM SET_TAC[]];
11783     UNDISCH_TAC `(f:real^M->real^N) continuous_on (s DELETE a)` THEN
11784     REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
11785     DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[IN_DELETE] THEN
11786     REWRITE_TAC[continuous_within] THEN
11787     MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
11788     ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_DELETE] THEN
11789     DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
11790     EXISTS_TAC `min d (dist(a:real^M,x))` THEN
11791     ASM_REWRITE_TAC[REAL_LT_MIN; GSYM DIST_NZ] THEN
11792     ASM_MESON_TAC[REAL_LT_REFL]]);;
11793
11794 (* ------------------------------------------------------------------------- *)
11795 (* Homeomorphisms between open intervals in real^1 and then in real^N.       *)
11796 (* Could prove similar things for closed intervals, but they drop out of     *)
11797 (* later stuff in "convex.ml" even more easily.                              *)
11798 (* ------------------------------------------------------------------------- *)
11799
11800 let HOMEOMORPHIC_OPEN_INTERVALS_1 = prove
11801  (`!a b c d.
11802         drop a < drop b /\ drop c < drop d
11803         ==> interval(a,b) homeomorphic interval(c,d)`,
11804   SUBGOAL_THEN
11805    `!a b. drop a < drop b
11806           ==> interval(vec 0:real^1,vec 1) homeomorphic interval(a,b)`
11807   ASSUME_TAC THENL
11808    [REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
11809     EXISTS_TAC `(\x. a + drop x % (b - a)):real^1->real^1` THEN
11810     EXISTS_TAC `(\x. inv(drop b - drop a) % (x - a)):real^1->real^1` THEN
11811     ASM_REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ] THEN
11812     REWRITE_TAC[DROP_ADD; DROP_CMUL; DROP_NEG; DROP_VEC; DROP_SUB] THEN
11813     REWRITE_TAC[REAL_ARITH `inv b * a:real = a / b`] THEN
11814     ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_SUB_LT;
11815        REAL_LT_ADDR; REAL_EQ_LDIV_EQ; REAL_DIV_RMUL; REAL_LT_IMP_NZ;
11816        REAL_LT_MUL; REAL_MUL_LZERO; REAL_ADD_SUB; REAL_LT_RMUL_EQ;
11817        REAL_ARITH `a + x < b <=> x < &1 * (b - a)`] THEN
11818     REPEAT CONJ_TAC THENL
11819      [REAL_ARITH_TAC;
11820       MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
11821       MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN
11822       REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID];
11823       MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
11824       ASM_SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]];
11825     REPEAT STRIP_TAC THEN
11826     FIRST_ASSUM(MP_TAC o SPECL [`a:real^1`; `b:real^1`]) THEN
11827     FIRST_X_ASSUM(MP_TAC o SPECL [`c:real^1`; `d:real^1`]) THEN
11828     ASM_REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN
11829     GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [HOMEOMORPHIC_SYM] THEN
11830     REWRITE_TAC[HOMEOMORPHIC_TRANS]]);;
11831
11832 let HOMEOMORPHIC_OPEN_INTERVAL_UNIV_1 = prove
11833  (`!a b. drop a < drop b ==> interval(a,b) homeomorphic (:real^1)`,
11834   REPEAT STRIP_TAC THEN
11835   MP_TAC(SPECL [`a:real^1`; `b:real^1`; `--vec 1:real^1`; `vec 1:real^1`]
11836         HOMEOMORPHIC_OPEN_INTERVALS_1) THEN
11837   ASM_REWRITE_TAC[DROP_VEC; DROP_NEG] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN
11838   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMEOMORPHIC_TRANS) THEN
11839   POP_ASSUM_LIST(K ALL_TAC) THEN
11840   REWRITE_TAC[HOMEOMORPHIC_MINIMAL; IN_UNIV] THEN
11841   EXISTS_TAC `\x:real^1. inv(&1 - norm x) % x` THEN
11842   EXISTS_TAC `\y. if &0 <= drop y then inv(&1 + drop y) % y
11843                   else inv(&1 - drop y) % y` THEN
11844   REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
11845    [X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN
11846     REWRITE_TAC[DROP_NEG; DROP_VEC; DROP_CMUL; NORM_REAL; GSYM drop] THEN
11847     SIMP_TAC[REAL_LE_MUL_EQ; REAL_LT_INV_EQ; REAL_LE_MUL_EQ; REAL_ARITH
11848      `--a < x /\ x < a ==> &0 < a - abs x`] THEN
11849     SIMP_TAC[real_abs; VECTOR_MUL_ASSOC] THEN
11850     COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
11851     GEN_REWRITE_TAC RAND_CONV [GSYM VECTOR_MUL_LID] THEN
11852     AP_THM_TAC THEN AP_TERM_TAC THEN
11853     REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD;
11854     X_GEN_TAC `y:real^1` THEN COND_CASES_TAC THEN
11855     ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_NEG; DROP_VEC; REAL_BOUNDS_LT] THEN
11856     REWRITE_TAC[DROP_CMUL; REAL_ABS_MUL; REAL_ABS_INV] THEN
11857     REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div)] THEN
11858     ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 <= x ==> &0 < abs(&1 + x)`;
11859                  REAL_ARITH `~(&0 <= x) ==> &0 < abs(&1 - x)`] THEN
11860     (CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
11861     REWRITE_TAC[NORM_REAL; VECTOR_MUL_ASSOC] THEN
11862     REWRITE_TAC[GSYM drop; DROP_CMUL; REAL_ABS_MUL] THEN
11863     ASM_REWRITE_TAC[real_abs; REAL_LE_INV_EQ] THEN
11864     ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> &0 <= &1 + x`;
11865                  REAL_ARITH `~(&0 <= x) ==> &0 <= &1 - x`] THEN
11866     GEN_REWRITE_TAC RAND_CONV [GSYM VECTOR_MUL_LID] THEN
11867     AP_THM_TAC THEN AP_TERM_TAC THEN
11868     REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD;
11869     MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
11870     X_GEN_TAC `x:real^1` THEN
11871     REWRITE_TAC[IN_INTERVAL_1; DROP_NEG; DROP_VEC] THEN
11872     DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN
11873     REWRITE_TAC[CONTINUOUS_AT_ID] THEN
11874     ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_INV THEN
11875     REWRITE_TAC[NETLIMIT_AT; o_DEF; LIFT_SUB; LIFT_DROP] THEN
11876     CONJ_TAC THENL
11877      [MATCH_MP_TAC CONTINUOUS_SUB THEN
11878       SIMP_TAC[CONTINUOUS_CONST; REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_NORM];
11879       REWRITE_TAC[NORM_REAL; GSYM drop] THEN ASM_REAL_ARITH_TAC];
11880     SUBGOAL_THEN `(:real^1) = {x | x$1 >= &0} UNION {x | x$1 <= &0}`
11881     SUBST1_TAC THENL
11882      [REWRITE_TAC[EXTENSION; IN_UNION; IN_UNION; IN_ELIM_THM; IN_UNIV] THEN
11883       REAL_ARITH_TAC;
11884       MATCH_MP_TAC CONTINUOUS_ON_CASES THEN
11885       REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; CLOSED_HALFSPACE_COMPONENT_GE;
11886                   IN_ELIM_THM] THEN
11887       REWRITE_TAC[GSYM drop; REAL_NOT_LE; real_ge; REAL_LET_ANTISYM] THEN
11888       SIMP_TAC[REAL_LE_ANTISYM; REAL_SUB_RZERO; REAL_ADD_RID] THEN
11889       CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN
11890       X_GEN_TAC `y:real^1` THEN REWRITE_TAC[IN_ELIM_THM; real_ge] THEN
11891       DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN
11892       REWRITE_TAC[CONTINUOUS_AT_ID] THEN
11893       ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_INV THEN
11894       REWRITE_TAC[NETLIMIT_AT; o_DEF; LIFT_ADD; LIFT_SUB; LIFT_DROP] THEN
11895       ASM_SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_AT_ID; CONTINUOUS_SUB;
11896                    CONTINUOUS_CONST] THEN
11897       ASM_REAL_ARITH_TAC]]);;
11898
11899 let HOMEOMORPHIC_OPEN_INTERVALS = prove
11900  (`!a b:real^N c d:real^N.
11901         (interval(a,b) = {} <=> interval(c,d) = {})
11902         ==> interval(a,b) homeomorphic interval(c,d)`,
11903   REPEAT GEN_TAC THEN ASM_CASES_TAC `interval(c:real^N,d) = {}` THEN
11904   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[HOMEOMORPHIC_REFL] THEN
11905   SUBGOAL_THEN
11906    `!i. 1 <= i /\ i <= dimindex(:N)
11907         ==> interval(lift((a:real^N)$i),lift((b:real^N)$i)) homeomorphic
11908             interval(lift((c:real^N)$i),lift((d:real^N)$i))`
11909   MP_TAC THENL
11910    [RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
11911     ASM_SIMP_TAC[HOMEOMORPHIC_OPEN_INTERVALS_1; LIFT_DROP];
11912     ALL_TAC] THEN
11913   REWRITE_TAC[HOMEOMORPHIC_MINIMAL; IN_INTERVAL_1; LIFT_DROP] THEN
11914   GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
11915   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
11916   MAP_EVERY X_GEN_TAC [`f:num->real^1->real^1`; `g:num->real^1->real^1`] THEN
11917   DISCH_TAC THEN
11918   EXISTS_TAC
11919    `(\x. lambda i.
11920        drop((f:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN
11921   EXISTS_TAC
11922    `(\x. lambda i.
11923        drop((g:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN
11924   ASM_SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; CART_EQ; LIFT_DROP] THEN
11925   ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN
11926   SIMP_TAC[LAMBDA_BETA; LIFT_DROP] THEN CONJ_TAC THEN REPEAT STRIP_TAC THEN
11927   ONCE_REWRITE_TAC[GSYM o_DEF] THEN
11928   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11929   ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT] THEN
11930   MATCH_MP_TAC CONTINUOUS_ON_SUBSET THENL
11931    [EXISTS_TAC `interval(lift((a:real^N)$i),lift((b:real^N)$i))`;
11932     EXISTS_TAC `interval(lift((c:real^N)$i),lift((d:real^N)$i))`] THEN
11933   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN
11934   ASM_SIMP_TAC[LIFT_DROP; IN_INTERVAL]);;
11935
11936 let HOMEOMORPHIC_OPEN_INTERVAL_UNIV = prove
11937  (`!a b:real^N.
11938         ~(interval(a,b) = {})
11939         ==> interval(a,b) homeomorphic (:real^N)`,
11940   REPEAT STRIP_TAC THEN
11941   SUBGOAL_THEN
11942    `!i. 1 <= i /\ i <= dimindex(:N)
11943         ==> interval(lift((a:real^N)$i),lift((b:real^N)$i)) homeomorphic
11944             (:real^1)`
11945   MP_TAC THENL
11946    [RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
11947     ASM_SIMP_TAC[HOMEOMORPHIC_OPEN_INTERVAL_UNIV_1; LIFT_DROP];
11948     ALL_TAC] THEN
11949   REWRITE_TAC[HOMEOMORPHIC_MINIMAL; IN_INTERVAL_1; LIFT_DROP] THEN
11950   GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
11951   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN
11952   MAP_EVERY X_GEN_TAC [`f:num->real^1->real^1`; `g:num->real^1->real^1`] THEN
11953   DISCH_TAC THEN
11954   EXISTS_TAC
11955    `(\x. lambda i.
11956        drop((f:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN
11957   EXISTS_TAC
11958    `(\x. lambda i.
11959        drop((g:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN
11960   ASM_SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; CART_EQ; LIFT_DROP; IN_UNIV] THEN
11961   ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN
11962   SIMP_TAC[LAMBDA_BETA; LIFT_DROP] THEN CONJ_TAC THEN REPEAT STRIP_TAC THEN
11963   ONCE_REWRITE_TAC[GSYM o_DEF] THEN
11964   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
11965   ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT] THEN
11966   MATCH_MP_TAC CONTINUOUS_ON_SUBSET THENL
11967    [EXISTS_TAC `interval(lift((a:real^N)$i),lift((b:real^N)$i))`;
11968     EXISTS_TAC `(:real^1)`] THEN
11969   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; IN_UNIV] THEN
11970   ASM_SIMP_TAC[LIFT_DROP; IN_INTERVAL]);;
11971
11972 let HOMEOMORPHIC_BALL_UNIV = prove
11973  (`!a:real^N r. &0 < r ==> ball(a,r) homeomorphic (:real^N)`,
11974   REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN
11975   SUBGOAL_THEN `?y:real^N. r = norm(y)` (CHOOSE_THEN SUBST_ALL_TAC) THENL
11976    [ASM_MESON_TAC[VECTOR_CHOOSE_SIZE; REAL_LT_IMP_LE]; POP_ASSUM MP_TAC] THEN
11977   REWRITE_TAC[NORM_POS_LT] THEN GEOM_NORMALIZE_TAC `y:real^N` THEN
11978   SIMP_TAC[] THEN GEN_TAC THEN REPEAT(DISCH_THEN(K ALL_TAC)) THEN
11979   REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
11980   EXISTS_TAC `\z:real^N. inv(&1 - norm(z)) % z` THEN
11981   EXISTS_TAC `\z:real^N. inv(&1 + norm(z)) % z` THEN
11982   REWRITE_TAC[IN_BALL; IN_UNIV; DIST_0; VECTOR_MUL_ASSOC; VECTOR_MUL_EQ_0;
11983               VECTOR_ARITH `a % x:real^N = x <=> (a - &1) % x = vec 0`] THEN
11984   REPEAT CONJ_TAC THENL
11985    [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN DISJ1_TAC THEN
11986     REWRITE_TAC[GSYM REAL_INV_MUL; REAL_SUB_0; REAL_INV_EQ_1] THEN
11987     REWRITE_TAC[NORM_MUL; REAL_ABS_INV] THEN
11988     ASM_SIMP_TAC[REAL_ARITH `x < &1 ==> abs(&1 - x) = &1 - x`] THEN
11989     POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD;
11990     X_GEN_TAC `y:real^N` THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV] THEN
11991     ASM_SIMP_TAC[NORM_POS_LE; REAL_ARITH
11992      `&0 <= y ==> inv(abs(&1 + y)) * z = z / (&1 + y)`] THEN
11993     ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_LDIV_EQ; REAL_ARITH
11994       `&0 <= y ==> &0 < &1 + y`] THEN
11995     CONJ_TAC THENL [REAL_ARITH_TAC; DISJ1_TAC] THEN
11996     REWRITE_TAC[GSYM REAL_INV_MUL; REAL_SUB_0; REAL_INV_EQ_1] THEN
11997     MP_TAC(ISPEC `y:real^N` NORM_POS_LE) THEN CONV_TAC REAL_FIELD;
11998     MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN
11999     GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_DEF] THEN
12000     MATCH_MP_TAC CONTINUOUS_ON_INV THEN
12001     SIMP_TAC[IN_BALL_0; REAL_SUB_0; REAL_ARITH `x < &1 ==> ~(&1 = x)`] THEN
12002     REWRITE_TAC[o_DEF; LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
12003     REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
12004     MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN
12005     REWRITE_TAC[CONTINUOUS_ON_ID];
12006     MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN
12007     GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_DEF] THEN
12008     MATCH_MP_TAC CONTINUOUS_ON_INV THEN
12009     SIMP_TAC[NORM_POS_LE; REAL_ARITH `&0 <= x ==> ~(&1 + x = &0)`] THEN
12010     REWRITE_TAC[o_DEF; LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
12011     REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
12012     MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN
12013     REWRITE_TAC[CONTINUOUS_ON_ID]]);;
12014
12015 (* ------------------------------------------------------------------------- *)
12016 (* Cardinalities of various useful sets.                                     *)
12017 (* ------------------------------------------------------------------------- *)
12018
12019 let CARD_EQ_EUCLIDEAN = prove
12020  (`(:real^N) =_c (:real)`,
12021   MATCH_MP_TAC CARD_EQ_CART THEN REWRITE_TAC[real_INFINITE]);;
12022
12023 let UNCOUNTABLE_EUCLIDEAN = prove
12024  (`~COUNTABLE(:real^N)`,
12025   MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN
12026   REWRITE_TAC[CARD_EQ_EUCLIDEAN]);;
12027
12028 let CARD_EQ_INTERVAL = prove
12029  (`(!a b:real^N. ~(interval(a,b) = {}) ==> interval[a,b] =_c (:real)) /\
12030    (!a b:real^N. ~(interval(a,b) = {}) ==> interval(a,b) =_c (:real))`,
12031   REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
12032   ASM_CASES_TAC `interval(a:real^N,b) = {}` THEN ASM_REWRITE_TAC[] THEN
12033   CONJ_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
12034    [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
12035     REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
12036     REWRITE_TAC[CARD_EQ_EUCLIDEAN];
12037     TRANS_TAC CARD_LE_TRANS `interval(a:real^N,b)` THEN
12038     SIMP_TAC[CARD_LE_SUBSET; INTERVAL_OPEN_SUBSET_CLOSED];
12039     TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
12040     REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
12041     REWRITE_TAC[CARD_EQ_EUCLIDEAN];
12042     ALL_TAC] THEN
12043   TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
12044   SIMP_TAC[ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE;
12045            CARD_EQ_EUCLIDEAN] THEN
12046   FIRST_X_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_OPEN_INTERVAL_UNIV) THEN
12047   DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_CARD_EQ) THEN
12048   MESON_TAC[CARD_EQ_IMP_LE; CARD_EQ_SYM]);;
12049
12050 let UNCOUNTABLE_INTERVAL = prove
12051  (`(!a b. ~(interval(a,b) = {}) ==> ~COUNTABLE(interval[a,b])) /\
12052    (!a b. ~(interval(a,b) = {}) ==> ~COUNTABLE(interval(a,b)))`,
12053   SIMP_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; CARD_EQ_INTERVAL]);;
12054
12055 let COUNTABLE_OPEN_INTERVAL = prove
12056  (`!a b. COUNTABLE(interval(a,b)) <=> interval(a,b) = {}`,
12057   MESON_TAC[COUNTABLE_EMPTY; UNCOUNTABLE_INTERVAL]);;
12058
12059 let CARD_EQ_OPEN = prove
12060  (`!s:real^N->bool. open s /\ ~(s = {}) ==> s =_c (:real)`,
12061   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
12062    [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
12063     REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
12064     REWRITE_TAC[CARD_EQ_EUCLIDEAN];
12065     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_INTERVAL]) THEN
12066     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
12067     DISCH_THEN(X_CHOOSE_TAC `c:real^N`) THEN
12068     DISCH_THEN(MP_TAC o SPEC `c:real^N`) THEN
12069     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
12070     MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
12071     ASM_CASES_TAC `interval(a:real^N,b) = {}` THEN
12072     ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN STRIP_TAC THEN
12073     TRANS_TAC CARD_LE_TRANS `interval[a:real^N,b]` THEN
12074     ASM_SIMP_TAC[CARD_LE_SUBSET] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
12075     ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN ASM_SIMP_TAC[CARD_EQ_INTERVAL]]);;
12076
12077 let UNCOUNTABLE_OPEN = prove
12078  (`!s:real^N->bool. open s /\ ~(s = {}) ==> ~(COUNTABLE s)`,
12079   SIMP_TAC[CARD_EQ_OPEN; CARD_EQ_REAL_IMP_UNCOUNTABLE]);;
12080
12081 let CARD_EQ_BALL = prove
12082  (`!a:real^N r. &0 < r ==> ball(a,r) =_c (:real)`,
12083   SIMP_TAC[CARD_EQ_OPEN; OPEN_BALL; BALL_EQ_EMPTY; GSYM REAL_NOT_LT]);;
12084
12085 let CARD_EQ_CBALL = prove
12086  (`!a:real^N r. &0 < r ==> cball(a,r) =_c (:real)`,
12087   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
12088    [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
12089     REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN
12090     REWRITE_TAC[CARD_EQ_EUCLIDEAN];
12091     TRANS_TAC CARD_LE_TRANS `ball(a:real^N,r)` THEN
12092     SIMP_TAC[CARD_LE_SUBSET; BALL_SUBSET_CBALL] THEN
12093     MATCH_MP_TAC CARD_EQ_IMP_LE THEN
12094     ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN ASM_SIMP_TAC[CARD_EQ_BALL]]);;
12095
12096 let FINITE_IMP_NOT_OPEN = prove
12097  (`!s:real^N->bool. FINITE s /\ ~(s = {}) ==> ~(open s)`,
12098   MESON_TAC[UNCOUNTABLE_OPEN; FINITE_IMP_COUNTABLE]);;
12099
12100 let OPEN_IMP_INFINITE = prove
12101  (`!s. open s ==> s = {} \/ INFINITE s`,
12102   MESON_TAC[FINITE_IMP_NOT_OPEN; INFINITE]);;
12103
12104 let EMPTY_INTERIOR_FINITE = prove
12105  (`!s:real^N->bool. FINITE s ==> interior s = {}`,
12106   REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` OPEN_INTERIOR) THEN
12107   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
12108   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] FINITE_IMP_NOT_OPEN) THEN
12109   MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN
12110   ASM_REWRITE_TAC[INTERIOR_SUBSET]);;
12111
12112 let CARD_EQ_CONNECTED = prove
12113  (`!s a b:real^N.
12114         connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> s =_c (:real)`,
12115   GEOM_ORIGIN_TAC `b:real^N` THEN GEOM_NORMALIZE_TAC `a:real^N` THEN
12116   REWRITE_TAC[NORM_EQ_SQUARE; REAL_POS; REAL_POW_ONE] THEN
12117   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
12118    [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN
12119     SIMP_TAC[CARD_LE_UNIV; CARD_EQ_EUCLIDEAN; CARD_EQ_IMP_LE];
12120     TRANS_TAC CARD_LE_TRANS `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL
12121      [MATCH_MP_TAC(ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE) THEN
12122       SIMP_TAC[UNIT_INTERVAL_NONEMPTY; CARD_EQ_INTERVAL];
12123       REWRITE_TAC[LE_C] THEN EXISTS_TAC `\x:real^N. lift(a dot x)` THEN
12124       SIMP_TAC[FORALL_LIFT; LIFT_EQ; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
12125       X_GEN_TAC `t:real` THEN STRIP_TAC THEN
12126       MATCH_MP_TAC CONNECTED_IVT_HYPERPLANE THEN
12127       MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `a:real^N`] THEN
12128       ASM_REWRITE_TAC[DOT_RZERO]]]);;
12129
12130 let UNCOUNTABLE_CONNECTED = prove
12131  (`!s a b:real^N.
12132         connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> ~COUNTABLE s`,
12133   REPEAT GEN_TAC THEN STRIP_TAC THEN
12134   MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN
12135   MATCH_MP_TAC CARD_EQ_CONNECTED THEN
12136   ASM_MESON_TAC[]);;
12137
12138 let CARD_LT_IMP_DISCONNECTED = prove
12139  (`!s x:real^N. s <_c (:real) /\ x IN s ==> connected_component s x = {x}`,
12140   REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE
12141    `s = {a} <=> a IN s /\ !a b. a IN s /\ b IN s /\ ~(a = b) ==> F`] THEN
12142   REPEAT STRIP_TAC THEN REWRITE_TAC[IN] THEN
12143   ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
12144   MP_TAC(ISPECL [`connected_component s (x:real^N)`; `a:real^N`; `b:real^N`]
12145         CARD_EQ_CONNECTED) THEN
12146   ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN
12147   DISCH_TAC THEN UNDISCH_TAC `(s:real^N->bool) <_c (:real)` THEN
12148   REWRITE_TAC[CARD_NOT_LT] THEN
12149   TRANS_TAC CARD_LE_TRANS `connected_component s (x:real^N)` THEN
12150   ASM_SIMP_TAC[ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE] THEN
12151   MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]);;
12152
12153 let COUNTABLE_IMP_DISCONNECTED = prove
12154  (`!s x:real^N. COUNTABLE s /\ x IN s ==> connected_component s x = {x}`,
12155   SIMP_TAC[CARD_LT_IMP_DISCONNECTED; COUNTABLE_IMP_CARD_LT_REAL]);;
12156
12157 let CONNECTED_CARD_EQ_IFF_NONTRIVIAL = prove
12158  (`!s:real^N->bool.
12159         connected s ==> (s =_c (:real) <=> ~(?a. s SUBSET {a}))`,
12160   REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
12161    [ALL_TAC; MATCH_MP_TAC CARD_EQ_CONNECTED THEN ASM SET_TAC[]] THEN
12162   FIRST_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN
12163   REWRITE_TAC[FINITE_SING] THEN
12164   ASM_MESON_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; FINITE_IMP_COUNTABLE]);;
12165
12166 (* ------------------------------------------------------------------------- *)
12167 (* "Iff" forms of constancy of function from connected set into a set that   *)
12168 (* is smaller than R, or countable, or finite, or disconnected, or discrete. *)
12169 (* ------------------------------------------------------------------------- *)
12170
12171 let [CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ;
12172      CONTINUOUS_DISCRETE_RANGE_CONSTANT_EQ;
12173      CONTINUOUS_FINITE_RANGE_CONSTANT_EQ] = (CONJUNCTS o prove)
12174   (`(!s. connected s <=>
12175          !f:real^M->real^N t.
12176             f continuous_on s /\ IMAGE f s SUBSET t /\
12177             (!y. y IN t ==> connected_component t y = {y})
12178             ==> ?a. !x. x IN s ==> f x = a) /\
12179     (!s. connected s <=>
12180          !f:real^M->real^N.
12181             f continuous_on s /\
12182             (!x. x IN s
12183                  ==> ?e. &0 < e /\
12184                          !y. y IN s /\ ~(f y = f x) ==> e <= norm(f y - f x))
12185             ==> ?a. !x. x IN s ==> f x = a) /\
12186     (!s. connected s <=>
12187          !f:real^M->real^N.
12188             f continuous_on s /\ FINITE(IMAGE f s)
12189             ==> ?a. !x. x IN s ==> f x = a)`,
12190   REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `s:real^M->bool` THEN
12191   MATCH_MP_TAC(TAUT
12192    `(s ==> t) /\ (t ==> u) /\ (u ==> v) /\ (v ==> s)
12193     ==> (s <=> t) /\ (s <=> u) /\ (s <=> v)`) THEN
12194   REPEAT CONJ_TAC THENL
12195    [REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN
12196     ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
12197     FIRST_X_ASSUM(X_CHOOSE_TAC `x:real^M` o
12198         GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
12199     EXISTS_TAC `(f:real^M->real^N) x` THEN
12200     MATCH_MP_TAC(SET_RULE
12201      `IMAGE f s SUBSET {a} ==> !y. y IN s ==> f y = a`) THEN
12202     FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN
12203     ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN
12204     MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
12205     ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE] THEN ASM SET_TAC[];
12206     REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
12207     EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN
12208     ASM_REWRITE_TAC[FORALL_IN_IMAGE; SUBSET_REFL] THEN
12209     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
12210     FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
12211     DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
12212     MATCH_MP_TAC(SET_RULE
12213      `(!y. y IN s /\ f y IN connected_component (IMAGE f s) a ==> f y = a) /\
12214       connected_component (IMAGE f s) a SUBSET (IMAGE f s) /\
12215       connected_component (IMAGE f s) a a
12216       ==> connected_component (IMAGE f s) a = {a}`) THEN
12217     REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_COMPONENT_REFL_EQ] THEN
12218     ASM_SIMP_TAC[FUN_IN_IMAGE] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN
12219     MP_TAC(ISPEC `connected_component (IMAGE (f:real^M->real^N) s) (f x)`
12220         CONNECTED_CLOSED) THEN
12221     REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN
12222     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
12223     ASM_REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC
12224      [`cball((f:real^M->real^N) x,e / &2)`;
12225       `(:real^N) DIFF ball((f:real^M->real^N) x,e)`] THEN
12226     REWRITE_TAC[GSYM OPEN_CLOSED; OPEN_BALL; CLOSED_CBALL] THEN
12227     REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN REPEAT CONJ_TAC THENL
12228      [REWRITE_TAC[SUBSET; IN_CBALL; IN_UNION; IN_DIFF; IN_BALL; IN_UNIV] THEN
12229       MATCH_MP_TAC(MESON[SUBSET; CONNECTED_COMPONENT_SUBSET]
12230        `(!x. x IN s ==> P x)
12231         ==> (!x. x IN connected_component s y ==> P x)`) THEN
12232       REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `z:real^M` THEN
12233       DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:real^M`) THEN
12234       ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH;
12235       MATCH_MP_TAC(SET_RULE
12236        `(!x. x IN s /\ x IN t ==> F) ==> s INTER t INTER u = {}`) THEN
12237       REWRITE_TAC[IN_BALL; IN_CBALL; IN_DIFF; IN_UNIV] THEN
12238       UNDISCH_TAC `&0 < e` THEN CONV_TAC NORM_ARITH;
12239       EXISTS_TAC `(f:real^M->real^N) x` THEN
12240       ASM_SIMP_TAC[CENTRE_IN_CBALL; REAL_HALF; REAL_LT_IMP_LE; IN_INTER] THEN
12241       REWRITE_TAC[IN] THEN
12242       ASM_SIMP_TAC[CONNECTED_COMPONENT_REFL_EQ; FUN_IN_IMAGE];
12243       EXISTS_TAC `(f:real^M->real^N) y` THEN
12244       ASM_REWRITE_TAC[IN_INTER; IN_DIFF; IN_UNIV; IN_BALL; REAL_NOT_LT] THEN
12245       ASM_SIMP_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist]];
12246     MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `f:real^M->real^N` THEN
12247     DISCH_THEN(fun th -> STRIP_TAC THEN MATCH_MP_TAC th) THEN
12248     ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
12249     ASM_CASES_TAC `IMAGE (f:real^M->real^N) s DELETE (f x) = {}` THENL
12250      [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN ASM SET_TAC[];
12251       ALL_TAC] THEN
12252     EXISTS_TAC
12253      `inf{norm(z - f x) |z| z IN IMAGE (f:real^M->real^N) s DELETE (f x)}` THEN
12254     REWRITE_TAC[SIMPLE_IMAGE] THEN
12255     ASM_SIMP_TAC[REAL_LT_INF_FINITE; REAL_INF_LE_FINITE; FINITE_DELETE;
12256                  FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN
12257     REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN
12258     REWRITE_TAC[IN_DELETE; NORM_POS_LT; VECTOR_SUB_EQ; IN_IMAGE] THEN
12259     MESON_TAC[REAL_LE_REFL];
12260     REWRITE_TAC[CONNECTED_CLOSED_IN_EQ] THEN
12261     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
12262     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
12263     MAP_EVERY X_GEN_TAC [`t:real^M->bool`; `u:real^M->bool`] THEN
12264     STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC
12265      `(\x. if x IN t then vec 0 else basis 1):real^M->real^N`) THEN
12266     REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL
12267      [EXPAND_TAC "s" THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
12268       ASM_REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[];
12269       MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{vec 0:real^N,basis 1}` THEN
12270       REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN SET_TAC[];
12271       SUBGOAL_THEN `?a b:real^M. a IN s /\ a IN t /\ b IN s /\ ~(b IN t)`
12272       STRIP_ASSUME_TAC THENL
12273        [ASM SET_TAC[]; DISCH_THEN(CHOOSE_THEN MP_TAC)] THEN
12274       DISCH_THEN(fun th -> MP_TAC(SPEC `a:real^M` th) THEN
12275                            MP_TAC(SPEC `b:real^M` th)) THEN
12276       ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
12277       CONV_TAC(RAND_CONV SYM_CONV) THEN
12278       SIMP_TAC[BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1; REAL_LE_REFL]]]);;
12279
12280 let CONTINUOUS_DISCONNECTED_RANGE_CONSTANT = prove
12281  (`!f:real^M->real^N s.
12282         connected s /\
12283         f continuous_on s /\ IMAGE f s SUBSET t /\
12284         (!y. y IN t ==> connected_component t y = {y})
12285         ==> ?a. !x. x IN s ==> f x = a`,
12286   MESON_TAC[CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ]);;
12287
12288 let CONTINUOUS_DISCRETE_RANGE_CONSTANT = prove
12289  (`!f:real^M->real^N s.
12290         connected s /\
12291         f continuous_on s /\
12292         (!x. x IN s
12293              ==> ?e. &0 < e /\
12294                      !y. y IN s /\ ~(f y = f x) ==> e <= norm(f y - f x))
12295         ==> ?a. !x. x IN s ==> f x = a`,
12296   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN
12297   REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN
12298   REWRITE_TAC[IMP_IMP; GSYM CONTINUOUS_DISCRETE_RANGE_CONSTANT_EQ]);;
12299
12300 let CONTINUOUS_FINITE_RANGE_CONSTANT = prove
12301  (`!f:real^M->real^N s.
12302         connected s /\
12303         f continuous_on s /\
12304         FINITE(IMAGE f s)
12305         ==> ?a. !x. x IN s ==> f x = a`,
12306   MESON_TAC[CONTINUOUS_FINITE_RANGE_CONSTANT_EQ]);;
12307
12308 let CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ = prove
12309  (`!s. connected s <=>
12310          !f:real^M->real^N.
12311             f continuous_on s /\ COUNTABLE(IMAGE f s)
12312             ==> ?a. !x. x IN s ==> f x = a`,
12313   GEN_TAC THEN EQ_TAC THENL
12314    [REWRITE_TAC[CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ];
12315     REWRITE_TAC[CONTINUOUS_FINITE_RANGE_CONSTANT_EQ]] THEN
12316   REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
12317   ASM_SIMP_TAC[FINITE_IMP_COUNTABLE] THEN
12318   EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN
12319   ASM_SIMP_TAC[COUNTABLE_IMP_DISCONNECTED; SUBSET_REFL]);;
12320
12321 let CONTINUOUS_CARD_LT_RANGE_CONSTANT_EQ = prove
12322  (`!s. connected s <=>
12323          !f:real^M->real^N.
12324             f continuous_on s /\ (IMAGE f s) <_c (:real)
12325             ==> ?a. !x. x IN s ==> f x = a`,
12326   GEN_TAC THEN EQ_TAC THENL
12327    [REWRITE_TAC[CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ];
12328     REWRITE_TAC[CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ]] THEN
12329   REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
12330   ASM_SIMP_TAC[COUNTABLE_IMP_CARD_LT_REAL] THEN
12331   EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN
12332   ASM_SIMP_TAC[CARD_LT_IMP_DISCONNECTED; SUBSET_REFL]);;
12333
12334 let CONTINUOUS_COUNTABLE_RANGE_CONSTANT = prove
12335  (`!f:real^M->real^N s.
12336         connected s /\ f continuous_on s /\ COUNTABLE(IMAGE f s)
12337         ==> ?a. !x. x IN s ==> f x = a`,
12338   MESON_TAC[CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ]);;
12339
12340 let CONTINUOUS_CARD_LT_RANGE_CONSTANT = prove
12341  (`!f:real^M->real^N s.
12342         connected s /\ f continuous_on s /\ (IMAGE f s) <_c (:real)
12343         ==> ?a. !x. x IN s ==> f x = a`,
12344   MESON_TAC[CONTINUOUS_CARD_LT_RANGE_CONSTANT_EQ]);;
12345
12346 (* ------------------------------------------------------------------------- *)
12347 (* Homeomorphism of hyperplanes.                                             *)
12348 (* ------------------------------------------------------------------------- *)
12349
12350 let HOMEOMORPHIC_HYPERPLANES = prove
12351  (`!a:real^N b c:real^N d.
12352         ~(a = vec 0) /\ ~(c = vec 0)
12353         ==> {x | a dot x = b} homeomorphic {x | c dot x = d}`,
12354   let lemma = prove
12355    (`~(a = vec 0)
12356      ==> {x:real^N | a dot x = b} homeomorphic {x:real^N | x$1 = &0}`,
12357     REPEAT STRIP_TAC THEN SUBGOAL_THEN `?c:real^N. a dot c = b`
12358     STRIP_ASSUME_TAC THENL
12359      [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN
12360       REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; VEC_COMPONENT] THEN
12361       DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN
12362       EXISTS_TAC `b / (a:real^N)$k % basis k:real^N` THEN
12363       ASM_SIMP_TAC[DOT_RMUL; DOT_BASIS; REAL_DIV_RMUL];
12364       FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
12365       ABBREV_TAC `p = {x:real^N | x$1 = &0}` THEN
12366       GEOM_ORIGIN_TAC `c:real^N` THEN
12367       REWRITE_TAC[VECTOR_ADD_RID; DOT_RADD; DOT_RZERO; REAL_EQ_ADD_LCANCEL_0;
12368                   REAL_ADD_RID] THEN
12369       REPEAT STRIP_TAC THEN UNDISCH_TAC `~(a:real^N = vec 0)` THEN
12370       GEOM_BASIS_MULTIPLE_TAC 1 `a:real^N` THEN
12371       SIMP_TAC[VECTOR_MUL_EQ_0; DE_MORGAN_THM; DOT_LMUL; REAL_ENTIRE] THEN
12372       SIMP_TAC[DOT_BASIS; LE_REFL; DIMINDEX_GE_1] THEN
12373       EXPAND_TAC "p" THEN REWRITE_TAC[HOMEOMORPHIC_REFL]]) in
12374   REPEAT STRIP_TAC THEN
12375   TRANS_TAC HOMEOMORPHIC_TRANS `{x:real^N | x$1 = &0}` THEN
12376   ASM_SIMP_TAC[lemma] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
12377   ASM_SIMP_TAC[lemma]);;
12378
12379 let HOMEOMORPHIC_HYPERPLANE_STANDARD_HYPERPLANE = prove
12380  (`!a:real^N b k c.
12381         ~(a = vec 0) /\ 1 <= k /\ k <= dimindex(:N)
12382         ==> {x | a dot x = b} homeomorphic {x:real^N | x$k = c}`,
12383   REPEAT STRIP_TAC THEN
12384   SUBGOAL_THEN `{x:real^N | x$k = c} = {x | basis k dot x = c}` SUBST1_TAC
12385   THENL [ASM_SIMP_TAC[DOT_BASIS]; MATCH_MP_TAC HOMEOMORPHIC_HYPERPLANES] THEN
12386   ASM_SIMP_TAC[BASIS_NONZERO]);;
12387
12388 let HOMEOMORPHIC_STANDARD_HYPERPLANE_HYPERPLANE = prove
12389  (`!a:real^N b k c.
12390         ~(a = vec 0) /\ 1 <= k /\ k <= dimindex(:N)
12391         ==> {x:real^N | x$k = c} homeomorphic {x | a dot x = b}`,
12392   ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
12393   REWRITE_TAC[HOMEOMORPHIC_HYPERPLANE_STANDARD_HYPERPLANE]);;
12394
12395 let HOMEOMORPHIC_HYPERPLANE_UNIV = prove
12396  (`!a b. ~(a = vec 0) /\ dimindex(:N) = dimindex(:M) + 1
12397          ==> {x:real^N | a dot x = b} homeomorphic (:real^M)`,
12398   REPEAT STRIP_TAC THEN TRANS_TAC HOMEOMORPHIC_TRANS
12399    `{x:real^N | basis(dimindex(:N)) dot x = &0}` THEN
12400   ASM_SIMP_TAC[HOMEOMORPHIC_HYPERPLANES; BASIS_NONZERO;
12401                LE_REFL; DIMINDEX_GE_1] THEN
12402   REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN
12403   EXISTS_TAC `(\x. lambda i. x$i):real^N->real^M` THEN
12404   EXISTS_TAC `(\x. lambda i. if i <= dimindex(:M) then x$i else &0)
12405               :real^M->real^N` THEN
12406   REPEAT CONJ_TAC THENL
12407    [MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN
12408     SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
12409              VECTOR_MUL_COMPONENT];
12410     REWRITE_TAC[SUBSET_UNIV];
12411     MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN
12412     SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
12413              VECTOR_MUL_COMPONENT] THEN
12414     REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
12415     REAL_ARITH_TAC;
12416     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_UNIV] THEN
12417     ASM_SIMP_TAC[DOT_BASIS; LAMBDA_BETA; LE_REFL; ARITH_RULE `1 <= n + 1`;
12418                  ARITH_RULE `~(m + 1 <= m)`];
12419     ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; DOT_BASIS; LE_REFL; CART_EQ;
12420                  ARITH_RULE `1 <= n + 1`] THEN
12421     GEN_TAC THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN
12422     ASM_CASES_TAC `i = dimindex(:M) + 1` THEN ASM_REWRITE_TAC[COND_ID] THEN
12423     COND_CASES_TAC THEN REWRITE_TAC[] THEN ASM_ARITH_TAC;
12424     ASM_SIMP_TAC[LAMBDA_BETA; CART_EQ; IN_UNIV; LE_REFL;
12425                  ARITH_RULE `i <= n ==> i <= n + 1`]]);;
12426
12427 (* ------------------------------------------------------------------------- *)
12428 (* "Isometry" (up to constant bounds) of injective linear map etc.           *)
12429 (* ------------------------------------------------------------------------- *)
12430
12431 let CAUCHY_ISOMETRIC = prove
12432  (`!f s e x.
12433         &0 < e /\ subspace s /\
12434         linear f /\ (!x. x IN s ==> norm(f x) >= e * norm(x)) /\
12435         (!n. x(n) IN s) /\ cauchy(f o x)
12436         ==> cauchy x`,
12437   REPEAT GEN_TAC THEN REWRITE_TAC[real_ge] THEN
12438   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
12439   REWRITE_TAC[CAUCHY; dist; o_THM] THEN
12440   FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_SUB th)]) THEN
12441   DISCH_THEN(fun th -> X_GEN_TAC `d:real` THEN DISCH_TAC THEN MP_TAC th) THEN
12442   DISCH_THEN(MP_TAC o SPEC `d * e`) THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN
12443   ASM_MESON_TAC[REAL_LE_RDIV_EQ; REAL_MUL_SYM; REAL_LET_TRANS; SUBSPACE_SUB;
12444                 REAL_LT_LDIV_EQ]);;
12445
12446 let COMPLETE_ISOMETRIC_IMAGE = prove
12447  (`!f:real^M->real^N s e.
12448         &0 < e /\ subspace s /\
12449         linear f /\ (!x. x IN s ==> norm(f x) >= e * norm(x)) /\
12450         complete s
12451         ==> complete(IMAGE f s)`,
12452   REPEAT GEN_TAC THEN REWRITE_TAC[complete; EXISTS_IN_IMAGE] THEN
12453   STRIP_TAC THEN X_GEN_TAC `g:num->real^N` THEN
12454   REWRITE_TAC[IN_IMAGE; SKOLEM_THM; FORALL_AND_THM] THEN
12455   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
12456   DISCH_THEN(X_CHOOSE_THEN `x:num->real^M` MP_TAC) THEN
12457   GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM FUN_EQ_THM] THEN
12458   REWRITE_TAC[GSYM o_DEF] THEN
12459   DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN
12460   FIRST_X_ASSUM(MP_TAC o SPEC `x:num->real^M`) THEN
12461   ASM_MESON_TAC[CAUCHY_ISOMETRIC; LINEAR_CONTINUOUS_AT;
12462                 CONTINUOUS_AT_SEQUENTIALLY]);;
12463
12464 let INJECTIVE_IMP_ISOMETRIC = prove
12465  (`!f:real^M->real^N s.
12466         closed s /\ subspace s /\
12467         linear f /\ (!x. x IN s /\ (f x = vec 0) ==> (x = vec 0))
12468         ==> ?e. &0 < e /\ !x. x IN s ==> norm(f x) >= e * norm(x)`,
12469   REPEAT STRIP_TAC THEN
12470   ASM_CASES_TAC `s SUBSET {vec 0 :real^M}` THENL
12471    [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; REAL_MUL_LID; real_ge] THEN
12472     ASM_MESON_TAC[SUBSET; IN_SING; NORM_0; LINEAR_0; REAL_LE_REFL];
12473     ALL_TAC] THEN
12474   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SUBSET]) THEN
12475   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; IN_SING] THEN
12476   DISCH_THEN(X_CHOOSE_THEN `a:real^M` STRIP_ASSUME_TAC) THEN
12477   MP_TAC(ISPECL
12478    [`{(f:real^M->real^N) x | x IN s /\ norm(x) = norm(a:real^M)}`;
12479     `vec 0:real^N`] DISTANCE_ATTAINS_INF) THEN
12480   ANTS_TAC THENL
12481    [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN
12482     CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
12483     MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
12484     SUBST1_TAC(SET_RULE
12485      `{f x | x IN s /\ norm(x) = norm(a:real^M)} =
12486       IMAGE (f:real^M->real^N) (s INTER {x | norm x = norm a})`) THEN
12487     MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
12488     ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN
12489     MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_REWRITE_TAC[] THEN
12490     SUBGOAL_THEN
12491      `{x:real^M | norm x = norm(a:real^M)} = frontier(cball(vec 0,norm a))`
12492     SUBST1_TAC THENL
12493      [ASM_SIMP_TAC[FRONTIER_CBALL; NORM_POS_LT; dist; VECTOR_SUB_LZERO;
12494                    NORM_NEG; sphere];
12495       ASM_SIMP_TAC[COMPACT_FRONTIER; COMPACT_CBALL]];
12496     ALL_TAC] THEN
12497   ONCE_REWRITE_TAC[SET_RULE `{f x | P x} = IMAGE f {x | P x}`] THEN
12498   REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN
12499   DISCH_THEN(X_CHOOSE_THEN `b:real^M` MP_TAC) THEN
12500   REWRITE_TAC[IN_ELIM_THM; dist; VECTOR_SUB_LZERO; NORM_NEG] THEN
12501   STRIP_TAC THEN REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE] THEN
12502   EXISTS_TAC `norm((f:real^M->real^N) b) / norm(b)` THEN CONJ_TAC THENL
12503    [ASM_MESON_TAC[REAL_LT_DIV; NORM_POS_LT; NORM_EQ_0]; ALL_TAC] THEN
12504   X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
12505   ASM_CASES_TAC `x:real^M = vec 0` THENL
12506    [FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP LINEAR_0 th]) THEN
12507     REWRITE_TAC[NORM_0; REAL_MUL_RZERO; real_ge; REAL_LE_REFL];
12508     ALL_TAC] THEN
12509   FIRST_X_ASSUM(MP_TAC o SPEC `(norm(a:real^M) / norm(x)) % x:real^M`) THEN
12510   ANTS_TAC THENL
12511    [ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
12512     ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN ASM_MESON_TAC[subspace];
12513     ALL_TAC] THEN
12514   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_CMUL th]) THEN
12515   ASM_REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; real_ge] THEN
12516   ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; NORM_POS_LT] THEN
12517   REWRITE_TAC[real_div; REAL_MUL_AC]);;
12518
12519 let CLOSED_INJECTIVE_IMAGE_SUBSPACE = prove
12520  (`!f s. subspace s /\
12521          linear f /\
12522          (!x. x IN s /\ f(x) = vec 0 ==> x = vec 0) /\
12523          closed s
12524          ==> closed(IMAGE f s)`,
12525   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM COMPLETE_EQ_CLOSED] THEN
12526   MATCH_MP_TAC COMPLETE_ISOMETRIC_IMAGE THEN
12527   ASM_REWRITE_TAC[COMPLETE_EQ_CLOSED] THEN
12528   MATCH_MP_TAC INJECTIVE_IMP_ISOMETRIC THEN
12529   ASM_REWRITE_TAC[]);;
12530
12531 (* ------------------------------------------------------------------------- *)
12532 (* Relating linear images to open/closed/interior/closure.                   *)
12533 (* ------------------------------------------------------------------------- *)
12534
12535 let OPEN_SURJECTIVE_LINEAR_IMAGE = prove
12536  (`!f:real^M->real^N.
12537         linear f /\ (!y. ?x. f x = y)
12538         ==> !s. open s ==> open(IMAGE f s)`,
12539   GEN_TAC THEN STRIP_TAC THEN
12540   REWRITE_TAC[open_def; FORALL_IN_IMAGE] THEN
12541   FIRST_ASSUM(MP_TAC o GEN `k:num` o SPEC `basis k:real^N`) THEN
12542   REWRITE_TAC[SKOLEM_THM] THEN
12543   DISCH_THEN(X_CHOOSE_THEN `b:num->real^M` STRIP_ASSUME_TAC) THEN
12544   SUBGOAL_THEN `bounded(IMAGE (b:num->real^M) (1..dimindex(:N)))` MP_TAC THENL
12545    [SIMP_TAC[FINITE_IMP_BOUNDED; FINITE_IMAGE; FINITE_NUMSEG]; ALL_TAC] THEN
12546   REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_NUMSEG] THEN
12547   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
12548   X_GEN_TAC `s:real^M->bool` THEN MATCH_MP_TAC MONO_FORALL THEN
12549   X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN s` THEN
12550   ASM_REWRITE_TAC[] THEN
12551   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
12552   EXISTS_TAC `e / B / &(dimindex(:N))` THEN
12553   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1] THEN
12554   X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE] THEN
12555   ABBREV_TAC `u = y - (f:real^M->real^N) x` THEN
12556   EXISTS_TAC `x + vsum(1..dimindex(:N)) (\i. (u:real^N)$i % b i):real^M` THEN
12557   ASM_SIMP_TAC[LINEAR_ADD; LINEAR_VSUM; FINITE_NUMSEG; o_DEF;
12558                LINEAR_CMUL; BASIS_EXPANSION] THEN
12559   CONJ_TAC THENL [EXPAND_TAC "u" THEN VECTOR_ARITH_TAC; ALL_TAC] THEN
12560   FIRST_X_ASSUM MATCH_MP_TAC THEN
12561   REWRITE_TAC[NORM_ARITH `dist(x + y,x) = norm y`] THEN
12562   MATCH_MP_TAC REAL_LET_TRANS THEN
12563   EXISTS_TAC `(dist(y,(f:real^M->real^N) x) * &(dimindex(:N))) * B` THEN
12564   ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1] THEN
12565   MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN REWRITE_TAC[FINITE_NUMSEG] THEN
12566   ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = b * a * c`] THEN
12567   GEN_REWRITE_TAC(RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN
12568   MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
12569   X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[NORM_MUL; dist] THEN
12570   MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS; NORM_POS_LE] THEN
12571   ASM_SIMP_TAC[COMPONENT_LE_NORM]);;
12572
12573 let OPEN_BIJECTIVE_LINEAR_IMAGE_EQ = prove
12574  (`!f:real^M->real^N s.
12575         linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
12576         ==> (open(IMAGE f s) <=> open s)`,
12577   REPEAT STRIP_TAC THEN EQ_TAC THENL
12578    [DISCH_TAC; ASM_MESON_TAC[OPEN_SURJECTIVE_LINEAR_IMAGE]] THEN
12579   SUBGOAL_THEN `s = {x | (f:real^M->real^N) x IN IMAGE f s}`
12580   SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
12581   MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE_UNIV THEN
12582   ASM_SIMP_TAC[LINEAR_CONTINUOUS_AT]);;
12583
12584 add_linear_invariants [OPEN_BIJECTIVE_LINEAR_IMAGE_EQ];;
12585
12586 let CLOSED_INJECTIVE_LINEAR_IMAGE = prove
12587  (`!f:real^M->real^N.
12588         linear f /\ (!x y. f x = f y ==> x = y)
12589         ==> !s. closed s ==> closed(IMAGE f s)`,
12590   REPEAT STRIP_TAC THEN
12591   MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN
12592   ASM_REWRITE_TAC[] THEN
12593   DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN
12594   MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN
12595   EXISTS_TAC `IMAGE (f:real^M->real^N) (:real^M)` THEN
12596   CONJ_TAC THENL
12597    [MP_TAC(ISPECL [`g:real^N->real^M`; `IMAGE (f:real^M->real^N) (:real^M)`;
12598                    `IMAGE (g:real^N->real^M) (IMAGE (f:real^M->real^N) s)`]
12599         CONTINUOUS_CLOSED_IN_PREIMAGE) THEN
12600     ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ANTS_TAC THENL
12601      [ASM_REWRITE_TAC[GSYM IMAGE_o; IMAGE_I]; ALL_TAC] THEN
12602     MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
12603     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN
12604     REWRITE_TAC[EXTENSION; o_THM; I_THM] THEN SET_TAC[];
12605     MATCH_MP_TAC CLOSED_INJECTIVE_IMAGE_SUBSPACE THEN
12606     ASM_REWRITE_TAC[IN_UNIV; SUBSPACE_UNIV; CLOSED_UNIV] THEN
12607     X_GEN_TAC `x:real^M` THEN
12608     DISCH_THEN(MP_TAC o AP_TERM `g:real^N->real^M`) THEN
12609     RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM; I_THM; o_THM]) THEN
12610     ASM_MESON_TAC[LINEAR_0]]);;
12611
12612 let CLOSED_INJECTIVE_LINEAR_IMAGE_EQ = prove
12613  (`!f:real^M->real^N s.
12614         linear f /\ (!x y. f x = f y ==> x = y)
12615         ==> (closed(IMAGE f s) <=> closed s)`,
12616   REPEAT STRIP_TAC THEN EQ_TAC THENL
12617    [DISCH_TAC; ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE]] THEN
12618   SUBGOAL_THEN `s = {x | (f:real^M->real^N) x IN IMAGE f s}`
12619   SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
12620   MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN
12621   ASM_SIMP_TAC[LINEAR_CONTINUOUS_AT]);;
12622
12623 add_linear_invariants [CLOSED_INJECTIVE_LINEAR_IMAGE_EQ];;
12624
12625 let CLOSURE_LINEAR_IMAGE_SUBSET = prove
12626  (`!f:real^M->real^N s.
12627         linear f ==> IMAGE f (closure s) SUBSET closure(IMAGE f s)`,
12628   REPEAT STRIP_TAC THEN
12629   MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN
12630   ASM_SIMP_TAC[CLOSED_CLOSURE; CLOSURE_SUBSET; LINEAR_CONTINUOUS_ON]);;
12631
12632 let CLOSURE_INJECTIVE_LINEAR_IMAGE  = prove
12633  (`!f:real^M->real^N s.
12634         linear f /\ (!x y. f x = f y ==> x = y)
12635         ==> closure(IMAGE f s) = IMAGE f (closure s)`,
12636   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
12637   ASM_SIMP_TAC[CLOSURE_LINEAR_IMAGE_SUBSET] THEN
12638   MATCH_MP_TAC CLOSURE_MINIMAL THEN
12639   SIMP_TAC[CLOSURE_SUBSET; IMAGE_SUBSET] THEN
12640   ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE; CLOSED_CLOSURE]);;
12641
12642 add_linear_invariants [CLOSURE_INJECTIVE_LINEAR_IMAGE];;
12643
12644 let CLOSURE_BOUNDED_LINEAR_IMAGE = prove
12645  (`!f:real^M->real^N s.
12646         linear f /\ bounded s
12647         ==> closure(IMAGE f s) = IMAGE f (closure s)`,
12648   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN
12649   ASM_SIMP_TAC[CLOSURE_LINEAR_IMAGE_SUBSET] THEN
12650   MATCH_MP_TAC CLOSURE_MINIMAL THEN
12651   SIMP_TAC[CLOSURE_SUBSET; IMAGE_SUBSET] THEN
12652   MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
12653   MATCH_MP_TAC COMPACT_LINEAR_IMAGE THEN
12654   ASM_REWRITE_TAC[COMPACT_CLOSURE]);;
12655
12656 let LINEAR_INTERIOR_IMAGE_SUBSET = prove
12657  (`!f:real^M->real^N s.
12658         linear f /\ (!x y. f x = f y ==> x = y)
12659        ==> interior(IMAGE f s) SUBSET IMAGE f (interior s)`,
12660   MESON_TAC[INTERIOR_IMAGE_SUBSET; LINEAR_CONTINUOUS_AT]);;
12661
12662 let LINEAR_IMAGE_SUBSET_INTERIOR = prove
12663  (`!f:real^M->real^N s.
12664         linear f /\ (!y. ?x. f x = y)
12665         ==> IMAGE f (interior s) SUBSET interior(IMAGE f s)`,
12666   REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_MAXIMAL THEN
12667   ASM_SIMP_TAC[OPEN_SURJECTIVE_LINEAR_IMAGE; OPEN_INTERIOR;
12668                IMAGE_SUBSET; INTERIOR_SUBSET]);;
12669
12670 let INTERIOR_BIJECTIVE_LINEAR_IMAGE = prove
12671  (`!f:real^M->real^N s.
12672         linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
12673         ==> interior(IMAGE f s) = IMAGE f (interior s)`,
12674   REWRITE_TAC[interior] THEN GEOM_TRANSFORM_TAC[]);;
12675
12676 add_linear_invariants [INTERIOR_BIJECTIVE_LINEAR_IMAGE];;
12677
12678 let FRONTIER_BIJECTIVE_LINEAR_IMAGE = prove
12679  (`!f:real^M->real^N s.
12680         linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y)
12681         ==> frontier(IMAGE f s) = IMAGE f (frontier s)`,
12682   REWRITE_TAC[frontier] THEN GEOM_TRANSFORM_TAC[]);;
12683
12684 add_linear_invariants [FRONTIER_BIJECTIVE_LINEAR_IMAGE];;
12685
12686 (* ------------------------------------------------------------------------- *)
12687 (* Corollaries, reformulations and special cases for M = N.                  *)
12688 (* ------------------------------------------------------------------------- *)
12689
12690 let IN_INTERIOR_LINEAR_IMAGE = prove
12691  (`!f:real^M->real^N g s x.
12692         linear f /\ linear g /\ (f o g = I) /\ x IN interior s
12693         ==> (f x) IN interior (IMAGE f s)`,
12694   REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN REPEAT STRIP_TAC THEN
12695   MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`]
12696     LINEAR_IMAGE_SUBSET_INTERIOR) THEN
12697   ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
12698   ASM_MESON_TAC[]);;
12699
12700 let LINEAR_OPEN_MAPPING = prove
12701  (`!f:real^M->real^N g.
12702         linear f /\ linear g /\ (f o g = I)
12703         ==> !s. open s ==> open(IMAGE f s)`,
12704   REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN DISCH_TAC THEN
12705   MATCH_MP_TAC OPEN_SURJECTIVE_LINEAR_IMAGE THEN
12706   ASM_MESON_TAC[]);;
12707
12708 let INTERIOR_INJECTIVE_LINEAR_IMAGE = prove
12709  (`!f:real^N->real^N s.
12710         linear f /\ (!x y. f x = f y ==> x = y)
12711         ==> interior(IMAGE f s) = IMAGE f (interior s)`,
12712   REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_BIJECTIVE_LINEAR_IMAGE THEN
12713   ASM_MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE]);;
12714
12715 let INTERIOR_SURJECTIVE_LINEAR_IMAGE = prove
12716  (`!f:real^N->real^N s.
12717         linear f /\ (!y. ?x. f x = y)
12718         ==> interior(IMAGE f s) = IMAGE f (interior s)`,
12719   REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_BIJECTIVE_LINEAR_IMAGE THEN
12720   ASM_MESON_TAC[LINEAR_SURJECTIVE_IMP_INJECTIVE]);;
12721
12722 let CLOSURE_SURJECTIVE_LINEAR_IMAGE = prove
12723  (`!f:real^N->real^N s.
12724         linear f /\ (!y. ?x. f x = y)
12725         ==> closure(IMAGE f s) = IMAGE f (closure s)`,
12726   REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_INJECTIVE_LINEAR_IMAGE THEN
12727   ASM_MESON_TAC[LINEAR_SURJECTIVE_IMP_INJECTIVE]);;
12728
12729 let FRONTIER_INJECTIVE_LINEAR_IMAGE = prove
12730  (`!f:real^N->real^N s.
12731         linear f /\ (!x y. f x = f y ==> x = y)
12732         ==> frontier(IMAGE f s) = IMAGE f (frontier s)`,
12733   REPEAT STRIP_TAC THEN MATCH_MP_TAC FRONTIER_BIJECTIVE_LINEAR_IMAGE THEN
12734   ASM_MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE]);;
12735
12736 let FRONTIER_SURJECTIVE_LINEAR_IMAGE = prove
12737  (`!f:real^N->real^N.
12738         linear f /\ (!y. ?x. f x = y)
12739         ==> frontier(IMAGE f s) = IMAGE f (frontier s)`,
12740   REPEAT STRIP_TAC THEN MATCH_MP_TAC FRONTIER_BIJECTIVE_LINEAR_IMAGE THEN
12741   ASM_MESON_TAC[LINEAR_SURJECTIVE_IMP_INJECTIVE]);;
12742
12743 let COMPLETE_INJECTIVE_LINEAR_IMAGE = prove
12744  (`!f:real^M->real^N.
12745         linear f /\ (!x y. f x = f y ==> x = y)
12746         ==> !s. complete s ==> complete(IMAGE f s)`,
12747   REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_INJECTIVE_LINEAR_IMAGE]);;
12748
12749 let COMPLETE_INJECTIVE_LINEAR_IMAGE_EQ = prove
12750  (`!f:real^M->real^N s.
12751         linear f /\ (!x y. f x = f y ==> x = y)
12752         ==> (complete(IMAGE f s) <=> complete s)`,
12753   REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_INJECTIVE_LINEAR_IMAGE_EQ]);;
12754
12755 add_linear_invariants [COMPLETE_INJECTIVE_LINEAR_IMAGE_EQ];;
12756
12757 let LIMPT_INJECTIVE_LINEAR_IMAGE_EQ = prove
12758  (`!f:real^M->real^N s.
12759         linear f /\ (!x y. f x = f y ==> x = y)
12760         ==> ((f x) limit_point_of (IMAGE f s) <=> x limit_point_of s)`,
12761   REWRITE_TAC[LIMPT_APPROACHABLE; EXISTS_IN_IMAGE] THEN
12762   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN
12763   DISCH_TAC THENL
12764    [MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_BOUNDED_BELOW_POS);
12765     MP_TAC(ISPEC `f:real^M->real^N` LINEAR_BOUNDED_POS)] THEN
12766   ASM_REWRITE_TAC[] THEN
12767   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THENL
12768    [FIRST_X_ASSUM(MP_TAC o SPEC `e * B:real`);
12769     FIRST_X_ASSUM(MP_TAC o SPEC `e / B:real`)] THEN
12770   ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; dist; GSYM LINEAR_SUB] THEN
12771   MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
12772   REPEAT(MATCH_MP_TAC MONO_AND THEN
12773          CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN
12774   ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ] THEN
12775   MATCH_MP_TAC(REAL_ARITH `a <= b ==> b < x ==> a < x`) THEN
12776   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ]);;
12777
12778 add_linear_invariants [LIMPT_INJECTIVE_LINEAR_IMAGE_EQ];;
12779
12780 let LIMPT_TRANSLATION_EQ = prove
12781  (`!a s x. (a + x) limit_point_of (IMAGE (\y. a + y) s) <=> x limit_point_of s`,
12782   REWRITE_TAC[limit_point_of] THEN GEOM_TRANSLATE_TAC[]);;
12783
12784 add_translation_invariants [LIMPT_TRANSLATION_EQ];;
12785
12786 let OPEN_OPEN_LEFT_PROJECTION = prove
12787  (`!s t:real^(M,N)finite_sum->bool.
12788         open s /\ open t ==> open {x | x IN s /\ ?y. pastecart x y IN t}`,
12789   REPEAT STRIP_TAC THEN
12790   SUBGOAL_THEN
12791    `{x | x IN s /\ ?y. (pastecart x y:real^(M,N)finite_sum) IN t} =
12792     s INTER IMAGE fstcart t`
12793   SUBST1_TAC THENL
12794    [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; IN_IMAGE] THEN
12795     MESON_TAC[FSTCART_PASTECART; PASTECART_FST_SND];
12796     MATCH_MP_TAC OPEN_INTER THEN ASM_REWRITE_TAC[] THEN
12797     MATCH_MP_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]
12798       OPEN_SURJECTIVE_LINEAR_IMAGE) THEN
12799     ASM_REWRITE_TAC[LINEAR_FSTCART] THEN MESON_TAC[FSTCART_PASTECART]]);;
12800
12801 let OPEN_OPEN_RIGHT_PROJECTION = prove
12802  (`!s t:real^(M,N)finite_sum->bool.
12803         open s /\ open t ==> open {y | y IN s /\ ?x. pastecart x y IN t}`,
12804   REPEAT STRIP_TAC THEN
12805   SUBGOAL_THEN
12806    `{y | y IN s /\ ?x. (pastecart x y:real^(M,N)finite_sum) IN t} =
12807     s INTER IMAGE sndcart t`
12808   SUBST1_TAC THENL
12809    [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; IN_IMAGE] THEN
12810     MESON_TAC[SNDCART_PASTECART; PASTECART_FST_SND];
12811     MATCH_MP_TAC OPEN_INTER THEN ASM_REWRITE_TAC[] THEN
12812     MATCH_MP_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]
12813       OPEN_SURJECTIVE_LINEAR_IMAGE) THEN
12814     ASM_REWRITE_TAC[LINEAR_SNDCART] THEN MESON_TAC[SNDCART_PASTECART]]);;
12815
12816 (* ------------------------------------------------------------------------- *)
12817 (* Even more special cases.                                                  *)
12818 (* ------------------------------------------------------------------------- *)
12819
12820 let INTERIOR_NEGATIONS = prove
12821  (`!s. interior(IMAGE (--) s) = IMAGE (--) (interior s)`,
12822   GEN_TAC THEN MATCH_MP_TAC INTERIOR_INJECTIVE_LINEAR_IMAGE THEN
12823   REWRITE_TAC[linear] THEN REPEAT CONJ_TAC THEN VECTOR_ARITH_TAC);;
12824
12825 let SYMMETRIC_INTERIOR = prove
12826  (`!s:real^N->bool.
12827         (!x. x IN s ==> --x IN s)
12828         ==> !x. x IN interior s ==> (--x) IN interior s`,
12829   REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN
12830   DISCH_THEN(MP_TAC o MATCH_MP(ISPEC `(--):real^N->real^N` FUN_IN_IMAGE)) THEN
12831   REWRITE_TAC[GSYM INTERIOR_NEGATIONS] THEN
12832   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
12833   REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ASM_MESON_TAC[VECTOR_NEG_NEG]);;
12834
12835 let CLOSURE_NEGATIONS = prove
12836  (`!s. closure(IMAGE (--) s) = IMAGE (--) (closure s)`,
12837   GEN_TAC THEN MATCH_MP_TAC CLOSURE_INJECTIVE_LINEAR_IMAGE THEN
12838   REWRITE_TAC[linear] THEN REPEAT CONJ_TAC THEN VECTOR_ARITH_TAC);;
12839
12840 let SYMMETRIC_CLOSURE = prove
12841  (`!s:real^N->bool.
12842         (!x. x IN s ==> --x IN s)
12843         ==> !x. x IN closure s ==> (--x) IN closure s`,
12844   REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN
12845   DISCH_THEN(MP_TAC o MATCH_MP(ISPEC `(--):real^N->real^N` FUN_IN_IMAGE)) THEN
12846   REWRITE_TAC[GSYM CLOSURE_NEGATIONS] THEN
12847   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
12848   REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ASM_MESON_TAC[VECTOR_NEG_NEG]);;
12849
12850 (* ------------------------------------------------------------------------- *)
12851 (* Some properties of a canonical subspace.                                  *)
12852 (* ------------------------------------------------------------------------- *)
12853
12854 let SUBSPACE_SUBSTANDARD = prove
12855  (`!d. subspace
12856          {x:real^N | !i. d < i /\ i <= dimindex(:N) ==> x$i = &0}`,
12857   GEN_TAC THEN ASM_CASES_TAC `d <= dimindex(:N)` THENL
12858    [MP_TAC(ARITH_RULE `!i. d < i ==> 1 <= i`) THEN
12859     SIMP_TAC[subspace; IN_ELIM_THM; REAL_MUL_RZERO; REAL_ADD_LID;
12860              VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT];
12861     ASM_SIMP_TAC[ARITH_RULE `~(d:num <= e) ==> (d < i /\ i <= e <=> F)`] THEN
12862     REWRITE_TAC[SET_RULE `{x | T} = UNIV`; SUBSPACE_UNIV]]);;
12863
12864 let CLOSED_SUBSTANDARD = prove
12865  (`!d. closed
12866         {x:real^N | !i. d < i /\ i <= dimindex(:N) ==> x$i = &0}`,
12867   GEN_TAC THEN
12868   SUBGOAL_THEN
12869    `{x:real^N | !i. d < i /\ i <= dimindex(:N) ==> x$i = &0} =
12870     INTERS {{x | basis i dot x = &0} | d < i /\ i <= dimindex(:N)}`
12871   SUBST1_TAC THENL
12872    [ALL_TAC;
12873     SIMP_TAC[CLOSED_INTERS; CLOSED_HYPERPLANE; IN_ELIM_THM;
12874              LEFT_IMP_EXISTS_THM]] THEN
12875   GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_INTERS; IN_ELIM_THM] THEN
12876   SIMP_TAC[LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN
12877   MP_TAC(ARITH_RULE `!i. d < i ==> 1 <= i`) THEN
12878   SIMP_TAC[DOT_BASIS] THEN MESON_TAC[]);;
12879
12880 let DIM_SUBSTANDARD = prove
12881  (`!d. d <= dimindex(:N)
12882        ==> (dim {x:real^N | !i. d < i /\ i <= dimindex(:N)
12883                                 ==> x$i = &0} =
12884             d)`,
12885   REPEAT STRIP_TAC THEN MATCH_MP_TAC DIM_UNIQUE THEN
12886   EXISTS_TAC `IMAGE (basis:num->real^N) (1..d)` THEN REPEAT CONJ_TAC THENL
12887    [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_NUMSEG] THEN
12888     MESON_TAC[BASIS_COMPONENT; ARITH_RULE `d < i ==> 1 <= i`; NOT_LT];
12889     ALL_TAC;
12890     MATCH_MP_TAC INDEPENDENT_MONO THEN
12891     EXISTS_TAC `{basis i :real^N | 1 <= i /\ i <= dimindex(:N)}` THEN
12892     REWRITE_TAC[INDEPENDENT_STDBASIS]THEN
12893     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_NUMSEG] THEN
12894     ASM_MESON_TAC[LE_TRANS];
12895     MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN REWRITE_TAC[HAS_SIZE_NUMSEG_1] THEN
12896     REWRITE_TAC[IN_NUMSEG] THEN ASM_MESON_TAC[LE_TRANS; BASIS_INJ]] THEN
12897   POP_ASSUM MP_TAC THEN SPEC_TAC(`d:num`,`d:num`) THEN
12898   INDUCT_TAC THENL
12899    [REWRITE_TAC[ARITH_RULE `0 < i <=> 1 <= i`; SPAN_STDBASIS] THEN
12900     SUBGOAL_THEN `IMAGE basis (1 .. 0) :real^N->bool = {}` SUBST1_TAC THENL
12901      [REWRITE_TAC[IMAGE_EQ_EMPTY; NUMSEG_EMPTY; ARITH]; ALL_TAC] THEN
12902     DISCH_TAC THEN REWRITE_TAC[SPAN_EMPTY; SUBSET; IN_ELIM_THM; IN_SING] THEN
12903     SIMP_TAC[CART_EQ; VEC_COMPONENT];
12904     ALL_TAC] THEN
12905   DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN
12906   ASM_SIMP_TAC[ARITH_RULE `SUC d <= n ==> d <= n`] THEN
12907   REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_TAC THEN
12908   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
12909   FIRST_X_ASSUM(MP_TAC o SPEC `x - (x$(SUC d)) % basis(SUC d) :real^N`) THEN
12910   ANTS_TAC THENL
12911    [X_GEN_TAC `i:num` THEN STRIP_TAC THEN
12912     FIRST_ASSUM(ASSUME_TAC o MATCH_MP(ARITH_RULE `d < i ==> 1 <= i`)) THEN
12913     ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN
12914     ASM_SIMP_TAC[BASIS_COMPONENT] THEN COND_CASES_TAC THEN
12915     ASM_REWRITE_TAC[REAL_MUL_RID; REAL_SUB_REFL] THEN
12916     ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO] THEN
12917     ASM_MESON_TAC[ARITH_RULE `d < i /\ ~(i = SUC d) ==> SUC d < i`];
12918     ALL_TAC] THEN
12919   DISCH_TAC THEN
12920   SUBST1_TAC(VECTOR_ARITH
12921    `x = (x - (x$(SUC d)) % basis(SUC d)) +
12922         x$(SUC d) % basis(SUC d) :real^N`) THEN
12923   MATCH_MP_TAC SPAN_ADD THEN CONJ_TAC THENL
12924    [ASM_MESON_TAC[SPAN_MONO; SUBSET_IMAGE; SUBSET; SUBSET_NUMSEG; LE_REFL; LE];
12925     MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN
12926     REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN
12927     MESON_TAC[LE_REFL; ARITH_RULE `1 <= SUC d`]]);;
12928
12929 (* ------------------------------------------------------------------------- *)
12930 (* Hence closure and completeness of all subspaces.                          *)
12931 (* ------------------------------------------------------------------------- *)
12932
12933 let CLOSED_SUBSPACE = prove
12934  (`!s:real^N->bool. subspace s ==> closed s`,
12935   REPEAT STRIP_TAC THEN ABBREV_TAC `d = dim(s:real^N->bool)` THEN
12936   MP_TAC(MATCH_MP DIM_SUBSTANDARD
12937     (ISPEC `s:real^N->bool` DIM_SUBSET_UNIV)) THEN
12938   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
12939   MP_TAC(ISPECL
12940    [`{x:real^N | !i. d < i /\ i <= dimindex(:N)
12941                                 ==> x$i = &0}`;
12942     `s:real^N->bool`] SUBSPACE_ISOMORPHISM) THEN
12943   ASM_REWRITE_TAC[SUBSPACE_SUBSTANDARD] THEN
12944   DISCH_THEN(X_CHOOSE_THEN `f:real^N->real^N` MP_TAC) THEN
12945   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
12946   DISCH_THEN(CONJUNCTS_THEN2 (SUBST_ALL_TAC o SYM) STRIP_ASSUME_TAC) THEN
12947   MATCH_MP_TAC(ISPEC `f:real^N->real^N` CLOSED_INJECTIVE_IMAGE_SUBSPACE) THEN
12948   ASM_REWRITE_TAC[SUBSPACE_SUBSTANDARD; CLOSED_SUBSTANDARD] THEN
12949   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
12950   ASM_REWRITE_TAC[] THEN
12951   CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LINEAR_0]] THEN
12952   REWRITE_TAC[IN_ELIM_THM] THEN
12953   ASM_MESON_TAC[VEC_COMPONENT; ARITH_RULE `d < i ==> 1 <= i`]);;
12954
12955 let COMPLETE_SUBSPACE = prove
12956  (`!s:real^N->bool. subspace s ==> complete s`,
12957   REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_SUBSPACE]);;
12958
12959 let CLOSED_SPAN = prove
12960  (`!s. closed(span s)`,
12961   SIMP_TAC[CLOSED_SUBSPACE; SUBSPACE_SPAN]);;
12962
12963 let DIM_CLOSURE = prove
12964  (`!s:real^N->bool. dim(closure s) = dim s`,
12965   GEN_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THENL
12966    [GEN_REWRITE_TAC RAND_CONV [GSYM DIM_SPAN]; ALL_TAC] THEN
12967   MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[CLOSURE_SUBSET] THEN
12968   MATCH_MP_TAC CLOSURE_MINIMAL THEN
12969   SIMP_TAC[CLOSED_SUBSPACE; SUBSPACE_SPAN; SPAN_INC]);;
12970
12971 let CLOSED_BOUNDEDPREIM_CONTINUOUS_IMAGE = prove
12972  (`!f:real^M->real^N s.
12973       closed s /\ f continuous_on s /\
12974       (!e. bounded {x | x IN s /\ norm(f x) <= e})
12975       ==> closed(IMAGE f s)`,
12976   REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSED_INTERS_COMPACT] THEN
12977   REWRITE_TAC[SET_RULE
12978    `cball(vec 0,e) INTER IMAGE (f:real^M->real^N) s =
12979     IMAGE f (s INTER {x | x IN s /\ f x IN cball(vec 0,e)})`] THEN
12980   X_GEN_TAC `e:real` THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
12981   CONJ_TAC THENL
12982    [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN
12983     ASM_REWRITE_TAC[] THEN SET_TAC[];
12984     MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_REWRITE_TAC[] THEN
12985     REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL
12986      [ASM_REWRITE_TAC[IN_CBALL_0];
12987       ASM_SIMP_TAC[CONTINUOUS_CLOSED_PREIMAGE; CLOSED_CBALL]]]);;
12988
12989 let CLOSED_INJECTIVE_IMAGE_SUBSET_SUBSPACE = prove
12990  (`!f:real^M->real^N s t.
12991         closed s /\ s SUBSET t /\ subspace t /\
12992         linear f /\
12993         (!x. x IN t /\ f(x) = vec 0 ==> x = vec 0)
12994         ==> closed(IMAGE f s)`,
12995   REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_BOUNDEDPREIM_CONTINUOUS_IMAGE THEN
12996   ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN
12997   MP_TAC(ISPECL [`f:real^M->real^N`; `t:real^M->bool`]
12998     INJECTIVE_IMP_ISOMETRIC) THEN
12999   ASM_SIMP_TAC[CLOSED_SUBSPACE; real_ge] THEN
13000   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
13001   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
13002   X_GEN_TAC `e:real` THEN MATCH_MP_TAC BOUNDED_SUBSET THEN
13003   EXISTS_TAC `cball(vec 0:real^M,e / B)` THEN
13004   REWRITE_TAC[BOUNDED_CBALL] THEN
13005   ASM_SIMP_TAC[SUBSET; IN_ELIM_THM; IN_CBALL_0; REAL_LE_RDIV_EQ] THEN
13006   ASM_MESON_TAC[SUBSET; REAL_LE_TRANS]);;
13007
13008 let BASIS_COORDINATES_LIPSCHITZ = prove
13009  (`!b:real^N->bool.
13010         independent b
13011         ==> ?B. &0 < B /\
13012                 !c v. v IN b
13013                       ==> abs(c v) <= B * norm(vsum b (\v. c(v) % v))`,
13014   X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN
13015   FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP INDEPENDENT_BOUND) THEN
13016   FIRST_ASSUM(X_CHOOSE_THEN `b:num->real^N` STRIP_ASSUME_TAC o
13017         GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN
13018   ABBREV_TAC `n = CARD(k:real^N->bool)` THEN
13019   MP_TAC(ISPECL
13020    [`(\x. vsum(1..n) (\i. x$i % b i)):real^N->real^N`;
13021     `span(IMAGE basis (1..n)):real^N->bool`]
13022         INJECTIVE_IMP_ISOMETRIC) THEN
13023   REWRITE_TAC[SUBSPACE_SPAN] THEN ANTS_TAC THENL
13024    [CONJ_TAC THENL [SIMP_TAC[CLOSED_SUBSPACE; SUBSPACE_SPAN]; ALL_TAC] THEN
13025     CONJ_TAC THENL
13026      [MATCH_MP_TAC LINEAR_COMPOSE_VSUM THEN
13027       REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN
13028       MATCH_MP_TAC LINEAR_VMUL_COMPONENT THEN
13029       SIMP_TAC[LINEAR_ID] THEN ASM_ARITH_TAC;
13030       ALL_TAC] THEN
13031     X_GEN_TAC `x:real^N` THEN
13032     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
13033     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SPAN_IMAGE_BASIS]) THEN
13034     REWRITE_TAC[IN_NUMSEG] THEN DISCH_TAC THEN
13035     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN
13036     DISCH_THEN(X_CHOOSE_TAC `c:real^N->num`) THEN
13037     SUBGOAL_THEN
13038      `vsum(1..n) (\i. (x:real^N)$i % b i:real^N) = vsum k (\v. x$(c v) % v)`
13039     SUBST1_TAC THENL
13040      [MATCH_MP_TAC VSUM_EQ_GENERAL_INVERSES THEN
13041       MAP_EVERY EXISTS_TAC [`b:num->real^N`; `c:real^N->num`] THEN
13042       ASM SET_TAC[];
13043       ALL_TAC] THEN
13044     DISCH_TAC THEN
13045     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INDEPENDENT_EXPLICIT]) THEN
13046     DISCH_THEN(MP_TAC o SPEC `\v:real^N. (x:real^N)$(c v)` o CONJUNCT2) THEN
13047     ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
13048     REWRITE_TAC[CART_EQ; FORALL_IN_IMAGE; VEC_COMPONENT] THEN
13049     ASM_MESON_TAC[IN_NUMSEG];
13050     ALL_TAC] THEN
13051   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
13052   EXISTS_TAC `inv(B:real)` THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN
13053   ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN
13054   MAP_EVERY X_GEN_TAC [`c:real^N->real`; `j:num`] THEN STRIP_TAC THEN
13055   ONCE_REWRITE_TAC[REAL_ARITH `inv B * x = x / B`] THEN
13056   ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN
13057   W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o rand o rand o snd) THEN
13058   ASM_REWRITE_TAC[FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN
13059   FIRST_X_ASSUM(MP_TAC o SPEC
13060    `(lambda i. if 1 <= i /\ i <= n then c(b i:real^N) else &0):real^N`) THEN
13061   SIMP_TAC[IN_SPAN_IMAGE_BASIS; LAMBDA_BETA] THEN
13062   ANTS_TAC THENL [MESON_TAC[IN_NUMSEG]; ALL_TAC] THEN
13063   MATCH_MP_TAC(REAL_ARITH `x = v /\ u <= y ==> x >= y ==> u <= v`) THEN
13064   CONJ_TAC THENL
13065    [AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ_NUMSEG THEN
13066     SUBGOAL_THEN `!i. i <= n ==> i <= dimindex(:N)` MP_TAC THENL
13067      [ASM_ARITH_TAC; SIMP_TAC[LAMBDA_BETA] THEN DISCH_THEN(K ALL_TAC)] THEN
13068     REWRITE_TAC[o_THM];
13069     GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
13070     ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN
13071     MP_TAC(ISPECL
13072      [`(lambda i. if 1 <= i /\ i <= n then c(b i:real^N) else &0):real^N`;
13073       `j:num`] COMPONENT_LE_NORM) THEN
13074     SUBGOAL_THEN `1 <= j /\ j <= dimindex(:N)` MP_TAC THENL
13075      [ASM_ARITH_TAC; SIMP_TAC[LAMBDA_BETA] THEN ASM_REWRITE_TAC[]]]);;
13076
13077 let BASIS_COORDINATES_CONTINUOUS = prove
13078  (`!b:real^N->bool e.
13079         independent b /\ &0 < e
13080         ==> ?d. &0 < d /\
13081                 !c. norm(vsum b (\v. c(v) % v)) < d
13082                     ==> !v. v IN b ==> abs(c v) < e`,
13083   REPEAT STRIP_TAC THEN
13084   FIRST_X_ASSUM(MP_TAC o MATCH_MP BASIS_COORDINATES_LIPSCHITZ) THEN
13085   DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
13086   EXISTS_TAC `e / B:real` THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN
13087   X_GEN_TAC `c:real^N->real` THEN DISCH_TAC THEN
13088   X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN
13089   MATCH_MP_TAC REAL_LET_TRANS THEN
13090   EXISTS_TAC `B * norm(vsum b (\v:real^N. c v % v))` THEN
13091   ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
13092   ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ]);;
13093
13094 (* ------------------------------------------------------------------------- *)
13095 (* Affine transformations of intervals.                                      *)
13096 (* ------------------------------------------------------------------------- *)
13097
13098 let AFFINITY_INVERSES = prove
13099  (`!m c. ~(m = &0)
13100          ==> (\x. m % x + c) o (\x. inv(m) % x + (--(inv(m) % c))) = I /\
13101              (\x. inv(m) % x + (--(inv(m) % c))) o (\x. m % x + c) = I`,
13102   REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN
13103   REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_RNEG] THEN
13104   SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RINV] THEN
13105   REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);;
13106
13107 let REAL_AFFINITY_LE = prove
13108  (`!m c x y. &0 < m ==> (m * x + c <= y <=> x <= inv(m) * y + --(c / m))`,
13109   REWRITE_TAC[REAL_ARITH `m * x + c <= y <=> x * m <= y - c`] THEN
13110   SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN REAL_ARITH_TAC);;
13111
13112 let REAL_LE_AFFINITY = prove
13113  (`!m c x y. &0 < m ==> (y <= m * x + c <=> inv(m) * y + --(c / m) <= x)`,
13114   REWRITE_TAC[REAL_ARITH `y <= m * x + c <=> y - c <= x * m`] THEN
13115   SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN REAL_ARITH_TAC);;
13116
13117 let REAL_AFFINITY_LT = prove
13118  (`!m c x y. &0 < m ==> (m * x + c < y <=> x < inv(m) * y + --(c / m))`,
13119   SIMP_TAC[REAL_LE_AFFINITY; GSYM REAL_NOT_LE]);;
13120
13121 let REAL_LT_AFFINITY = prove
13122  (`!m c x y. &0 < m ==> (y < m * x + c <=> inv(m) * y + --(c / m) < x)`,
13123   SIMP_TAC[REAL_AFFINITY_LE; GSYM REAL_NOT_LE]);;
13124
13125 let REAL_AFFINITY_EQ = prove
13126  (`!m c x y. ~(m = &0) ==> (m * x + c = y <=> x = inv(m) * y + --(c / m))`,
13127   CONV_TAC REAL_FIELD);;
13128
13129 let REAL_EQ_AFFINITY = prove
13130  (`!m c x y. ~(m = &0) ==> (y = m * x + c  <=> inv(m) * y + --(c / m) = x)`,
13131   CONV_TAC REAL_FIELD);;
13132
13133 let VECTOR_AFFINITY_EQ = prove
13134  (`!m c x y. ~(m = &0)
13135              ==> (m % x + c = y <=> x = inv(m) % y + --(inv(m) % c))`,
13136   SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
13137            real_div; VECTOR_NEG_COMPONENT; REAL_AFFINITY_EQ] THEN
13138   REWRITE_TAC[REAL_MUL_AC]);;
13139
13140 let VECTOR_EQ_AFFINITY = prove
13141  (`!m c x y. ~(m = &0)
13142              ==> (y = m % x + c <=> inv(m) % y + --(inv(m) % c) = x)`,
13143   SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
13144            real_div; VECTOR_NEG_COMPONENT; REAL_EQ_AFFINITY] THEN
13145   REWRITE_TAC[REAL_MUL_AC]);;
13146
13147 let IMAGE_AFFINITY_INTERVAL = prove
13148  (`!a b:real^N m c.
13149         IMAGE (\x. m % x + c) (interval[a,b]) =
13150             if interval[a,b] = {} then {}
13151             else if &0 <= m then interval[m % a + c,m % b + c]
13152             else interval[m % b + c,m % a + c]`,
13153   REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IMAGE_CLAUSES] THEN
13154   ASM_CASES_TAC `m = &0` THEN ASM_REWRITE_TAC[REAL_LE_LT] THENL
13155    [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID; COND_ID] THEN
13156     REWRITE_TAC[INTERVAL_SING] THEN ASM SET_TAC[];
13157     ALL_TAC] THEN
13158   FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH
13159    `~(x = &0) ==> &0 < x \/ &0 < --x`)) THEN
13160   ASM_SIMP_TAC[EXTENSION; IN_IMAGE; REAL_ARITH `&0 < --x ==> ~(&0 < x)`] THENL
13161    [ALL_TAC;
13162     ONCE_REWRITE_TAC[VECTOR_ARITH `x = m % y + c <=> c = (--m) % y + x`]] THEN
13163   ASM_SIMP_TAC[VECTOR_EQ_AFFINITY; REAL_LT_IMP_NZ; UNWIND_THM1] THEN
13164   SIMP_TAC[IN_INTERVAL; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
13165            VECTOR_NEG_COMPONENT] THEN
13166   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_LT_INV_EQ]) THEN
13167   SIMP_TAC[REAL_AFFINITY_LE; REAL_LE_AFFINITY; real_div] THEN
13168   DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[REAL_INV_INV] THEN
13169   REWRITE_TAC[REAL_MUL_LNEG; REAL_NEGNEG] THEN
13170   ASM_SIMP_TAC[REAL_FIELD `&0 < m ==> (inv m * x) * m = x`] THEN
13171   GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC);;
13172
13173 (* ------------------------------------------------------------------------- *)
13174 (* Existence of eigenvectors. The proof is only in this file because it uses *)
13175 (* a few simple results about continuous functions (at least                 *)
13176 (* CONTINUOUS_ON_LIFT_DOT2, CONTINUOUS_ATTAINS_SUP and CLOSED_SUBSPACE).     *)
13177 (* ------------------------------------------------------------------------- *)
13178
13179 let SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE = prove
13180  (`!f:real^N->real^N s.
13181         linear f /\ adjoint f = f /\
13182         subspace s /\ ~(s = {vec 0}) /\ (!x. x IN s ==> f x IN s)
13183         ==> ?v c. v IN s /\ norm(v) = &1 /\ f(v) = c % v`,
13184   let lemma = prove
13185    (`!a b. (!x. a * x <= b * x pow 2) ==> &0 <= b ==> a = &0`,
13186     REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN
13187     ASM_CASES_TAC `b = &0` THEN ASM_REWRITE_TAC[] THENL
13188      [FIRST_X_ASSUM(fun t -> MP_TAC(SPEC `&1` t) THEN
13189         MP_TAC(SPEC `-- &1` t)) THEN ASM_REAL_ARITH_TAC;
13190       DISCH_TAC THEN  FIRST_X_ASSUM(MP_TAC o SPEC `a / &2 / b`) THEN
13191       ASM_SIMP_TAC[REAL_FIELD
13192        `&0 < b ==> (b * (a / b) pow 2) = a pow 2 / b`] THEN
13193       REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN SIMP_TAC[GSYM real_div] THEN
13194       ASM_SIMP_TAC[REAL_LE_DIV2_EQ] THEN
13195       REWRITE_TAC[REAL_LT_SQUARE; REAL_ARITH
13196         `(a * a) / &2 <= (a / &2) pow 2 <=> ~(&0 < a * a)`]]) in
13197   REPEAT STRIP_TAC THEN
13198   MP_TAC(ISPECL [`\x:real^N. (f x) dot x`;
13199                  `s INTER sphere(vec 0:real^N,&1)`]
13200         CONTINUOUS_ATTAINS_SUP) THEN
13201   REWRITE_TAC[EXISTS_IN_GSPEC; FORALL_IN_GSPEC; o_DEF] THEN ANTS_TAC THENL
13202    [ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_DOT2; LINEAR_CONTINUOUS_ON;
13203                    CONTINUOUS_ON_ID] THEN
13204     ASM_SIMP_TAC[COMPACT_SPHERE; CLOSED_INTER_COMPACT; CLOSED_SUBSPACE] THEN
13205     FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE
13206       `~(s = {a}) ==> a IN s ==> ?b. ~(b = a) /\ b IN s`)) THEN
13207     ASM_SIMP_TAC[SUBSPACE_0; IN_SPHERE_0; GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
13208     DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN
13209     EXISTS_TAC `inv(norm x) % x:real^N` THEN
13210     ASM_REWRITE_TAC[IN_ELIM_THM; VECTOR_SUB_RZERO; NORM_MUL] THEN
13211     ASM_SIMP_TAC[SUBSPACE_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN
13212     ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0];
13213     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N` THEN
13214     REWRITE_TAC[IN_INTER; IN_SPHERE_0] THEN STRIP_TAC THEN
13215     ABBREV_TAC `c = (f:real^N->real^N) v dot v` THEN
13216     EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[]] THEN
13217   ABBREV_TAC `p = \x y:real^N. c * (x dot y) - (f x) dot y` THEN
13218   SUBGOAL_THEN `!x:real^N. x IN s ==> &0 <= p x x` (LABEL_TAC "POSDEF") THENL
13219    [X_GEN_TAC `x:real^N` THEN EXPAND_TAC "p" THEN REWRITE_TAC[] THEN
13220     ASM_CASES_TAC `x:real^N = vec 0` THEN DISCH_TAC THEN
13221     ASM_REWRITE_TAC[DOT_RZERO; REAL_MUL_RZERO; REAL_SUB_LE; REAL_LE_REFL] THEN
13222     FIRST_X_ASSUM(MP_TAC o SPEC `inv(norm x) % x:real^N`) THEN
13223     ASM_SIMP_TAC[SUBSPACE_MUL] THEN
13224     ASM_SIMP_TAC[LINEAR_CMUL; NORM_MUL; REAL_ABS_INV; DOT_RMUL] THEN
13225     ASM_SIMP_TAC[REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0; DOT_LMUL] THEN
13226     ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; DOT_POS_LT] THEN
13227     REWRITE_TAC[GSYM NORM_POW_2; real_div; REAL_INV_POW] THEN REAL_ARITH_TAC;
13228     ALL_TAC] THEN
13229   SUBGOAL_THEN `!y:real^N. y IN s ==> !a. p v y * a <= p y y * a pow 2`
13230   MP_TAC THENL
13231    [REPEAT STRIP_TAC THEN
13232     REMOVE_THEN "POSDEF" (MP_TAC o SPEC `v - (&2 * a) % y:real^N`) THEN
13233     EXPAND_TAC "p" THEN ASM_SIMP_TAC[SUBSPACE_SUB; SUBSPACE_MUL] THEN
13234     ASM_SIMP_TAC[LINEAR_SUB; LINEAR_CMUL] THEN
13235     REWRITE_TAC[DOT_LSUB; DOT_LMUL] THEN
13236     REWRITE_TAC[DOT_RSUB; DOT_RMUL] THEN
13237     SUBGOAL_THEN `f y dot (v:real^N) = f v dot y` SUBST1_TAC THENL
13238      [ASM_MESON_TAC[ADJOINT_CLAUSES; DOT_SYM]; ALL_TAC] THEN
13239     ASM_REWRITE_TAC[GSYM NORM_POW_2] THEN REWRITE_TAC[NORM_POW_2] THEN
13240     MATCH_MP_TAC(REAL_ARITH
13241         `&4 * (z - y) = x ==> &0 <= x ==> y <= z`) THEN
13242     REWRITE_TAC[DOT_SYM] THEN CONV_TAC REAL_RING;
13243     DISCH_THEN(MP_TAC o GEN `y:real^N` o DISCH `(y:real^N) IN s` o
13244       MATCH_MP lemma o C MP (ASSUME `(y:real^N) IN s`) o SPEC `y:real^N`) THEN
13245     ASM_SIMP_TAC[] THEN EXPAND_TAC "p" THEN
13246     REWRITE_TAC[GSYM DOT_LMUL; GSYM DOT_LSUB] THEN
13247     DISCH_THEN(MP_TAC o SPEC `c % v - f v:real^N`) THEN
13248     ASM_SIMP_TAC[SUBSPACE_MUL; SUBSPACE_SUB; DOT_EQ_0; VECTOR_SUB_EQ]]);;
13249
13250 let SELF_ADJOINT_HAS_EIGENVECTOR = prove
13251  (`!f:real^N->real^N.
13252         linear f /\ adjoint f = f ==> ?v c. norm(v) = &1 /\ f(v) = c % v`,
13253   REPEAT STRIP_TAC THEN
13254   MP_TAC(ISPECL [`f:real^N->real^N`; `(:real^N)`]
13255         SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE) THEN
13256   ASM_REWRITE_TAC[SUBSPACE_UNIV; IN_UNIV] THEN DISCH_THEN MATCH_MP_TAC THEN
13257   MATCH_MP_TAC(SET_RULE `!a. ~(a IN s) ==> ~(UNIV = s)`) THEN
13258   EXISTS_TAC `vec 1:real^N` THEN
13259   REWRITE_TAC[IN_SING; VEC_EQ; ARITH_EQ]);;
13260
13261 let SELF_ADJOINT_HAS_EIGENVECTOR_BASIS_OF_SUBSPACE = prove
13262  (`!f:real^N->real^N s.
13263         linear f /\ adjoint f = f /\
13264         subspace s /\ (!x. x IN s ==> f x IN s)
13265         ==> ?b. b SUBSET s /\
13266                 pairwise orthogonal b /\
13267                 (!x. x IN b ==> norm x = &1 /\ ?c. f(x) = c % x) /\
13268                 independent b /\
13269                 span b = s /\
13270                 b HAS_SIZE dim s`,
13271   let lemma = prove
13272    (`!f:real^N->real^N s.
13273           linear f /\ adjoint f = f /\ subspace s /\ (!x. x IN s ==> f x IN s)
13274           ==> ?b. b SUBSET s /\ b HAS_SIZE dim s /\
13275                   pairwise orthogonal b /\
13276                   (!x. x IN b ==> norm x = &1 /\ ?c. f(x) = c % x)`,
13277     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP] THEN
13278     GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN
13279     WF_INDUCT_TAC `dim(s:real^N->bool)` THEN STRIP_TAC THEN
13280     ASM_CASES_TAC `dim(s:real^N->bool) = 0` THENL
13281      [EXISTS_TAC `{}:real^N->bool` THEN
13282       ASM_SIMP_TAC[HAS_SIZE_CLAUSES; NOT_IN_EMPTY;
13283                    PAIRWISE_EMPTY; EMPTY_SUBSET];
13284       ALL_TAC] THEN
13285     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [DIM_EQ_0]) THEN
13286     DISCH_THEN(ASSUME_TAC o MATCH_MP (SET_RULE
13287      `~(s SUBSET {a}) ==> ~(s = {a})`)) THEN
13288     MP_TAC(ISPECL [`f:real^N->real^N`; `s:real^N->bool`]
13289       SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE) THEN
13290     ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
13291     DISCH_THEN(X_CHOOSE_THEN `v:real^N` MP_TAC) THEN
13292     ASM_CASES_TAC `v:real^N = vec 0` THEN ASM_REWRITE_TAC[NORM_0] THEN
13293     CONV_TAC REAL_RAT_REDUCE_CONV THEN
13294     DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
13295     FIRST_X_ASSUM(MP_TAC o SPEC `{y:real^N | y IN s /\ orthogonal v y}`) THEN
13296     REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTOR; IN_ELIM_THM] THEN
13297     MP_TAC(ISPECL [`span {v:real^N}`; `s:real^N->bool`]
13298           DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS) THEN
13299     REWRITE_TAC[ONCE_REWRITE_RULE[ORTHOGONAL_SYM] ORTHOGONAL_TO_SPAN_EQ] THEN
13300     ASM_REWRITE_TAC[SUBSPACE_SPAN; IN_SING; FORALL_UNWIND_THM2] THEN
13301     ANTS_TAC THENL
13302      [MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN ASM SET_TAC[];
13303       DISCH_THEN(SUBST1_TAC o SYM)] THEN
13304     ASM_REWRITE_TAC[DIM_SPAN; DIM_SING; ARITH_RULE `n < n + 1`] THEN
13305     ANTS_TAC THENL
13306      [REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN
13307       ASM_SIMP_TAC[SUBSPACE_INTER; SUBSPACE_ORTHOGONAL_TO_VECTOR] THEN
13308       REWRITE_TAC[orthogonal] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
13309       MATCH_MP_TAC EQ_TRANS THEN
13310       EXISTS_TAC `(f:real^N->real^N) v dot x` THEN CONJ_TAC THENL
13311        [ASM_MESON_TAC[ADJOINT_CLAUSES];
13312         ASM_MESON_TAC[DOT_LMUL; REAL_MUL_RZERO]];
13313       DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN
13314       EXISTS_TAC `(v:real^N) INSERT b` THEN
13315       ASM_REWRITE_TAC[FORALL_IN_INSERT] THEN
13316       CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
13317       ASM_REWRITE_TAC[PAIRWISE_INSERT] THEN
13318       RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE; SUBSET; IN_ELIM_THM]) THEN
13319       CONJ_TAC THENL
13320        [ASM_SIMP_TAC[HAS_SIZE; FINITE_INSERT; CARD_CLAUSES] THEN
13321         COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD1] THEN
13322         ASM_MESON_TAC[ORTHOGONAL_REFL];
13323         RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_ELIM_THM]) THEN
13324         ASM_MESON_TAC[ORTHOGONAL_SYM]]]) in
13325   REPEAT STRIP_TAC THEN
13326   MP_TAC(ISPECL [`f:real^N->real^N`; `s:real^N->bool`] lemma) THEN
13327   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
13328   X_GEN_TAC `b:real^N->bool` THEN
13329   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
13330   MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
13331    [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN
13332     ASM_MESON_TAC[NORM_ARITH `~(norm(vec 0:real^N) = &1)`];
13333     DISCH_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
13334      [ASM_MESON_TAC[SPAN_SUBSET_SUBSPACE];
13335       MATCH_MP_TAC CARD_GE_DIM_INDEPENDENT THEN
13336       RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN
13337       ASM_REWRITE_TAC[LE_REFL]]]);;
13338
13339 let SELF_ADJOINT_HAS_EIGENVECTOR_BASIS = prove
13340  (`!f:real^N->real^N.
13341         linear f /\ adjoint f = f
13342         ==> ?b. pairwise orthogonal b /\
13343                 (!x. x IN b ==> norm x = &1 /\ ?c. f(x) = c % x) /\
13344                 independent b /\
13345                 span b = (:real^N) /\
13346                 b HAS_SIZE (dimindex(:N))`,
13347   REPEAT STRIP_TAC THEN
13348   MP_TAC(ISPECL [`f:real^N->real^N`; `(:real^N)`]
13349         SELF_ADJOINT_HAS_EIGENVECTOR_BASIS_OF_SUBSPACE) THEN
13350   ASM_REWRITE_TAC[SUBSPACE_UNIV; IN_UNIV; DIM_UNIV; SUBSET_UNIV]);;
13351
13352 (* ------------------------------------------------------------------------- *)
13353 (* Diagonalization of symmetric matrix.                                      *)
13354 (* ------------------------------------------------------------------------- *)
13355
13356 let SYMMETRIC_MATRIX_DIAGONALIZABLE_EXPLICIT = prove
13357  (`!A:real^N^N.
13358     transp A = A
13359     ==> ?P d. orthogonal_matrix P /\
13360               transp P ** A ** P = (lambda i j. if i = j then d i else &0)`,
13361   let lemma1 = prove
13362    (`!A:real^N^N P:real^N^N d.
13363        A ** P = P ** (lambda i j. if i = j then d i else &0) <=>
13364        !i. 1 <= i /\ i <= dimindex(:N)
13365            ==> A ** column i P = d i % column i P`,
13366     SIMP_TAC[CART_EQ; matrix_mul; matrix_vector_mul; LAMBDA_BETA;
13367              column; VECTOR_MUL_COMPONENT] THEN
13368     REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[COND_RAND] THEN
13369     SIMP_TAC[REAL_MUL_RZERO; SUM_DELTA; IN_NUMSEG] THEN
13370     EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN
13371     REWRITE_TAC[REAL_MUL_SYM]) in
13372   let lemma2 = prove
13373    (`!A:real^N^N P:real^N^N d.
13374           orthogonal_matrix P /\
13375           transp P ** A ** P = (lambda i j. if i = j then d i else &0) <=>
13376           orthogonal_matrix P /\
13377           !i. 1 <= i /\ i <= dimindex(:N)
13378               ==> A ** column i P = d i % column i P`,
13379     REPEAT GEN_TAC THEN REWRITE_TAC[GSYM lemma1; orthogonal_matrix] THEN
13380     ABBREV_TAC `D:real^N^N = lambda i j. if i = j then d i else &0` THEN
13381     MESON_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID]) in
13382   REPEAT STRIP_TAC THEN
13383   REWRITE_TAC[lemma2] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
13384   REWRITE_TAC[GSYM SKOLEM_THM] THEN
13385   MP_TAC(ISPEC `\x:real^N. (A:real^N^N) ** x`
13386     SELF_ADJOINT_HAS_EIGENVECTOR_BASIS) THEN
13387   ASM_SIMP_TAC[MATRIX_SELF_ADJOINT; MATRIX_VECTOR_MUL_LINEAR;
13388                MATRIX_OF_MATRIX_VECTOR_MUL] THEN
13389   DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` MP_TAC) THEN
13390   REWRITE_TAC[CONJ_ASSOC] THEN ONCE_REWRITE_TAC[IMP_CONJ_ALT] THEN
13391   REWRITE_TAC[HAS_SIZE] THEN STRIP_TAC THEN
13392   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN
13393   ASM_REWRITE_TAC[IN_NUMSEG; TAUT
13394    `p /\ q /\ x = y ==> a = b <=> p /\ q /\ ~(a = b) ==> ~(x = y)`] THEN
13395   DISCH_THEN(X_CHOOSE_THEN `f:num->real^N` STRIP_ASSUME_TAC) THEN
13396   ASM_REWRITE_TAC[PAIRWISE_IMAGE; FORALL_IN_IMAGE] THEN
13397   ASM_SIMP_TAC[pairwise; IN_NUMSEG] THEN STRIP_TAC THEN
13398   EXISTS_TAC `transp(lambda i. f i):real^N^N` THEN
13399   SIMP_TAC[COLUMN_TRANSP; ORTHOGONAL_MATRIX_TRANSP] THEN
13400   SIMP_TAC[ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_INDEXED; row] THEN
13401   SIMP_TAC[LAMBDA_ETA; LAMBDA_BETA; pairwise; IN_NUMSEG] THEN
13402   ASM_MESON_TAC[]);;
13403
13404 let SYMMETRIC_MATRIX_IMP_DIAGONALIZABLE = prove
13405  (`!A:real^N^N.
13406      transp A = A
13407      ==> ?P. orthogonal_matrix P /\ diagonal_matrix(transp P ** A ** P)`,
13408   GEN_TAC THEN
13409   DISCH_THEN(MP_TAC o MATCH_MP SYMMETRIC_MATRIX_DIAGONALIZABLE_EXPLICIT) THEN
13410   MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
13411   SIMP_TAC[diagonal_matrix; LAMBDA_BETA]);;
13412
13413 let SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE = prove
13414  (`!A:real^N^N.
13415      transp A = A <=>
13416      ?P. orthogonal_matrix P /\ diagonal_matrix(transp P ** A ** P)`,
13417   GEN_TAC THEN EQ_TAC THEN
13418   REWRITE_TAC[SYMMETRIC_MATRIX_IMP_DIAGONALIZABLE] THEN
13419   REWRITE_TAC[orthogonal_matrix] THEN
13420   DISCH_THEN(X_CHOOSE_THEN `P:real^N^N` STRIP_ASSUME_TAC) THEN
13421   ABBREV_TAC `D:real^N^N = transp P ** (A:real^N^N) ** P` THEN
13422   SUBGOAL_THEN `A:real^N^N = P ** (D:real^N^N) ** transp P` SUBST1_TAC THENL
13423    [EXPAND_TAC "D" THEN REWRITE_TAC[MATRIX_MUL_ASSOC] THEN
13424     ASM_REWRITE_TAC[MATRIX_MUL_LID] THEN
13425     ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_RID];
13426     REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; MATRIX_MUL_ASSOC] THEN
13427     ASM_MESON_TAC[TRANSP_DIAGONAL_MATRIX]]);;
13428
13429 (* ------------------------------------------------------------------------- *)
13430 (* Some matrix identities are easier to deduce for invertible matrices. We   *)
13431 (* can then extend by continuity, which is why this material needs to be     *)
13432 (* here after basic topological notions have been defined.                   *)
13433 (* ------------------------------------------------------------------------- *)
13434
13435 let CONTINUOUS_LIFT_DET = prove
13436  (`!(A:A->real^N^N) net.
13437         (!i j. 1 <= i /\ i <= dimindex(:N) /\
13438                1 <= j /\ j <= dimindex(:N)
13439                ==> (\x. lift(A x$i$j)) continuous net)
13440         ==> (\x. lift(det(A x))) continuous net`,
13441   REPEAT STRIP_TAC THEN REWRITE_TAC[det] THEN
13442   SIMP_TAC[LIFT_SUM; FINITE_PERMUTATIONS; FINITE_NUMSEG; o_DEF] THEN
13443   MATCH_MP_TAC CONTINUOUS_VSUM THEN
13444   SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG; LIFT_CMUL; IN_ELIM_THM] THEN
13445   X_GEN_TAC `p:num->num` THEN DISCH_TAC THEN
13446   MATCH_MP_TAC CONTINUOUS_CMUL THEN
13447   MATCH_MP_TAC CONTINUOUS_LIFT_PRODUCT THEN
13448   REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
13449   REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
13450   FIRST_ASSUM(MP_TAC o MATCH_MP PERMUTES_IMAGE) THEN
13451   DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN
13452   ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG]);;
13453
13454 let CONTINUOUS_ON_LIFT_DET = prove
13455  (`!A:real^M->real^N^N s.
13456         (!i j. 1 <= i /\ i <= dimindex(:N) /\
13457                1 <= j /\ j <= dimindex(:N)
13458                ==> (\x. lift(A x$i$j)) continuous_on s)
13459         ==> (\x. lift(det(A x))) continuous_on s`,
13460   SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_LIFT_DET]);;
13461
13462 let NEARBY_INVERTIBLE_MATRIX = prove
13463  (`!A:real^N^N.
13464      ?e. &0 < e /\ !x. ~(x = &0) /\ abs x < e ==> invertible(A + x %% mat 1)`,
13465   GEN_TAC THEN MP_TAC(ISPEC `A:real^N^N` CHARACTERISTIC_POLYNOMIAL) THEN
13466   DISCH_THEN(X_CHOOSE_THEN `a:num->real` STRIP_ASSUME_TAC) THEN
13467   MP_TAC(ISPECL [`dimindex(:N)`; `a:num->real`] REAL_POLYFUN_FINITE_ROOTS) THEN
13468   MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL
13469    [EXISTS_TAC `dimindex(:N)` THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC;
13470     ALL_TAC] THEN
13471   DISCH_THEN(MP_TAC o ISPEC `lift` o MATCH_MP FINITE_IMAGE) THEN
13472   DISCH_THEN(MP_TAC o MATCH_MP LIMIT_POINT_FINITE) THEN
13473   DISCH_THEN(MP_TAC o SPEC `lift(&0)`) THEN
13474   REWRITE_TAC[LIMPT_APPROACHABLE; EXISTS_IN_IMAGE; EXISTS_IN_GSPEC] THEN
13475   REWRITE_TAC[DIST_LIFT; LIFT_EQ; REAL_SUB_RZERO; NOT_FORALL_THM; NOT_IMP] THEN
13476   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN
13477   ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN
13478   DISCH_THEN(fun th -> X_GEN_TAC `x:real` THEN STRIP_TAC THEN
13479                 MP_TAC(SPEC `--x:real` th)) THEN
13480   FIRST_X_ASSUM(SUBST1_TAC o SYM o SPEC `--x:real`) THEN
13481   ASM_REWRITE_TAC[REAL_NEG_EQ_0; REAL_ABS_NEG] THEN
13482   ONCE_REWRITE_TAC[GSYM INVERTIBLE_NEG] THEN
13483   REWRITE_TAC[INVERTIBLE_DET_NZ; CONTRAPOS_THM] THEN
13484   REWRITE_TAC[MATRIX_SUB; MATRIX_NEG_MINUS1] THEN
13485   ONCE_REWRITE_TAC[REAL_ARITH `--x = -- &1 * x`] THEN
13486   REWRITE_TAC[GSYM MATRIX_CMUL_ADD_LDISTRIB; GSYM MATRIX_CMUL_ASSOC] THEN
13487   REWRITE_TAC[MATRIX_CMUL_LID; MATRIX_ADD_SYM]);;
13488
13489 let MATRIX_WLOG_INVERTIBLE = prove
13490  (`!P. (!A:real^N^N. invertible A ==> P A) /\
13491        (!A:real^N^N. ?d. &0 < d /\
13492                          closed {x | x IN cball(vec 0,d) /\
13493                                      P(A + drop x %% mat 1)})
13494        ==> !A:real^N^N. P A`,
13495   REPEAT GEN_TAC THEN
13496   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
13497   MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
13498   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
13499   FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^1` o
13500     GEN_REWRITE_RULE I [CLOSED_LIMPT]) THEN
13501   ASM_SIMP_TAC[IN_ELIM_THM; DROP_VEC; MATRIX_CMUL_LZERO; MATRIX_ADD_RID] THEN
13502   ANTS_TAC THENL [ALL_TAC; CONV_TAC TAUT] THEN
13503   MP_TAC(ISPEC `A:real^N^N` NEARBY_INVERTIBLE_MATRIX) THEN
13504   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
13505   REWRITE_TAC[LIMPT_APPROACHABLE] THEN X_GEN_TAC `k:real` THEN
13506   DISCH_TAC THEN REWRITE_TAC[EXISTS_LIFT; IN_ELIM_THM] THEN
13507   REWRITE_TAC[GSYM LIFT_NUM; IN_CBALL_0; NORM_LIFT; DIST_LIFT] THEN
13508   REWRITE_TAC[REAL_SUB_RZERO; LIFT_EQ; LIFT_DROP] THEN
13509   EXISTS_TAC `min d ((min e k) / &2)` THEN
13510   CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
13511   CONJ_TAC THENL [ASM_REAL_ARITH_TAC; FIRST_X_ASSUM MATCH_MP_TAC] THEN
13512   FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC);;
13513
13514 let SYLVESTER_DETERMINANT_IDENTITY = prove
13515  (`!A:real^N^M B:real^M^N. det(mat 1 + A ** B) = det(mat 1 + B ** A)`,
13516   let lemma1 = prove
13517    (`!A:real^N^N B:real^N^N. det(mat 1 + A ** B) = det(mat 1 + B ** A)`,
13518     ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN
13519     MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THENL
13520      [REPEAT STRIP_TAC THEN
13521       SUBGOAL_THEN `det((mat 1 + A ** B) ** A:real^N^N) =
13522                     det(A ** (mat 1 + B ** A))`
13523       MP_TAC THENL
13524        [REWRITE_TAC[MATRIX_ADD_RDISTRIB; MATRIX_ADD_LDISTRIB] THEN
13525         REWRITE_TAC[MATRIX_MUL_LID; MATRIX_MUL_RID; MATRIX_MUL_ASSOC];
13526         REWRITE_TAC[DET_MUL] THEN
13527         FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INVERTIBLE_DET_NZ]) THEN
13528         CONV_TAC REAL_RING];
13529       X_GEN_TAC `A:real^N^N` THEN EXISTS_TAC `&1` THEN
13530       REWRITE_TAC[REAL_LT_01; SET_RULE
13531        `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN
13532       MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN
13533       ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN
13534       REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN
13535       REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN
13536       MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN
13537       REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN
13538       REWRITE_TAC[o_DEF; LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_SUB THEN
13539       CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN
13540       MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN
13541       ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; LIFT_ADD] THEN
13542       MATCH_MP_TAC CONTINUOUS_ADD THEN
13543       ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA; CONTINUOUS_CONST] THEN
13544       SIMP_TAC[LIFT_SUM; FINITE_NUMSEG; o_DEF] THEN
13545       MATCH_MP_TAC CONTINUOUS_VSUM THEN
13546       REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN
13547       DISCH_TAC THENL [ONCE_REWRITE_TAC[REAL_MUL_SYM]; ALL_TAC] THEN
13548       REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_CMUL THEN
13549       REWRITE_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; LIFT_ADD] THEN
13550       MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN
13551       REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] LIFT_CMUL] THEN
13552       MATCH_MP_TAC CONTINUOUS_CMUL THEN
13553       REWRITE_TAC[LIFT_DROP; CONTINUOUS_AT_ID]]) in
13554   let lemma2 = prove
13555    (`!A:real^N^M B:real^M^N.
13556           dimindex(:M) <= dimindex(:N)
13557           ==> det(mat 1 + A ** B) = det(mat 1 + B ** A)`,
13558     REPEAT STRIP_TAC THEN
13559     MAP_EVERY ABBREV_TAC
13560      [`A':real^N^N =
13561           lambda i j. if i <= dimindex(:M) then (A:real^N^M)$i$j
13562                       else &0`;
13563       `B':real^N^N =
13564           lambda i j. if j <= dimindex(:M) then (B:real^M^N)$i$j
13565                       else &0`] THEN
13566     MP_TAC(ISPECL [`A':real^N^N`; `B':real^N^N`] lemma1) THEN
13567     SUBGOAL_THEN
13568      `(B':real^N^N) ** (A':real^N^N) = (B:real^M^N) ** (A:real^N^M)`
13569     SUBST1_TAC THENL
13570      [MAP_EVERY EXPAND_TAC ["A'"; "B'"] THEN
13571       SIMP_TAC[CART_EQ; LAMBDA_BETA; matrix_mul] THEN REPEAT STRIP_TAC THEN
13572       MATCH_MP_TAC SUM_EQ_SUPERSET THEN
13573       ASM_SIMP_TAC[IN_NUMSEG; REAL_MUL_LZERO; FINITE_NUMSEG; SUBSET_NUMSEG;
13574                    LE_REFL; TAUT `(p /\ q) /\ ~(p /\ r) <=> p /\ q /\ ~r`];
13575       DISCH_THEN(SUBST1_TAC o SYM)] THEN
13576     REWRITE_TAC[det] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
13577      `sum {p | p permutes 1..dimindex(:N) /\ !i. dimindex(:M) < i ==> p i = i}
13578           (\p. sign p * product (1..dimindex(:N))
13579                      (\i. (mat 1 + (A':real^N^N) ** (B':real^N^N))$i$p i))` THEN
13580     CONJ_TAC THENL
13581      [ALL_TAC;
13582       CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN
13583       CONJ_TAC THENL [SET_TAC[]; SIMP_TAC[IN_ELIM_THM; IMP_CONJ]] THEN
13584       X_GEN_TAC `p:num->num` THEN REPEAT STRIP_TAC THEN
13585       REWRITE_TAC[REAL_ENTIRE; PRODUCT_EQ_0_NUMSEG] THEN DISJ2_TAC THEN
13586       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN
13587       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN
13588       REWRITE_TAC[NOT_IMP] THEN STRIP_TAC THEN
13589       FIRST_ASSUM(MP_TAC o SPEC `k:num` o CONJUNCT1 o
13590         GEN_REWRITE_RULE I [permutes]) THEN
13591       ASM_REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
13592       FIRST_ASSUM(MP_TAC o MATCH_MP PERMUTES_IMAGE) THEN
13593       DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN
13594       ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG] THEN
13595       DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_SIMP_TAC[] THEN STRIP_TAC THEN
13596       ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MAT_COMPONENT; REAL_ADD_LID] THEN
13597       ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA] THEN
13598       MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN REPEAT STRIP_TAC THEN
13599       REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN EXPAND_TAC "A'" THEN
13600       ASM_SIMP_TAC[LAMBDA_BETA; GSYM NOT_LT]] THEN
13601     CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_EQ_GENERAL THEN
13602     EXISTS_TAC `\f:num->num. f` THEN REWRITE_TAC[IN_ELIM_THM] THEN
13603     CONJ_TAC THEN X_GEN_TAC `p:num->num` THEN STRIP_TAC THENL
13604      [REWRITE_TAC[MESON[] `(?!x. P x /\ x = y) <=> P y`] THEN CONJ_TAC THENL
13605        [MATCH_MP_TAC PERMUTES_SUBSET THEN
13606         EXISTS_TAC `1..dimindex(:M)` THEN
13607         ASM_REWRITE_TAC[SUBSET_NUMSEG; LE_REFL];
13608         X_GEN_TAC `k:num` THEN DISCH_TAC THEN
13609         FIRST_X_ASSUM(MATCH_MP_TAC o CONJUNCT1 o
13610           GEN_REWRITE_RULE I [permutes]) THEN
13611         ASM_REWRITE_TAC[IN_NUMSEG; DE_MORGAN_THM; NOT_LE]];
13612       MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
13613        [MATCH_MP_TAC PERMUTES_SUPERSET THEN
13614         EXISTS_TAC `1..dimindex(:N)` THEN
13615         ASM_REWRITE_TAC[IN_DIFF; IN_NUMSEG] THEN ASM_MESON_TAC[NOT_LE];
13616         DISCH_TAC] THEN
13617       AP_TERM_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE
13618        `m:num <= n ==> n = m + (n - m)`)) THEN
13619       SIMP_TAC[PRODUCT_ADD_SPLIT; ARITH_RULE `1 <= n + 1`] THEN
13620       MATCH_MP_TAC(REAL_RING `x = y /\ z = &1 ==> x = y * z`) THEN
13621       CONJ_TAC THENL
13622        [MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN
13623         X_GEN_TAC `i:num` THEN STRIP_TAC THEN
13624         SUBGOAL_THEN `i <= dimindex(:N)` ASSUME_TAC THENL
13625          [ASM_ARITH_TAC; ALL_TAC] THEN
13626         MP_TAC(ISPECL [`p:num->num`; `1..dimindex(:M)`] PERMUTES_IMAGE) THEN
13627         ASM_REWRITE_TAC[] THEN
13628         DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN
13629         ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG] THEN
13630         DISCH_THEN(MP_TAC o SPEC `i:num`) THEN
13631         ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
13632         SUBGOAL_THEN `(p:num->num) i <= dimindex(:N)` ASSUME_TAC THENL
13633          [ASM_ARITH_TAC; ALL_TAC] THEN
13634         ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MAT_COMPONENT] THEN
13635         AP_TERM_TAC THEN ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA] THEN
13636         MATCH_MP_TAC SUM_EQ_NUMSEG THEN REPEAT STRIP_TAC THEN
13637         MAP_EVERY EXPAND_TAC ["A'"; "B'"] THEN
13638         ASM_SIMP_TAC[LAMBDA_BETA];
13639         MATCH_MP_TAC PRODUCT_EQ_1_NUMSEG THEN
13640         ASM_SIMP_TAC[ARITH_RULE `n + 1 <= i ==> n < i`] THEN
13641         ASM_SIMP_TAC[ARITH_RULE `m:num <= n ==> m + (n - m) = n`] THEN
13642         X_GEN_TAC `i:num` THEN STRIP_TAC THEN
13643         SUBGOAL_THEN `1 <= i` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
13644         ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MAT_COMPONENT] THEN
13645         ASM_SIMP_TAC[REAL_EQ_ADD_LCANCEL_0; matrix_mul; LAMBDA_BETA] THEN
13646         MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN REPEAT STRIP_TAC THEN
13647         REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN EXPAND_TAC "A'" THEN
13648         ASM_SIMP_TAC[LAMBDA_BETA; ARITH_RULE `m + 1 <= i ==> ~(i <= m)`]]]) in
13649   REPEAT GEN_TAC THEN DISJ_CASES_TAC (ARITH_RULE
13650    `dimindex(:M) <= dimindex(:N) \/ dimindex(:N) <= dimindex(:M)`)
13651   THENL [ALL_TAC; CONV_TAC SYM_CONV] THEN
13652   MATCH_MP_TAC lemma2 THEN ASM_REWRITE_TAC[]);;
13653
13654 let COFACTOR_MATRIX_MUL = prove
13655  (`!A B:real^N^N. cofactor(A ** B) = cofactor(A) ** cofactor(B)`,
13656   MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THENL
13657    [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN
13658     CONJ_TAC THENL
13659      [ASM_SIMP_TAC[COFACTOR_MATRIX_INV; GSYM INVERTIBLE_DET_NZ;
13660                    INVERTIBLE_MATRIX_MUL] THEN
13661       REWRITE_TAC[DET_MUL; MATRIX_MUL_LMUL] THEN
13662       REWRITE_TAC[MATRIX_MUL_RMUL; MATRIX_CMUL_ASSOC;
13663                   GSYM MATRIX_TRANSP_MUL] THEN
13664       ASM_SIMP_TAC[MATRIX_INV_MUL];
13665       GEN_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01]];
13666     X_GEN_TAC `A:real^N^N` THEN EXISTS_TAC `&1` THEN
13667     REWRITE_TAC[REAL_LT_01] THEN REWRITE_TAC[RIGHT_AND_FORALL_THM] THEN
13668     MATCH_MP_TAC CLOSED_FORALL THEN GEN_TAC] THEN
13669   REWRITE_TAC[SET_RULE
13670    `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN
13671   MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN
13672   REWRITE_TAC[CART_EQ] THEN
13673   MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
13674   MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN
13675   ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN
13676   REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN
13677   REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN
13678   MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN
13679   REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN
13680   ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA; cofactor; LIFT_SUM;
13681                FINITE_NUMSEG; o_DEF] THEN
13682   (MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THENL
13683     [ALL_TAC;
13684      MATCH_MP_TAC CONTINUOUS_VSUM THEN
13685      REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
13686      X_GEN_TAC `k:num` THEN STRIP_TAC THEN
13687      REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN
13688      REWRITE_TAC[o_DEF] THEN CONJ_TAC]) THEN
13689   MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN
13690   MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN
13691   ASM_SIMP_TAC[LAMBDA_BETA; CONTINUOUS_CONST] THEN
13692   REPEAT(W(fun (asl,w) ->
13693    let t = find_term is_cond w in
13694    ASM_CASES_TAC (lhand(rator t)) THEN ASM_REWRITE_TAC[CONTINUOUS_CONST])) THEN
13695   SIMP_TAC[LIFT_SUM; FINITE_NUMSEG; o_DEF] THEN
13696   TRY(MATCH_MP_TAC CONTINUOUS_VSUM THEN REWRITE_TAC[FINITE_NUMSEG] THEN
13697       REWRITE_TAC[IN_NUMSEG] THEN X_GEN_TAC `p:num` THEN STRIP_TAC) THEN
13698   REWRITE_TAC[LIFT_CMUL] THEN
13699   TRY(MATCH_MP_TAC CONTINUOUS_MUL THEN
13700       REWRITE_TAC[o_DEF; CONTINUOUS_CONST]) THEN
13701   REWRITE_TAC[MATRIX_ADD_COMPONENT; LIFT_ADD] THEN
13702   MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN
13703   REWRITE_TAC[MATRIX_CMUL_COMPONENT; LIFT_CMUL; o_DEF] THEN
13704   MATCH_MP_TAC CONTINUOUS_MUL THEN
13705   REWRITE_TAC[CONTINUOUS_CONST; o_DEF; LIFT_DROP; CONTINUOUS_AT_ID]);;
13706
13707 let DET_COFACTOR = prove
13708  (`!A:real^N^N. det(cofactor A) = det(A) pow (dimindex(:N) - 1)`,
13709   MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THEN
13710   X_GEN_TAC `A:real^N^N` THENL
13711    [REWRITE_TAC[INVERTIBLE_DET_NZ] THEN STRIP_TAC THEN
13712     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_FIELD
13713      `~(a = &0) ==> a * x = a * y ==> x = y`)) THEN
13714     GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM DET_TRANSP] THEN
13715     REWRITE_TAC[GSYM DET_MUL; MATRIX_MUL_RIGHT_COFACTOR] THEN
13716     REWRITE_TAC[DET_CMUL; GSYM(CONJUNCT2 real_pow); DET_I; REAL_MUL_RID] THEN
13717     SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> SUC(n - 1) = n`];
13718     ALL_TAC] THEN
13719   EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN
13720   REWRITE_TAC[SET_RULE
13721    `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN
13722   MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN
13723   ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN
13724   REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN
13725   REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN
13726   MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN
13727   REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN
13728   MATCH_MP_TAC CONTINUOUS_SUB THEN
13729   CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CONTINUOUS_LIFT_POW] THEN
13730   MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN
13731   MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN
13732   ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; LIFT_ADD;
13733                LIFT_CMUL; LIFT_DROP; CONTINUOUS_ADD; CONTINUOUS_CONST;
13734                CONTINUOUS_MUL; o_DEF; LIFT_DROP; CONTINUOUS_AT_ID] THEN
13735   ASM_SIMP_TAC[cofactor; LAMBDA_BETA] THEN
13736   MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN
13737   MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN
13738   ASM_SIMP_TAC[LAMBDA_BETA] THEN
13739   REPEAT(W(fun (asl,w) ->
13740    let t = find_term is_cond w in
13741    ASM_CASES_TAC (lhand(rator t)) THEN ASM_REWRITE_TAC[CONTINUOUS_CONST])) THEN
13742   ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; LIFT_ADD;
13743                LIFT_CMUL; LIFT_DROP; CONTINUOUS_ADD; CONTINUOUS_CONST;
13744                CONTINUOUS_MUL; o_DEF; LIFT_DROP; CONTINUOUS_AT_ID]);;
13745
13746 let INVERTIBLE_COFACTOR = prove
13747  (`!A:real^N^N. invertible(cofactor A) <=> dimindex(:N) = 1 \/ invertible A`,
13748   SIMP_TAC[DET_COFACTOR; INVERTIBLE_DET_NZ; REAL_POW_EQ_0; DE_MORGAN_THM;
13749            DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (n - 1 = 0 <=> n = 1)`;
13750            DISJ_ACI]);;
13751
13752 let COFACTOR_COFACTOR = prove
13753  (`!A:real^N^N.
13754      2 <= dimindex(:N)
13755      ==> cofactor(cofactor A) = (det(A) pow (dimindex(:N) - 2)) %% A`,
13756   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN
13757   MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THEN
13758   X_GEN_TAC `A:real^N^N` THENL
13759    [REWRITE_TAC[INVERTIBLE_DET_NZ] THEN DISCH_TAC THEN
13760     MP_TAC(ISPECL [`A:real^N^N`; `transp(cofactor A):real^N^N`]
13761         COFACTOR_MATRIX_MUL) THEN
13762     REWRITE_TAC[MATRIX_MUL_RIGHT_COFACTOR; COFACTOR_CMUL; COFACTOR_I] THEN
13763     REWRITE_TAC[COFACTOR_TRANSP] THEN
13764     DISCH_THEN(MP_TAC o AP_TERM `transp:real^N^N->real^N^N`) THEN
13765     REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; TRANSP_MATRIX_CMUL] THEN
13766     REWRITE_TAC[TRANSP_MAT] THEN
13767     DISCH_THEN(MP_TAC o AP_TERM `(\x. x ** A):real^N^N->real^N^N`) THEN
13768     REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_LEFT_COFACTOR] THEN
13769     REWRITE_TAC[MATRIX_MUL_LMUL; MATRIX_MUL_RMUL] THEN
13770     REWRITE_TAC[MATRIX_MUL_LID; MATRIX_MUL_RID] THEN
13771     DISCH_THEN(MP_TAC o AP_TERM `\x:real^N^N. inv(det(A:real^N^N)) %% x`) THEN
13772     ASM_SIMP_TAC[MATRIX_CMUL_ASSOC; REAL_MUL_LINV; MATRIX_CMUL_LID] THEN
13773     DISCH_THEN(SUBST1_TAC o SYM) THEN AP_THM_TAC THEN AP_TERM_TAC THEN
13774     ASM_SIMP_TAC[REAL_POW_SUB; ARITH_RULE `2 <= n ==> 1 <= n`] THEN
13775     REWRITE_TAC[REAL_POW_2; real_div; REAL_INV_POW] THEN REAL_ARITH_TAC;
13776     POP_ASSUM(K ALL_TAC)] THEN
13777   EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN
13778   REWRITE_TAC[SET_RULE
13779    `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN
13780   MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN
13781   REWRITE_TAC[CART_EQ] THEN
13782   MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
13783   MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN
13784   ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN
13785   REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN
13786   REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN
13787   MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN
13788   REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN
13789   MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THENL
13790    [REPLICATE_TAC 2
13791      (ONCE_REWRITE_TAC[cofactor] THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN
13792       MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN REPEAT STRIP_TAC THEN
13793       ASM_SIMP_TAC[LAMBDA_BETA] THEN
13794       REPEAT(W(fun (asl,w) ->
13795        let t = find_term is_cond w in
13796        ASM_CASES_TAC (lhand(rator t)) THEN
13797        ASM_REWRITE_TAC[CONTINUOUS_CONST])));
13798     REWRITE_TAC[MATRIX_CMUL_COMPONENT; LIFT_CMUL] THEN
13799     MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL
13800      [MATCH_MP_TAC CONTINUOUS_LIFT_POW THEN
13801       MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN REPEAT STRIP_TAC;
13802       ALL_TAC]] THEN
13803   REWRITE_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT] THEN
13804   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
13805   REWRITE_TAC[LIFT_ADD; LIFT_CMUL; LIFT_DROP] THEN
13806   SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_CONST; CONTINUOUS_CMUL;
13807            CONTINUOUS_AT_ID]);;
13808
13809 let RANK_COFACTOR_EQ_FULL = prove
13810  (`!A:real^N^N. rank(cofactor A) = dimindex(:N) <=>
13811                 dimindex(:N) = 1 \/ rank A = dimindex(:N)`,
13812   REWRITE_TAC[RANK_EQ_FULL_DET; DET_COFACTOR; REAL_POW_EQ_0] THEN
13813   SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (n - 1 = 0 <=> n = 1)`] THEN
13814   CONV_TAC TAUT);;
13815
13816 let COFACTOR_EQ_0 = prove
13817  (`!A:real^N^N. cofactor A = mat 0 <=> rank(A) < dimindex(:N) - 1`,
13818   let lemma1 = prove
13819    (`!A:real^N^N. rank(A) < dimindex(:N) - 1 ==> cofactor A = mat 0`,
13820     GEN_TAC THEN REWRITE_TAC[RANK_ROW] THEN DISCH_TAC THEN
13821     SIMP_TAC[CART_EQ; cofactor; MAT_COMPONENT; LAMBDA_BETA; COND_ID] THEN
13822     X_GEN_TAC `m:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN
13823     REWRITE_TAC[DET_EQ_0_RANK] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
13824      (ARITH_RULE `r < n - 1 ==> s <= r + 1 ==> s < n`)) THEN
13825     REWRITE_TAC[RANK_ROW; rows] THEN MATCH_MP_TAC LE_TRANS THEN
13826     EXISTS_TAC
13827      `dim (basis n INSERT
13828            {row i ((lambda k l. if l = n then &0 else (A:real^N^N)$k$l)
13829                    :real^N^N)
13830             | i IN (1..dimindex(:N)) DELETE m})` THEN
13831     CONJ_TAC THENL
13832      [MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[GSYM IN_NUMSEG] THEN
13833       MATCH_MP_TAC(SET_RULE
13834        `m IN s /\ (!i. i IN s DELETE m ==> f i = g i) /\ f m = a
13835         ==> {f i | i IN s} SUBSET a INSERT {g i | i IN s DELETE m}`) THEN
13836       ASM_SIMP_TAC[IN_NUMSEG; IN_DELETE; row; LAMBDA_BETA; basis; LAMBDA_ETA];
13837       REWRITE_TAC[DIM_INSERT] THEN MATCH_MP_TAC(ARITH_RULE
13838        `n <= k ==> (if p then n else n + 1) <= k + 1`) THEN
13839       MATCH_MP_TAC(MESON[DIM_LINEAR_IMAGE_LE; DIM_SUBSET; LE_TRANS]
13840        `(?f. linear f /\ t SUBSET IMAGE f s) ==> dim t <= dim s`) THEN
13841       EXISTS_TAC `(\x. lambda i. if i = n then &0 else x$i)
13842                   :real^N->real^N` THEN
13843       REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN CONJ_TAC THENL
13844        [SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
13845                   VECTOR_MUL_COMPONENT] THEN
13846         REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
13847         REAL_ARITH_TAC;
13848         X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG; IN_DELETE] THEN
13849         STRIP_TAC THEN REWRITE_TAC[IN_IMAGE] THEN
13850         ONCE_REWRITE_TAC[CONJ_SYM] THEN
13851         REWRITE_TAC[EXISTS_IN_GSPEC] THEN EXISTS_TAC `i:num` THEN
13852         ASM_SIMP_TAC[row; CART_EQ; LAMBDA_BETA]]])
13853   and lemma2 = prove
13854    (`!A:real^N^N.
13855           rank A < dimindex(:N)
13856           ==> ?n x. 1 <= n /\ n <= dimindex(:N) /\
13857                     rank A <
13858                     rank((lambda i. if i = n then x else row i A):real^N^N)`,
13859     REPEAT STRIP_TAC THEN SUBGOAL_THEN
13860      `?n. 1 <= n /\ n <= dimindex(:N) /\
13861           row n (A:real^N^N) IN
13862           span {row j A | j IN (1..dimindex(:N)) DELETE n}`
13863     MP_TAC THENL
13864      [MP_TAC(ISPEC `transp A:real^N^N` HOMOGENEOUS_LINEAR_EQUATIONS_DET) THEN
13865       ASM_REWRITE_TAC[DET_EQ_0_RANK; RANK_TRANSP] THEN
13866       DISCH_THEN(X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC) THEN
13867       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN
13868       REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; VEC_COMPONENT] THEN
13869       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN
13870       ASM_REWRITE_TAC[] THEN
13871       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN
13872       SIMP_TAC[matrix_vector_mul; transp; VEC_COMPONENT; LAMBDA_BETA] THEN
13873       DISCH_TAC THEN
13874       SUBGOAL_THEN `row n A = vsum ((1..dimindex(:N)) DELETE n)
13875                        (\i. --((c:real^N)$i / c$n) % row i (A:real^N^N))`
13876       SUBST1_TAC THENL
13877        [ASM_SIMP_TAC[VSUM_DELETE; FINITE_NUMSEG; IN_NUMSEG; REAL_DIV_REFL] THEN
13878         REWRITE_TAC[VECTOR_ARITH `n = x - -- &1 % n <=> x:real^N = vec 0`] THEN
13879         SIMP_TAC[VSUM_COMPONENT; row; VECTOR_MUL_COMPONENT; LAMBDA_BETA;
13880           CART_EQ; REAL_ARITH `--(x / y) * z:real = --(inv y) * z * x`] THEN
13881         ASM_SIMP_TAC[SUM_LMUL; VEC_COMPONENT; REAL_MUL_RZERO];
13882         MATCH_MP_TAC SPAN_VSUM THEN SIMP_TAC[FINITE_DELETE; FINITE_NUMSEG] THEN
13883         X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_DELETE; IN_NUMSEG] THEN
13884         STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN
13885         MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]];
13886       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN
13887       ASM_REWRITE_TAC[] THEN
13888       SUBGOAL_THEN `span {row j (A:real^N^N) | j IN (1..dimindex(:N)) DELETE n}
13889                     PSUBSET (:real^N)`
13890       MP_TAC THENL
13891        [REWRITE_TAC[PSUBSET; SUBSET_UNIV] THEN
13892         DISCH_THEN(MP_TAC o AP_TERM `dim:(real^N->bool)->num`) THEN
13893         REWRITE_TAC[DIM_UNIV] THEN
13894         MATCH_MP_TAC(ARITH_RULE `1 <= n /\ x <= n - 1 ==> ~(x = n)`) THEN
13895         REWRITE_TAC[DIMINDEX_GE_1; DIM_SPAN] THEN
13896         W(MP_TAC o PART_MATCH (lhand o rand) DIM_LE_CARD o lhand o snd) THEN
13897         ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
13898         SIMP_TAC[FINITE_IMAGE; FINITE_DELETE; FINITE_NUMSEG] THEN
13899         MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LE_TRANS) THEN
13900         W(MP_TAC o PART_MATCH (lhand o rand) CARD_IMAGE_LE o lhand o snd) THEN
13901         SIMP_TAC[FINITE_DELETE; FINITE_NUMSEG] THEN
13902         MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LE_TRANS) THEN
13903         ASM_SIMP_TAC[CARD_DELETE; IN_NUMSEG; FINITE_NUMSEG] THEN
13904         REWRITE_TAC[CARD_NUMSEG_1; LE_REFL];
13905         DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
13906          `s PSUBSET UNIV ==> ?x. ~(x IN s)`)) THEN
13907         MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN
13908         REWRITE_TAC[RANK_ROW] THEN DISCH_TAC THEN
13909         SUBGOAL_THEN
13910          `!A:real^N^N. rows A = row n A INSERT
13911                                 {row j A | j IN (1..dimindex (:N)) DELETE n}`
13912          (fun th -> REWRITE_TAC[th])
13913         THENL
13914          [REWRITE_TAC[rows; IN_DELETE; IN_NUMSEG] THEN ASM SET_TAC[];
13915           ASM_SIMP_TAC[DIM_INSERT]] THEN
13916         COND_CASES_TAC THENL
13917          [FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN
13918           FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[]
13919             `x IN span s ==> x = y /\ s = t ==> ~(y IN span t) ==> q`)) THEN
13920           ASM_SIMP_TAC[row; LAMBDA_BETA; LAMBDA_ETA];
13921           MATCH_MP_TAC(ARITH_RULE `s = t ==> s < t + 1`) THEN
13922           AP_TERM_TAC THEN REWRITE_TAC[row]] THEN
13923         MATCH_MP_TAC(SET_RULE
13924          `(!x. x IN s ==> f x = g x) ==> {f x | x IN s} = {g x | x IN s}`) THEN
13925         ASM_SIMP_TAC[IN_DELETE; IN_NUMSEG; LAMBDA_BETA; CART_EQ]]]) in
13926   GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[lemma1] THEN DISCH_TAC THEN
13927   MATCH_MP_TAC(ARITH_RULE
13928    `r <= n /\ ~(r = n) /\ ~(r = n - 1) ==> r < n - 1`) THEN
13929   REPEAT CONJ_TAC THENL
13930    [MP_TAC(ISPEC `A:real^N^N` RANK_BOUND) THEN ARITH_TAC;
13931     REWRITE_TAC[RANK_EQ_FULL_DET] THEN
13932     MP_TAC(SYM(ISPEC `A:real^N^N` MATRIX_MUL_LEFT_COFACTOR)) THEN
13933     ASM_REWRITE_TAC[MATRIX_CMUL_EQ_0; TRANSP_MAT; MATRIX_MUL_LZERO] THEN
13934     REWRITE_TAC[MAT_EQ; ARITH_EQ];
13935     DISCH_TAC] THEN
13936   MP_TAC(ISPEC `A:real^N^N` lemma2) THEN
13937   ASM_REWRITE_TAC[DIMINDEX_GE_1; ARITH_RULE `n - 1 < n <=> 1 <= n`] THEN
13938   DISCH_THEN(X_CHOOSE_THEN `n:num` (X_CHOOSE_THEN `x:real^N`
13939     STRIP_ASSUME_TAC)) THEN
13940   FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE
13941    `n - 1 < k ==> k <= MIN n n ==> k = n`)) THEN
13942   REWRITE_TAC[RANK_BOUND; RANK_EQ_FULL_DET] THEN
13943   MP_TAC(GEN `A:real^N^N` (ISPECL [`A:real^N^N`; `n:num`]
13944     DET_COFACTOR_EXPANSION)) THEN
13945   ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC SUM_EQ_0 THEN
13946   X_GEN_TAC `m:num` THEN SIMP_TAC[IN_NUMSEG; REAL_ENTIRE] THEN STRIP_TAC THEN
13947   DISJ2_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN
13948   DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[CART_EQ] THEN
13949   DISCH_THEN(MP_TAC o SPEC `m:num`) THEN
13950   ASM_SIMP_TAC[MAT_COMPONENT; COND_ID] THEN
13951   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EQ_TRANS) THEN
13952   ASM_SIMP_TAC[cofactor; LAMBDA_BETA] THEN AP_TERM_TAC THEN
13953   ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; row] THEN
13954   REPEAT STRIP_TAC THEN
13955   REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA]) THEN
13956   ASM_MESON_TAC[]);;
13957
13958 let RANK_COFACTOR_EQ_1 = prove
13959  (`!A:real^N^N. rank(cofactor A) = 1 <=>
13960                 dimindex(:N) = 1 \/ rank A = dimindex(:N) - 1`,
13961   GEN_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL
13962    [ASM_MESON_TAC[RANK_COFACTOR_EQ_FULL]; ASM_REWRITE_TAC[]] THEN
13963   EQ_TAC THENL
13964    [ASM_CASES_TAC `cofactor A:real^N^N = mat 0` THEN
13965     ASM_REWRITE_TAC[RANK_0; ARITH_EQ] THEN DISCH_TAC THEN
13966     MATCH_MP_TAC(ARITH_RULE
13967      `~(r < n - 1) /\ ~(r = n) /\ r <= MIN n n ==> r = n - 1`) THEN
13968     ASM_REWRITE_TAC[RANK_BOUND; GSYM COFACTOR_EQ_0] THEN
13969     MP_TAC(ISPEC `A:real^N^N` RANK_COFACTOR_EQ_FULL) THEN ASM_REWRITE_TAC[];
13970     DISCH_TAC THEN MATCH_MP_TAC(ARITH_RULE
13971      `~(n = 0) /\ n <= 1 ==> n = 1`) THEN
13972     ASM_REWRITE_TAC[RANK_EQ_0; COFACTOR_EQ_0; LT_REFL] THEN
13973     MP_TAC(ISPECL [`A:real^N^N`; `transp(cofactor A):real^N^N`]
13974       RANK_SYLVESTER) THEN
13975     ASM_REWRITE_TAC[MATRIX_MUL_RIGHT_COFACTOR; RANK_TRANSP] THEN
13976     FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE
13977      `a = n - 1 ==> 1 <= n ==> a < n`)) THEN
13978     ASM_SIMP_TAC[GSYM DET_EQ_0_RANK; DIMINDEX_GE_1] THEN
13979     DISCH_TAC THEN REWRITE_TAC[MATRIX_CMUL_LZERO; RANK_0] THEN
13980     ARITH_TAC]);;
13981
13982 let RANK_COFACTOR = prove
13983  (`!A:real^N^N.
13984         rank(cofactor A) = if rank(A) = dimindex(:N) then dimindex(:N)
13985                            else if rank(A) = dimindex(:N) - 1 then 1
13986                            else 0`,
13987   GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[RANK_COFACTOR_EQ_FULL] THEN
13988   COND_CASES_TAC THEN ASM_REWRITE_TAC[RANK_COFACTOR_EQ_1] THEN
13989   REWRITE_TAC[RANK_EQ_0; COFACTOR_EQ_0] THEN
13990   MATCH_MP_TAC(ARITH_RULE
13991    `r <= MIN n n /\ ~(r = n) /\ ~(r = n - 1) ==> r < n - 1`) THEN
13992   ASM_REWRITE_TAC[RANK_BOUND]);;
13993
13994 (* ------------------------------------------------------------------------- *)
13995 (* Not in so many words, but combining this with intermediate value theorem  *)
13996 (* implies the determinant is an open map.                                   *)
13997 (* ------------------------------------------------------------------------- *)
13998
13999 let DET_OPEN_MAP = prove
14000  (`!A:real^N^N e.
14001         &0 < e
14002         ==> (?B:real^N^N. (!i j. abs(B$i$j - A$i$j) < e) /\ det B < det A) /\
14003             (?C:real^N^N. (!i j. abs(C$i$j - A$i$j) < e) /\ det C > det A)`,
14004   let lemma1 = prove
14005    (`!A:real^N^N i e.
14006           1 <= i /\ i <= dimindex(:N) /\ row i A = vec 0 /\ &0 < e
14007           ==> (?B:real^N^N. (!i j. abs(B$i$j - A$i$j) < e) /\ det B < &0) /\
14008               (?C:real^N^N. (!i j. abs(C$i$j - A$i$j) < e) /\ det C > &0)`,
14009     REPEAT GEN_TAC THEN STRIP_TAC THEN
14010     SUBGOAL_THEN `det(A:real^N^N) = &0` ASSUME_TAC THENL
14011      [ASM_MESON_TAC[DET_ZERO_ROW]; ALL_TAC] THEN
14012     MP_TAC(ISPEC `A:real^N^N` NEARBY_INVERTIBLE_MATRIX) THEN
14013     DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
14014     FIRST_X_ASSUM(MP_TAC o SPEC `min d e / &2`) THEN
14015     ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[INVERTIBLE_DET_NZ]] THEN
14016     DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP (REAL_ARITH
14017      `~(x = &0) ==> x < &0 \/ &0 < x`))
14018     THENL [ALL_TAC; ONCE_REWRITE_TAC[CONJ_SYM]] THEN
14019     (CONJ_TAC THENL
14020        [EXISTS_TAC `A + min d e / &2 %% mat 1:real^N^N`;
14021         EXISTS_TAC `(lambda j. if j = i then
14022                          --(&1) % row i (A + min d e / &2 %% mat 1:real^N^N)
14023                          else row j (A + min d e / &2 %% mat 1:real^N^N))
14024                     :real^N^N`]) THEN
14025     ASM_SIMP_TAC[DET_ROW_MUL; MESON[]
14026      `(if j = i then f i else f j) = f j`] THEN
14027     REWRITE_TAC[row; LAMBDA_ETA] THEN
14028     ASM_REWRITE_TAC[real_gt; GSYM row] THEN
14029     TRY(CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC]) THEN
14030     (MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN
14031      SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !A:real^N^N. A$m = A$k`
14032      CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
14033      SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$n = z$l`
14034      CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC]) THEN
14035     ASM_SIMP_TAC[LAMBDA_BETA] THEN
14036     TRY COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
14037     ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; MAT_COMPONENT;
14038                  VECTOR_MUL_COMPONENT] THEN
14039     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN
14040     DISCH_THEN(MP_TAC o SPEC `l:num`) THEN
14041     ASM_SIMP_TAC[row; LAMBDA_BETA; VEC_COMPONENT] THEN
14042     COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC)
14043   and lemma2 = prove
14044    (`!A:real^N^N x:real^N i.
14045           1 <= i /\ i <= dimindex(:N) /\ x$i = &1
14046           ==> det(lambda k. if k = i then transp A ** x else row k A) = det A`,
14047     REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
14048     EXISTS_TAC
14049      `det(lambda k. if k = i
14050                     then row i (A:real^N^N) + (transp A ** x - row i A)
14051                     else row k A)` THEN
14052     CONJ_TAC THENL
14053      [REWRITE_TAC[VECTOR_ARITH `r + (x - r):real^N = x`]; ALL_TAC] THEN
14054     MATCH_MP_TAC DET_ROW_SPAN THEN
14055     SUBGOAL_THEN
14056      `transp(A:real^N^N) ** x - row i A =
14057       vsum ((1..dimindex(:N)) DELETE i) (\k. x$k % row k A)`
14058     SUBST1_TAC THENL
14059      [SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_SUB_COMPONENT; row; transp;
14060                LAMBDA_BETA; matrix_vector_mul; VECTOR_MUL_COMPONENT] THEN
14061       ASM_SIMP_TAC[SUM_DELETE; IN_NUMSEG; FINITE_NUMSEG; REAL_MUL_LID] THEN
14062       REWRITE_TAC[REAL_MUL_AC];
14063       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SPAN_VSUM THEN
14064       REWRITE_TAC[FINITE_DELETE; IN_DELETE; IN_NUMSEG; FINITE_NUMSEG] THEN
14065       X_GEN_TAC `j:num` THEN STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN
14066       MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]]) in
14067   REPEAT GEN_TAC THEN DISCH_TAC THEN
14068   ASM_CASES_TAC `cofactor(A:real^N^N) = mat 0` THENL
14069    [MP_TAC(SYM(ISPEC `A:real^N^N` MATRIX_MUL_LEFT_COFACTOR)) THEN
14070     ASM_REWRITE_TAC[MATRIX_CMUL_EQ_0; TRANSP_MAT; MATRIX_MUL_LZERO] THEN
14071     REWRITE_TAC[MAT_EQ; ARITH_EQ] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
14072     SUBGOAL_THEN
14073      `?c i. 1 <= i /\ i <= dimindex(:N) /\ c$i = &1 /\
14074             transp(A:real^N^N) ** c = vec 0`
14075     STRIP_ASSUME_TAC THENL
14076      [MP_TAC(ISPEC `transp A:real^N^N` HOMOGENEOUS_LINEAR_EQUATIONS_DET) THEN
14077       ASM_REWRITE_TAC[DET_TRANSP] THEN
14078       DISCH_THEN(X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC) THEN
14079       ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
14080       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN
14081       REWRITE_TAC[VEC_COMPONENT; NOT_IMP; NOT_FORALL_THM] THEN
14082       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
14083       EXISTS_TAC `inv(c$i) % c:real^N` THEN
14084       ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_MUL_LINV] THEN
14085       ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_RMUL; VECTOR_MUL_RZERO];
14086       ALL_TAC] THEN
14087     MP_TAC(ISPECL
14088     [`(lambda k. if k = i then transp A ** c else row k (A:real^N^N)):real^N^N`;
14089      `i:num`; `min e (e / &(dimindex(:N)) /
14090                       (&1 + norm(&2 % basis i - c:real^N)))`] lemma1) THEN
14091     ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1;
14092                  NORM_ARITH `&0 < &1 + norm(x:real^N)`] THEN
14093     ANTS_TAC THENL
14094      [ASM_SIMP_TAC[row; CART_EQ; VEC_COMPONENT; LAMBDA_BETA];
14095       ALL_TAC] THEN
14096     MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN
14097     ABBREV_TAC `A':real^N^N =
14098                 lambda k. if k = i then vec 0 else row k (A:real^N^N)` THEN
14099     DISCH_THEN(X_CHOOSE_THEN `B:real^N^N` STRIP_ASSUME_TAC) THEN
14100     EXISTS_TAC `(lambda k. if k = i then transp(B:real^N^N) **
14101                                          (&2 % basis i - c)
14102                            else row k B):real^N^N` THEN
14103     ASM_SIMP_TAC[lemma2; BASIS_COMPONENT; VECTOR_MUL_COMPONENT;
14104                  VECTOR_SUB_COMPONENT; REAL_ARITH `&2 * x - x = x`] THEN
14105     (MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN
14106      SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !A:real^N^N. A$m = A$k`
14107      CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
14108      SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$n = z$l`
14109      CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC]) THEN
14110     EXPAND_TAC "A'" THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN
14111     (COND_CASES_TAC THENL
14112       [ALL_TAC;
14113        FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `l:num`]) THEN
14114        EXPAND_TAC "A'" THEN ASM_SIMP_TAC[LAMBDA_BETA; row]] THEN
14115      SUBGOAL_THEN
14116       `(A:real^N^N)$k$l = (transp(A':real^N^N) ** (&2 % basis i - c:real^N))$l`
14117      SUBST1_TAC THENL
14118       [ASM_SIMP_TAC[matrix_vector_mul; transp; LAMBDA_BETA] THEN
14119        EXPAND_TAC "A'" THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN
14120        REWRITE_TAC[COND_RAND; COND_RATOR] THEN
14121        SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT;
14122          VEC_COMPONENT; REAL_MUL_RZERO; REAL_SUB_LZERO; REAL_MUL_LZERO] THEN
14123        ASM_SIMP_TAC[SUM_CASES; FINITE_NUMSEG; SUM_0; REAL_ADD_LID] THEN
14124        ASM_SIMP_TAC[GSYM DELETE; SUM_DELETE; IN_NUMSEG; FINITE_NUMSEG] THEN
14125        UNDISCH_TAC `transp(A:real^N^N) ** (c:real^N) = vec 0` THEN
14126        ASM_SIMP_TAC[CART_EQ; VEC_COMPONENT; matrix_vector_mul; LAMBDA_BETA;
14127                     row; transp] THEN
14128        DISCH_THEN(MP_TAC o SPEC `l:num`) THEN ASM_REWRITE_TAC[] THEN
14129        SIMP_TAC[REAL_MUL_RNEG; SUM_NEG] THEN REAL_ARITH_TAC;
14130        REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT; GSYM TRANSP_MATRIX_SUB;
14131                    GSYM MATRIX_VECTOR_MUL_SUB_RDISTRIB]] THEN
14132       ASM_SIMP_TAC[matrix_vector_mul; transp; LAMBDA_BETA] THEN
14133       W(MP_TAC o PART_MATCH lhand SUM_ABS_NUMSEG o lhand o snd) THEN
14134       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN
14135       MATCH_MP_TAC SUM_BOUND_LT_GEN THEN
14136       ASM_SIMP_TAC[FINITE_NUMSEG; NUMSEG_EMPTY;
14137                    GSYM NOT_LE; DIMINDEX_GE_1] THEN
14138       X_GEN_TAC `r:num` THEN REWRITE_TAC[CARD_NUMSEG_1; IN_NUMSEG] THEN
14139       STRIP_TAC THEN REWRITE_TAC[REAL_ABS_MUL] THEN
14140       TRANS_TAC REAL_LET_TRANS
14141        `abs((B - A':real^N^N)$r$l) * (&1 + norm(&2 % basis i - c:real^N))` THEN
14142       CONJ_TAC THENL
14143        [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN
14144         MATCH_MP_TAC(REAL_ARITH `a <= b ==> a <= &1 + b`) THEN
14145         ASM_SIMP_TAC[COMPONENT_LE_NORM];
14146         ASM_SIMP_TAC[MATRIX_SUB_COMPONENT; GSYM REAL_LT_RDIV_EQ;
14147                      NORM_ARITH `&0 < &1 + norm(x:real^N)`]]);
14148     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN
14149     SIMP_TAC[CART_EQ; MAT_COMPONENT; COND_ID] THEN
14150     REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; real_gt] THEN
14151     DISCH_THEN(X_CHOOSE_THEN `i:num` (CONJUNCTS_THEN2 STRIP_ASSUME_TAC
14152      (X_CHOOSE_THEN `j:num` STRIP_ASSUME_TAC))) THEN
14153     FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH
14154      `~(x = &0) ==> &0 < x \/ x < &0`))
14155     THENL [ALL_TAC; ONCE_REWRITE_TAC[CONJ_SYM]] THEN
14156     (CONJ_TAC THENL
14157      [EXISTS_TAC `(lambda m n. if m = i /\ n = j
14158                                then (A:real^N^N)$i$j -
14159                                     e / (&1 + abs(cofactor A$i$j))
14160                                else A$m$n):real^N^N`;
14161       EXISTS_TAC `(lambda m n. if m = i /\ n = j
14162                                then (A:real^N^N)$i$j +
14163                                     e / (&1 + abs(cofactor A$i$j))
14164                                else A$m$n):real^N^N`]) THEN
14165      (CONJ_TAC THENL
14166        [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN
14167         SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !A:real^N^N. A$m = A$k`
14168         CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
14169         SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$n = z$l`
14170         CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN
14171         ASM_SIMP_TAC[LAMBDA_BETA] THEN
14172         COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM] THEN
14173         REWRITE_TAC[REAL_ARITH `abs(a - e - a) = abs e`;
14174                     REAL_ARITH `abs((a + e) - a) = abs e`] THEN
14175         REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_ABS] THEN
14176         ASM_SIMP_TAC[REAL_ARITH `abs(&1 + abs x) = &1 + abs x`;
14177                      REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &1 + abs x`] THEN
14178         MATCH_MP_TAC(REAL_ARITH
14179          `&0 < e /\ &0 < e * x ==> abs e < e * (&1 + x)`) THEN
14180         ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN ASM_REAL_ARITH_TAC;
14181         ALL_TAC]) THEN
14182     MP_TAC(GEN `A:real^N^N` (SPECL [`A:real^N^N`; `i:num`]
14183         DET_COFACTOR_EXPANSION)) THEN
14184     ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN
14185     ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
14186     ASM_SIMP_TAC[GSYM SUM_SUB_NUMSEG; LAMBDA_BETA] THEN
14187     REWRITE_TAC[REAL_ARITH `p - A$i$j * cofactor A$i$j =
14188                             --(A$i$j * cofactor A$i$j - p)`] THEN
14189     REWRITE_TAC[SUM_NEG; REAL_ARITH
14190      `a * b - c * d:real = b * (a - c) + c * (b - d)`] THEN
14191     REWRITE_TAC[SUM_ADD_NUMSEG; REAL_NEG_ADD] THEN MATCH_MP_TAC(REAL_ARITH
14192      `b = &0 /\ &0 < a ==> &0 < a + b`) THEN
14193     (CONJ_TAC THENL
14194       [REWRITE_TAC[REAL_NEG_EQ_0] THEN
14195        MATCH_MP_TAC SUM_EQ_0 THEN X_GEN_TAC `m:num` THEN
14196        REWRITE_TAC[IN_NUMSEG; REAL_ENTIRE] THEN STRIP_TAC THEN DISJ2_TAC THEN
14197        REWRITE_TAC[REAL_SUB_0] THEN REWRITE_TAC[cofactor] THEN
14198        ASM_SIMP_TAC[LAMBDA_BETA] THEN AP_TERM_TAC THEN
14199        ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN ASM_MESON_TAC[];
14200        ALL_TAC]) THEN
14201     REWRITE_TAC[GSYM SUM_NEG; GSYM REAL_MUL_RNEG] THEN
14202     MATCH_MP_TAC SUM_POS_LT THEN REWRITE_TAC[FINITE_NUMSEG] THEN
14203     MATCH_MP_TAC(MESON[REAL_LT_IMP_LE; REAL_LE_REFL]
14204      `(?i. P i /\ &0 < f i /\ (!j. P j /\ ~(j = i) ==> f j = &0))
14205       ==> (!j. P j ==> &0 <= f j) /\ (?j. P j /\ &0 < f j)`) THEN
14206     EXISTS_TAC `j:num` THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN
14207     ASM_SIMP_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; IN_NUMSEG; REAL_NEG_0] THEN
14208     REWRITE_TAC[REAL_ARITH `a - (a + e):real = --e`;
14209                 REAL_ARITH `a - (a - e):real = e`; REAL_NEG_NEG] THEN
14210     ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN
14211     REWRITE_TAC[REAL_ARITH `&0 < a * --b <=> &0 < --a * b`] THEN
14212     ASM_SIMP_TAC[REAL_LT_MUL_EQ; REAL_NEG_GT0] THEN
14213     MATCH_MP_TAC REAL_LT_DIV THEN ASM_REAL_ARITH_TAC]);;
14214
14215 (* ------------------------------------------------------------------------- *)
14216 (* Infinite sums of vectors. Allow general starting point (and more).        *)
14217 (* ------------------------------------------------------------------------- *)
14218
14219 parse_as_infix("sums",(12,"right"));;
14220
14221 let sums = new_definition
14222   `(f sums l) s = ((\n. vsum(s INTER (0..n)) f) --> l) sequentially`;;
14223
14224 let infsum = new_definition
14225  `infsum s f = @l. (f sums l) s`;;
14226
14227 let summable = new_definition
14228  `summable s f = ?l. (f sums l) s`;;
14229
14230 let SUMS_SUMMABLE = prove
14231  (`!f l s. (f sums l) s ==> summable s f`,
14232   REWRITE_TAC[summable] THEN MESON_TAC[]);;
14233
14234 let SUMS_INFSUM = prove
14235  (`!f s. (f sums (infsum s f)) s <=> summable s f`,
14236   REWRITE_TAC[infsum; summable] THEN MESON_TAC[]);;
14237
14238 let SUMS_LIM = prove
14239  (`!f:num->real^N s.
14240       (f sums lim sequentially (\n. vsum (s INTER (0..n)) f)) s
14241       <=> summable s f`,
14242   GEN_TAC THEN GEN_TAC THEN EQ_TAC THENL [MESON_TAC[summable];
14243   REWRITE_TAC[summable; sums] THEN STRIP_TAC THEN REWRITE_TAC[lim] THEN
14244   ASM_MESON_TAC[]]);;
14245
14246 let FINITE_INTER_NUMSEG = prove
14247  (`!s m n. FINITE(s INTER (m..n))`,
14248   MESON_TAC[FINITE_SUBSET; FINITE_NUMSEG; INTER_SUBSET]);;
14249
14250 let SERIES_FROM = prove
14251  (`!f l k. (f sums l) (from k) = ((\n. vsum(k..n) f) --> l) sequentially`,
14252   REPEAT GEN_TAC THEN REWRITE_TAC[sums] THEN
14253   AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
14254   AP_THM_TAC THEN AP_TERM_TAC THEN
14255   REWRITE_TAC[EXTENSION; numseg; from; IN_ELIM_THM; IN_INTER] THEN ARITH_TAC);;
14256
14257 let SERIES_UNIQUE = prove
14258  (`!f:num->real^N l l' s. (f sums l) s /\ (f sums l') s ==> (l = l')`,
14259   REWRITE_TAC[sums] THEN MESON_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIM_UNIQUE]);;
14260
14261 let INFSUM_UNIQUE = prove
14262  (`!f:num->real^N l s. (f sums l) s ==> infsum s f = l`,
14263   MESON_TAC[SERIES_UNIQUE; SUMS_INFSUM; summable]);;
14264
14265 let SERIES_TERMS_TOZERO = prove
14266  (`!f l n. (f sums l) (from n) ==> (f --> vec 0) sequentially`,
14267   REPEAT GEN_TAC THEN SIMP_TAC[sums; LIM_SEQUENTIALLY; FROM_INTER_NUMSEG] THEN
14268   DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
14269   FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
14270   ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN
14271   EXISTS_TAC `N + n + 1` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN
14272   FIRST_X_ASSUM(fun th ->
14273     MP_TAC(SPEC `m - 1` th) THEN MP_TAC(SPEC `m:num` th)) THEN
14274   SUBGOAL_THEN `0 < m /\ n <= m` (fun th -> SIMP_TAC[VSUM_CLAUSES_RIGHT; th])
14275   THENL [ASM_ARITH_TAC; ALL_TAC] THEN
14276   REPEAT(ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_TAC]) THEN
14277   REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);;
14278
14279 let SERIES_FINITE = prove
14280  (`!f s. FINITE s ==> (f sums (vsum s f)) s`,
14281   REPEAT GEN_TAC THEN REWRITE_TAC[num_FINITE; LEFT_IMP_EXISTS_THM] THEN
14282   X_GEN_TAC `n:num` THEN REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN
14283   DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `n:num` THEN
14284   X_GEN_TAC `m:num` THEN DISCH_TAC THEN
14285   SUBGOAL_THEN `s INTER (0..m) = s`
14286    (fun th -> ASM_REWRITE_TAC[th; DIST_REFL]) THEN
14287   REWRITE_TAC[EXTENSION; IN_INTER; IN_NUMSEG; LE_0] THEN
14288   ASM_MESON_TAC[LE_TRANS]);;
14289
14290 let SERIES_LINEAR = prove
14291  (`!f h l s. (f sums l) s /\ linear h ==> ((\n. h(f n)) sums h l) s`,
14292   SIMP_TAC[sums; LIM_LINEAR; FINITE_INTER; FINITE_NUMSEG;
14293            GSYM(REWRITE_RULE[o_DEF] LINEAR_VSUM)]);;
14294
14295 let SERIES_0 = prove
14296  (`!s. ((\n. vec 0) sums (vec 0)) s`,
14297   REWRITE_TAC[sums; VSUM_0; LIM_CONST]);;
14298
14299 let SERIES_ADD = prove
14300  (`!x x0 y y0 s.
14301      (x sums x0) s /\ (y sums y0) s ==> ((\n. x n + y n) sums (x0 + y0)) s`,
14302   SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_ADD; LIM_ADD]);;
14303
14304 let SERIES_SUB = prove
14305  (`!x x0 y y0 s.
14306      (x sums x0) s /\ (y sums y0) s ==> ((\n. x n - y n) sums (x0 - y0)) s`,
14307   SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_SUB; LIM_SUB]);;
14308
14309 let SERIES_CMUL = prove
14310  (`!x x0 c s. (x sums x0) s ==> ((\n. c % x n) sums (c % x0)) s`,
14311   SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_LMUL; LIM_CMUL]);;
14312
14313 let SERIES_NEG = prove
14314  (`!x x0 s. (x sums x0) s ==> ((\n. --(x n)) sums (--x0)) s`,
14315   SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_NEG; LIM_NEG]);;
14316
14317 let SUMS_IFF = prove
14318  (`!f g k. (!x. x IN k ==> f x = g x) ==> ((f sums l) k <=> (g sums l) k)`,
14319   REPEAT STRIP_TAC THEN REWRITE_TAC[sums] THEN
14320   AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
14321   MATCH_MP_TAC VSUM_EQ THEN ASM_SIMP_TAC[IN_INTER]);;
14322
14323 let SUMS_EQ = prove
14324  (`!f g k. (!x. x IN k ==> f x = g x) /\ (f sums l) k ==> (g sums l) k`,
14325   MESON_TAC[SUMS_IFF]);;
14326
14327 let SUMS_0 = prove
14328  (`!f:num->real^N s. (!n. n IN s ==> f n = vec 0) ==> (f sums vec 0) s`,
14329   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMS_EQ THEN
14330   EXISTS_TAC `\n:num. vec 0:real^N` THEN ASM_SIMP_TAC[SERIES_0]);;
14331
14332 let SERIES_FINITE_SUPPORT = prove
14333  (`!f:num->real^N s k.
14334      FINITE (s INTER k) /\ (!x. ~(x IN s INTER k) ==> f x = vec 0)
14335      ==> (f sums vsum (s INTER k) f) k`,
14336   REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN REPEAT STRIP_TAC THEN
14337   FIRST_ASSUM(MP_TAC o ISPEC `\x:num. x` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN
14338   REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
14339   STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
14340   SUBGOAL_THEN `vsum (k INTER (0..n)) (f:num->real^N) = vsum(s INTER k) f`
14341    (fun th -> ASM_REWRITE_TAC[DIST_REFL; th]) THEN
14342   MATCH_MP_TAC VSUM_SUPERSET THEN
14343   ASM_SIMP_TAC[SUBSET; IN_INTER; IN_NUMSEG; LE_0] THEN
14344   ASM_MESON_TAC[IN_INTER; LE_TRANS]);;
14345
14346 let SERIES_COMPONENT = prove
14347  (`!f s l:real^N k. (f sums l) s /\ 1 <= k /\ k <= dimindex(:N)
14348                     ==> ((\i. lift(f(i)$k)) sums lift(l$k)) s`,
14349   REPEAT GEN_TAC THEN REWRITE_TAC[sums] THEN STRIP_TAC THEN
14350   ONCE_REWRITE_TAC[GSYM o_DEF] THEN
14351   ASM_SIMP_TAC[GSYM LIFT_SUM; GSYM VSUM_COMPONENT;
14352                FINITE_INTER; FINITE_NUMSEG] THEN
14353   ASM_SIMP_TAC[o_DEF; LIM_COMPONENT]);;
14354
14355 let SERIES_DIFFS = prove
14356  (`!f:num->real^N k.
14357         (f --> vec 0) sequentially
14358         ==> ((\n. f(n) - f(n + 1)) sums f(k)) (from k)`,
14359   REWRITE_TAC[sums; FROM_INTER_NUMSEG; VSUM_DIFFS] THEN
14360   REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN
14361   EXISTS_TAC `\n. (f:num->real^N) k - f(n + 1)` THEN CONJ_TAC THENL
14362    [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `k:num` THEN
14363     SIMP_TAC[];
14364     GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_SUB_RZERO] THEN
14365     MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN
14366     MATCH_MP_TAC SEQ_OFFSET THEN ASM_REWRITE_TAC[]]);;
14367
14368 let SERIES_TRIVIAL = prove
14369  (`!f. (f sums vec 0) {}`,
14370   REWRITE_TAC[sums; INTER_EMPTY; VSUM_CLAUSES; LIM_CONST]);;
14371
14372 let SERIES_RESTRICT = prove
14373  (`!f k l:real^N.
14374         ((\n. if n IN k then f(n) else vec 0) sums l) (:num) <=>
14375         (f sums l) k`,
14376   REPEAT GEN_TAC THEN REWRITE_TAC[sums] THEN
14377   AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
14378   REWRITE_TAC[FUN_EQ_THM; INTER_UNIV] THEN GEN_TAC THEN
14379   MATCH_MP_TAC(MESON[] `vsum s f = vsum t f /\ vsum t f = vsum t g
14380                         ==> vsum s f = vsum t g`) THEN
14381   CONJ_TAC THENL
14382    [MATCH_MP_TAC VSUM_SUPERSET THEN SET_TAC[];
14383     MATCH_MP_TAC VSUM_EQ THEN SIMP_TAC[IN_INTER]]);;
14384
14385 let SERIES_VSUM = prove
14386  (`!f l k s. FINITE s /\ s SUBSET k /\ (!x. ~(x IN s) ==> f x = vec 0) /\
14387              vsum s f = l ==> (f sums l) k`,
14388   REPEAT STRIP_TAC THEN EXPAND_TAC "l" THEN
14389   SUBGOAL_THEN `s INTER k = s:num->bool` ASSUME_TAC THENL
14390    [ASM SET_TAC []; ASM_MESON_TAC [SERIES_FINITE_SUPPORT]]);;
14391
14392 let SUMS_REINDEX = prove
14393  (`!k a l n. ((\x. a(x + k)) sums l) (from n) <=> (a sums l) (from(n + k))`,
14394   REPEAT GEN_TAC THEN REWRITE_TAC[sums; FROM_INTER_NUMSEG] THEN
14395   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM VSUM_OFFSET] THEN
14396   REWRITE_TAC[LIM_SEQUENTIALLY] THEN
14397   ASM_MESON_TAC[ARITH_RULE `N + k:num <= n ==> n = (n - k) + k /\ N <= n - k`;
14398                 ARITH_RULE `N + k:num <= n ==> N <= n + k`]);;
14399
14400 (* ------------------------------------------------------------------------- *)
14401 (* Similar combining theorems just for summability.                          *)
14402 (* ------------------------------------------------------------------------- *)
14403
14404 let SUMMABLE_LINEAR = prove
14405  (`!f h s. summable s f /\ linear h ==> summable s (\n. h(f n))`,
14406   REWRITE_TAC[summable] THEN MESON_TAC[SERIES_LINEAR]);;
14407
14408 let SUMMABLE_0 = prove
14409  (`!s. summable s (\n. vec 0)`,
14410   REWRITE_TAC[summable] THEN MESON_TAC[SERIES_0]);;
14411
14412 let SUMMABLE_ADD = prove
14413  (`!x y s. summable s x /\ summable s y ==> summable s (\n. x n + y n)`,
14414   REWRITE_TAC[summable] THEN MESON_TAC[SERIES_ADD]);;
14415
14416 let SUMMABLE_SUB = prove
14417  (`!x y s. summable s x /\ summable s y ==> summable s (\n. x n - y n)`,
14418   REWRITE_TAC[summable] THEN MESON_TAC[SERIES_SUB]);;
14419
14420 let SUMMABLE_CMUL = prove
14421  (`!s x c. summable s x ==> summable s (\n. c % x n)`,
14422   REWRITE_TAC[summable] THEN MESON_TAC[SERIES_CMUL]);;
14423
14424 let SUMMABLE_NEG = prove
14425  (`!x s. summable s x ==> summable s (\n. --(x n))`,
14426   REWRITE_TAC[summable] THEN MESON_TAC[SERIES_NEG]);;
14427
14428 let SUMMABLE_IFF = prove
14429  (`!f g k. (!x. x IN k ==> f x = g x) ==> (summable k f <=> summable k g)`,
14430   REWRITE_TAC[summable] THEN MESON_TAC[SUMS_IFF]);;
14431
14432 let SUMMABLE_EQ = prove
14433  (`!f g k. (!x. x IN k ==> f x = g x) /\ summable k f ==> summable k g`,
14434   REWRITE_TAC[summable] THEN MESON_TAC[SUMS_EQ]);;
14435
14436 let SUMMABLE_COMPONENT = prove
14437  (`!f:num->real^N s k.
14438         summable s f /\ 1 <= k /\ k <= dimindex(:N)
14439         ==> summable s (\i. lift(f(i)$k))`,
14440   REPEAT STRIP_TAC THEN
14441   FIRST_X_ASSUM(X_CHOOSE_TAC `l:real^N` o REWRITE_RULE[summable]) THEN
14442   REWRITE_TAC[summable] THEN EXISTS_TAC `lift((l:real^N)$k)` THEN
14443   ASM_SIMP_TAC[SERIES_COMPONENT]);;
14444
14445 let SERIES_SUBSET = prove
14446  (`!x s t l.
14447         s SUBSET t /\
14448         ((\i. if i IN s then x i else vec 0) sums l) t
14449         ==> (x sums l) s`,
14450   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
14451   REWRITE_TAC[sums] THEN MATCH_MP_TAC EQ_IMP THEN
14452   AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
14453   ASM_SIMP_TAC[GSYM VSUM_RESTRICT_SET; FINITE_INTER_NUMSEG] THEN
14454   AP_THM_TAC THEN AP_TERM_TAC THEN POP_ASSUM MP_TAC THEN SET_TAC[]);;
14455
14456 let SUMMABLE_SUBSET = prove
14457  (`!x s t.
14458         s SUBSET t /\
14459         summable t (\i. if i IN s then x i else vec 0)
14460         ==> summable s x`,
14461   REWRITE_TAC[summable] THEN MESON_TAC[SERIES_SUBSET]);;
14462
14463 let SUMMABLE_TRIVIAL = prove
14464  (`!f:num->real^N. summable {} f`,
14465   GEN_TAC THEN REWRITE_TAC[summable] THEN EXISTS_TAC `vec 0:real^N` THEN
14466   REWRITE_TAC[SERIES_TRIVIAL]);;
14467
14468 let SUMMABLE_RESTRICT = prove
14469  (`!f:num->real^N k.
14470         summable (:num) (\n. if n IN k then f(n) else vec 0) <=>
14471         summable k f`,
14472   REWRITE_TAC[summable; SERIES_RESTRICT]);;
14473
14474 let SUMS_FINITE_DIFF = prove
14475  (`!f:num->real^N t s l.
14476         t SUBSET s /\ FINITE t /\ (f sums l) s
14477         ==> (f sums (l - vsum t f)) (s DIFF t)`,
14478   REPEAT GEN_TAC THEN
14479   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
14480   FIRST_ASSUM(MP_TAC o ISPEC `f:num->real^N` o MATCH_MP SERIES_FINITE) THEN
14481   ONCE_REWRITE_TAC[GSYM SERIES_RESTRICT] THEN
14482   REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
14483   DISCH_THEN(MP_TAC o MATCH_MP SERIES_SUB) THEN
14484   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
14485   REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:num` THEN REWRITE_TAC[IN_DIFF] THEN
14486   FIRST_ASSUM(MP_TAC o SPEC `x:num` o GEN_REWRITE_RULE I [SUBSET]) THEN
14487   MAP_EVERY ASM_CASES_TAC [`(x:num) IN s`; `(x:num) IN t`] THEN
14488   ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);;
14489
14490 let SUMS_FINITE_UNION = prove
14491  (`!f:num->real^N s t l.
14492         FINITE t /\ (f sums l) s
14493         ==> (f sums (l + vsum (t DIFF s) f)) (s UNION t)`,
14494   REPEAT GEN_TAC THEN
14495   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
14496   FIRST_ASSUM(MP_TAC o SPEC `s:num->bool` o MATCH_MP FINITE_DIFF) THEN
14497   DISCH_THEN(MP_TAC o ISPEC `f:num->real^N` o MATCH_MP SERIES_FINITE) THEN
14498   ONCE_REWRITE_TAC[GSYM SERIES_RESTRICT] THEN
14499   REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
14500   DISCH_THEN(MP_TAC o MATCH_MP SERIES_ADD) THEN
14501   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
14502   REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:num` THEN
14503   REWRITE_TAC[IN_DIFF; IN_UNION] THEN
14504   MAP_EVERY ASM_CASES_TAC [`(x:num) IN s`; `(x:num) IN t`] THEN
14505   ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);;
14506
14507 let SUMS_OFFSET = prove
14508  (`!f:num->real^N l m n.
14509         (f sums l) (from m) /\ m < n
14510         ==> (f sums (l - vsum(m..(n-1)) f)) (from n)`,
14511   REPEAT STRIP_TAC THEN
14512   SUBGOAL_THEN `from n = from m DIFF (m..(n-1))` SUBST1_TAC THENL
14513    [REWRITE_TAC[EXTENSION; IN_FROM; IN_DIFF; IN_NUMSEG] THEN ASM_ARITH_TAC;
14514     MATCH_MP_TAC SUMS_FINITE_DIFF THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN
14515     SIMP_TAC[SUBSET; IN_FROM; IN_NUMSEG]]);;
14516
14517 let SUMS_OFFSET_REV = prove
14518  (`!f:num->real^N l m n.
14519         (f sums l) (from m) /\ n < m
14520         ==> (f sums (l + vsum(n..m-1) f)) (from n)`,
14521   REPEAT STRIP_TAC THEN
14522   MP_TAC(ISPECL [`f:num->real^N`; `from m`; `n..m-1`; `l:real^N`]
14523                 SUMS_FINITE_UNION) THEN
14524   ASM_REWRITE_TAC[FINITE_NUMSEG] THEN MATCH_MP_TAC EQ_IMP THEN
14525   BINOP_TAC THENL [AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC; ALL_TAC] THEN
14526   REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNION; IN_FROM; IN_NUMSEG] THEN
14527   ASM_ARITH_TAC);;
14528
14529 let SUMMABLE_REINDEX = prove
14530  (`!k a n. summable (from n) (\x. a (x + k)) <=> summable (from(n + k)) a`,
14531   REWRITE_TAC[summable; GSYM SUMS_REINDEX]);;
14532
14533 let SERIES_DROP_LE = prove
14534  (`!f g s a b.
14535         (f sums a) s /\ (g sums b) s /\
14536         (!x. x IN s ==> drop(f x) <= drop(g x))
14537         ==> drop a <= drop b`,
14538   REWRITE_TAC[sums] THEN REPEAT STRIP_TAC THEN
14539   MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LE) THEN
14540   REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; TRIVIAL_LIMIT_SEQUENTIALLY] THEN
14541   EXISTS_TAC `\n. vsum (s INTER (0..n)) (f:num->real^1)` THEN
14542   EXISTS_TAC `\n. vsum (s INTER (0..n)) (g:num->real^1)` THEN
14543   ASM_REWRITE_TAC[DROP_VSUM] THEN EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN
14544   MATCH_MP_TAC SUM_LE THEN
14545   ASM_SIMP_TAC[FINITE_INTER; FINITE_NUMSEG; o_THM; IN_INTER; IN_NUMSEG]);;
14546
14547 let SERIES_DROP_POS = prove
14548  (`!f s a.
14549         (f sums a) s /\ (!x. x IN s ==> &0 <= drop(f x))
14550         ==> &0 <= drop a`,
14551   REPEAT STRIP_TAC THEN
14552   MP_TAC(ISPECL [`(\n. vec 0):num->real^1`; `f:num->real^1`; `s:num->bool`;
14553                  `vec 0:real^1`; `a:real^1`] SERIES_DROP_LE) THEN
14554   ASM_SIMP_TAC[SUMS_0; DROP_VEC]);;
14555
14556 let SERIES_BOUND = prove
14557  (`!f:num->real^N g s a b.
14558         (f sums a) s /\ ((lift o g) sums (lift b)) s /\
14559         (!i. i IN s ==> norm(f i) <= g i)
14560         ==> norm(a) <= b`,
14561   REWRITE_TAC[sums] THEN REPEAT STRIP_TAC THEN
14562   MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN
14563   EXISTS_TAC `\n. vsum (s INTER (0..n)) (f:num->real^N)` THEN
14564   ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN
14565   REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN
14566   X_GEN_TAC `m:num` THEN DISCH_TAC THEN
14567   TRANS_TAC REAL_LE_TRANS `sum (s INTER (0..m)) g` THEN CONJ_TAC THEN
14568   ASM_SIMP_TAC[VSUM_NORM_LE; IN_INTER; FINITE_NUMSEG; FINITE_INTER] THEN
14569   RULE_ASSUM_TAC(REWRITE_RULE[GSYM sums]) THEN
14570   UNDISCH_TAC `((lift o g) sums lift b) s` THEN
14571   GEN_REWRITE_TAC LAND_CONV [GSYM SERIES_RESTRICT] THEN
14572   REWRITE_TAC[GSYM FROM_0] THEN DISCH_THEN(MP_TAC o SPEC `m + 1` o MATCH_MP
14573    (REWRITE_RULE[IMP_CONJ] SUMS_OFFSET)) THEN
14574   REWRITE_TAC[ARITH_RULE `0 < m + 1`; o_DEF; ADD_SUB] THEN
14575   REWRITE_TAC[GSYM VSUM_RESTRICT_SET] THEN
14576   REWRITE_TAC[VSUM_REAL; o_DEF; LIFT_DROP; ETA_AX] THEN
14577   DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SERIES_DROP_POS)) THEN
14578   REWRITE_TAC[DROP_SUB; LIFT_DROP; ONCE_REWRITE_RULE[INTER_COMM] (GSYM INTER);
14579               REAL_SUB_LE] THEN
14580   DISCH_THEN MATCH_MP_TAC THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
14581   ASM_SIMP_TAC[LIFT_DROP; DROP_VEC; REAL_LE_REFL] THEN
14582   ASM_MESON_TAC[NORM_ARITH `norm(x:real^N) <= y ==> &0 <= y`]);;
14583
14584 (* ------------------------------------------------------------------------- *)
14585 (* Similar combining theorems for infsum.                                    *)
14586 (* ------------------------------------------------------------------------- *)
14587
14588 let INFSUM_LINEAR = prove
14589  (`!f h s. summable s f /\ linear h
14590            ==> infsum s (\n. h(f n)) = h(infsum s f)`,
14591   REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN
14592   MATCH_MP_TAC SERIES_LINEAR THEN ASM_REWRITE_TAC[SUMS_INFSUM]);;
14593
14594 let INFSUM_0 = prove
14595  (`infsum s (\i. vec 0) = vec 0`,
14596   MATCH_MP_TAC INFSUM_UNIQUE THEN REWRITE_TAC[SERIES_0]);;
14597
14598 let INFSUM_ADD = prove
14599  (`!x y s. summable s x /\ summable s y
14600            ==> infsum s (\i. x i + y i) = infsum s x + infsum s y`,
14601   REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN
14602   MATCH_MP_TAC SERIES_ADD THEN ASM_REWRITE_TAC[SUMS_INFSUM]);;
14603
14604 let INFSUM_SUB = prove
14605  (`!x y s. summable s x /\ summable s y
14606            ==> infsum s (\i. x i - y i) = infsum s x - infsum s y`,
14607   REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN
14608   MATCH_MP_TAC SERIES_SUB THEN ASM_REWRITE_TAC[SUMS_INFSUM]);;
14609
14610 let INFSUM_CMUL = prove
14611  (`!s x c. summable s x ==> infsum s (\n. c % x n) = c % infsum s x`,
14612   REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN
14613   MATCH_MP_TAC SERIES_CMUL THEN ASM_REWRITE_TAC[SUMS_INFSUM]);;
14614
14615 let INFSUM_NEG = prove
14616  (`!s x. summable s x ==> infsum s (\n. --(x n)) = --(infsum s x)`,
14617   REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN
14618   MATCH_MP_TAC SERIES_NEG THEN ASM_REWRITE_TAC[SUMS_INFSUM]);;
14619
14620 let INFSUM_EQ = prove
14621  (`!f g k. summable k f /\ summable k g /\ (!x. x IN k ==> f x = g x)
14622            ==> infsum k f = infsum k g`,
14623   REPEAT STRIP_TAC THEN REWRITE_TAC[infsum] THEN
14624   AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[SUMS_EQ; SUMS_INFSUM]);;
14625
14626 let INFSUM_RESTRICT = prove
14627  (`!k a:num->real^N.
14628         infsum (:num) (\n. if n IN k then a n else vec 0) = infsum k a`,
14629   REPEAT GEN_TAC THEN
14630   MP_TAC(ISPECL [`a:num->real^N`; `k:num->bool`] SUMMABLE_RESTRICT) THEN
14631   ASM_CASES_TAC `summable k (a:num->real^N)` THEN ASM_REWRITE_TAC[] THEN
14632   STRIP_TAC THENL
14633    [MATCH_MP_TAC INFSUM_UNIQUE THEN
14634     ASM_REWRITE_TAC[SERIES_RESTRICT; SUMS_INFSUM];
14635     RULE_ASSUM_TAC(REWRITE_RULE[summable; NOT_EXISTS_THM]) THEN
14636     ASM_REWRITE_TAC[infsum]]);;
14637
14638 let PARTIAL_SUMS_COMPONENT_LE_INFSUM = prove
14639  (`!f:num->real^N s k n.
14640         1 <= k /\ k <= dimindex(:N) /\
14641         (!i. i IN s ==> &0 <= (f i)$k) /\
14642         summable s f
14643         ==> (vsum (s INTER (0..n)) f)$k <= (infsum s f)$k`,
14644   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUMS_INFSUM] THEN
14645   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
14646   REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN DISCH_TAC THEN
14647   REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN
14648   FIRST_X_ASSUM(MP_TAC o SPEC
14649    `vsum (s INTER (0..n)) (f:num->real^N)$k - (infsum s f)$k`) THEN
14650   ASM_REWRITE_TAC[REAL_SUB_LT] THEN
14651   DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N + n:num`)) THEN
14652   REWRITE_TAC[LE_ADD; REAL_NOT_LT; dist] THEN
14653   MATCH_MP_TAC REAL_LE_TRANS THEN
14654   EXISTS_TAC `abs((vsum (s INTER (0..N + n)) f - infsum s f:real^N)$k)` THEN
14655   ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN
14656   MATCH_MP_TAC(REAL_ARITH `s < a /\ a <= b ==> a - s <= abs(b - s)`) THEN
14657   ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
14658   SIMP_TAC[NUMSEG_ADD_SPLIT; LE_0; UNION_OVER_INTER] THEN
14659   W(MP_TAC o PART_MATCH (lhs o rand) VSUM_UNION o lhand o rand o snd) THEN
14660   ANTS_TAC THENL
14661    [SIMP_TAC[FINITE_INTER; FINITE_NUMSEG; DISJOINT; EXTENSION] THEN
14662     REWRITE_TAC[IN_INTER; NOT_IN_EMPTY; IN_NUMSEG] THEN ARITH_TAC;
14663     DISCH_THEN SUBST1_TAC THEN
14664     REWRITE_TAC[REAL_LE_ADDR; VECTOR_ADD_COMPONENT] THEN
14665     ASM_SIMP_TAC[VSUM_COMPONENT] THEN MATCH_MP_TAC SUM_POS_LE THEN
14666     ASM_SIMP_TAC[FINITE_INTER; IN_INTER; FINITE_NUMSEG]]);;
14667
14668 let PARTIAL_SUMS_DROP_LE_INFSUM = prove
14669  (`!f s n.
14670         (!i. i IN s ==> &0 <= drop(f i)) /\
14671         summable s f
14672         ==> drop(vsum (s INTER (0..n)) f) <= drop(infsum s f)`,
14673   REPEAT STRIP_TAC THEN REWRITE_TAC[drop] THEN
14674   MATCH_MP_TAC PARTIAL_SUMS_COMPONENT_LE_INFSUM THEN
14675   ASM_REWRITE_TAC[DIMINDEX_1; LE_REFL; GSYM drop]);;
14676
14677 (* ------------------------------------------------------------------------- *)
14678 (* Cauchy criterion for series.                                              *)
14679 (* ------------------------------------------------------------------------- *)
14680
14681 let SEQUENCE_CAUCHY_WLOG = prove
14682  (`!P s. (!m n:num. P m /\ P n ==> dist(s m,s n) < e) <=>
14683          (!m n. P m /\ P n /\ m <= n ==> dist(s m,s n) < e)`,
14684   MESON_TAC[DIST_SYM; LE_CASES]);;
14685
14686 let VSUM_DIFF_LEMMA = prove
14687  (`!f:num->real^N k m n.
14688         m <= n
14689         ==> vsum(k INTER (0..n)) f - vsum(k INTER (0..m)) f =
14690             vsum(k INTER (m+1..n)) f`,
14691   REPEAT STRIP_TAC THEN
14692   MP_TAC(ISPECL [`f:num->real^N`; `k INTER (0..n)`; `k INTER (0..m)`]
14693     VSUM_DIFF) THEN
14694   ANTS_TAC THENL
14695    [SIMP_TAC[FINITE_INTER; FINITE_NUMSEG] THEN MATCH_MP_TAC
14696      (SET_RULE `s SUBSET t ==> (u INTER s SUBSET u INTER t)`) THEN
14697     REWRITE_TAC[SUBSET; IN_NUMSEG] THEN POP_ASSUM MP_TAC THEN ARITH_TAC;
14698     DISCH_THEN(SUBST1_TAC o SYM) THEN AP_THM_TAC THEN AP_TERM_TAC THEN
14699     REWRITE_TAC[SET_RULE
14700      `(k INTER s) DIFF (k INTER t) = k INTER (s DIFF t)`] THEN
14701     AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_NUMSEG] THEN
14702     POP_ASSUM MP_TAC THEN ARITH_TAC]);;
14703
14704 let NORM_VSUM_TRIVIAL_LEMMA = prove
14705  (`!e. &0 < e ==> (P ==> norm(vsum(s INTER (m..n)) f) < e <=>
14706                    P ==> n < m \/ norm(vsum(s INTER (m..n)) f) < e)`,
14707   REPEAT STRIP_TAC THEN ASM_CASES_TAC `n:num < m` THEN ASM_REWRITE_TAC[] THEN
14708   FIRST_X_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I [GSYM NUMSEG_EMPTY]) THEN
14709   ASM_REWRITE_TAC[VSUM_CLAUSES; NORM_0; INTER_EMPTY]);;
14710
14711 let SERIES_CAUCHY = prove
14712  (`!f s. (?l. (f sums l) s) =
14713          !e. &0 < e
14714              ==> ?N. !m n. m >= N
14715                            ==> norm(vsum(s INTER (m..n)) f) < e`,
14716   REPEAT GEN_TAC THEN REWRITE_TAC[sums; CONVERGENT_EQ_CAUCHY; cauchy] THEN
14717   REWRITE_TAC[SEQUENCE_CAUCHY_WLOG] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN
14718   SIMP_TAC[dist; VSUM_DIFF_LEMMA; NORM_VSUM_TRIVIAL_LEMMA] THEN
14719   REWRITE_TAC[GE; TAUT `a ==> b \/ c <=> a /\ ~b ==> c`] THEN
14720   REWRITE_TAC[NOT_LT; ARITH_RULE
14721    `(N <= m /\ N <= n /\ m <= n) /\ m + 1 <= n <=>
14722     N + 1 <= m + 1 /\ m + 1 <= n`] THEN
14723   AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN
14724   ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
14725   EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THENL
14726    [EXISTS_TAC `N + 1`; EXISTS_TAC `N:num`] THEN
14727   REPEAT STRIP_TAC THEN
14728   ASM_SIMP_TAC[ARITH_RULE `N + 1 <= m + 1 ==> N <= m + 1`] THEN
14729   FIRST_X_ASSUM(MP_TAC o SPECL [`m - 1`; `n:num`]) THEN
14730   SUBGOAL_THEN `m - 1 + 1 = m` SUBST_ALL_TAC THENL
14731    [ALL_TAC; ANTS_TAC THEN SIMP_TAC[]] THEN
14732   ASM_ARITH_TAC);;
14733
14734 let SUMMABLE_CAUCHY = prove
14735  (`!f s. summable s f <=>
14736          !e. &0 < e
14737              ==> ?N. !m n. m >= N ==> norm(vsum(s INTER (m..n)) f) < e`,
14738   REWRITE_TAC[summable; GSYM SERIES_CAUCHY]);;
14739
14740 let SUMMABLE_IFF_EVENTUALLY = prove
14741  (`!f g k. (?N. !n. N <= n /\ n IN k ==> f n = g n)
14742            ==> (summable k f <=> summable k g)`,
14743   REWRITE_TAC[summable; SERIES_CAUCHY] THEN REPEAT GEN_TAC THEN
14744   DISCH_THEN(X_CHOOSE_THEN `N0:num` STRIP_ASSUME_TAC) THEN
14745   AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN
14746   AP_TERM_TAC THEN EQ_TAC THEN
14747   DISCH_THEN(X_CHOOSE_THEN `N1:num`
14748    (fun th -> EXISTS_TAC `N0 + N1:num` THEN MP_TAC th)) THEN
14749   REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
14750   DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
14751   (ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN
14752   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
14753   MATCH_MP_TAC VSUM_EQ THEN ASM_SIMP_TAC[IN_INTER; IN_NUMSEG] THEN
14754   REPEAT STRIP_TAC THENL [ALL_TAC; CONV_TAC SYM_CONV] THEN
14755   FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
14756   ASM_ARITH_TAC);;
14757
14758 let SUMMABLE_EQ_EVENTUALLY = prove
14759  (`!f g k. (?N. !n. N <= n /\ n IN k ==> f n = g n) /\ summable k f
14760            ==> summable k g`,
14761   MESON_TAC[SUMMABLE_IFF_EVENTUALLY]);;
14762
14763 let SUMMABLE_IFF_COFINITE = prove
14764  (`!f s t. FINITE((s DIFF t) UNION (t DIFF s))
14765            ==> (summable s f <=> summable t f)`,
14766   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM SUMMABLE_RESTRICT] THEN
14767   MATCH_MP_TAC SUMMABLE_IFF_EVENTUALLY THEN
14768   FIRST_ASSUM(MP_TAC o ISPEC `\x:num.x` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN
14769   DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN REWRITE_TAC[IN_UNIV] THEN
14770   DISCH_TAC THEN EXISTS_TAC `N + 1` THEN
14771   REWRITE_TAC[ARITH_RULE `N + 1 <= n <=> ~(n <= N)`] THEN ASM SET_TAC[]);;
14772
14773 let SUMMABLE_EQ_COFINITE = prove
14774  (`!f s t. FINITE((s DIFF t) UNION (t DIFF s)) /\ summable s f
14775            ==> summable t f`,
14776   MESON_TAC[SUMMABLE_IFF_COFINITE]);;
14777
14778 let SUMMABLE_FROM_ELSEWHERE = prove
14779  (`!f m n. summable (from m) f ==> summable (from n) f`,
14780   REPEAT GEN_TAC THEN
14781   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUMMABLE_EQ_COFINITE) THEN
14782   MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..(m+n)` THEN
14783   SIMP_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; IN_UNION; IN_DIFF; IN_FROM] THEN
14784   ARITH_TAC);;
14785
14786 (* ------------------------------------------------------------------------- *)
14787 (* Uniform vesion of Cauchy criterion.                                       *)
14788 (* ------------------------------------------------------------------------- *)
14789
14790 let SERIES_CAUCHY_UNIFORM = prove
14791  (`!P f:A->num->real^N k.
14792         (?l. !e. &0 < e
14793                  ==> ?N. !n x. N <= n /\ P x
14794                                ==> dist(vsum(k INTER (0..n)) (f x),
14795                                         l x) < e) <=>
14796         (!e. &0 < e ==> ?N. !m n x. N <= m /\ P x
14797                                     ==> norm(vsum(k INTER (m..n)) (f x)) < e)`,
14798   REPEAT GEN_TAC THEN
14799   REWRITE_TAC[sums; UNIFORMLY_CONVERGENT_EQ_CAUCHY; cauchy] THEN
14800   ONCE_REWRITE_TAC[MESON[]
14801    `(!m n:num y. N <= m /\ N <= n /\ P y ==> Q m n y) <=>
14802     (!y. P y ==> !m n. N <= m /\ N <= n ==> Q m n y)`] THEN
14803   REWRITE_TAC[SEQUENCE_CAUCHY_WLOG] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN
14804   SIMP_TAC[dist; VSUM_DIFF_LEMMA; NORM_VSUM_TRIVIAL_LEMMA] THEN
14805   REWRITE_TAC[GE; TAUT `a ==> b \/ c <=> a /\ ~b ==> c`] THEN
14806   REWRITE_TAC[NOT_LT; ARITH_RULE
14807    `(N <= m /\ N <= n /\ m <= n) /\ m + 1 <= n <=>
14808     N + 1 <= m + 1 /\ m + 1 <= n`] THEN
14809   AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN
14810   ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
14811   EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THENL
14812    [EXISTS_TAC `N + 1`; EXISTS_TAC `N:num`] THEN
14813   REPEAT STRIP_TAC THEN
14814   ASM_SIMP_TAC[ARITH_RULE `N + 1 <= m + 1 ==> N <= m + 1`] THEN
14815   FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN
14816   DISCH_THEN(MP_TAC o SPECL [`m - 1`; `n:num`]) THEN
14817   SUBGOAL_THEN `m - 1 + 1 = m` SUBST_ALL_TAC THENL
14818    [ALL_TAC; ANTS_TAC THEN SIMP_TAC[]] THEN
14819   ASM_ARITH_TAC);;
14820
14821 (* ------------------------------------------------------------------------- *)
14822 (* So trivially, terms of a convergent series go to zero.                    *)
14823 (* ------------------------------------------------------------------------- *)
14824
14825 let SERIES_GOESTOZERO = prove
14826  (`!s x. summable s x
14827          ==> !e. &0 < e
14828                  ==> eventually (\n. n IN s ==> norm(x n) < e) sequentially`,
14829   REPEAT GEN_TAC THEN REWRITE_TAC[summable; SERIES_CAUCHY] THEN
14830   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
14831   MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
14832   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN
14833   X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN
14834   FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `n:num`]) THEN
14835   ASM_SIMP_TAC[NUMSEG_SING; GE; SET_RULE `n IN s ==> s INTER {n} = {n}`] THEN
14836   REWRITE_TAC[VSUM_SING]);;
14837
14838 let SUMMABLE_IMP_TOZERO = prove
14839  (`!f:num->real^N k.
14840        summable k f
14841        ==> ((\n. if n IN k then f(n) else vec 0) --> vec 0) sequentially`,
14842   REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM SUMMABLE_RESTRICT] THEN
14843   REWRITE_TAC[summable; LIM_SEQUENTIALLY; INTER_UNIV; sums] THEN
14844   DISCH_THEN(X_CHOOSE_TAC `l:real^N`) THEN X_GEN_TAC `e:real` THEN
14845   DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
14846   ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN
14847   X_GEN_TAC `N:num` THEN DISCH_TAC THEN EXISTS_TAC `N + 1` THEN
14848   X_GEN_TAC `n:num` THEN DISCH_TAC THEN
14849   FIRST_X_ASSUM(fun th ->
14850     MP_TAC(SPEC `n - 1` th) THEN MP_TAC(SPEC `n:num` th)) THEN
14851   ASM_SIMP_TAC[ARITH_RULE `N + 1 <= n ==> N <= n /\ N <= n - 1`] THEN
14852   ABBREV_TAC `m = n - 1` THEN
14853   SUBGOAL_THEN `n = SUC m` SUBST1_TAC THENL
14854    [ASM_ARITH_TAC; ALL_TAC] THEN
14855   REWRITE_TAC[VSUM_CLAUSES_NUMSEG; LE_0] THEN
14856   REWRITE_TAC[NORM_ARITH `dist(x,vec 0) = norm x`] THEN
14857   COND_CASES_TAC THEN ASM_REWRITE_TAC[NORM_0] THEN CONV_TAC NORM_ARITH);;
14858
14859 let SUMMABLE_IMP_BOUNDED = prove
14860  (`!f:num->real^N k. summable k f ==> bounded (IMAGE f k)`,
14861   REPEAT GEN_TAC THEN
14862   DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_IMP_TOZERO) THEN
14863   DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN
14864   REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV] THEN
14865   MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[REAL_LT_IMP_LE; NORM_0]);;
14866
14867 let SUMMABLE_IMP_SUMS_BOUNDED = prove
14868  (`!f:num->real^N k.
14869        summable (from k) f ==> bounded { vsum(k..n) f | n IN (:num) }`,
14870   REWRITE_TAC[summable; sums; LEFT_IMP_EXISTS_THM] THEN REPEAT GEN_TAC THEN
14871   DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN
14872   REWRITE_TAC[FROM_INTER_NUMSEG; SIMPLE_IMAGE]);;
14873
14874 (* ------------------------------------------------------------------------- *)
14875 (* Comparison test.                                                          *)
14876 (* ------------------------------------------------------------------------- *)
14877
14878 let SERIES_COMPARISON = prove
14879  (`!f g s. (?l. ((lift o g) sums l) s) /\
14880            (?N. !n. n >= N /\ n IN s ==> norm(f n) <= g n)
14881            ==> ?l:real^N. (f sums l) s`,
14882   REPEAT GEN_TAC THEN REWRITE_TAC[SERIES_CAUCHY] THEN
14883   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC `N1:num`)) THEN
14884   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
14885   MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
14886   DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN
14887   EXISTS_TAC `N1 + N2:num` THEN
14888   MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN
14889   MATCH_MP_TAC REAL_LET_TRANS THEN
14890   EXISTS_TAC `norm (vsum (s INTER (m .. n)) (lift o g))` THEN CONJ_TAC THENL
14891    [SIMP_TAC[GSYM LIFT_SUM; FINITE_INTER_NUMSEG; NORM_LIFT] THEN
14892     MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs(a)`) THEN
14893     MATCH_MP_TAC VSUM_NORM_LE THEN
14894     REWRITE_TAC[FINITE_INTER_NUMSEG; IN_INTER; IN_NUMSEG] THEN
14895     ASM_MESON_TAC[ARITH_RULE `m >= N1 + N2:num /\ m <= x ==> x >= N1`];
14896     ASM_MESON_TAC[ARITH_RULE `m >= N1 + N2:num ==> m >= N2`]]);;
14897
14898 let SUMMABLE_COMPARISON = prove
14899  (`!f g s. summable s (lift o g) /\
14900            (?N. !n. n >= N /\ n IN s ==> norm(f n) <= g n)
14901            ==> summable s f`,
14902   REWRITE_TAC[summable; SERIES_COMPARISON]);;
14903
14904 let SERIES_LIFT_ABSCONV_IMP_CONV = prove
14905  (`!x:num->real^N k. summable k (\n. lift(norm(x n))) ==> summable k x`,
14906   REWRITE_TAC[summable] THEN REPEAT STRIP_TAC THEN
14907   MATCH_MP_TAC SERIES_COMPARISON THEN
14908   EXISTS_TAC `\n:num. norm(x n:real^N)` THEN
14909   ASM_REWRITE_TAC[o_DEF; REAL_LE_REFL] THEN ASM_MESON_TAC[]);;
14910
14911 let SUMMABLE_SUBSET_ABSCONV = prove
14912  (`!x:num->real^N s t.
14913         summable s (\n. lift(norm(x n))) /\ t SUBSET s
14914         ==> summable t (\n. lift(norm(x n)))`,
14915   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_SUBSET THEN
14916   EXISTS_TAC `s:num->bool` THEN ASM_REWRITE_TAC[] THEN
14917   REWRITE_TAC[summable] THEN MATCH_MP_TAC SERIES_COMPARISON THEN
14918   EXISTS_TAC `\n:num. norm(x n:real^N)` THEN
14919   ASM_REWRITE_TAC[o_DEF; GSYM summable] THEN
14920   EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
14921   REWRITE_TAC[REAL_LE_REFL; NORM_LIFT; REAL_ABS_NORM; NORM_0; NORM_POS_LE]);;
14922
14923 let SERIES_COMPARISON_BOUND = prove
14924  (`!f:num->real^N g s a.
14925         (g sums a) s /\ (!i. i IN s ==> norm(f i) <= drop(g i))
14926         ==> ?l. (f sums l) s /\ norm(l) <= drop a`,
14927   REPEAT STRIP_TAC THEN
14928   MP_TAC(ISPECL [`f:num->real^N`; `drop o (g:num->real^1)`; `s:num->bool`]
14929         SUMMABLE_COMPARISON) THEN
14930   REWRITE_TAC[o_DEF; LIFT_DROP; GE; ETA_AX; summable] THEN
14931   ANTS_TAC THENL [ASM_MESON_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN
14932   X_GEN_TAC `l:real^N` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
14933   RULE_ASSUM_TAC(REWRITE_RULE[FROM_0; INTER_UNIV; sums]) THEN
14934   MATCH_MP_TAC SERIES_BOUND THEN MAP_EVERY EXISTS_TAC
14935    [`f:num->real^N`; `drop o (g:num->real^1)`; `s:num->bool`] THEN
14936   ASM_REWRITE_TAC[sums; o_DEF; LIFT_DROP; ETA_AX]);;
14937
14938 (* ------------------------------------------------------------------------- *)
14939 (* Uniform version of comparison test.                                       *)
14940 (* ------------------------------------------------------------------------- *)
14941
14942 let SERIES_COMPARISON_UNIFORM = prove
14943  (`!f g P s. (?l. ((lift o g) sums l) s) /\
14944              (?N. !n x. N <= n /\ n IN s /\ P x ==> norm(f x n) <= g n)
14945              ==> ?l:A->real^N.
14946                     !e. &0 < e
14947                         ==> ?N. !n x. N <= n /\ P x
14948                                       ==> dist(vsum(s INTER (0..n)) (f x),
14949                                                l x) < e`,
14950   REPEAT GEN_TAC THEN SIMP_TAC[GE; SERIES_CAUCHY; SERIES_CAUCHY_UNIFORM] THEN
14951   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC `N1:num`)) THEN
14952   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
14953   MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
14954   DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN
14955   EXISTS_TAC `N1 + N2:num` THEN
14956   MAP_EVERY X_GEN_TAC [`m:num`; `n:num`; `x:A`] THEN DISCH_TAC THEN
14957   MATCH_MP_TAC REAL_LET_TRANS THEN
14958   EXISTS_TAC `norm (vsum (s INTER (m .. n)) (lift o g))` THEN CONJ_TAC THENL
14959    [SIMP_TAC[GSYM LIFT_SUM; FINITE_INTER_NUMSEG; NORM_LIFT] THEN
14960     MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs(a)`) THEN
14961     MATCH_MP_TAC VSUM_NORM_LE THEN
14962     REWRITE_TAC[FINITE_INTER_NUMSEG; IN_INTER; IN_NUMSEG] THEN
14963     ASM_MESON_TAC[ARITH_RULE `N1 + N2:num <= m /\ m <= x ==> N1 <= x`];
14964     ASM_MESON_TAC[ARITH_RULE `N1 + N2:num <= m ==> N2 <= m`]]);;
14965
14966 (* ------------------------------------------------------------------------- *)
14967 (* Ratio test.                                                               *)
14968 (* ------------------------------------------------------------------------- *)
14969
14970 let SERIES_RATIO = prove
14971  (`!c a s N.
14972       c < &1 /\
14973       (!n. n >= N ==> norm(a(SUC n)) <= c * norm(a(n)))
14974       ==> ?l:real^N. (a sums l) s`,
14975   REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN
14976   MATCH_MP_TAC SERIES_COMPARISON THEN
14977   DISJ_CASES_TAC(REAL_ARITH `c <= &0 \/ &0 < c`) THENL
14978    [EXISTS_TAC `\n:num. &0` THEN REWRITE_TAC[o_DEF; LIFT_NUM] THEN
14979     CONJ_TAC THENL [MESON_TAC[SERIES_0]; ALL_TAC] THEN
14980     EXISTS_TAC `N + 1` THEN REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN
14981     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `c * norm(a(n - 1):real^N)` THEN
14982     CONJ_TAC THENL
14983      [ASM_MESON_TAC[ARITH_RULE `N + 1 <= n ==> SUC(n - 1) = n /\ N <= n - 1`];
14984       ALL_TAC] THEN
14985     MATCH_MP_TAC(REAL_ARITH `&0 <= --c * x ==> c * x <= &0`) THEN
14986     MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[NORM_POS_LE] THEN
14987     UNDISCH_TAC `c <= &0` THEN REAL_ARITH_TAC;
14988     ASSUME_TAC(MATCH_MP REAL_LT_IMP_LE (ASSUME `&0 < c`))] THEN
14989   EXISTS_TAC `\n. norm(a(N):real^N) * c pow (n - N)` THEN
14990   REWRITE_TAC[] THEN CONJ_TAC THENL
14991    [ALL_TAC;
14992     EXISTS_TAC `N:num` THEN
14993     SIMP_TAC[GE; LE_EXISTS; IMP_CONJ; ADD_SUB2; LEFT_IMP_EXISTS_THM] THEN
14994     SUBGOAL_THEN `!d:num. norm(a(N + d):real^N) <= norm(a N) * c pow d`
14995      (fun th -> MESON_TAC[th]) THEN INDUCT_TAC THEN
14996     REWRITE_TAC[ADD_CLAUSES; real_pow; REAL_MUL_RID; REAL_LE_REFL] THEN
14997     MATCH_MP_TAC REAL_LE_TRANS THEN
14998     EXISTS_TAC `c * norm((a:num->real^N) (N + d))` THEN
14999     ASM_SIMP_TAC[LE_ADD] THEN ASM_MESON_TAC[REAL_LE_LMUL; REAL_MUL_AC]] THEN
15000   GEN_REWRITE_TAC I [SERIES_CAUCHY] THEN X_GEN_TAC `e:real` THEN
15001   SIMP_TAC[GSYM LIFT_SUM; FINITE_INTER; NORM_LIFT; FINITE_NUMSEG] THEN
15002   DISCH_TAC THEN SIMP_TAC[SUM_LMUL; FINITE_INTER; FINITE_NUMSEG] THEN
15003   ASM_CASES_TAC `(a:num->real^N) N = vec 0` THENL
15004    [ASM_REWRITE_TAC[NORM_0; REAL_MUL_LZERO; REAL_ABS_NUM]; ALL_TAC] THEN
15005   MP_TAC(SPECL [`c:real`; `((&1 - c) * e) / norm((a:num->real^N) N)`]
15006                REAL_ARCH_POW_INV) THEN
15007   ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; REAL_SUB_LT; NORM_POS_LT; GE] THEN
15008   DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN EXISTS_TAC `N + M:num` THEN
15009   MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN
15010   MATCH_MP_TAC REAL_LET_TRANS THEN
15011   EXISTS_TAC `abs(norm((a:num->real^N) N) *
15012                   sum(m..n) (\i. c pow (i - N)))` THEN
15013   CONJ_TAC THENL
15014    [REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN
15015     REWRITE_TAC[REAL_ABS_POS] THEN
15016     MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= abs y`) THEN
15017     ASM_SIMP_TAC[SUM_POS_LE; FINITE_INTER_NUMSEG; REAL_POW_LE] THEN
15018     MATCH_MP_TAC SUM_SUBSET THEN ASM_SIMP_TAC[REAL_POW_LE] THEN
15019     REWRITE_TAC[FINITE_INTER_NUMSEG; FINITE_NUMSEG] THEN
15020     REWRITE_TAC[IN_INTER; IN_DIFF] THEN MESON_TAC[];
15021     ALL_TAC] THEN
15022   REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM] THEN
15023   DISJ_CASES_TAC(ARITH_RULE `n:num < m \/ m <= n`) THENL
15024    [ASM_SIMP_TAC[SUM_TRIV_NUMSEG; REAL_ABS_NUM; REAL_MUL_RZERO]; ALL_TAC] THEN
15025   SUBGOAL_THEN `m = 0 + m /\ n = (n - m) + m` (CONJUNCTS_THEN SUBST1_TAC) THENL
15026    [UNDISCH_TAC `m:num <= n` THEN ARITH_TAC; ALL_TAC] THEN
15027   REWRITE_TAC[SUM_OFFSET] THEN UNDISCH_TAC `N + M:num <= m` THEN
15028   SIMP_TAC[LE_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN
15029   REWRITE_TAC[ARITH_RULE `(i + (N + M) + d) - N:num = (M + d) + i`] THEN
15030   ONCE_REWRITE_TAC[REAL_POW_ADD] THEN REWRITE_TAC[SUM_LMUL; SUM_GP] THEN
15031   ASM_SIMP_TAC[LT; REAL_LT_IMP_NE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
15032   ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_POS_LT; REAL_ABS_MUL] THEN
15033   REWRITE_TAC[REAL_ABS_POW] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
15034   ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_ABS_DIV; REAL_POW_LT; REAL_ARITH
15035    `&0 < c /\ c < &1 ==> &0 < abs c /\ &0 < abs(&1 - c)`; REAL_LT_LDIV_EQ] THEN
15036   MATCH_MP_TAC(REAL_ARITH
15037    `&0 < x /\ x <= &1 /\ &1 <= e ==> abs(c pow 0 - x) < e`) THEN
15038   ASM_SIMP_TAC[REAL_POW_LT; REAL_POW_1_LE; REAL_LT_IMP_LE] THEN
15039   ASM_SIMP_TAC[REAL_ARITH `c < &1 ==> x * abs(&1 - c) = (&1 - c) * x`] THEN
15040   REWRITE_TAC[real_div; REAL_INV_MUL; REAL_POW_ADD; REAL_MUL_ASSOC] THEN
15041   REWRITE_TAC[REAL_ARITH
15042    `(((a * b) * c) * d) * e = (e * ((a * b) * c)) * d`] THEN
15043   ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; REAL_POW_LT; REAL_MUL_LID;
15044                REAL_ARITH `&0 < c ==> abs c = c`] THEN
15045   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
15046    `xm < e ==> &0 <= (d - &1) * e ==> xm <= d * e`)) THEN
15047   MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL
15048    [REWRITE_TAC[REAL_SUB_LE; GSYM REAL_POW_INV] THEN
15049     MATCH_MP_TAC REAL_POW_LE_1 THEN
15050     MATCH_MP_TAC REAL_INV_1_LE THEN ASM_SIMP_TAC[REAL_LT_IMP_LE];
15051     MATCH_MP_TAC REAL_LT_IMP_LE THEN
15052     ASM_SIMP_TAC[REAL_SUB_LT; REAL_LT_MUL; REAL_LT_DIV; NORM_POS_LT]]);;
15053
15054 (* ------------------------------------------------------------------------- *)
15055 (* Ostensibly weaker versions of the boundedness of partial sums.            *)
15056 (* ------------------------------------------------------------------------- *)
15057
15058 let BOUNDED_PARTIAL_SUMS = prove
15059  (`!f:num->real^N k.
15060         bounded { vsum(k..n) f | n IN (:num) }
15061         ==> bounded { vsum(m..n) f | m IN (:num) /\ n IN (:num) }`,
15062   REPEAT STRIP_TAC THEN
15063   SUBGOAL_THEN `bounded { vsum(0..n) f:real^N | n IN (:num) }` MP_TAC THENL
15064    [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
15065     REWRITE_TAC[bounded] THEN
15066     REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN
15067     DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
15068     EXISTS_TAC `sum { i:num | i < k} (\i. norm(f i:real^N)) + B` THEN
15069     X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i:num < k` THENL
15070      [MATCH_MP_TAC(REAL_ARITH
15071        `!y. x <= y /\ y <= a /\ &0 < b ==> x <= a + b`) THEN
15072       EXISTS_TAC `sum (0..i) (\i. norm(f i:real^N))` THEN
15073       ASM_SIMP_TAC[VSUM_NORM; FINITE_NUMSEG] THEN
15074       MATCH_MP_TAC SUM_SUBSET THEN
15075       REWRITE_TAC[FINITE_NUMSEG; FINITE_NUMSEG_LT; NORM_POS_LE] THEN
15076       REWRITE_TAC[IN_DIFF; IN_NUMSEG; IN_ELIM_THM] THEN ASM_ARITH_TAC;
15077       ALL_TAC] THEN
15078     ASM_CASES_TAC `k = 0` THENL
15079      [FIRST_X_ASSUM SUBST_ALL_TAC THEN MATCH_MP_TAC(REAL_ARITH
15080        `x <= B /\ &0 <= b ==> x <= b + B`) THEN
15081       ASM_SIMP_TAC[SUM_POS_LE; FINITE_NUMSEG_LT; NORM_POS_LE];
15082       ALL_TAC] THEN
15083     MP_TAC(ISPECL [`f:num->real^N`; `0`; `k:num`; `i:num`]
15084       VSUM_COMBINE_L) THEN
15085     ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
15086     DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[NUMSEG_LT] THEN
15087     MATCH_MP_TAC(NORM_ARITH
15088      `norm(x) <= a /\ norm(y) <= b ==> norm(x + y) <= a + b`) THEN
15089     ASM_SIMP_TAC[VSUM_NORM; FINITE_NUMSEG];
15090     ALL_TAC] THEN
15091   DISCH_THEN(fun th ->
15092     MP_TAC(MATCH_MP BOUNDED_DIFFS (W CONJ th)) THEN MP_TAC th) THEN
15093   REWRITE_TAC[IMP_IMP; GSYM BOUNDED_UNION] THEN
15094   MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b ==> c <=> b ==> a ==> c`]
15095         BOUNDED_SUBSET) THEN
15096   REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN
15097   MAP_EVERY X_GEN_TAC [`x:real^N`; `m:num`; `n:num`] THEN
15098   DISCH_THEN SUBST1_TAC THEN
15099   ASM_CASES_TAC `m = 0` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
15100   ASM_CASES_TAC `n:num < m` THENL
15101    [DISJ2_TAC THEN REPEAT(EXISTS_TAC `vsum(0..0) (f:num->real^N)`) THEN
15102     ASM_SIMP_TAC[VSUM_TRIV_NUMSEG; VECTOR_SUB_REFL] THEN MESON_TAC[];
15103     ALL_TAC] THEN
15104   DISJ2_TAC THEN MAP_EVERY EXISTS_TAC
15105    [`vsum(0..n) (f:num->real^N)`; `vsum(0..(m-1)) (f:num->real^N)`] THEN
15106   CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
15107   MP_TAC(ISPECL [`f:num->real^N`; `0`; `m:num`; `n:num`]
15108       VSUM_COMBINE_L) THEN
15109   ANTS_TAC THENL [ASM_ARITH_TAC; VECTOR_ARITH_TAC]);;
15110
15111 (* ------------------------------------------------------------------------- *)
15112 (* General Dirichlet convergence test (could make this uniform on a set).    *)
15113 (* ------------------------------------------------------------------------- *)
15114
15115 let SUMMABLE_BILINEAR_PARTIAL_PRE = prove
15116  (`!f g h:real^M->real^N->real^P l k.
15117         bilinear h /\
15118         ((\n. h (f(n + 1)) (g(n))) --> l) sequentially /\
15119         summable (from k) (\n. h (f(n + 1) - f(n)) (g(n)))
15120         ==> summable (from k) (\n. h (f n) (g(n) - g(n - 1)))`,
15121   REPEAT GEN_TAC THEN
15122   REWRITE_TAC[summable; sums; FROM_INTER_NUMSEG] THEN
15123   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
15124   FIRST_ASSUM(fun th ->
15125    REWRITE_TAC[MATCH_MP BILINEAR_VSUM_PARTIAL_PRE th]) THEN
15126   DISCH_THEN(X_CHOOSE_TAC `l':real^P`) THEN
15127   EXISTS_TAC `l - (h:real^M->real^N->real^P) (f k) (g(k - 1)) - l'` THEN
15128   REWRITE_TAC[LIM_CASES_SEQUENTIALLY] THEN
15129   REPEAT(MATCH_MP_TAC LIM_SUB THEN ASM_REWRITE_TAC[LIM_CONST]));;
15130
15131 let SERIES_DIRICHLET_BILINEAR = prove
15132  (`!f g h:real^M->real^N->real^P k m p l.
15133         bilinear h /\
15134         bounded { vsum (m..n) f | n IN (:num)} /\
15135         summable (from p) (\n. lift(norm(g(n + 1) - g(n)))) /\
15136         ((\n. h (g(n + 1)) (vsum(1..n) f)) --> l) sequentially
15137         ==> summable (from k) (\n. h (g n) (f n))`,
15138   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_FROM_ELSEWHERE THEN
15139   EXISTS_TAC `1` THEN
15140   FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP BOUNDED_PARTIAL_SUMS) THEN
15141   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
15142   SIMP_TAC[IN_ELIM_THM; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN
15143   REWRITE_TAC[MESON[] `(!x a b. x = f a b ==> p a b) <=> (!a b. p a b)`] THEN
15144   X_GEN_TAC `B:real` THEN STRIP_TAC THEN
15145   FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN
15146   DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN
15147   MATCH_MP_TAC SUMMABLE_EQ THEN
15148   EXISTS_TAC `\n. (h:real^M->real^N->real^P)
15149                   (g n) (vsum (1..n) f - vsum (1..n-1) f)` THEN
15150   SIMP_TAC[IN_FROM; GSYM NUMSEG_RREC] THEN
15151   SIMP_TAC[VSUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG;
15152            ARITH_RULE `1 <= n ==> ~(n <= n - 1)`] THEN
15153   CONJ_TAC THENL
15154    [REPEAT STRIP_TAC THEN ASM_SIMP_TAC[BILINEAR_RADD; BILINEAR_RSUB] THEN
15155     VECTOR_ARITH_TAC;
15156     ALL_TAC] THEN
15157   MATCH_MP_TAC SUMMABLE_FROM_ELSEWHERE THEN EXISTS_TAC `p:num` THEN
15158   MP_TAC(ISPECL [`g:num->real^M`; `\n. vsum(1..n) f:real^N`;
15159                  `h:real^M->real^N->real^P`; `l:real^P`; `p:num`]
15160          SUMMABLE_BILINEAR_PARTIAL_PRE) THEN
15161   REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN
15162   ASM_REWRITE_TAC[] THEN
15163   SUBGOAL_THEN
15164     `summable (from p) (lift o (\n. C * B * norm(g(n + 1) - g(n):real^M)))`
15165   MP_TAC THENL [ASM_SIMP_TAC[o_DEF; LIFT_CMUL; SUMMABLE_CMUL]; ALL_TAC] THEN
15166   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUMMABLE_COMPARISON) THEN
15167   EXISTS_TAC `0` THEN REWRITE_TAC[IN_FROM; GE; LE_0] THEN
15168   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
15169    `C * norm(g(n + 1) - g(n):real^M) * norm(vsum (1..n) f:real^N)` THEN
15170   ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN
15171   GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
15172   ASM_SIMP_TAC[REAL_LE_LMUL; NORM_POS_LE]);;
15173
15174 let SERIES_DIRICHLET = prove
15175  (`!f:num->real^N g N k m.
15176         bounded { vsum (m..n) f | n IN (:num)} /\
15177         (!n. N <= n ==> g(n + 1) <= g(n)) /\
15178         ((lift o g) --> vec 0) sequentially
15179         ==> summable (from k) (\n. g(n) % f(n))`,
15180   REPEAT STRIP_TAC THEN
15181   MP_TAC(ISPECL [`f:num->real^N`; `lift o (g:num->real)`;
15182                  `\x y:real^N. drop x % y`] SERIES_DIRICHLET_BILINEAR) THEN
15183   REWRITE_TAC[o_THM; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN
15184   MAP_EVERY EXISTS_TAC [`m:num`; `N:num`; `vec 0:real^N`] THEN CONJ_TAC THENL
15185    [REWRITE_TAC[bilinear; linear; DROP_ADD; DROP_CMUL] THEN
15186     REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC;
15187     ALL_TAC] THEN
15188   ASM_REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN
15189   FIRST_ASSUM(MP_TAC o SPEC `1` o MATCH_MP SEQ_OFFSET) THEN
15190   REWRITE_TAC[o_THM] THEN DISCH_TAC THEN CONJ_TAC THENL
15191    [MATCH_MP_TAC SUMMABLE_EQ_EVENTUALLY THEN
15192     EXISTS_TAC `\n. lift(g(n) - g(n + 1))` THEN REWRITE_TAC[] THEN
15193     CONJ_TAC THENL
15194      [ASM_MESON_TAC[REAL_ARITH `b <= a ==> abs(b - a) = a - b`];
15195       REWRITE_TAC[summable; sums; FROM_INTER_NUMSEG; VSUM_DIFFS; LIFT_SUB] THEN
15196       REWRITE_TAC[LIM_CASES_SEQUENTIALLY] THEN
15197       EXISTS_TAC `lift(g(N:num)) - vec 0` THEN
15198       MATCH_MP_TAC LIM_SUB THEN ASM_REWRITE_TAC[LIM_CONST]];
15199     MATCH_MP_TAC LIM_NULL_VMUL_BOUNDED THEN ASM_REWRITE_TAC[o_DEF] THEN
15200     REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
15201     FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP BOUNDED_PARTIAL_SUMS) THEN
15202     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
15203     SIMP_TAC[IN_ELIM_THM; IN_UNIV] THEN MESON_TAC[]]);;
15204
15205 (* ------------------------------------------------------------------------- *)
15206 (* Rearranging absolutely convergent series.                                 *)
15207 (* ------------------------------------------------------------------------- *)
15208
15209 let SERIES_INJECTIVE_IMAGE_STRONG = prove
15210  (`!x:num->real^N s f.
15211         summable (IMAGE f s) (\n. lift(norm(x n))) /\
15212         (!m n. m IN s /\ n IN s /\ f m = f n ==> m = n)
15213         ==> ((\n. vsum (IMAGE f s INTER (0..n)) x -
15214                   vsum (s INTER (0..n)) (x o f)) --> vec 0)
15215             sequentially`,
15216   let lemma = prove
15217    (`!f:A->real^N s t.
15218           FINITE s /\ FINITE t
15219           ==> vsum s f - vsum t f = vsum (s DIFF t) f - vsum (t DIFF s) f`,
15220     REPEAT STRIP_TAC THEN
15221     ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN
15222     ASM_SIMP_TAC[VSUM_DIFF; INTER_SUBSET] THEN
15223     REWRITE_TAC[INTER_COMM] THEN VECTOR_ARITH_TAC) in
15224   REPEAT STRIP_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN
15225   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
15226   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUMMABLE_CAUCHY]) THEN
15227   SIMP_TAC[VSUM_REAL; FINITE_INTER; FINITE_NUMSEG] THEN
15228   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [o_DEF] THEN
15229   REWRITE_TAC[NORM_LIFT; LIFT_DROP] THEN
15230   SIMP_TAC[real_abs; SUM_POS_LE; NORM_POS_LE; FINITE_INTER; FINITE_NUMSEG] THEN
15231   DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN
15232   ASM_REWRITE_TAC[dist; GE; VECTOR_SUB_RZERO; REAL_HALF] THEN
15233   DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN
15234   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN
15235   DISCH_THEN(X_CHOOSE_TAC `g:num->num`) THEN
15236   MP_TAC(ISPECL [`g:num->num`; `0..N`] UPPER_BOUND_FINITE_SET) THEN
15237   REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; LE_0] THEN
15238   DISCH_THEN(X_CHOOSE_TAC `P:num`) THEN
15239   EXISTS_TAC `MAX N P` THEN X_GEN_TAC `n:num` THEN
15240   SIMP_TAC[ARITH_RULE `MAX a b <= c <=> a <= c /\ b <= c`] THEN DISCH_TAC THEN
15241   W(MP_TAC o PART_MATCH (rand o rand) VSUM_IMAGE o rand o
15242     rand o lhand o snd) THEN
15243   ANTS_TAC THENL
15244    [ASM_MESON_TAC[FINITE_INTER; FINITE_NUMSEG; IN_INTER];
15245     DISCH_THEN(SUBST1_TAC o SYM)] THEN
15246   W(MP_TAC o PART_MATCH (lhand o rand) lemma o rand o lhand o snd) THEN
15247   SIMP_TAC[FINITE_INTER; FINITE_IMAGE; FINITE_NUMSEG] THEN
15248   DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(NORM_ARITH
15249    `norm a < e / &2 /\ norm b < e / &2 ==> norm(a - b:real^N) < e`) THEN
15250   CONJ_TAC THEN
15251   W(MP_TAC o PART_MATCH (lhand o rand) VSUM_NORM o lhand o snd) THEN
15252   SIMP_TAC[FINITE_DIFF; FINITE_IMAGE; FINITE_INTER; FINITE_NUMSEG] THEN
15253   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN
15254   MATCH_MP_TAC REAL_LET_TRANS THENL
15255    [EXISTS_TAC
15256      `sum(IMAGE (f:num->num) s INTER (N..n)) (\i. norm(x i :real^N))` THEN
15257     ASM_SIMP_TAC[LE_REFL] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN
15258     SIMP_TAC[NORM_POS_LE; FINITE_INTER; FINITE_NUMSEG] THEN
15259     MATCH_MP_TAC(SET_RULE
15260      `(!x. x IN s /\ f(x) IN n /\ ~(x IN m) ==> f x IN t)
15261       ==> (IMAGE f s INTER n) DIFF (IMAGE f (s INTER m)) SUBSET
15262           IMAGE f s INTER t`) THEN
15263     ASM_SIMP_TAC[IN_NUMSEG; LE_0; NOT_LE] THEN
15264     X_GEN_TAC `i:num` THEN STRIP_TAC THEN
15265     MATCH_MP_TAC LT_IMP_LE THEN ONCE_REWRITE_TAC[GSYM NOT_LE] THEN
15266     FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE BINDER_CONV
15267      [GSYM CONTRAPOS_THM]) THEN
15268     ASM_SIMP_TAC[] THEN ASM_ARITH_TAC;
15269     MP_TAC(ISPECL [`f:num->num`; `0..n`] UPPER_BOUND_FINITE_SET) THEN
15270     REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; LE_0] THEN
15271     DISCH_THEN(X_CHOOSE_TAC `p:num`) THEN
15272     EXISTS_TAC
15273      `sum(IMAGE (f:num->num) s INTER (N..p)) (\i. norm(x i :real^N))` THEN
15274     ASM_SIMP_TAC[LE_REFL] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN
15275     SIMP_TAC[NORM_POS_LE; FINITE_INTER; FINITE_NUMSEG] THEN
15276     MATCH_MP_TAC(SET_RULE
15277      `(!x. x IN s /\ x IN n /\ ~(f x IN m) ==> f x IN t)
15278       ==> (IMAGE f (s INTER n) DIFF (IMAGE f s) INTER m) SUBSET
15279           (IMAGE f s INTER t)`) THEN
15280     ASM_SIMP_TAC[IN_NUMSEG; LE_0] THEN ASM_ARITH_TAC]);;
15281
15282 let SERIES_INJECTIVE_IMAGE = prove
15283  (`!x:num->real^N s f l.
15284         summable (IMAGE f s) (\n. lift(norm(x n))) /\
15285         (!m n. m IN s /\ n IN s /\ f m = f n ==> m = n)
15286         ==> (((x o f) sums l) s <=> (x sums l) (IMAGE f s))`,
15287   REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[sums] THEN
15288   MATCH_MP_TAC LIM_TRANSFORM_EQ THEN REWRITE_TAC[] THEN
15289   MATCH_MP_TAC SERIES_INJECTIVE_IMAGE_STRONG THEN
15290   ASM_REWRITE_TAC[]);;
15291
15292 let SERIES_REARRANGE_EQ = prove
15293  (`!x:num->real^N s p l.
15294         summable s (\n. lift(norm(x n))) /\ p permutes s
15295         ==> (((x o p) sums l) s <=> (x sums l) s)`,
15296   REPEAT STRIP_TAC THEN
15297   MP_TAC(ISPECL [`x:num->real^N`; `s:num->bool`; `p:num->num`; `l:real^N`]
15298         SERIES_INJECTIVE_IMAGE) THEN
15299   ASM_SIMP_TAC[PERMUTES_IMAGE] THEN
15300   ASM_MESON_TAC[PERMUTES_INJECTIVE]);;
15301
15302 let SERIES_REARRANGE = prove
15303  (`!x:num->real^N s p l.
15304         summable s (\n. lift(norm(x n))) /\ p permutes s /\ (x sums l) s
15305         ==> ((x o p) sums l) s`,
15306   MESON_TAC[SERIES_REARRANGE_EQ]);;
15307
15308 let SUMMABLE_REARRANGE = prove
15309  (`!x s p.
15310         summable s (\n. lift(norm(x n))) /\ p permutes s
15311         ==> summable s (x o p)`,
15312   MESON_TAC[SERIES_LIFT_ABSCONV_IMP_CONV; summable; SERIES_REARRANGE]);;
15313
15314 (* ------------------------------------------------------------------------- *)
15315 (* Banach fixed point theorem (not really topological...)                    *)
15316 (* ------------------------------------------------------------------------- *)
15317
15318 let BANACH_FIX = prove
15319  (`!f s c. complete s /\ ~(s = {}) /\
15320            &0 <= c /\ c < &1 /\
15321            (IMAGE f s) SUBSET s /\
15322            (!x y. x IN s /\ y IN s ==> dist(f(x),f(y)) <= c * dist(x,y))
15323            ==> ?!x:real^N. x IN s /\ (f x = x)`,
15324   REPEAT STRIP_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN CONJ_TAC THENL
15325    [ALL_TAC;
15326     MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
15327     SUBGOAL_THEN `dist((f:real^N->real^N) x,f y) <= c * dist(x,y)` MP_TAC THENL
15328      [ASM_MESON_TAC[]; ALL_TAC] THEN
15329     ASM_REWRITE_TAC[REAL_ARITH `a <= c * a <=> &0 <= --a * (&1 - c)`] THEN
15330     ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_SUB_LT; real_div] THEN
15331     REWRITE_TAC[REAL_MUL_LZERO; REAL_ARITH `&0 <= --x <=> ~(&0 < x)`] THEN
15332     MESON_TAC[DIST_POS_LT]] THEN
15333   STRIP_ASSUME_TAC(prove_recursive_functions_exist num_RECURSION
15334     `(z 0 = @x:real^N. x IN s) /\ (!n. z(SUC n) = f(z n))`) THEN
15335   SUBGOAL_THEN `!n. (z:num->real^N) n IN s` ASSUME_TAC THENL
15336    [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN
15337     ASM_MESON_TAC[MEMBER_NOT_EMPTY; SUBSET; IN_IMAGE];
15338     ALL_TAC] THEN
15339   UNDISCH_THEN `z 0 = @x:real^N. x IN s` (K ALL_TAC) THEN
15340   SUBGOAL_THEN `?x:real^N. x IN s /\ (z --> x) sequentially` MP_TAC THENL
15341    [ALL_TAC;
15342     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN
15343     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
15344     ABBREV_TAC `e = dist(f(a:real^N),a)` THEN
15345     SUBGOAL_THEN `~(&0 < e)` (fun th -> ASM_MESON_TAC[th; DIST_POS_LT]) THEN
15346     DISCH_TAC THEN
15347     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN
15348     DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN
15349     ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN
15350     SUBGOAL_THEN
15351      `dist(f(z N),a:real^N) < e / &2 /\ dist(f(z(N:num)),f(a)) < e / &2`
15352      (fun th -> ASM_MESON_TAC[th; DIST_TRIANGLE_HALF_R; REAL_LT_REFL]) THEN
15353     CONJ_TAC THENL [ASM_MESON_TAC[ARITH_RULE `N <= SUC N`]; ALL_TAC] THEN
15354     MATCH_MP_TAC REAL_LET_TRANS THEN
15355     EXISTS_TAC `c * dist((z:num->real^N) N,a)` THEN ASM_SIMP_TAC[] THEN
15356     MATCH_MP_TAC(REAL_ARITH `x < y /\ c * x <= &1 * x ==> c * x < y`) THEN
15357     ASM_SIMP_TAC[LE_REFL; REAL_LE_RMUL; DIST_POS_LE; REAL_LT_IMP_LE]] THEN
15358   FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [complete]) THEN
15359   ASM_REWRITE_TAC[CAUCHY] THEN
15360   SUBGOAL_THEN `!n. dist(z(n):real^N,z(SUC n)) <= c pow n * dist(z(0),z(1))`
15361   ASSUME_TAC THENL
15362    [INDUCT_TAC THEN
15363     REWRITE_TAC[real_pow; ARITH; REAL_MUL_LID; REAL_LE_REFL] THEN
15364     MATCH_MP_TAC REAL_LE_TRANS THEN
15365     EXISTS_TAC `c * dist(z(n):real^N,z(SUC n))` THEN
15366     CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
15367     REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_LE_LMUL];
15368     ALL_TAC] THEN
15369   SUBGOAL_THEN
15370    `!m n:num. (&1 - c) * dist(z(m):real^N,z(m+n))
15371                 <= c pow m * dist(z(0),z(1)) * (&1 - c pow n)`
15372   ASSUME_TAC THENL
15373    [GEN_TAC THEN INDUCT_TAC THENL
15374      [REWRITE_TAC[ADD_CLAUSES; DIST_REFL; REAL_MUL_RZERO] THEN
15375       MATCH_MP_TAC REAL_LE_MUL THEN
15376       ASM_SIMP_TAC[REAL_LE_MUL; REAL_POW_LE; DIST_POS_LE; REAL_SUB_LE;
15377                    REAL_POW_1_LE; REAL_LT_IMP_LE];
15378       ALL_TAC] THEN
15379     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
15380     `(&1 - c) * (dist(z m:real^N,z(m + n)) + dist(z(m + n),z(m + SUC n)))` THEN
15381     ASM_SIMP_TAC[REAL_LE_LMUL; REAL_SUB_LE; REAL_LT_IMP_LE; DIST_TRIANGLE] THEN
15382     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
15383       `c * x <= y ==> c * x' + y <= y' ==> c * (x + x') <= y'`)) THEN
15384     REWRITE_TAC[REAL_ARITH
15385      `q + a * b * (&1 - x) <= a * b * (&1 - y) <=> q <= a * b * (x - y)`] THEN
15386     REWRITE_TAC[ADD_CLAUSES; real_pow] THEN
15387     REWRITE_TAC[REAL_ARITH `a * b * (d - c * d) = (&1 - c) * a * d * b`] THEN
15388     MATCH_MP_TAC REAL_LE_LMUL THEN
15389     ASM_SIMP_TAC[REAL_SUB_LE; REAL_LT_IMP_LE] THEN
15390     REWRITE_TAC[GSYM REAL_POW_ADD; REAL_MUL_ASSOC] THEN ASM_MESON_TAC[];
15391     ALL_TAC] THEN
15392   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
15393   ASM_CASES_TAC `(z:num->real^N) 0 = z 1` THENL
15394    [FIRST_X_ASSUM SUBST_ALL_TAC THEN EXISTS_TAC `0` THEN
15395     REWRITE_TAC[GE; LE_0] THEN X_GEN_TAC `n:num` THEN
15396     FIRST_X_ASSUM(MP_TAC o SPECL [`0`; `n:num`]) THEN
15397     REWRITE_TAC[ADD_CLAUSES; DIST_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN
15398     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
15399     ASM_CASES_TAC `(z:num->real^N) 0 = z n` THEN
15400     ASM_REWRITE_TAC[DIST_REFL; REAL_NOT_LE] THEN
15401     ASM_SIMP_TAC[REAL_LT_MUL; DIST_POS_LT; REAL_SUB_LT];
15402     ALL_TAC] THEN
15403   MP_TAC(SPECL [`c:real`; `e * (&1 - c) / dist((z:num->real^N) 0,z 1)`]
15404    REAL_ARCH_POW_INV) THEN
15405   ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; REAL_SUB_LT; DIST_POS_LT] THEN
15406   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
15407   REWRITE_TAC[real_div; GE; REAL_MUL_ASSOC] THEN
15408   ASM_SIMP_TAC[REAL_LT_RDIV_EQ; GSYM real_div; DIST_POS_LT] THEN
15409   ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_SUB_LT] THEN DISCH_TAC THEN
15410   REWRITE_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN
15411   GEN_TAC THEN X_GEN_TAC `d:num` THEN DISCH_THEN SUBST_ALL_TAC THEN
15412   ONCE_REWRITE_TAC[DIST_SYM] THEN
15413   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(REAL_ARITH
15414     `d < e ==> x <= d ==> x < e`)) THEN
15415   ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN
15416   FIRST_X_ASSUM(MP_TAC o SPECL [`N:num`; `d:num`]) THEN
15417   MATCH_MP_TAC(REAL_ARITH
15418   `(c * d) * e <= (c * d) * &1 ==> x * y <= c * d * e ==> y * x <= c * d`) THEN
15419   MATCH_MP_TAC REAL_LE_LMUL THEN
15420   ASM_SIMP_TAC[REAL_LE_MUL; REAL_POW_LE; DIST_POS_LE; REAL_ARITH
15421    `&0 <= x ==> &1 - x <= &1`]);;
15422
15423 (* ------------------------------------------------------------------------- *)
15424 (* Edelstein fixed point theorem.                                            *)
15425 (* ------------------------------------------------------------------------- *)
15426
15427 let EDELSTEIN_FIX = prove
15428  (`!f s. compact s /\ ~(s = {}) /\ (IMAGE f s) SUBSET s /\
15429          (!x y. x IN s /\ y IN s /\ ~(x = y) ==> dist(f(x),f(y)) < dist(x,y))
15430          ==> ?!x:real^N. x IN s /\ f x = x`,
15431   MAP_EVERY X_GEN_TAC [`g:real^N->real^N`; `s:real^N->bool`] THEN
15432   REPEAT STRIP_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN CONJ_TAC THENL
15433    [ALL_TAC; ASM_MESON_TAC[REAL_LT_REFL]] THEN
15434   SUBGOAL_THEN
15435    `!x y. x IN s /\ y IN s ==> dist((g:real^N->real^N)(x),g(y)) <= dist(x,y)`
15436   ASSUME_TAC THENL
15437    [REPEAT STRIP_TAC THEN ASM_CASES_TAC `x:real^N = y` THEN
15438     ASM_SIMP_TAC[DIST_REFL; REAL_LE_LT];
15439     ALL_TAC] THEN
15440   ASM_CASES_TAC `?x:real^N. x IN s /\ ~(g x = x)` THENL
15441    [ALL_TAC; ASM SET_TAC[]] THEN
15442   FIRST_X_ASSUM(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN
15443   ABBREV_TAC `y = (g:real^N->real^N) x` THEN
15444   SUBGOAL_THEN `(y:real^N) IN s` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
15445   FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_PCROSS o W CONJ) THEN
15446   REWRITE_TAC[compact; PCROSS] THEN
15447   (STRIP_ASSUME_TAC o prove_general_recursive_function_exists)
15448     `?f:num->real^N->real^N.
15449         (!z. f 0 z = z) /\ (!z n. f (SUC n) z = g(f n z))` THEN
15450   SUBGOAL_THEN `!n z. z IN s ==> (f:num->real^N->real^N) n z IN s`
15451   STRIP_ASSUME_TAC THENL [INDUCT_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN
15452   SUBGOAL_THEN
15453    `!m n w z. m <= n /\ w IN s /\ z IN s
15454               ==> dist((f:num->real^N->real^N) n w,f n z) <= dist(f m w,f m z)`
15455   ASSUME_TAC THENL
15456    [REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN
15457     MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
15458     RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN
15459     ASM_SIMP_TAC[REAL_LE_REFL] THEN MESON_TAC[REAL_LE_TRANS];
15460     ALL_TAC] THEN
15461   DISCH_THEN(MP_TAC o SPEC
15462    `\n:num. pastecart (f n (x:real^N)) (f n y:real^N)`) THEN
15463   ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
15464   MAP_EVERY X_GEN_TAC [`l:real^(N,N)finite_sum`; `s:num->num`] THEN
15465   REWRITE_TAC[o_DEF; IN_ELIM_THM] THEN
15466   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
15467   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
15468   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
15469   DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC SUBST_ALL_TAC) THEN
15470   SUBGOAL_THEN
15471    `(\x:real^(N,N)finite_sum. fstcart x) continuous_on UNIV /\
15472     (\x:real^(N,N)finite_sum. sndcart x) continuous_on UNIV`
15473   MP_TAC THENL
15474    [CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN
15475     REWRITE_TAC[ETA_AX; LINEAR_FSTCART; LINEAR_SNDCART];
15476     ALL_TAC] THEN
15477   REWRITE_TAC[CONTINUOUS_ON_SEQUENTIALLY; IN_UNIV] THEN
15478   DISCH_THEN(CONJUNCTS_THEN(fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP th))) THEN
15479   REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART; IMP_IMP] THEN
15480   ONCE_REWRITE_TAC[CONJ_SYM] THEN
15481   DISCH_THEN(fun th -> CONJUNCTS_THEN2 (LABEL_TAC "A") (LABEL_TAC "B") th THEN
15482     MP_TAC(MATCH_MP LIM_SUB th)) THEN
15483   REWRITE_TAC[] THEN DISCH_THEN(LABEL_TAC "AB") THEN
15484   SUBGOAL_THEN
15485    `!n. dist(a:real^N,b) <= dist((f:num->real^N->real^N) n x,f n y)`
15486   STRIP_ASSUME_TAC THENL
15487    [X_GEN_TAC `N:num` THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN
15488     ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN
15489     USE_THEN "AB" (MP_TAC o REWRITE_RULE[LIM_SEQUENTIALLY]) THEN
15490     DISCH_THEN(fun th -> FIRST_X_ASSUM(MP_TAC o MATCH_MP th)) THEN
15491     REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `M:num` THEN
15492     DISCH_THEN(MP_TAC o SPEC `M + N:num`) THEN REWRITE_TAC[LE_ADD] THEN
15493     MATCH_MP_TAC(NORM_ARITH
15494      `dist(fx,fy) <= dist(x,y)
15495       ==> ~(dist(fx - fy,a - b) < dist(a,b) - dist(x,y))`) THEN
15496     FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
15497     FIRST_X_ASSUM(MP_TAC o SPEC `M + N:num` o MATCH_MP MONOTONE_BIGGER) THEN
15498     ARITH_TAC;
15499     ALL_TAC] THEN
15500   SUBGOAL_THEN `b:real^N = a` SUBST_ALL_TAC THENL
15501    [MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
15502     ABBREV_TAC `e = dist(a,b) - dist((g:real^N->real^N) a,g b)` THEN
15503     SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL
15504      [ASM_MESON_TAC[REAL_SUB_LT]; ALL_TAC] THEN
15505     SUBGOAL_THEN
15506      `?n. dist((f:num->real^N->real^N) n x,a) < e / &2 /\
15507           dist(f n y,b) < e / &2`
15508     STRIP_ASSUME_TAC THENL
15509      [MAP_EVERY (fun s -> USE_THEN s (MP_TAC o SPEC `e / &2` o
15510         REWRITE_RULE[LIM_SEQUENTIALLY])) ["A"; "B"] THEN
15511       ASM_REWRITE_TAC[REAL_HALF] THEN
15512       DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN
15513       DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN
15514       EXISTS_TAC `(s:num->num) (M + N)` THEN
15515       CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC;
15516       ALL_TAC] THEN
15517     SUBGOAL_THEN `dist(f (SUC n) x,(g:real^N->real^N) a) +
15518                   dist((f:num->real^N->real^N) (SUC n) y,g b) < e`
15519     MP_TAC THENL
15520      [ASM_REWRITE_TAC[] THEN
15521       MATCH_MP_TAC(REAL_ARITH `x < e / &2 /\ y < e / &2 ==> x + y < e`) THEN
15522       CONJ_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
15523        `dist(x,y) < e
15524         ==> dist(g x,g y) <= dist(x,y) ==> dist(g x,g y) < e`)) THEN
15525       ASM_SIMP_TAC[];
15526       ALL_TAC] THEN
15527     MP_TAC(SPEC `SUC n` (ASSUME
15528     `!n. dist (a:real^N,b) <=
15529          dist ((f:num->real^N->real^N) n x,f n y)`)) THEN
15530     EXPAND_TAC "e" THEN NORM_ARITH_TAC;
15531     ALL_TAC] THEN
15532   EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN
15533   MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN
15534   EXISTS_TAC `\n:num. (f:num->real^N->real^N) (SUC(s n)) x` THEN
15535   REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL
15536    [ASM_REWRITE_TAC[] THEN
15537     SUBGOAL_THEN `(g:real^N->real^N) continuous_on s` MP_TAC THENL
15538      [REWRITE_TAC[continuous_on] THEN ASM_MESON_TAC[REAL_LET_TRANS];
15539       ALL_TAC] THEN
15540     REWRITE_TAC[CONTINUOUS_ON_SEQUENTIALLY; o_DEF] THEN
15541     DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[];
15542     SUBGOAL_THEN `!n. (f:num->real^N->real^N) (SUC n) x = f n y`
15543      (fun th -> ASM_SIMP_TAC[th]) THEN
15544     INDUCT_TAC THEN ASM_REWRITE_TAC[]]);;
15545
15546 (* ------------------------------------------------------------------------- *)
15547 (* Dini's theorem.                                                           *)
15548 (* ------------------------------------------------------------------------- *)
15549
15550 let DINI = prove
15551  (`!f:num->real^N->real^1 g s.
15552         compact s /\ (!n. (f n) continuous_on s) /\ g continuous_on s /\
15553         (!x. x IN s ==> ((\n. (f n x)) --> g x) sequentially) /\
15554         (!n x. x IN s ==> drop(f n x) <= drop(f (n + 1) x))
15555         ==> !e. &0 < e
15556                 ==> eventually (\n. !x. x IN s ==> norm(f n x - g x) < e)
15557                                sequentially`,
15558   REPEAT STRIP_TAC THEN
15559   SUBGOAL_THEN
15560    `!x:real^N m n:num. x IN s /\ m <= n ==> drop(f m x) <= drop(f n x)`
15561   ASSUME_TAC THENL
15562    [GEN_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN
15563     MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_SIMP_TAC[ADD1] THEN
15564     REAL_ARITH_TAC;
15565     ALL_TAC] THEN
15566   SUBGOAL_THEN `!n:num x:real^N. x IN s ==> drop(f n x) <= drop(g x)`
15567   ASSUME_TAC THENL
15568    [REPEAT STRIP_TAC THEN
15569     MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LE) THEN
15570     EXISTS_TAC `\m:num. (f:num->real^N->real^1) n x` THEN
15571     EXISTS_TAC `\m:num. (f:num->real^N->real^1) m x` THEN
15572     ASM_SIMP_TAC[LIM_CONST; TRIVIAL_LIMIT_SEQUENTIALLY] THEN
15573     REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN ASM_MESON_TAC[];
15574     ALL_TAC] THEN
15575   RULE_ASSUM_TAC(REWRITE_RULE[LIM_SEQUENTIALLY; dist]) THEN
15576   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I
15577    [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN
15578   DISCH_THEN(MP_TAC o SPEC
15579    `IMAGE (\n. { x | x IN s /\ norm((f:num->real^N->real^1) n x - g x) < e})
15580           (:num)`) THEN
15581   REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN
15582   ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
15583   REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE; SUBSET_UNION; UNIONS_IMAGE] THEN
15584   REWRITE_TAC[IN_UNIV; IN_ELIM_THM; EVENTUALLY_SEQUENTIALLY] THEN
15585   SIMP_TAC[SUBSET; IN_UNIV; IN_ELIM_THM] THEN ANTS_TAC THENL
15586    [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LE_REFL]] THEN
15587     X_GEN_TAC `n:num` THEN REWRITE_TAC[GSYM IN_BALL_0] THEN
15588     MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN
15589     ASM_SIMP_TAC[OPEN_BALL; CONTINUOUS_ON_SUB; ETA_AX];
15590
15591     DISCH_THEN(X_CHOOSE_THEN `k:num->bool` (CONJUNCTS_THEN2
15592      (MP_TAC o SPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET)
15593      (LABEL_TAC "*"))) THEN
15594     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
15595     REWRITE_TAC[] THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN
15596     DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
15597     REMOVE_THEN "*" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
15598     DISCH_THEN(X_CHOOSE_THEN `m:num` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
15599     REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN MATCH_MP_TAC(REAL_ARITH
15600      `m <= n /\ n <= g ==> abs(m - g) < e ==> abs(n - g) < e`) THEN
15601     ASM_MESON_TAC[LE_TRANS]]);;
15602
15603 (* ------------------------------------------------------------------------- *)
15604 (* Closest point of a (closed) set to a point.                               *)
15605 (* ------------------------------------------------------------------------- *)
15606
15607 let closest_point = new_definition
15608  `closest_point s a = @x. x IN s /\ !y. y IN s ==> dist(a,x) <= dist(a,y)`;;
15609
15610 let CLOSEST_POINT_EXISTS = prove
15611  (`!s a. closed s /\ ~(s = {})
15612          ==> (closest_point s a) IN s /\
15613              !y. y IN s ==> dist(a,closest_point s a) <= dist(a,y)`,
15614   REWRITE_TAC[closest_point] THEN CONV_TAC(ONCE_DEPTH_CONV SELECT_CONV) THEN
15615   REWRITE_TAC[DISTANCE_ATTAINS_INF]);;
15616
15617 let CLOSEST_POINT_IN_SET = prove
15618  (`!s a. closed s /\ ~(s = {}) ==> (closest_point s a) IN s`,
15619   MESON_TAC[CLOSEST_POINT_EXISTS]);;
15620
15621 let CLOSEST_POINT_LE = prove
15622  (`!s a x. closed s /\ x IN s ==> dist(a,closest_point s a) <= dist(a,x)`,
15623   MESON_TAC[CLOSEST_POINT_EXISTS; MEMBER_NOT_EMPTY]);;
15624
15625 let CLOSEST_POINT_SELF = prove
15626  (`!s x:real^N. x IN s ==> closest_point s x = x`,
15627   REPEAT STRIP_TAC THEN REWRITE_TAC[closest_point] THEN
15628   MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[] THEN GEN_TAC THEN EQ_TAC THENL
15629    [STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
15630     ASM_SIMP_TAC[DIST_LE_0; DIST_REFL];
15631     STRIP_TAC THEN ASM_REWRITE_TAC[DIST_REFL; DIST_POS_LE]]);;
15632
15633 let CLOSEST_POINT_REFL = prove
15634  (`!s x:real^N. closed s /\ ~(s = {}) ==> (closest_point s x = x <=> x IN s)`,
15635   MESON_TAC[CLOSEST_POINT_IN_SET; CLOSEST_POINT_SELF]);;
15636
15637 let DIST_CLOSEST_POINT_LIPSCHITZ = prove
15638  (`!s x y:real^N.
15639         closed s /\ ~(s = {})
15640         ==> abs(dist(x,closest_point s x) - dist(y,closest_point s y))
15641             <= dist(x,y)`,
15642   REPEAT GEN_TAC THEN DISCH_TAC THEN
15643   FIRST_ASSUM(MP_TAC o MATCH_MP CLOSEST_POINT_EXISTS) THEN
15644   DISCH_THEN(fun th ->
15645     CONJUNCTS_THEN2 ASSUME_TAC
15646      (MP_TAC o SPEC `closest_point s (y:real^N)`) (SPEC `x:real^N` th) THEN
15647     CONJUNCTS_THEN2 ASSUME_TAC
15648      (MP_TAC o SPEC `closest_point s (x:real^N)`) (SPEC `y:real^N` th)) THEN
15649   ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);;
15650
15651 let CONTINUOUS_AT_DIST_CLOSEST_POINT = prove
15652  (`!s x:real^N.
15653         closed s /\ ~(s = {})
15654         ==> (\x. lift(dist(x,closest_point s x))) continuous (at x)`,
15655   REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_at; DIST_LIFT] THEN
15656   ASM_MESON_TAC[DIST_CLOSEST_POINT_LIPSCHITZ; REAL_LET_TRANS]);;
15657
15658 let CONTINUOUS_ON_DIST_CLOSEST_POINT = prove
15659  (`!s t. closed s /\ ~(s = {})
15660          ==> (\x. lift(dist(x,closest_point s x))) continuous_on t`,
15661   MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON;
15662             CONTINUOUS_AT_DIST_CLOSEST_POINT]);;
15663
15664 let UNIFORMLY_CONTINUOUS_ON_DIST_CLOSEST_POINT = prove
15665  (`!s t:real^N->bool.
15666         closed s /\ ~(s = {})
15667         ==> (\x. lift(dist(x,closest_point s x))) uniformly_continuous_on t`,
15668   REPEAT STRIP_TAC THEN REWRITE_TAC[uniformly_continuous_on; DIST_LIFT] THEN
15669   ASM_MESON_TAC[DIST_CLOSEST_POINT_LIPSCHITZ; REAL_LET_TRANS]);;
15670
15671 let SEGMENT_TO_CLOSEST_POINT = prove
15672  (`!s a:real^N.
15673         closed s /\ ~(s = {})
15674         ==> segment(a,closest_point s a) INTER s = {}`,
15675   REPEAT STRIP_TAC THEN
15676   REWRITE_TAC[SET_RULE `s INTER t = {} <=> !x. x IN s ==> ~(x IN t)`] THEN
15677   GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP DIST_IN_OPEN_SEGMENT) THEN
15678   MATCH_MP_TAC(TAUT `(r ==> ~p) ==> p /\ q ==> ~r`) THEN
15679   ASM_MESON_TAC[CLOSEST_POINT_EXISTS; REAL_NOT_LT; DIST_SYM]);;
15680
15681 let SEGMENT_TO_POINT_EXISTS = prove
15682  (`!s a:real^N.
15683         closed s /\ ~(s = {}) ==> ?b. b IN s /\ segment(a,b) INTER s = {}`,
15684   MESON_TAC[SEGMENT_TO_CLOSEST_POINT; CLOSEST_POINT_EXISTS]);;
15685
15686 let CLOSEST_POINT_IN_INTERIOR = prove
15687  (`!s x:real^N.
15688         closed s /\ ~(s = {})
15689         ==> ((closest_point s x) IN interior s <=> x IN interior s)`,
15690   REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN
15691   ASM_SIMP_TAC[CLOSEST_POINT_SELF] THEN
15692   MATCH_MP_TAC(TAUT `~q /\ ~p ==> (p <=> q)`) THEN
15693   CONJ_TAC THENL [ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]; STRIP_TAC] THEN
15694   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR_CBALL]) THEN
15695   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
15696   SUBGOAL_THEN `closest_point s (x:real^N) IN s` ASSUME_TAC THENL
15697    [ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]; ALL_TAC] THEN
15698   SUBGOAL_THEN `~(closest_point s (x:real^N) = x)` ASSUME_TAC THENL
15699    [ASM_MESON_TAC[]; ALL_TAC] THEN
15700   MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`;
15701    `closest_point s x -
15702     (min (&1) (e / norm(closest_point s x - x))) %
15703     (closest_point s x - x):real^N`]
15704     CLOSEST_POINT_LE) THEN
15705   ASM_REWRITE_TAC[dist; NOT_IMP; VECTOR_ARITH
15706    `x - (y - e % (y - x)):real^N = (&1 - e) % (x - y)`] THEN
15707   CONJ_TAC THENL
15708    [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
15709     REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(a:real^N,a - x) = norm x`] THEN
15710     REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
15711     ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN
15712     MATCH_MP_TAC(REAL_ARITH `&0 <= a ==> abs(min (&1) a) <= a`) THEN
15713     ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_DIV; NORM_POS_LE];
15714     REWRITE_TAC[NORM_MUL; REAL_ARITH
15715      `~(n <= a * n) <=> &0 < (&1 - a) * n`] THEN
15716     MATCH_MP_TAC REAL_LT_MUL THEN
15717     ASM_SIMP_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN
15718     MATCH_MP_TAC(REAL_ARITH
15719      `&0 < e /\ e <= &1 ==> &0 < &1 - abs(&1 - e)`) THEN
15720     REWRITE_TAC[REAL_MIN_LE; REAL_LT_MIN; REAL_LT_01; REAL_LE_REFL] THEN
15721     ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]]);;
15722
15723 let CLOSEST_POINT_IN_FRONTIER = prove
15724  (`!s x:real^N.
15725         closed s /\ ~(s = {}) /\ ~(x IN interior s)
15726         ==> (closest_point s x) IN frontier s`,
15727   SIMP_TAC[frontier; IN_DIFF; CLOSEST_POINT_IN_INTERIOR] THEN
15728   SIMP_TAC[CLOSEST_POINT_IN_SET; CLOSURE_CLOSED]);;
15729
15730 (* ------------------------------------------------------------------------- *)
15731 (* More general infimum of distance between two sets.                        *)
15732 (* ------------------------------------------------------------------------- *)
15733
15734 let setdist = new_definition
15735  `setdist(s,t) =
15736         if s = {} \/ t = {} then &0
15737         else inf {dist(x,y) | x IN s /\ y IN t}`;;
15738
15739 let SETDIST_EMPTY = prove
15740  (`(!t. setdist({},t) = &0) /\ (!s. setdist(s,{}) = &0)`,
15741   REWRITE_TAC[setdist]);;
15742
15743 let SETDIST_POS_LE = prove
15744  (`!s t. &0 <= setdist(s,t)`,
15745   REPEAT GEN_TAC THEN REWRITE_TAC[setdist] THEN
15746   COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN
15747   MATCH_MP_TAC REAL_LE_INF THEN
15748   REWRITE_TAC[FORALL_IN_GSPEC; DIST_POS_LE] THEN ASM SET_TAC[]);;
15749
15750 let REAL_LE_SETDIST = prove
15751   (`!s t:real^N->bool d.
15752         ~(s = {}) /\ ~(t = {}) /\
15753         (!x y. x IN s /\ y IN t ==> d <= dist(x,y))
15754         ==> d <= setdist(s,t)`,
15755   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[setdist] THEN
15756   MP_TAC(ISPEC `{dist(x:real^N,y) | x IN s /\ y IN t}` INF) THEN
15757   REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL
15758    [CONJ_TAC THENL [ASM SET_TAC[]; MESON_TAC[DIST_POS_LE]]; ALL_TAC] THEN
15759   ASM_MESON_TAC[]);;
15760
15761 let SETDIST_LE_DIST = prove
15762  (`!s t x y:real^N. x IN s /\ y IN t ==> setdist(s,t) <= dist(x,y)`,
15763   REPEAT GEN_TAC THEN REWRITE_TAC[setdist] THEN
15764   COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
15765   MP_TAC(ISPEC `{dist(x:real^N,y) | x IN s /\ y IN t}` INF) THEN
15766   REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL
15767    [CONJ_TAC THENL [ASM SET_TAC[]; MESON_TAC[DIST_POS_LE]]; ALL_TAC] THEN
15768   ASM_MESON_TAC[]);;
15769
15770 let REAL_LE_SETDIST_EQ = prove
15771  (`!d s t:real^N->bool.
15772         d <= setdist(s,t) <=>
15773         (!x y. x IN s /\ y IN t ==> d <= dist(x,y)) /\
15774         (s = {} \/ t = {} ==> d <= &0)`,
15775   REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC
15776    [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN
15777   ASM_REWRITE_TAC[SETDIST_EMPTY; NOT_IN_EMPTY] THEN
15778   ASM_MESON_TAC[REAL_LE_SETDIST; SETDIST_LE_DIST; REAL_LE_TRANS]);;
15779
15780 let REAL_SETDIST_LT_EXISTS = prove
15781  (`!s t:real^N->bool b.
15782         ~(s = {}) /\ ~(t = {}) /\ setdist(s,t) < b
15783         ==> ?x y. x IN s /\ y IN t /\ dist(x,y) < b`,
15784   REWRITE_TAC[GSYM REAL_NOT_LE; REAL_LE_SETDIST_EQ] THEN MESON_TAC[]);;
15785
15786 let SETDIST_REFL = prove
15787  (`!s:real^N->bool. setdist(s,s) = &0`,
15788   GEN_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM; SETDIST_POS_LE] THEN
15789   ASM_CASES_TAC `s:real^N->bool = {}` THENL
15790    [ASM_REWRITE_TAC[setdist; REAL_LE_REFL]; ALL_TAC] THEN
15791   ASM_MESON_TAC[SETDIST_LE_DIST; MEMBER_NOT_EMPTY; DIST_REFL]);;
15792
15793 let SETDIST_SYM = prove
15794  (`!s t. setdist(s,t) = setdist(t,s)`,
15795   REPEAT GEN_TAC THEN REWRITE_TAC[setdist; DISJ_SYM] THEN
15796   COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
15797   AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN
15798   MESON_TAC[DIST_SYM]);;
15799
15800 let SETDIST_TRIANGLE = prove
15801  (`!s a t:real^N->bool.
15802         setdist(s,t) <= setdist(s,{a}) + setdist({a},t)`,
15803   REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
15804   ASM_REWRITE_TAC[SETDIST_EMPTY; REAL_ADD_LID; SETDIST_POS_LE] THEN
15805   ASM_CASES_TAC `t:real^N->bool = {}` THEN
15806   ASM_REWRITE_TAC[SETDIST_EMPTY; REAL_ADD_RID; SETDIST_POS_LE] THEN
15807   ONCE_REWRITE_TAC[GSYM REAL_LE_SUB_RADD] THEN
15808   MATCH_MP_TAC REAL_LE_SETDIST THEN
15809   ASM_REWRITE_TAC[NOT_INSERT_EMPTY; IN_SING; IMP_CONJ;
15810                   RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN
15811   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
15812   ONCE_REWRITE_TAC[REAL_ARITH `x - y <= z <=> x - z <= y`] THEN
15813   MATCH_MP_TAC REAL_LE_SETDIST THEN
15814   ASM_REWRITE_TAC[NOT_INSERT_EMPTY; IN_SING; IMP_CONJ;
15815                   RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN
15816   X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN
15817   REWRITE_TAC[REAL_LE_SUB_RADD] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
15818   EXISTS_TAC `dist(x:real^N,y)` THEN
15819   ASM_SIMP_TAC[SETDIST_LE_DIST] THEN CONV_TAC NORM_ARITH);;
15820
15821 let SETDIST_SINGS = prove
15822  (`!x y. setdist({x},{y}) = dist(x,y)`,
15823   REWRITE_TAC[setdist; NOT_INSERT_EMPTY] THEN
15824   REWRITE_TAC[SET_RULE `{f x y | x IN {a} /\ y IN {b}} = {f a b}`] THEN
15825   SIMP_TAC[INF_INSERT_FINITE; FINITE_EMPTY]);;
15826
15827 let SETDIST_LIPSCHITZ = prove
15828  (`!s t x y:real^N. abs(setdist({x},s) - setdist({y},s)) <= dist(x,y)`,
15829   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SETDIST_SINGS] THEN
15830   REWRITE_TAC[REAL_ARITH
15831    `abs(x - y) <= z <=> x <= z + y /\ y <= z + x`] THEN
15832   MESON_TAC[SETDIST_TRIANGLE; SETDIST_SYM]);;
15833
15834 let CONTINUOUS_AT_LIFT_SETDIST = prove
15835  (`!s x:real^N. (\y. lift(setdist({y},s))) continuous (at x)`,
15836   REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_at; DIST_LIFT] THEN
15837   ASM_MESON_TAC[SETDIST_LIPSCHITZ; REAL_LET_TRANS]);;
15838
15839 let CONTINUOUS_ON_LIFT_SETDIST = prove
15840  (`!s t:real^N->bool. (\y. lift(setdist({y},s))) continuous_on t`,
15841   MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON;
15842             CONTINUOUS_AT_LIFT_SETDIST]);;
15843
15844 let UNIFORMLY_CONTINUOUS_ON_LIFT_SETDIST = prove
15845  (`!s t:real^N->bool.
15846          (\y. lift(setdist({y},s))) uniformly_continuous_on t`,
15847   REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on; DIST_LIFT] THEN
15848   ASM_MESON_TAC[SETDIST_LIPSCHITZ; REAL_LET_TRANS]);;
15849
15850 let SETDIST_DIFFERENCES = prove
15851  (`!s t. setdist(s,t) = setdist({vec 0},{x - y:real^N | x IN s /\ y IN t})`,
15852   REPEAT GEN_TAC THEN REWRITE_TAC[setdist; NOT_INSERT_EMPTY;
15853      SET_RULE `{f x y | x IN s /\ y IN t} = {} <=> s = {} \/ t = {}`] THEN
15854   COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN
15855   REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING] THEN
15856   REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM2; DIST_0] THEN
15857   REWRITE_TAC[dist] THEN MESON_TAC[]);;
15858
15859 let SETDIST_SUBSET_RIGHT = prove
15860  (`!s t u:real^N->bool.
15861     ~(t = {}) /\ t SUBSET u ==> setdist(s,u) <= setdist(s,t)`,
15862   REPEAT STRIP_TAC THEN
15863   MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `u:real^N->bool = {}`] THEN
15864   ASM_REWRITE_TAC[SETDIST_EMPTY; SETDIST_POS_LE; REAL_LE_REFL] THEN
15865   ASM_REWRITE_TAC[setdist] THEN MATCH_MP_TAC REAL_LE_INF_SUBSET THEN
15866   ASM_REWRITE_TAC[FORALL_IN_GSPEC; SUBSET] THEN
15867   REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
15868   MESON_TAC[DIST_POS_LE]);;
15869
15870 let SETDIST_SUBSET_LEFT = prove
15871  (`!s t u:real^N->bool.
15872     ~(s = {}) /\ s SUBSET t ==> setdist(t,u) <= setdist(s,u)`,
15873   MESON_TAC[SETDIST_SUBSET_RIGHT; SETDIST_SYM]);;
15874
15875 let SETDIST_CLOSURE = prove
15876  (`(!s t:real^N->bool. setdist(closure s,t) = setdist(s,t)) /\
15877    (!s t:real^N->bool. setdist(s,closure t) = setdist(s,t))`,
15878   GEN_REWRITE_TAC RAND_CONV [SWAP_FORALL_THM] THEN
15879   GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SETDIST_SYM] THEN
15880   REWRITE_TAC[] THEN
15881   REWRITE_TAC[MESON[REAL_LE_ANTISYM]
15882    `x:real = y <=> !d. d <= x <=> d <= y`] THEN
15883   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_SETDIST_EQ] THEN
15884   MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN
15885   ASM_REWRITE_TAC[CLOSURE_EQ_EMPTY; CLOSURE_EMPTY; NOT_IN_EMPTY] THEN
15886   MATCH_MP_TAC(SET_RULE
15887    `s SUBSET c /\
15888     (!y. Q y /\ (!x. x IN s ==> P x y) ==> (!x. x IN c ==> P x y))
15889    ==> ((!x y. x IN c /\ Q y ==> P x y) <=>
15890         (!x y. x IN s /\ Q y ==> P x y))`) THEN
15891   REWRITE_TAC[CLOSURE_SUBSET] THEN GEN_TAC THEN STRIP_TAC THEN
15892   MATCH_MP_TAC CONTINUOUS_GE_ON_CLOSURE THEN
15893   ASM_REWRITE_TAC[o_DEF; dist] THEN
15894   MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN
15895   SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);;
15896
15897 let SETDIST_COMPACT_CLOSED = prove
15898  (`!s t:real^N->bool.
15899         compact s /\ closed t /\ ~(s = {}) /\ ~(t = {})
15900         ==> ?x y. x IN s /\ y IN t /\ dist(x,y) = setdist(s,t)`,
15901   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
15902   MATCH_MP_TAC(MESON[]
15903    `(!x y. P x /\ Q y ==> S x y) /\ (?x y. P x /\ Q y /\ R x y)
15904     ==> ?x y. P x /\ Q y /\ R x y /\ S x y`) THEN
15905   SIMP_TAC[SETDIST_LE_DIST] THEN
15906   ASM_REWRITE_TAC[REAL_LE_SETDIST_EQ] THEN
15907   MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN t}`; `vec 0:real^N`]
15908         DISTANCE_ATTAINS_INF) THEN
15909   ASM_SIMP_TAC[COMPACT_CLOSED_DIFFERENCES; EXISTS_IN_GSPEC; FORALL_IN_GSPEC;
15910                DIST_0; GSYM CONJ_ASSOC] THEN
15911   REWRITE_TAC[dist] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);;
15912
15913 let SETDIST_CLOSED_COMPACT = prove
15914  (`!s t:real^N->bool.
15915         closed s /\ compact t /\ ~(s = {}) /\ ~(t = {})
15916         ==> ?x y. x IN s /\ y IN t /\ dist(x,y) = setdist(s,t)`,
15917   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
15918   MATCH_MP_TAC(MESON[]
15919    `(!x y. P x /\ Q y ==> S x y) /\ (?x y. P x /\ Q y /\ R x y)
15920     ==> ?x y. P x /\ Q y /\ R x y /\ S x y`) THEN
15921   SIMP_TAC[SETDIST_LE_DIST] THEN
15922   ASM_REWRITE_TAC[REAL_LE_SETDIST_EQ] THEN
15923   MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN t}`; `vec 0:real^N`]
15924         DISTANCE_ATTAINS_INF) THEN
15925   ASM_SIMP_TAC[CLOSED_COMPACT_DIFFERENCES; EXISTS_IN_GSPEC; FORALL_IN_GSPEC;
15926                DIST_0; GSYM CONJ_ASSOC] THEN
15927   REWRITE_TAC[dist] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);;
15928
15929 let SETDIST_EQ_0_COMPACT_CLOSED = prove
15930  (`!s t:real^N->bool.
15931         compact s /\ closed t
15932         ==> (setdist(s,t) = &0 <=> s = {} \/ t = {} \/ ~(s INTER t = {}))`,
15933   REPEAT STRIP_TAC THEN
15934   MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN
15935   ASM_REWRITE_TAC[SETDIST_EMPTY] THEN EQ_TAC THENL
15936    [MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`]
15937       SETDIST_COMPACT_CLOSED) THEN ASM_REWRITE_TAC[] THEN
15938     REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN MESON_TAC[DIST_EQ_0];
15939     REWRITE_TAC[GSYM REAL_LE_ANTISYM; SETDIST_POS_LE] THEN
15940     REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN
15941     MESON_TAC[SETDIST_LE_DIST; DIST_EQ_0]]);;
15942
15943 let SETDIST_EQ_0_CLOSED_COMPACT = prove
15944  (`!s t:real^N->bool.
15945         closed s /\ compact t
15946         ==> (setdist(s,t) = &0 <=> s = {} \/ t = {} \/ ~(s INTER t = {}))`,
15947   ONCE_REWRITE_TAC[SETDIST_SYM] THEN
15948   SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED] THEN SET_TAC[]);;
15949
15950 let SETDIST_EQ_0_BOUNDED = prove
15951  (`!s t:real^N->bool.
15952         (bounded s \/ bounded t)
15953         ==> (setdist(s,t) = &0 <=>
15954              s = {} \/ t = {} \/ ~(closure(s) INTER closure(t) = {}))`,
15955   REPEAT GEN_TAC THEN
15956   MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN
15957   ASM_REWRITE_TAC[SETDIST_EMPTY] THEN STRIP_TAC THEN
15958   ONCE_REWRITE_TAC[MESON[SETDIST_CLOSURE]
15959    `setdist(s,t) = setdist(closure s,closure t)`] THEN
15960   ASM_SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; SETDIST_EQ_0_CLOSED_COMPACT;
15961                COMPACT_CLOSURE; CLOSED_CLOSURE; CLOSURE_EQ_EMPTY]);;
15962
15963
15964 let SETDIST_TRANSLATION = prove
15965  (`!a:real^N s t.
15966         setdist(IMAGE (\x. a + x) s,IMAGE (\x. a + x) t) = setdist(s,t)`,
15967   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[SETDIST_DIFFERENCES] THEN
15968   AP_TERM_TAC THEN AP_TERM_TAC THEN
15969   REWRITE_TAC[SET_RULE
15970    `{f x y | x IN IMAGE g s /\ y IN IMAGE g t} =
15971     {f (g x) (g y) | x IN s /\ y IN t}`] THEN
15972   REWRITE_TAC[VECTOR_ARITH `(a + x) - (a + y):real^N = x - y`]);;
15973
15974 add_translation_invariants [SETDIST_TRANSLATION];;
15975
15976 let SETDIST_LINEAR_IMAGE = prove
15977  (`!f:real^M->real^N s t.
15978         linear f /\ (!x. norm(f x) = norm x)
15979         ==> setdist(IMAGE f s,IMAGE f t) = setdist(s,t)`,
15980   REPEAT STRIP_TAC THEN REWRITE_TAC[setdist; IMAGE_EQ_EMPTY] THEN
15981   COND_CASES_TAC THEN ASM_REWRITE_TAC[dist] THEN AP_TERM_TAC THEN
15982   REWRITE_TAC[SET_RULE
15983    `{f x y | x IN IMAGE g s /\ y IN IMAGE g t} =
15984     {f (g x) (g y) | x IN s /\ y IN t}`] THEN
15985   FIRST_X_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_SUB th)]) THEN
15986   ASM_REWRITE_TAC[]);;
15987
15988 add_linear_invariants [SETDIST_LINEAR_IMAGE];;
15989
15990 let SETDIST_UNIQUE = prove
15991  (`!s t a b:real^N d.
15992         a IN s /\ b IN t /\ dist(a,b) = d /\
15993         (!x y. x IN s /\ y IN t ==> dist(a,b) <= dist(x,y))
15994         ==> setdist(s,t) = d`,
15995   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL
15996    [ASM_MESON_TAC[SETDIST_LE_DIST];
15997     MATCH_MP_TAC REAL_LE_SETDIST THEN ASM SET_TAC[]]);;
15998
15999 let SETDIST_CLOSEST_POINT = prove
16000  (`!a:real^N s.
16001       closed s /\ ~(s = {}) ==> setdist({a},s) = dist(a,closest_point s a)`,
16002   REPEAT STRIP_TAC THEN MATCH_MP_TAC SETDIST_UNIQUE THEN
16003   REWRITE_TAC[RIGHT_EXISTS_AND_THM; IN_SING; UNWIND_THM2] THEN
16004   EXISTS_TAC `closest_point s (a:real^N)` THEN
16005   ASM_MESON_TAC[CLOSEST_POINT_EXISTS; DIST_SYM]);;
16006
16007 let SETDIST_EQ_0_SING = prove
16008  (`(!s x:real^N. setdist({x},s) = &0 <=> s = {} \/ x IN closure s) /\
16009    (!s x:real^N. setdist(s,{x}) = &0 <=> s = {} \/ x IN closure s)`,
16010   SIMP_TAC[SETDIST_EQ_0_BOUNDED; BOUNDED_SING; CLOSURE_SING] THEN SET_TAC[]);;
16011
16012 let SETDIST_EQ_0_CLOSED = prove
16013  (`!s x. closed s ==> (setdist({x},s) = &0 <=> s = {} \/ x IN s)`,
16014   SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; COMPACT_SING] THEN SET_TAC[]);;
16015
16016 let SETDIST_EQ_0_CLOSED_IN = prove
16017  (`!u s x. closed_in (subtopology euclidean u) s /\ x IN u
16018            ==> (setdist({x},s) = &0 <=> s = {} \/ x IN s)`,
16019   REWRITE_TAC[SETDIST_EQ_0_SING; CLOSED_IN_INTER_CLOSURE] THEN SET_TAC[]);;
16020
16021 let SETDIST_SING_IN_SET = prove
16022  (`!x s. x IN s ==> setdist({x},s) = &0`,
16023   SIMP_TAC[SETDIST_EQ_0_SING; REWRITE_RULE[SUBSET] CLOSURE_SUBSET]);;
16024
16025 let SETDIST_SING_TRIANGLE = prove
16026  (`!s x y:real^N. abs(setdist({x},s) - setdist({y},s)) <= dist(x,y)`,
16027   REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN
16028   ASM_REWRITE_TAC[SETDIST_EMPTY; REAL_SUB_REFL; REAL_ABS_NUM; DIST_POS_LE] THEN
16029   REWRITE_TAC[GSYM REAL_BOUNDS_LE; REAL_NEG_SUB] THEN REPEAT STRIP_TAC THEN
16030   ONCE_REWRITE_TAC[REAL_ARITH `a - b <= c <=> a - c <= b`;
16031                    REAL_ARITH `--a <= b - c <=> c - a <= b`] THEN
16032   MATCH_MP_TAC REAL_LE_SETDIST THEN ASM_REWRITE_TAC[NOT_INSERT_EMPTY] THEN
16033   SIMP_TAC[IN_SING; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN
16034   X_GEN_TAC `z:real^N` THEN DISCH_TAC THENL
16035    [MATCH_MP_TAC(NORM_ARITH
16036      `a <= dist(y:real^N,z) ==> a - dist(x,y) <= dist(x,z)`);
16037     MATCH_MP_TAC(NORM_ARITH
16038      `a <= dist(x:real^N,z) ==> a - dist(x,y) <= dist(y,z)`)] THEN
16039   MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[IN_SING]);;
16040
16041 let SETDIST_LE_SING = prove
16042  (`!s t x:real^N. x IN s ==> setdist(s,t) <= setdist({x},t)`,
16043   REPEAT STRIP_TAC THEN MATCH_MP_TAC SETDIST_SUBSET_LEFT THEN ASM SET_TAC[]);;
16044
16045 let SETDIST_BALLS = prove
16046  (`(!a b:real^N r s.
16047         setdist(ball(a,r),ball(b,s)) =
16048         if r <= &0 \/ s <= &0 then &0 else max (&0) (dist(a,b) - (r + s))) /\
16049    (!a b:real^N r s.
16050         setdist(ball(a,r),cball(b,s)) =
16051         if r <= &0 \/ s < &0 then &0 else max (&0) (dist(a,b) - (r + s))) /\
16052    (!a b:real^N r s.
16053         setdist(cball(a,r),ball(b,s)) =
16054         if r < &0 \/ s <= &0 then &0 else max (&0) (dist(a,b) - (r + s))) /\
16055    (!a b:real^N r s.
16056         setdist(cball(a,r),cball(b,s)) =
16057         if r < &0 \/ s < &0 then &0 else max (&0) (dist(a,b) - (r + s)))`,
16058   REWRITE_TAC[MESON[]
16059    `(x = if p then y else z) <=> (p ==> x = y) /\ (~p ==> x = z)`] THEN
16060   SIMP_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN
16061   SIMP_TAC[BALL_EMPTY; CBALL_EMPTY; SETDIST_EMPTY; DE_MORGAN_THM] THEN
16062   ONCE_REWRITE_TAC[MESON[SETDIST_CLOSURE]
16063    `setdist(s,t) = setdist(closure s,closure t)`] THEN
16064   SIMP_TAC[REAL_NOT_LE; REAL_NOT_LT; CLOSURE_BALL] THEN
16065   REWRITE_TAC[SETDIST_CLOSURE] THEN
16066   MATCH_MP_TAC(TAUT `(s ==> p /\ q /\ r) /\ s ==> p /\ q /\ r /\ s`) THEN
16067   CONJ_TAC THENL [MESON_TAC[REAL_LT_IMP_LE]; REPEAT GEN_TAC] THEN
16068   REWRITE_TAC[real_max; REAL_SUB_LE] THEN COND_CASES_TAC THEN
16069   SIMP_TAC[SETDIST_EQ_0_BOUNDED; BOUNDED_CBALL; CLOSED_CBALL; CLOSURE_CLOSED;
16070            CBALL_EQ_EMPTY; INTER_BALLS_EQ_EMPTY]
16071   THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
16072   ASM_CASES_TAC `b:real^N = a` THENL
16073    [FIRST_X_ASSUM SUBST_ALL_TAC THEN
16074     RULE_ASSUM_TAC(REWRITE_RULE[DIST_REFL]) THEN
16075     ASM_CASES_TAC `r = &0 /\ s = &0` THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
16076     ASM_SIMP_TAC[CBALL_SING; SETDIST_SINGS] THEN REAL_ARITH_TAC;
16077     STRIP_TAC] THEN
16078   REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL
16079    [ALL_TAC;
16080     MATCH_MP_TAC REAL_LE_SETDIST THEN
16081     ASM_REWRITE_TAC[CBALL_EQ_EMPTY; REAL_NOT_LT; IN_CBALL] THEN
16082     CONV_TAC NORM_ARITH] THEN
16083   MATCH_MP_TAC REAL_LE_TRANS THEN
16084   EXISTS_TAC `dist(a + r / dist(a,b) % (b - a):real^N,
16085                    b - s / dist(a,b) % (b - a))` THEN
16086   CONJ_TAC THENL
16087    [MATCH_MP_TAC SETDIST_LE_DIST THEN
16088     REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(a:real^N,a + x) = norm x`;
16089                 NORM_ARITH `dist(a:real^N,a - x) = norm x`] THEN
16090     ONCE_REWRITE_TAC[DIST_SYM] THEN
16091     REWRITE_TAC[dist; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN
16092     ASM_SIMP_TAC[REAL_DIV_RMUL; VECTOR_SUB_EQ; NORM_EQ_0] THEN
16093     ASM_REAL_ARITH_TAC;
16094     REWRITE_TAC[dist; VECTOR_ARITH
16095      `(a + d % (b - a)) - (b - e % (b - a)):real^N =
16096       (&1 - d - e) % (a - b)`] THEN
16097     REWRITE_TAC[NORM_MUL; REAL_ARITH
16098       `&1 - r / y - s / y = &1 - (r + s) / y`] THEN
16099     ONCE_REWRITE_TAC[GSYM REAL_ABS_NORM] THEN
16100     REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_NORM] THEN
16101     ASM_SIMP_TAC[VECTOR_SUB_EQ; NORM_EQ_0; REAL_FIELD
16102      `~(n = &0) ==> (&1 - x / n) * n = n - x`] THEN
16103     REWRITE_TAC[GSYM dist] THEN ASM_REAL_ARITH_TAC]);;
16104
16105 (* ------------------------------------------------------------------------- *)
16106 (* Use set distance for an easy proof of separation properties etc.          *)
16107 (* ------------------------------------------------------------------------- *)
16108
16109 let SEPARATION_CLOSURES = prove
16110  (`!s t:real^N->bool.
16111         s INTER closure(t) = {} /\ t INTER closure(s) = {}
16112         ==> ?u v. DISJOINT u v /\ open u /\ open v /\
16113                   s SUBSET u /\ t SUBSET v`,
16114   REPEAT STRIP_TAC THEN
16115   ASM_CASES_TAC `s:real^N->bool = {}` THENL
16116    [MAP_EVERY EXISTS_TAC [`{}:real^N->bool`; `(:real^N)`] THEN
16117     ASM_REWRITE_TAC[OPEN_EMPTY; OPEN_UNIV] THEN ASM SET_TAC[];
16118     ALL_TAC] THEN
16119   ASM_CASES_TAC `t:real^N->bool = {}` THENL
16120    [MAP_EVERY EXISTS_TAC [`(:real^N)`; `{}:real^N->bool`] THEN
16121     ASM_REWRITE_TAC[OPEN_EMPTY; OPEN_UNIV] THEN ASM SET_TAC[];
16122     ALL_TAC] THEN
16123   EXISTS_TAC `{x | x IN (:real^N) /\
16124                    lift(setdist({x},t) - setdist({x},s)) IN
16125                    {x | &0 < x$1}}` THEN
16126   EXISTS_TAC `{x | x IN (:real^N) /\
16127                    lift(setdist({x},t) - setdist({x},s)) IN
16128                    {x | x$1 < &0}}` THEN
16129   REPEAT CONJ_TAC THENL
16130    [REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s /\ x IN t ==> F`] THEN
16131     REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN REAL_ARITH_TAC;
16132     MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN
16133     SIMP_TAC[REWRITE_RULE[real_gt] OPEN_HALFSPACE_COMPONENT_GT; OPEN_UNIV] THEN
16134     SIMP_TAC[LIFT_SUB; CONTINUOUS_ON_SUB; CONTINUOUS_ON_LIFT_SETDIST];
16135     MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN
16136     SIMP_TAC[OPEN_HALFSPACE_COMPONENT_LT; OPEN_UNIV] THEN
16137     SIMP_TAC[LIFT_SUB; CONTINUOUS_ON_SUB; CONTINUOUS_ON_LIFT_SETDIST];
16138     REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIV; GSYM drop; LIFT_DROP] THEN
16139     GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH
16140      `&0 <= x /\ y = &0 /\ ~(x = &0) ==> &0 < x - y`);
16141     REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIV; GSYM drop; LIFT_DROP] THEN
16142     GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH
16143      `&0 <= y /\ x = &0 /\ ~(y = &0) ==> x - y < &0`)] THEN
16144   ASM_SIMP_TAC[SETDIST_POS_LE; SETDIST_EQ_0_BOUNDED; BOUNDED_SING] THEN
16145   ASM_SIMP_TAC[CLOSED_SING; CLOSURE_CLOSED; NOT_INSERT_EMPTY;
16146                REWRITE_RULE[SUBSET] CLOSURE_SUBSET;
16147                SET_RULE `{a} INTER s = {} <=> ~(a IN s)`] THEN
16148   ASM SET_TAC[]);;
16149
16150 let SEPARATION_NORMAL = prove
16151  (`!s t:real^N->bool.
16152         closed s /\ closed t /\ s INTER t = {}
16153         ==> ?u v. open u /\ open v /\
16154                   s SUBSET u /\ t SUBSET v /\ u INTER v = {}`,
16155   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM DISJOINT] THEN
16156   ONCE_REWRITE_TAC[TAUT
16157     `a /\ b /\ c /\ d /\ e <=> e /\ a /\ b /\ c /\ d`] THEN
16158   MATCH_MP_TAC SEPARATION_CLOSURES THEN
16159   ASM_SIMP_TAC[CLOSURE_CLOSED] THEN ASM SET_TAC[]);;
16160
16161 let SEPARATION_NORMAL_LOCAL = prove
16162  (`!s t u:real^N->bool.
16163         closed_in (subtopology euclidean u) s /\
16164         closed_in (subtopology euclidean u) t /\
16165         s INTER t = {}
16166         ==> ?s' t'. open_in (subtopology euclidean u) s' /\
16167                     open_in (subtopology euclidean u) t' /\
16168                     s SUBSET s' /\ t SUBSET t' /\ s' INTER t' = {}`,
16169   REPEAT STRIP_TAC THEN
16170   ASM_CASES_TAC `s:real^N->bool = {}` THENL
16171    [MAP_EVERY EXISTS_TAC [`{}:real^N->bool`; `u:real^N->bool`] THEN
16172     ASM_SIMP_TAC[OPEN_IN_REFL; OPEN_IN_EMPTY; INTER_EMPTY; EMPTY_SUBSET] THEN
16173     ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET];
16174     ALL_TAC] THEN
16175   ASM_CASES_TAC `t:real^N->bool = {}` THENL
16176    [MAP_EVERY EXISTS_TAC [`u:real^N->bool`; `{}:real^N->bool`] THEN
16177     ASM_SIMP_TAC[OPEN_IN_REFL; OPEN_IN_EMPTY; INTER_EMPTY; EMPTY_SUBSET] THEN
16178     ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET];
16179     ALL_TAC] THEN
16180   EXISTS_TAC `{x:real^N | x IN u /\ setdist({x},s) < setdist({x},t)}` THEN
16181   EXISTS_TAC `{x:real^N | x IN u /\ setdist({x},t) < setdist({x},s)}` THEN
16182   SIMP_TAC[EXTENSION; SUBSET; IN_ELIM_THM; SETDIST_SING_IN_SET; IN_INTER;
16183            NOT_IN_EMPTY; SETDIST_POS_LE; CONJ_ASSOC;
16184            REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN
16185   CONJ_TAC THENL [ALL_TAC; MESON_TAC[REAL_LT_ANTISYM]] THEN
16186   ONCE_REWRITE_TAC[GSYM CONJ_ASSOC] THEN CONJ_TAC THENL
16187    [ALL_TAC;
16188     ASM_MESON_TAC[SETDIST_EQ_0_CLOSED_IN; CLOSED_IN_IMP_SUBSET; SUBSET;
16189                   MEMBER_NOT_EMPTY; IN_INTER]] THEN
16190   ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
16191   ONCE_REWRITE_TAC[MESON[LIFT_DROP] `&0 < x <=> &0 < drop(lift x)`] THEN
16192   REWRITE_TAC[SET_RULE
16193    `{x | x IN u /\ &0 < drop(f x)} =
16194     {x | x IN u /\ f x IN {x | &0 < drop x}}`] THEN
16195   REWRITE_TAC[drop] THEN CONJ_TAC THEN
16196   MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN
16197   REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT; LIFT_SUB;
16198            REWRITE_RULE[real_gt] OPEN_HALFSPACE_COMPONENT_GT; OPEN_UNIV] THEN
16199   SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_LIFT_SETDIST]);;
16200
16201 let SEPARATION_NORMAL_COMPACT = prove
16202  (`!s t:real^N->bool.
16203         compact s /\ closed t /\ s INTER t = {}
16204         ==> ?u v. open u /\ compact(closure u) /\ open v /\
16205                   s SUBSET u /\ t SUBSET v /\ u INTER v = {}`,
16206   REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE] THEN
16207   REPEAT STRIP_TAC THEN FIRST_ASSUM
16208    (MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
16209   DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
16210   MP_TAC(ISPECL [`s:real^N->bool`; `t UNION ((:real^N) DIFF ball(vec 0,r))`]
16211         SEPARATION_NORMAL) THEN
16212   ASM_SIMP_TAC[CLOSED_UNION; GSYM OPEN_CLOSED; OPEN_BALL] THEN
16213   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
16214   REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
16215   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
16216   CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_CLOSURE; ASM SET_TAC[]] THEN
16217   MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(vec 0:real^N,r)` THEN
16218   REWRITE_TAC[BOUNDED_BALL] THEN ASM SET_TAC[]);;
16219
16220 let SEPARATION_HAUSDORFF = prove
16221  (`!x:real^N y.
16222       ~(x = y)
16223       ==> ?u v. open u /\ open v /\ x IN u /\ y IN v /\ (u INTER v = {})`,
16224   REPEAT STRIP_TAC THEN
16225   MP_TAC(SPECL [`{x:real^N}`; `{y:real^N}`] SEPARATION_NORMAL) THEN
16226   REWRITE_TAC[SING_SUBSET; CLOSED_SING] THEN
16227   DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);;
16228
16229 let SEPARATION_T2 = prove
16230  (`!x:real^N y.
16231         ~(x = y) <=> ?u v. open u /\ open v /\ x IN u /\ y IN v /\
16232                            (u INTER v = {})`,
16233   REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[SEPARATION_HAUSDORFF] THEN
16234   REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN MESON_TAC[]);;
16235
16236 let SEPARATION_T1 = prove
16237  (`!x:real^N y.
16238         ~(x = y) <=> ?u v. open u /\ open v /\ x IN u /\ ~(y IN u) /\
16239                            ~(x IN v) /\ y IN v`,
16240   REPEAT STRIP_TAC THEN EQ_TAC THENL
16241    [ASM_SIMP_TAC[SEPARATION_T2; EXTENSION; NOT_IN_EMPTY; IN_INTER];
16242     ALL_TAC] THEN MESON_TAC[]);;
16243
16244 let SEPARATION_T0 = prove
16245  (`!x:real^N y. ~(x = y) <=> ?u. open u /\ ~(x IN u <=> y IN u)`,
16246   MESON_TAC[SEPARATION_T1]);;
16247
16248 (* ------------------------------------------------------------------------- *)
16249 (* Hausdorff distance between sets.                                          *)
16250 (* ------------------------------------------------------------------------- *)
16251
16252 let hausdist = new_definition
16253  `hausdist(s:real^N->bool,t:real^N->bool) =
16254         let ds = {setdist({x},t) | x IN s} UNION {setdist({y},s) | y IN t} in
16255         if ~(ds = {}) /\ (?b. !d. d IN ds ==> d <= b) then sup ds
16256         else &0`;;
16257
16258 let HAUSDIST_POS_LE = prove
16259  (`!s t:real^N->bool. &0 <= hausdist(s,t)`,
16260   REPEAT GEN_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN
16261   REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION] THEN
16262   COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN
16263   MATCH_MP_TAC REAL_LE_SUP THEN
16264   ASM_REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION; SETDIST_POS_LE] THEN
16265   ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
16266   ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
16267   MATCH_MP_TAC(SET_RULE
16268    `~(s = {}) /\ (!x. x IN s ==> P x) ==> ?y. y IN s /\ P y`) THEN
16269   ASM_REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION; SETDIST_POS_LE]);;
16270
16271 let HAUSDIST_REFL = prove
16272  (`!s:real^N->bool. hausdist(s,s) = &0`,
16273   GEN_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM; HAUSDIST_POS_LE] THEN
16274   REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN
16275   COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN
16276   MATCH_MP_TAC REAL_SUP_LE THEN
16277   REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION] THEN
16278   ASM_SIMP_TAC[SETDIST_SING_IN_SET; REAL_LE_REFL]);;
16279
16280 let HAUSDIST_SYM = prove
16281  (`!s t:real^N->bool. hausdist(s,t) = hausdist(t,s)`,
16282   REPEAT GEN_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN
16283   GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [UNION_COMM] THEN
16284   REWRITE_TAC[]);;
16285
16286 let HAUSDIST_EMPTY = prove
16287  (`(!t:real^N->bool. hausdist ({},t) = &0) /\
16288    (!s:real^N->bool. hausdist (s,{}) = &0)`,
16289   REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_EMPTY] THEN
16290   REWRITE_TAC[SET_RULE `{f x | x IN {}} = {}`; UNION_EMPTY] THEN
16291   REWRITE_TAC[SET_RULE `{c |x| x IN s} = {} <=> s = {}`] THEN
16292   X_GEN_TAC `s:real^N->bool` THEN
16293   ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN
16294   ASM_SIMP_TAC[SET_RULE `~(s = {}) ==> {c |x| x IN s} = {c}`] THEN
16295   REWRITE_TAC[SUP_SING; COND_ID]);;
16296
16297 let HAUSDIST_SINGS = prove
16298  (`!x y:real^N. hausdist({x},{y}) = dist(x,y)`,
16299   REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_SINGS] THEN
16300   REWRITE_TAC[SET_RULE `{f x | x IN {a}} = {f a}`] THEN
16301   REWRITE_TAC[DIST_SYM; UNION_IDEMPOT; SUP_SING; NOT_INSERT_EMPTY] THEN
16302   REWRITE_TAC[IN_SING; FORALL_UNWIND_THM2] THEN
16303   MESON_TAC[REAL_LE_REFL]);;
16304
16305 let HAUSDIST_EQ = prove
16306  (`!s t:real^M->bool s' t':real^N->bool.
16307         (!b. (!x. x IN s ==> setdist({x},t) <= b) /\
16308              (!y. y IN t ==> setdist({y},s) <= b) <=>
16309              (!x. x IN s' ==> setdist({x},t') <= b) /\
16310              (!y. y IN t' ==> setdist({y},s') <= b))
16311         ==> hausdist(s,t) = hausdist(s',t')`,
16312   REPEAT STRIP_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN
16313   MATCH_MP_TAC(MESON[]
16314    `(p <=> p') /\ s = s'
16315     ==> (if p then s else &0) = (if p' then s' else &0)`) THEN
16316   CONJ_TAC THENL
16317    [BINOP_TAC THENL
16318      [PURE_REWRITE_TAC[SET_RULE `s = {} <=> !x. x IN s ==> F`];
16319       AP_TERM_TAC THEN ABS_TAC];
16320     MATCH_MP_TAC SUP_EQ] THEN
16321   PURE_REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC] THEN
16322   ASM_REWRITE_TAC[] THEN
16323   REWRITE_TAC[DE_MORGAN_THM; NOT_FORALL_THM; MEMBER_NOT_EMPTY] THEN
16324   REWRITE_TAC[GSYM DE_MORGAN_THM] THEN AP_TERM_TAC THEN EQ_TAC THEN
16325   DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN ASSUME_TAC th) THEN
16326   ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
16327   DISCH_THEN(MP_TAC o SPEC `--(&1):real`) THEN
16328   SIMP_TAC[SETDIST_POS_LE; REAL_ARITH `&0 <= x ==> ~(x <= --(&1))`] THEN
16329   SET_TAC[]);;
16330
16331 let HAUSDIST_TRANSLATION = prove
16332  (`!a s t:real^N->bool.
16333         hausdist(IMAGE (\x. a + x) s,IMAGE (\x. a + x) t) = hausdist(s,t)`,
16334   REPEAT GEN_TAC THEN REWRITE_TAC[hausdist] THEN
16335   REWRITE_TAC[SET_RULE `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`] THEN
16336   REWRITE_TAC[SET_RULE `{a + x:real^N} = IMAGE (\x. a + x) {x}`] THEN
16337   REWRITE_TAC[SETDIST_TRANSLATION]);;
16338
16339 add_translation_invariants [HAUSDIST_TRANSLATION];;
16340
16341 let HAUSDIST_LINEAR_IMAGE = prove
16342  (`!f:real^M->real^N s t.
16343            linear f /\ (!x. norm(f x) = norm x)
16344            ==> hausdist(IMAGE f s,IMAGE f t) = hausdist(s,t)`,
16345   REPEAT STRIP_TAC THEN
16346   REPEAT GEN_TAC THEN REWRITE_TAC[hausdist] THEN
16347   REWRITE_TAC[SET_RULE `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`] THEN
16348   ONCE_REWRITE_TAC[SET_RULE `{(f:real^M->real^N) x} = IMAGE f {x}`] THEN
16349   ASM_SIMP_TAC[SETDIST_LINEAR_IMAGE]);;
16350
16351 add_linear_invariants [HAUSDIST_LINEAR_IMAGE];;
16352
16353 let HAUSDIST_CLOSURE = prove
16354  (`(!s t:real^N->bool. hausdist(closure s,t) = hausdist(s,t)) /\
16355    (!s t:real^N->bool. hausdist(s,closure t) = hausdist(s,t))`,
16356   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAUSDIST_EQ THEN
16357   GEN_TAC THEN BINOP_TAC THEN REWRITE_TAC[SETDIST_CLOSURE] THEN
16358   PURE_ONCE_REWRITE_TAC[SET_RULE
16359    `(!x. P x ==> Q x) <=> (!x. P x ==> x IN {x | Q x})`] THEN
16360   MATCH_MP_TAC FORALL_IN_CLOSURE_EQ THEN
16361   REWRITE_TAC[EMPTY_GSPEC; CONTINUOUS_ON_ID; CLOSED_EMPTY] THEN
16362   ONCE_REWRITE_TAC[MESON[LIFT_DROP] `x <= b <=> drop(lift x) <= b`] THEN
16363   REWRITE_TAC[SET_RULE
16364     `{x | drop(lift(f x)) <= b} =
16365      {x | x IN UNIV /\ lift(f x) IN {x | drop x <= b}}`] THEN
16366   MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN
16367   REWRITE_TAC[CLOSED_UNIV; CONTINUOUS_ON_LIFT_SETDIST] THEN
16368   REWRITE_TAC[drop; CLOSED_HALFSPACE_COMPONENT_LE]);;
16369
16370 let REAL_HAUSDIST_LE = prove
16371  (`!s t:real^N->bool b.
16372         ~(s = {}) /\ ~(t = {}) /\
16373         (!x. x IN s ==> setdist({x},t) <= b) /\
16374         (!y. y IN t ==> setdist({y},s) <= b)
16375         ==> hausdist(s,t) <= b`,
16376   REPEAT STRIP_TAC THEN
16377   REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_SINGS] THEN
16378   ASM_REWRITE_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN
16379   REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC] THEN
16380   COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
16381   MATCH_MP_TAC REAL_SUP_LE THEN
16382   ASM_REWRITE_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN
16383   ASM_REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC]);;
16384
16385 let REAL_HAUSDIST_LE_SUMS = prove
16386  (`!s t:real^N->bool b.
16387         ~(s = {}) /\ ~(t = {}) /\
16388         s SUBSET {y + z | y IN t /\ z IN cball(vec 0,b)} /\
16389         t SUBSET {y + z | y IN s /\ z IN cball(vec 0,b)}
16390         ==> hausdist(s,t) <= b`,
16391   REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_CBALL_0] THEN
16392   REWRITE_TAC[VECTOR_ARITH `a:real^N = b + x <=> a - b = x`;
16393               ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN
16394   REWRITE_TAC[GSYM dist] THEN REPEAT STRIP_TAC THEN
16395   MATCH_MP_TAC REAL_HAUSDIST_LE THEN
16396   ASM_MESON_TAC[SETDIST_LE_DIST; REAL_LE_TRANS; IN_SING]);;
16397
16398 let REAL_LE_HAUSDIST  = prove
16399  (`!s t:real^N->bool a b c z.
16400         ~(s = {}) /\ ~(t = {}) /\
16401         (!x. x IN s ==> setdist({x},t) <= b) /\
16402         (!y. y IN t ==> setdist({y},s) <= c) /\
16403         (z IN s /\ a <= setdist({z},t) \/ z IN t /\ a <= setdist({z},s))
16404         ==> a <= hausdist(s,t)`,
16405   REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
16406   REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_SINGS] THEN
16407   ASM_REWRITE_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN
16408   REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC] THEN COND_CASES_TAC THENL
16409    [MATCH_MP_TAC REAL_LE_SUP THEN
16410     ASM_SIMP_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN
16411     REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC];
16412     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN
16413     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
16414     REWRITE_TAC[NOT_FORALL_THM]] THEN
16415   EXISTS_TAC `max b c:real` THEN
16416   ASM_SIMP_TAC[REAL_LE_MAX] THEN ASM SET_TAC[]);;
16417
16418 let SETDIST_LE_HAUSDIST = prove
16419  (`!s t:real^N->bool.
16420         bounded s /\ bounded t ==> setdist(s,t) <= hausdist(s,t)`,
16421   REPEAT STRIP_TAC THEN
16422   ASM_CASES_TAC `s:real^N->bool = {}` THEN
16423   ASM_REWRITE_TAC[SETDIST_EMPTY; HAUSDIST_EMPTY; REAL_LE_REFL] THEN
16424   ASM_CASES_TAC `t:real^N->bool = {}` THEN
16425   ASM_REWRITE_TAC[SETDIST_EMPTY; HAUSDIST_EMPTY; REAL_LE_REFL] THEN
16426   MATCH_MP_TAC REAL_LE_HAUSDIST THEN REWRITE_TAC[CONJ_ASSOC] THEN
16427   ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM] THEN
16428   CONJ_TAC THENL
16429    [ALL_TAC; ASM_MESON_TAC[SETDIST_LE_SING; MEMBER_NOT_EMPTY]] THEN
16430   MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN
16431   ASM_REWRITE_TAC[] THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC; GSYM dist] THEN
16432   DISCH_THEN(X_CHOOSE_TAC `b:real`) THEN
16433   CONJ_TAC THEN EXISTS_TAC `b:real` THEN REPEAT STRIP_TAC THEN
16434   ASM_MESON_TAC[REAL_LE_TRANS; SETDIST_LE_DIST; MEMBER_NOT_EMPTY; IN_SING;
16435                 DIST_SYM]);;
16436
16437 let SETDIST_SING_LE_HAUSDIST = prove
16438  (`!s t x:real^N.
16439         bounded s /\ bounded t /\ x IN s ==> setdist({x},t) <= hausdist(s,t)`,
16440   REPEAT GEN_TAC THEN
16441   ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN
16442   ASM_CASES_TAC `t:real^N->bool = {}` THEN
16443   ASM_REWRITE_TAC[SETDIST_EMPTY; HAUSDIST_EMPTY; REAL_LE_REFL] THEN
16444   STRIP_TAC THEN MATCH_MP_TAC REAL_LE_HAUSDIST THEN
16445   ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
16446   REWRITE_TAC[LEFT_EXISTS_AND_THM; EXISTS_OR_THM; CONJ_ASSOC] THEN
16447   CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_REFL]] THEN CONJ_TAC THEN
16448   MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN
16449   ASM_REWRITE_TAC[] THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN
16450   MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[GSYM dist] THEN GEN_TAC THENL
16451    [ALL_TAC; ONCE_REWRITE_TAC[SWAP_FORALL_THM]] THEN
16452   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^N` THEN
16453   REPEAT STRIP_TAC THENL
16454    [UNDISCH_TAC `~(t:real^N->bool = {})`;
16455     UNDISCH_TAC `~(s:real^N->bool = {})`] THEN
16456   REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
16457   DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN
16458   FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N`) THEN ASM_REWRITE_TAC[] THEN
16459   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THENL
16460    [ALL_TAC; ONCE_REWRITE_TAC[DIST_SYM]] THEN
16461   MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[IN_SING]);;
16462
16463 let UPPER_LOWER_HEMICONTINUOUS = prove
16464  (`!f:real^M->real^N->bool t s.
16465       (!x. x IN s ==> f(x) SUBSET t) /\
16466       (!u. open_in (subtopology euclidean t) u
16467            ==> open_in (subtopology euclidean s)
16468                        {x | x IN s /\ f(x) SUBSET u}) /\
16469       (!u. closed_in (subtopology euclidean t) u
16470            ==> closed_in (subtopology euclidean s)
16471                          {x | x IN s /\ f(x) SUBSET u})
16472       ==> !x e. x IN s /\ &0 < e /\ bounded(f x)
16473                 ==> ?d. &0 < d /\
16474                         !x'. x' IN s /\ dist(x,x') < d
16475                              ==> hausdist(f x,f x') < e`,
16476   REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT STRIP_TAC THEN
16477   ASM_CASES_TAC `(f:real^M->real^N->bool) x = {}` THENL
16478    [ASM_REWRITE_TAC[HAUSDIST_EMPTY] THEN MESON_TAC[REAL_LT_01]; ALL_TAC] THEN
16479   FIRST_ASSUM(MP_TAC o SPECL [`x:real^M`; `e / &2`] o MATCH_MP
16480         UPPER_LOWER_HEMICONTINUOUS_EXPLICIT) THEN
16481   ASM_REWRITE_TAC[REAL_HALF] THEN
16482   DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN
16483   FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN
16484   DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
16485   FIRST_ASSUM(MP_TAC o SPEC `t INTER ball(vec 0:real^N,r)` o
16486         CONJUNCT1 o CONJUNCT2) THEN
16487   SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN REWRITE_TAC[open_in] THEN
16488   DISCH_THEN(MP_TAC o SPEC `x:real^M` o CONJUNCT2) THEN
16489   ASM_SIMP_TAC[SUBSET_INTER; IN_ELIM_THM] THEN
16490   DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN
16491   EXISTS_TAC `min d1 d2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
16492   X_GEN_TAC `x':real^M` THEN STRIP_TAC THEN
16493   REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x':real^M`)) THEN
16494   ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[] THEN
16495   STRIP_TAC THEN STRIP_TAC THEN
16496   ASM_CASES_TAC `(f:real^M->real^N->bool) x' = {}` THEN
16497   ASM_REWRITE_TAC[HAUSDIST_EMPTY] THEN
16498   MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN
16499   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_HAUSDIST_LE THEN
16500   ASM_MESON_TAC[SETDIST_LE_DIST; DIST_SYM; REAL_LE_TRANS;
16501                 IN_SING; REAL_LT_IMP_LE]);;
16502
16503 let HAUSDIST_NONTRIVIAL = prove
16504  (`!s t:real^N->bool.
16505         bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {})
16506         ==> hausdist(s,t) =
16507             sup({setdist ({x},t) | x IN s} UNION {setdist ({y},s) | y IN t})`,
16508   REPEAT STRIP_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN
16509   COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
16510   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN
16511   ASM_SIMP_TAC[EMPTY_UNION; SIMPLE_IMAGE; IMAGE_EQ_EMPTY] THEN
16512   MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN
16513   MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN
16514   ASM_REWRITE_TAC[bounded; FORALL_IN_UNION; FORALL_IN_IMAGE; GSYM dist] THEN
16515   MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN
16516   ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS;
16517                 MEMBER_NOT_EMPTY; IN_SING]);;
16518
16519 let HAUSDIST_NONTRIVIAL_ALT = prove
16520  (`!s t:real^N->bool.
16521         bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {})
16522         ==> hausdist(s,t) = max (sup {setdist ({x},t) | x IN s})
16523                                 (sup {setdist ({y},s) | y IN t})`,
16524   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL] THEN
16525   MATCH_MP_TAC SUP_UNION THEN
16526   ASM_REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN
16527   CONJ_TAC THEN
16528   MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN
16529   ASM_REWRITE_TAC[bounded; FORALL_IN_UNION; FORALL_IN_IMAGE; GSYM dist] THEN
16530   MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[FORALL_IN_GSPEC; GSYM dist] THEN
16531   ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS;
16532                 MEMBER_NOT_EMPTY; IN_SING]);;
16533
16534 let REAL_HAUSDIST_LE_EQ = prove
16535  (`!s t:real^N->bool b.
16536         ~(s = {}) /\ ~(t = {}) /\ bounded s /\ bounded t
16537         ==> (hausdist(s,t) <= b <=>
16538              (!x. x IN s ==> setdist({x},t) <= b) /\
16539              (!y. y IN t ==> setdist({y},s) <= b))`,
16540   REPEAT STRIP_TAC THEN
16541   ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL_ALT; REAL_MAX_LE] THEN
16542   BINOP_TAC THEN
16543   ONCE_REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x <= b) <=>
16544                              (!y. y IN {f x | x IN s} ==> y <= b)`] THEN
16545   MATCH_MP_TAC REAL_SUP_LE_EQ THEN
16546   ASM_REWRITE_TAC[SIMPLE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN
16547   MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN
16548   ASM_REWRITE_TAC[bounded; FORALL_IN_UNION; FORALL_IN_IMAGE; GSYM dist] THEN
16549   MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[FORALL_IN_GSPEC; GSYM dist] THEN
16550   ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS;
16551                 MEMBER_NOT_EMPTY; IN_SING]);;
16552
16553 let HAUSDIST_COMPACT_EXISTS = prove
16554  (`!s t:real^N->bool.
16555         bounded s /\ compact t /\ ~(t = {})
16556         ==> !x. x IN s ==> ?y. y IN t /\ dist(x,y) <= hausdist(s,t)`,
16557   REPEAT STRIP_TAC THEN
16558   ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN
16559   MP_TAC(ISPECL [`{x:real^N}`; `t:real^N->bool`]
16560         SETDIST_COMPACT_CLOSED) THEN
16561   ASM_SIMP_TAC[COMPACT_SING; COMPACT_IMP_CLOSED; NOT_INSERT_EMPTY] THEN
16562   REWRITE_TAC[IN_SING; UNWIND_THM2; RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN
16563   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN
16564   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
16565   MATCH_MP_TAC REAL_LE_HAUSDIST THEN
16566   ASM_REWRITE_TAC[LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM] THEN
16567   REWRITE_TAC[CONJ_ASSOC] THEN
16568   CONJ_TAC THENL [CONJ_TAC; ASM_MESON_TAC[REAL_LE_REFL]] THEN
16569   MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN
16570   ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN
16571   REWRITE_TAC[bounded; FORALL_IN_GSPEC; GSYM dist] THEN
16572   MATCH_MP_TAC MONO_EXISTS THEN
16573   ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS;
16574                 MEMBER_NOT_EMPTY; IN_SING]);;
16575
16576 let HAUSDIST_COMPACT_SUMS = prove
16577  (`!s t:real^N->bool.
16578         bounded s /\ compact t /\ ~(t = {})
16579         ==> s SUBSET {y + z | y IN t /\ z IN cball(vec 0,hausdist(s,t))}`,
16580   REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_CBALL_0] THEN
16581   REWRITE_TAC[VECTOR_ARITH `a:real^N = b + x <=> a - b = x`;
16582               ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN
16583   REWRITE_TAC[GSYM dist; HAUSDIST_COMPACT_EXISTS]);;
16584
16585 let HAUSDIST_TRANS = prove
16586  (`!s t u:real^N->bool.
16587         bounded s /\ bounded t /\ bounded u /\ ~(t = {})
16588         ==> hausdist(s,u) <= hausdist(s,t) + hausdist(t,u)`,
16589   let lemma = prove
16590    (`!s t u:real^N->bool.
16591           bounded s /\ bounded t /\ bounded u /\
16592           ~(s = {}) /\ ~(t = {}) /\ ~(u = {})
16593           ==> !x. x IN s ==> setdist({x},u) <= hausdist(s,t) + hausdist(t,u)`,
16594     REPEAT STRIP_TAC THEN
16595     MP_TAC(ISPECL [`closure s:real^N->bool`; `closure t:real^N->bool`]
16596         HAUSDIST_COMPACT_EXISTS) THEN
16597     ASM_SIMP_TAC[COMPACT_CLOSURE; BOUNDED_CLOSURE; CLOSURE_EQ_EMPTY] THEN
16598     DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
16599     ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET; HAUSDIST_CLOSURE] THEN
16600     DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
16601     MP_TAC(ISPECL [`closure t:real^N->bool`; `closure u:real^N->bool`]
16602       HAUSDIST_COMPACT_EXISTS) THEN
16603     ASM_SIMP_TAC[COMPACT_CLOSURE; BOUNDED_CLOSURE; CLOSURE_EQ_EMPTY] THEN
16604     DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN
16605     ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET; HAUSDIST_CLOSURE] THEN
16606     DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN
16607     TRANS_TAC REAL_LE_TRANS `dist(x:real^N,z)` THEN  CONJ_TAC THENL
16608      [ASM_MESON_TAC[SETDIST_CLOSURE; SETDIST_LE_DIST; IN_SING]; ALL_TAC] THEN
16609     TRANS_TAC REAL_LE_TRANS `dist(x:real^N,y) + dist(y,z)` THEN
16610     REWRITE_TAC[DIST_TRIANGLE] THEN ASM_REAL_ARITH_TAC) in
16611   REPEAT STRIP_TAC THEN
16612   ASM_CASES_TAC `s:real^N->bool = {}` THEN
16613   ASM_REWRITE_TAC[HAUSDIST_EMPTY; REAL_ADD_LID; HAUSDIST_POS_LE] THEN
16614   ASM_CASES_TAC `u:real^N->bool = {}` THEN
16615   ASM_REWRITE_TAC[HAUSDIST_EMPTY; REAL_ADD_RID; HAUSDIST_POS_LE] THEN
16616   ASM_SIMP_TAC[REAL_HAUSDIST_LE_EQ] THEN
16617   ASM_MESON_TAC[lemma; HAUSDIST_SYM; SETDIST_SYM; REAL_ADD_SYM]);;
16618
16619 let HAUSDIST_EQ_0 = prove
16620  (`!s t:real^N->bool.
16621       bounded s /\ bounded t
16622       ==> (hausdist(s,t) = &0 <=> s = {} \/ t = {} \/ closure s = closure t)`,
16623   REPEAT STRIP_TAC THEN
16624   MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN
16625   ASM_REWRITE_TAC[HAUSDIST_EMPTY] THEN
16626   ASM_SIMP_TAC[GSYM REAL_LE_ANTISYM; HAUSDIST_POS_LE; REAL_HAUSDIST_LE_EQ] THEN
16627   SIMP_TAC[SETDIST_POS_LE; REAL_ARITH `&0 <= x ==> (x <= &0 <=> x = &0)`] THEN
16628   ASM_REWRITE_TAC[SETDIST_EQ_0_SING; GSYM SUBSET_ANTISYM_EQ; SUBSET] THEN
16629   SIMP_TAC[FORALL_IN_CLOSURE_EQ; CLOSED_CLOSURE; CONTINUOUS_ON_ID]);;
16630
16631 let HAUSDIST_COMPACT_NONTRIVIAL = prove
16632  (`!s t:real^N->bool.
16633         compact s /\ compact t /\ ~(s = {}) /\ ~(t = {})
16634         ==> hausdist(s,t) =
16635             inf {e | &0 <= e /\
16636                    s SUBSET {x + y | x IN t /\ norm y <= e} /\
16637                    t SUBSET {x + y | x IN s /\ norm y <= e}}`,
16638   REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
16639   MATCH_MP_TAC REAL_INF_UNIQUE THEN
16640   REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN
16641   REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
16642   REWRITE_TAC[VECTOR_ARITH `a:real^N = b + x <=> a - b = x`;
16643               ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN
16644   REWRITE_TAC[GSYM dist] THEN CONJ_TAC THENL
16645    [REPEAT STRIP_TAC THEN
16646     MATCH_MP_TAC REAL_HAUSDIST_LE THEN
16647     ASM_MESON_TAC[SETDIST_LE_DIST; DIST_SYM; REAL_LE_TRANS;
16648                   IN_SING; REAL_LT_IMP_LE];
16649     REPEAT STRIP_TAC THEN EXISTS_TAC `hausdist(s:real^N->bool,t)` THEN
16650     ASM_REWRITE_TAC[HAUSDIST_POS_LE] THEN
16651     ASM_MESON_TAC[DIST_SYM; HAUSDIST_SYM;
16652                   HAUSDIST_COMPACT_EXISTS; COMPACT_IMP_BOUNDED]]);;
16653
16654 let HAUSDIST_BALLS = prove
16655  (`(!a b:real^N r s.
16656         hausdist(ball(a,r),ball(b,s)) =
16657         if r <= &0 \/ s <= &0 then &0 else dist(a,b) + abs(r - s)) /\
16658    (!a b:real^N r s.
16659         hausdist(ball(a,r),cball(b,s)) =
16660         if r <= &0 \/ s < &0 then &0 else dist(a,b) + abs(r - s)) /\
16661    (!a b:real^N r s.
16662         hausdist(cball(a,r),ball(b,s)) =
16663         if r < &0 \/ s <= &0 then &0 else dist(a,b) + abs(r - s)) /\
16664    (!a b:real^N r s.
16665         hausdist(cball(a,r),cball(b,s)) =
16666         if r < &0 \/ s < &0 then &0 else dist(a,b) + abs(r - s))`,
16667   REWRITE_TAC[MESON[]
16668    `(x = if p then y else z) <=> (p ==> x = y) /\ (~p ==> x = z)`] THEN
16669   SIMP_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN
16670   SIMP_TAC[BALL_EMPTY; CBALL_EMPTY; HAUSDIST_EMPTY; DE_MORGAN_THM] THEN
16671   ONCE_REWRITE_TAC[MESON[HAUSDIST_CLOSURE]
16672    `hausdist(s,t) = hausdist(closure s,closure t)`] THEN
16673   SIMP_TAC[REAL_NOT_LE; REAL_NOT_LT; CLOSURE_BALL] THEN
16674   REWRITE_TAC[HAUSDIST_CLOSURE] THEN
16675   MATCH_MP_TAC(TAUT `(s ==> p /\ q /\ r) /\ s ==> p /\ q /\ r /\ s`) THEN
16676   CONJ_TAC THENL [MESON_TAC[REAL_LT_IMP_LE]; REPEAT STRIP_TAC] THEN
16677   ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL; BOUNDED_CBALL; CBALL_EQ_EMPTY;
16678                REAL_NOT_LT] THEN
16679   MATCH_MP_TAC SUP_UNIQUE THEN
16680   REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION] THEN
16681   REWRITE_TAC[MESON[CBALL_SING] `{a} = cball(a:real^N,&0)`] THEN
16682   ASM_REWRITE_TAC[SETDIST_BALLS; REAL_LT_REFL] THEN
16683   X_GEN_TAC `c:real` THEN REWRITE_TAC[IN_CBALL] THEN
16684   EQ_TAC THENL [ALL_TAC; NORM_ARITH_TAC] THEN
16685   ASM_CASES_TAC `b:real^N = a` THENL
16686    [ASM_REWRITE_TAC[DIST_SYM; DIST_REFL; REAL_MAX_LE] THEN
16687     DISCH_THEN(CONJUNCTS_THEN2
16688      (MP_TAC o SPEC `a + r % basis 1:real^N`)
16689      (MP_TAC o SPEC `a + s % basis 1:real^N`)) THEN
16690     REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN
16691     SIMP_TAC[NORM_MUL; NORM_BASIS; LE_REFL; DIMINDEX_GE_1] THEN
16692     ASM_REAL_ARITH_TAC;
16693     DISCH_THEN(CONJUNCTS_THEN2
16694      (MP_TAC o SPEC `a - r / dist(a,b) % (b - a):real^N`)
16695      (MP_TAC o SPEC `b - s / dist(a,b) % (a - b):real^N`)) THEN
16696     REWRITE_TAC[NORM_ARITH `dist(a:real^N,a - x) = norm x`] THEN
16697     REWRITE_TAC[dist; NORM_MUL; VECTOR_ARITH
16698      `b - e % (a - b) - a:real^N = (&1 + e) % (b - a)`] THEN
16699     ONCE_REWRITE_TAC[GSYM REAL_ABS_NORM] THEN
16700     REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_NORM] THEN
16701     REWRITE_TAC[NORM_SUB; REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN
16702     ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN
16703     ASM_REAL_ARITH_TAC]);;
16704
16705 let HAUSDIST_ALT = prove
16706  (`!s t:real^N->bool.
16707         bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {})
16708         ==> hausdist(s,t) =
16709             sup {abs(setdist({x},s) - setdist({x},t)) | x IN (:real^N)}`,
16710   REPEAT GEN_TAC THEN
16711   ONCE_REWRITE_TAC[GSYM COMPACT_CLOSURE; GSYM(CONJUNCT2 SETDIST_CLOSURE);
16712     GSYM CLOSURE_EQ_EMPTY; MESON[HAUSDIST_CLOSURE]
16713     `hausdist(s:real^N->bool,t) = hausdist(closure s,closure t)`] THEN
16714   SPEC_TAC(`closure t:real^N->bool`,`t:real^N->bool`) THEN
16715   SPEC_TAC(`closure s:real^N->bool`,`s:real^N->bool`) THEN
16716   REPEAT STRIP_TAC THEN
16717   ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL; COMPACT_IMP_BOUNDED] THEN
16718   MATCH_MP_TAC SUP_EQ THEN
16719   REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC; IN_UNIV] THEN
16720   REWRITE_TAC[REAL_ARITH `abs(y - x) <= b <=> x <= y + b /\ y <= x + b`] THEN
16721   GEN_TAC THEN REWRITE_TAC[FORALL_AND_THM] THEN BINOP_TAC THEN
16722   (EQ_TAC THENL [ALL_TAC; MESON_TAC[SETDIST_SING_IN_SET; REAL_ADD_LID]]) THEN
16723   DISCH_TAC THEN X_GEN_TAC `z:real^N` THENL
16724    [MP_TAC(ISPECL[`{z:real^N}`; `s:real^N->bool`] SETDIST_CLOSED_COMPACT);
16725     MP_TAC(ISPECL[`{z:real^N}`; `t:real^N->bool`] SETDIST_CLOSED_COMPACT)] THEN
16726   ASM_REWRITE_TAC[CLOSED_SING; NOT_INSERT_EMPTY] THEN
16727   REWRITE_TAC[IN_SING; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN
16728   DISCH_THEN(X_CHOOSE_THEN `y:real^N` (STRIP_ASSUME_TAC o GSYM)) THEN
16729   FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THENL
16730    [MP_TAC(ISPECL[`{y:real^N}`; `t:real^N->bool`] SETDIST_CLOSED_COMPACT);
16731     MP_TAC(ISPECL[`{y:real^N}`; `s:real^N->bool`] SETDIST_CLOSED_COMPACT)] THEN
16732   ASM_REWRITE_TAC[CLOSED_SING; NOT_INSERT_EMPTY] THEN
16733   REWRITE_TAC[IN_SING; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN
16734   DISCH_THEN(X_CHOOSE_THEN `x:real^N` (STRIP_ASSUME_TAC o GSYM)) THEN
16735   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
16736   TRANS_TAC REAL_LE_TRANS `dist(z:real^N,x)` THEN
16737   ASM_SIMP_TAC[SETDIST_LE_DIST; IN_SING] THEN
16738   UNDISCH_TAC `dist(y:real^N,x) <= b` THEN CONV_TAC NORM_ARITH);;
16739
16740 let CONTINUOUS_DIAMETER = prove
16741  (`!s:real^N->bool e.
16742         bounded s /\ ~(s = {}) /\ &0 < e
16743         ==> ?d. &0 < d /\
16744                 !t. bounded t /\ ~(t = {}) /\ hausdist(s,t) < d
16745                     ==> abs(diameter s - diameter t) < e`,
16746   REPEAT STRIP_TAC THEN EXISTS_TAC `e / &2` THEN
16747   ASM_REWRITE_TAC[REAL_HALF] THEN REPEAT STRIP_TAC THEN
16748   SUBGOAL_THEN `diameter(s:real^N->bool) - diameter(t:real^N->bool) =
16749                 diameter(closure s) - diameter(closure t)`
16750   SUBST1_TAC THENL [ASM_MESON_TAC[DIAMETER_CLOSURE]; ALL_TAC] THEN
16751   MATCH_MP_TAC REAL_LET_TRANS THEN
16752   EXISTS_TAC `&2 * hausdist(s:real^N->bool,t)` THEN
16753   CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
16754   MP_TAC(ISPECL [`vec 0:real^N`; `hausdist(s:real^N->bool,t)`]
16755     DIAMETER_CBALL) THEN
16756   ASM_SIMP_TAC[HAUSDIST_POS_LE; GSYM REAL_NOT_LE] THEN
16757   DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC(REAL_ARITH
16758    `x <= y + e /\ y <= x + e ==> abs(x - y) <= e`) THEN
16759   CONJ_TAC THEN
16760   W(MP_TAC o PART_MATCH (rand o rand) DIAMETER_SUMS o rand o snd) THEN
16761   ASM_SIMP_TAC[BOUNDED_CBALL; BOUNDED_CLOSURE] THEN
16762   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN
16763   MATCH_MP_TAC DIAMETER_SUBSET THEN
16764   ASM_SIMP_TAC[BOUNDED_SUMS; BOUNDED_CBALL; BOUNDED_CLOSURE] THEN
16765   ONCE_REWRITE_TAC[MESON[HAUSDIST_CLOSURE]
16766    `hausdist(s:real^N->bool,t) = hausdist(closure s,closure t)`]
16767   THENL [ALL_TAC; ONCE_REWRITE_TAC[HAUSDIST_SYM]] THEN
16768   MATCH_MP_TAC HAUSDIST_COMPACT_SUMS THEN
16769   ASM_SIMP_TAC[COMPACT_CLOSURE; BOUNDED_CLOSURE; CLOSURE_EQ_EMPTY]);;
16770
16771 (* ------------------------------------------------------------------------- *)
16772 (* Isometries are embeddings, and even surjective in the compact case.       *)
16773 (* ------------------------------------------------------------------------- *)
16774
16775 let ISOMETRY_IMP_OPEN_MAP = prove
16776  (`!f:real^M->real^N s t u.
16777         IMAGE f s = t /\
16778         (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y)) /\
16779         open_in (subtopology euclidean s) u
16780         ==> open_in (subtopology euclidean t) (IMAGE f u)`,
16781   REWRITE_TAC[open_in; FORALL_IN_IMAGE] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN
16782   CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `x:real^M` THEN DISCH_TAC] THEN
16783   FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN
16784   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN
16785   STRIP_TAC THEN ASM_REWRITE_TAC[IMP_CONJ] THEN
16786   EXPAND_TAC "t" THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN
16787   RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN
16788   ASM_SIMP_TAC[IN_IMAGE] THEN ASM_MESON_TAC[]);;
16789
16790 let ISOMETRY_IMP_EMBEDDING = prove
16791  (`!f:real^M->real^N s t.
16792         IMAGE f s = t /\ (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y))
16793         ==> ?g. homeomorphism (s,t) (f,g)`,
16794   REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN
16795   ASM_SIMP_TAC[ISOMETRY_ON_IMP_CONTINUOUS_ON] THEN
16796   CONJ_TAC THENL [ASM_MESON_TAC[DIST_EQ_0]; REPEAT STRIP_TAC] THEN
16797   MATCH_MP_TAC ISOMETRY_IMP_OPEN_MAP THEN ASM_MESON_TAC[]);;
16798
16799 let ISOMETRY_IMP_HOMEOMORPHISM_COMPACT = prove
16800  (`!f s:real^N->bool.
16801         compact s /\ IMAGE f s SUBSET s /\
16802         (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y))
16803         ==> ?g. homeomorphism (s,s) (f,g)`,
16804   REPEAT STRIP_TAC THEN
16805   SUBGOAL_THEN `IMAGE (f:real^N->real^N) s = s`
16806    (fun th -> ASM_MESON_TAC[th; ISOMETRY_IMP_EMBEDDING]) THEN
16807   FIRST_ASSUM(ASSUME_TAC o MATCH_MP ISOMETRY_ON_IMP_CONTINUOUS_ON) THEN
16808   ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[SUBSET] THEN
16809   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
16810   SUBGOAL_THEN `setdist({x},IMAGE (f:real^N->real^N) s) = &0` MP_TAC THENL
16811    [MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ ~(&0 < x) ==> x = &0`) THEN
16812     REWRITE_TAC[SETDIST_POS_LE] THEN DISCH_TAC THEN
16813     (X_CHOOSE_THEN `z:num->real^N` STRIP_ASSUME_TAC o
16814      prove_recursive_functions_exist num_RECURSION)
16815      `z 0 = (x:real^N) /\ !n. z(SUC n) = f(z n)` THEN
16816     SUBGOAL_THEN `!n. (z:num->real^N) n IN s` ASSUME_TAC THENL
16817      [INDUCT_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN
16818     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [compact]) THEN
16819     DISCH_THEN(MP_TAC o SPEC `z:num->real^N`) THEN
16820     ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN
16821     MAP_EVERY X_GEN_TAC [`l:real^N`; `r:num->num`] THEN STRIP_TAC THEN
16822     FIRST_ASSUM(MP_TAC o MATCH_MP CONVERGENT_IMP_CAUCHY) THEN
16823     REWRITE_TAC[cauchy] THEN
16824     DISCH_THEN(MP_TAC o SPEC `setdist({x},IMAGE (f:real^N->real^N) s)`) THEN
16825     ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `N:num`
16826      (MP_TAC o SPECL [`N:num`; `N + 1`])) THEN
16827     ANTS_TAC THENL [ARITH_TAC; REWRITE_TAC[REAL_NOT_LT; o_THM]] THEN
16828     SUBGOAL_THEN `(r:num->num) N < r (N + 1)` MP_TAC THENL
16829      [FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC;
16830       REWRITE_TAC[LT_EXISTS; LEFT_IMP_EXISTS_THM]] THEN
16831     X_GEN_TAC `d:num` THEN DISCH_THEN SUBST1_TAC THEN
16832     TRANS_TAC REAL_LE_TRANS `dist(x:real^N,z(SUC d))` THEN CONJ_TAC THENL
16833      [MATCH_MP_TAC SETDIST_LE_DIST THEN ASM SET_TAC[]; ALL_TAC] THEN
16834     MATCH_MP_TAC REAL_EQ_IMP_LE THEN
16835     SPEC_TAC(`(r:num->num) N`,`m:num`) THEN
16836     INDUCT_TAC THEN ASM_MESON_TAC[ADD_CLAUSES];
16837     REWRITE_TAC[SETDIST_EQ_0_SING; IMAGE_EQ_EMPTY] THEN
16838     ASM_MESON_TAC[COMPACT_IMP_CLOSED; NOT_IN_EMPTY;
16839                   COMPACT_CONTINUOUS_IMAGE; CLOSURE_CLOSED]]);;
16840
16841 (* ------------------------------------------------------------------------- *)
16842 (* Urysohn's lemma (for real^N, where the proof is easy using distances).    *)
16843 (* ------------------------------------------------------------------------- *)
16844
16845 let URYSOHN_LOCAL_STRONG = prove
16846  (`!s t u a b.
16847         closed_in (subtopology euclidean u) s /\
16848         closed_in (subtopology euclidean u) t /\
16849         s INTER t = {} /\ ~(a = b)
16850         ==> ?f:real^N->real^M.
16851                f continuous_on u /\
16852                (!x. x IN u ==> f(x) IN segment[a,b]) /\
16853                (!x. x IN u ==> (f x = a <=> x IN s)) /\
16854                (!x. x IN u ==> (f x = b <=> x IN t))`,
16855   let lemma = prove
16856    (`!s t u a b.
16857           closed_in (subtopology euclidean u) s /\
16858           closed_in (subtopology euclidean u) t /\
16859           s INTER t = {} /\ ~(s = {}) /\ ~(t = {}) /\ ~(a = b)
16860           ==> ?f:real^N->real^M.
16861                  f continuous_on u /\
16862                  (!x. x IN u ==> f(x) IN segment[a,b]) /\
16863                  (!x. x IN u ==> (f x = a <=> x IN s)) /\
16864                  (!x. x IN u ==> (f x = b <=> x IN t))`,
16865     REPEAT STRIP_TAC THEN EXISTS_TAC
16866       `\x:real^N. a + setdist({x},s) / (setdist({x},s) + setdist({x},t)) %
16867                       (b - a:real^M)` THEN REWRITE_TAC[] THEN
16868     SUBGOAL_THEN
16869      `(!x:real^N. x IN u ==> (setdist({x},s) = &0 <=> x IN s)) /\
16870       (!x:real^N. x IN u ==> (setdist({x},t) = &0 <=> x IN t))`
16871     STRIP_ASSUME_TAC THENL
16872      [ASM_REWRITE_TAC[SETDIST_EQ_0_SING] THEN CONJ_TAC THENL
16873        [MP_TAC(ISPEC `s:real^N->bool` CLOSED_IN_CLOSED);
16874         MP_TAC(ISPEC `t:real^N->bool` CLOSED_IN_CLOSED)] THEN
16875       DISCH_THEN(MP_TAC o SPEC `u:real^N->bool`) THEN
16876       ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool`
16877        (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN
16878       ASM_MESON_TAC[CLOSURE_CLOSED; INTER_SUBSET; SUBSET_CLOSURE; SUBSET;
16879                     IN_INTER; CLOSURE_SUBSET];
16880       ALL_TAC] THEN
16881     SUBGOAL_THEN `!x:real^N. x IN u ==> &0 < setdist({x},s) + setdist({x},t)`
16882     ASSUME_TAC THENL
16883      [REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
16884         `&0 <= x /\ &0 <= y /\ ~(x = &0 /\ y = &0) ==> &0 < x + y`) THEN
16885       REWRITE_TAC[SETDIST_POS_LE] THEN ASM SET_TAC[];
16886       ALL_TAC] THEN
16887     REPEAT CONJ_TAC THENL
16888      [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
16889       REWRITE_TAC[real_div; GSYM VECTOR_MUL_ASSOC] THEN
16890       REPEAT(MATCH_MP_TAC CONTINUOUS_ON_MUL THEN CONJ_TAC) THEN
16891       REWRITE_TAC[CONTINUOUS_ON_CONST; o_DEF] THEN
16892       REWRITE_TAC[CONTINUOUS_ON_LIFT_SETDIST] THEN
16893       MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
16894       ASM_SIMP_TAC[REAL_LT_IMP_NZ] THEN
16895       REWRITE_TAC[LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
16896       REWRITE_TAC[CONTINUOUS_ON_LIFT_SETDIST];
16897       X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
16898       REWRITE_TAC[segment; IN_ELIM_THM] THEN
16899       REWRITE_TAC[VECTOR_MUL_EQ_0; LEFT_OR_DISTRIB; VECTOR_ARITH
16900        `a + x % (b - a):real^N = (&1 - u) % a + u % b <=>
16901         (x - u) % (b - a) = vec 0`;
16902        EXISTS_OR_THM] THEN
16903       DISJ1_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
16904       REWRITE_TAC[REAL_SUB_0; UNWIND_THM1] THEN
16905       ASM_SIMP_TAC[REAL_LE_DIV; REAL_LE_ADD; SETDIST_POS_LE; REAL_LE_LDIV_EQ;
16906                    REAL_ARITH `a <= &1 * (a + b) <=> &0 <= b`];
16907       REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a <=> x = vec 0`];
16908       REWRITE_TAC[VECTOR_ARITH `a + x % (b - a):real^N = b <=>
16909                                 (x - &1) % (b - a) = vec 0`]] THEN
16910     ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN
16911     ASM_SIMP_TAC[REAL_SUB_0; REAL_EQ_LDIV_EQ;
16912                  REAL_MUL_LZERO; REAL_MUL_LID] THEN
16913     REWRITE_TAC[REAL_ARITH `x:real = x + y <=> y = &0`] THEN
16914     ASM_REWRITE_TAC[]) in
16915   MATCH_MP_TAC(MESON[]
16916    `(!s t. P s t <=> P t s) /\
16917     (!s t. ~(s = {}) /\ ~(t = {}) ==> P s t) /\
16918     P {} {} /\ (!t. ~(t = {}) ==> P {} t)
16919     ==> !s t. P s t`) THEN
16920   REPEAT CONJ_TAC THENL
16921    [REPEAT GEN_TAC THEN
16922     GEN_REWRITE_TAC (RAND_CONV o BINDER_CONV) [SWAP_FORALL_THM] THEN
16923     REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN
16924     REWRITE_TAC[SEGMENT_SYM; INTER_COMM; CONJ_ACI; EQ_SYM_EQ];
16925     SIMP_TAC[lemma];
16926     REPEAT STRIP_TAC THEN EXISTS_TAC `(\x. midpoint(a,b)):real^N->real^M` THEN
16927     ASM_SIMP_TAC[NOT_IN_EMPTY; CONTINUOUS_ON_CONST; MIDPOINT_IN_SEGMENT] THEN
16928     REWRITE_TAC[midpoint] THEN CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN
16929     UNDISCH_TAC `~(a:real^M = b)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN
16930     VECTOR_ARITH_TAC;
16931     REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = u` THENL
16932      [EXISTS_TAC `(\x. b):real^N->real^M` THEN
16933       ASM_REWRITE_TAC[NOT_IN_EMPTY; ENDS_IN_SEGMENT; IN_UNIV;
16934                       CONTINUOUS_ON_CONST];
16935       SUBGOAL_THEN `?c:real^N. c IN u /\ ~(c IN t)` STRIP_ASSUME_TAC THENL
16936        [REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET)) THEN
16937         REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM SET_TAC[];
16938         ALL_TAC] THEN
16939       MP_TAC(ISPECL [`{c:real^N}`; `t:real^N->bool`; `u:real^N->bool`;
16940                      `midpoint(a,b):real^M`; `b:real^M`] lemma) THEN
16941       ASM_REWRITE_TAC[CLOSED_IN_SING; MIDPOINT_EQ_ENDPOINT] THEN
16942       ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
16943       MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[NOT_IN_EMPTY] THEN
16944       X_GEN_TAC `f:real^N->real^M` THEN STRIP_TAC THEN CONJ_TAC THENL
16945        [SUBGOAL_THEN
16946          `segment[midpoint(a,b):real^M,b] SUBSET segment[a,b]` MP_TAC
16947         THENL
16948          [REWRITE_TAC[SUBSET; IN_SEGMENT; midpoint] THEN GEN_TAC THEN
16949           DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN
16950           EXISTS_TAC `(&1 + u) / &2` THEN ASM_REWRITE_TAC[] THEN
16951           REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
16952           VECTOR_ARITH_TAC;
16953           ASM SET_TAC[]];
16954         SUBGOAL_THEN `~(a IN segment[midpoint(a,b):real^M,b])` MP_TAC THENL
16955          [ALL_TAC; ASM_MESON_TAC[]] THEN
16956         DISCH_THEN(MP_TAC o CONJUNCT2 o MATCH_MP DIST_IN_CLOSED_SEGMENT) THEN
16957         REWRITE_TAC[DIST_MIDPOINT] THEN
16958         UNDISCH_TAC `~(a:real^M = b)` THEN NORM_ARITH_TAC]]]);;
16959
16960 let URYSOHN_LOCAL = prove
16961  (`!s t u a b.
16962         closed_in (subtopology euclidean u) s /\
16963         closed_in (subtopology euclidean u) t /\
16964         s INTER t = {}
16965         ==> ?f:real^N->real^M.
16966                f continuous_on u /\
16967                (!x. x IN u ==> f(x) IN segment[a,b]) /\
16968                (!x. x IN s ==> f x = a) /\
16969                (!x. x IN t ==> f x = b)`,
16970   REPEAT STRIP_TAC THEN ASM_CASES_TAC `a:real^M = b` THENL
16971    [EXISTS_TAC `(\x. b):real^N->real^M` THEN
16972     ASM_REWRITE_TAC[ENDS_IN_SEGMENT; CONTINUOUS_ON_CONST];
16973     MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`; `u:real^N->bool`;
16974                    `a:real^M`; `b:real^M`] URYSOHN_LOCAL_STRONG) THEN
16975     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN
16976     REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET)) THEN
16977     REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN SET_TAC[]]);;
16978
16979 let URYSOHN_STRONG = prove
16980  (`!s t a b.
16981         closed s /\ closed t /\ s INTER t = {} /\ ~(a = b)
16982         ==> ?f:real^N->real^M.
16983                f continuous_on (:real^N) /\ (!x. f(x) IN segment[a,b]) /\
16984                (!x. f x = a <=> x IN s) /\ (!x. f x = b <=> x IN t)`,
16985   REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN] THEN
16986   ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
16987   DISCH_THEN(MP_TAC o MATCH_MP URYSOHN_LOCAL_STRONG) THEN
16988   REWRITE_TAC[IN_UNIV]);;
16989
16990 let URYSOHN = prove
16991  (`!s t a b.
16992         closed s /\ closed t /\ s INTER t = {}
16993         ==> ?f:real^N->real^M.
16994                f continuous_on (:real^N) /\ (!x. f(x) IN segment[a,b]) /\
16995                (!x. x IN s ==> f x = a) /\ (!x. x IN t ==> f x = b)`,
16996   REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN] THEN
16997   ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN DISCH_THEN
16998    (MP_TAC o ISPECL [`a:real^M`; `b:real^M`] o MATCH_MP URYSOHN_LOCAL) THEN
16999   REWRITE_TAC[IN_UNIV]);;
17000
17001 (* ------------------------------------------------------------------------- *)
17002 (* Countability of some relevant sets.                                       *)
17003 (* ------------------------------------------------------------------------- *)
17004
17005 let COUNTABLE_INTEGER = prove
17006  (`COUNTABLE integer`,
17007   MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC
17008    `IMAGE (\n. (&n:real)) (:num) UNION IMAGE (\n. --(&n)) (:num)` THEN
17009   SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_UNION; NUM_COUNTABLE] THEN
17010   REWRITE_TAC[SUBSET; IN_UNION; IN_IMAGE; IN_UNIV] THEN
17011   REWRITE_TAC[IN; INTEGER_CASES]);;
17012
17013 let CARD_EQ_INTEGER = prove
17014  (`integer =_c (:num)`,
17015   REWRITE_TAC[GSYM CARD_LE_ANTISYM; GSYM COUNTABLE_ALT; COUNTABLE_INTEGER] THEN
17016   REWRITE_TAC[le_c] THEN EXISTS_TAC `real_of_num` THEN
17017   REWRITE_TAC[IN_UNIV; REAL_OF_NUM_EQ] THEN
17018   REWRITE_TAC[IN; INTEGER_CLOSED]);;
17019
17020 let COUNTABLE_RATIONAL = prove
17021  (`COUNTABLE rational`,
17022   MATCH_MP_TAC COUNTABLE_SUBSET THEN
17023   EXISTS_TAC `IMAGE (\(x,y). x / y) (integer CROSS integer)` THEN
17024   SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_CROSS; COUNTABLE_INTEGER] THEN
17025   REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PAIR_THM; IN_CROSS] THEN
17026   REWRITE_TAC[rational; IN] THEN MESON_TAC[]);;
17027
17028 let CARD_EQ_RATIONAL = prove
17029  (`rational =_c (:num)`,
17030   REWRITE_TAC[GSYM CARD_LE_ANTISYM; GSYM COUNTABLE_ALT; COUNTABLE_RATIONAL] THEN
17031   REWRITE_TAC[le_c] THEN EXISTS_TAC `real_of_num` THEN
17032   REWRITE_TAC[IN_UNIV; REAL_OF_NUM_EQ] THEN
17033   REWRITE_TAC[IN; RATIONAL_CLOSED]);;
17034
17035 let COUNTABLE_INTEGER_COORDINATES = prove
17036  (`COUNTABLE { x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }`,
17037   MATCH_MP_TAC COUNTABLE_CART THEN
17038   REWRITE_TAC[SET_RULE `{x | P x} = P`; COUNTABLE_INTEGER]);;
17039
17040 let COUNTABLE_RATIONAL_COORDINATES = prove
17041  (`COUNTABLE { x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) }`,
17042   MATCH_MP_TAC COUNTABLE_CART THEN
17043   REWRITE_TAC[SET_RULE `{x | P x} = P`; COUNTABLE_RATIONAL]);;
17044
17045 (* ------------------------------------------------------------------------- *)
17046 (* Density of points with rational, or just dyadic rational, coordinates.    *)
17047 (* ------------------------------------------------------------------------- *)
17048
17049 let CLOSURE_DYADIC_RATIONALS = prove
17050  (`closure { inv(&2 pow n) % x |n,x|
17051              !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) } = (:real^N)`,
17052   REWRITE_TAC[EXTENSION; CLOSURE_APPROACHABLE; IN_UNIV; EXISTS_IN_GSPEC] THEN
17053   MAP_EVERY X_GEN_TAC [`x:real^N`; `e:real`] THEN DISCH_TAC THEN
17054   MP_TAC(SPECL [`inv(&2)`; `e / &(dimindex(:N))`] REAL_ARCH_POW_INV) THEN
17055   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1;
17056                REAL_POW_INV; REAL_LT_RDIV_EQ] THEN
17057   CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC MONO_EXISTS THEN
17058   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
17059   EXISTS_TAC `(lambda i. floor(&2 pow n * (x:real^N)$i)):real^N` THEN
17060   ASM_SIMP_TAC[LAMBDA_BETA; FLOOR; dist; NORM_MUL] THEN
17061   MATCH_MP_TAC(MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS)
17062    (SPEC_ALL NORM_LE_L1)) THEN
17063   SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN
17064   MATCH_MP_TAC REAL_LET_TRANS THEN
17065   EXISTS_TAC `&(dimindex(:N)) * inv(&2 pow n)` THEN ASM_REWRITE_TAC[] THEN
17066   GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN
17067   MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
17068   X_GEN_TAC `k:num` THEN STRIP_TAC THEN
17069   GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN
17070   SIMP_TAC[REAL_ABS_MUL; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH;
17071     REAL_FIELD `~(a = &0) ==> inv a * b - x = inv a * (b - a * x)`] THEN
17072   MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN
17073   REWRITE_TAC[REAL_LE_REFL; REAL_ABS_POW; REAL_ABS_INV; REAL_ABS_NUM] THEN
17074   MP_TAC(SPEC `&2 pow n * (x:real^N)$k` FLOOR) THEN REAL_ARITH_TAC);;
17075
17076 let CLOSURE_RATIONAL_COORDINATES = prove
17077  (`closure { x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) } =
17078    (:real^N)`,
17079   MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ s = UNIV ==> t = UNIV`) THEN
17080   EXISTS_TAC
17081    `closure { inv(&2 pow n) % x:real^N |n,x|
17082               !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }` THEN
17083
17084   CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[CLOSURE_DYADIC_RATIONALS]] THEN
17085   MATCH_MP_TAC SUBSET_CLOSURE THEN
17086   REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM; VECTOR_MUL_COMPONENT] THEN
17087   ASM_SIMP_TAC[RATIONAL_CLOSED]);;
17088
17089 let CLOSURE_DYADIC_RATIONALS_IN_OPEN_SET = prove
17090  (`!s:real^N->bool.
17091         open s
17092         ==> closure(s INTER
17093                     { inv(&2 pow n) % x | n,x |
17094                       !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }) =
17095             closure s`,
17096   REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_OPEN_INTER_SUPERSET THEN
17097   ASM_REWRITE_TAC[CLOSURE_DYADIC_RATIONALS; SUBSET_UNIV]);;
17098
17099 let CLOSURE_RATIONALS_IN_OPEN_SET = prove
17100  (`!s:real^N->bool.
17101         open s
17102         ==> closure(s INTER
17103                     { inv(&2 pow n) % x | n,x |
17104                       !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }) =
17105             closure s`,
17106   REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_OPEN_INTER_SUPERSET THEN
17107   ASM_REWRITE_TAC[CLOSURE_DYADIC_RATIONALS; SUBSET_UNIV]);;
17108
17109 (* ------------------------------------------------------------------------- *)
17110 (* Various separability-type properties.                                     *)
17111 (* ------------------------------------------------------------------------- *)
17112
17113 let UNIV_SECOND_COUNTABLE = prove
17114  (`?b. COUNTABLE b /\ (!c. c IN b ==> open c) /\
17115        !s:real^N->bool. open s ==> ?u. u SUBSET b /\ s = UNIONS u`,
17116   EXISTS_TAC
17117    `IMAGE (\(v:real^N,q). ball(v,q))
17118           ({v | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(v$i)} CROSS
17119            rational)` THEN
17120   REPEAT CONJ_TAC THENL
17121    [MATCH_MP_TAC COUNTABLE_IMAGE THEN MATCH_MP_TAC COUNTABLE_CROSS THEN
17122     REWRITE_TAC[COUNTABLE_RATIONAL] THEN MATCH_MP_TAC COUNTABLE_CART THEN
17123     REWRITE_TAC[COUNTABLE_RATIONAL; SET_RULE `{x | P x} = P`];
17124     REWRITE_TAC[FORALL_IN_IMAGE; CROSS; FORALL_IN_GSPEC; OPEN_BALL];
17125     REPEAT STRIP_TAC THEN
17126     ASM_CASES_TAC `s:real^N->bool = {}` THENL
17127      [EXISTS_TAC `{}:(real^N->bool)->bool` THEN
17128       ASM_REWRITE_TAC[UNIONS_0; EMPTY_SUBSET];
17129       ALL_TAC] THEN
17130     EXISTS_TAC `{c | c IN IMAGE (\(v:real^N,q). ball(v,q))
17131           ({v | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(v$i)} CROSS
17132            rational) /\ c SUBSET s}` THEN
17133     CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
17134     MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
17135     REWRITE_TAC[SUBSET; IN_UNIONS; IN_ELIM_THM] THEN
17136     REWRITE_TAC[GSYM CONJ_ASSOC; EXISTS_IN_IMAGE] THEN
17137     REWRITE_TAC[CROSS; EXISTS_PAIR_THM; EXISTS_IN_GSPEC] THEN
17138     REWRITE_TAC[IN_ELIM_PAIR_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
17139     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN
17140     DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
17141     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; SUBSET; IN_BALL] THEN
17142     X_GEN_TAC `e:real` THEN STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN
17143     MP_TAC(REWRITE_RULE[EXTENSION; IN_UNIV] CLOSURE_RATIONAL_COORDINATES) THEN
17144     REWRITE_TAC[CLOSURE_APPROACHABLE] THEN
17145     DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `e / &4`]) THEN
17146     ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_ELIM_THM]] THEN
17147     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN
17148     SUBGOAL_THEN `?x. rational x /\ e / &3 < x /\ x < e / &2`
17149      (X_CHOOSE_THEN `q:real` STRIP_ASSUME_TAC)
17150     THENL
17151      [MP_TAC(ISPECL [`&5 / &12 * e`; `e / &12`] RATIONAL_APPROXIMATION) THEN
17152       ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN
17153       SIMP_TAC[] THEN REAL_ARITH_TAC;
17154       EXISTS_TAC `q:real` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
17155        [ASM_REWRITE_TAC[IN];
17156         REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
17157         REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC;
17158         ASM_REAL_ARITH_TAC]]]);;
17159
17160 let UNIV_SECOND_COUNTABLE_SEQUENCE = prove
17161  (`?b:num->real^N->bool.
17162         (!m n. b m = b n <=> m = n) /\
17163         (!n. open(b n)) /\
17164         (!s. open s ==> ?k. s = UNIONS {b n | n IN k})`,
17165   X_CHOOSE_THEN `bb:(real^N->bool)->bool` STRIP_ASSUME_TAC
17166     UNIV_SECOND_COUNTABLE THEN
17167   MP_TAC(ISPEC `bb:(real^N->bool)->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN
17168   ANTS_TAC THENL
17169    [ASM_REWRITE_TAC[INFINITE] THEN DISCH_TAC THEN
17170     SUBGOAL_THEN
17171      `INFINITE {ball(vec 0:real^N,inv(&n + &1)) | n IN (:num)}`
17172     MP_TAC THENL
17173      [REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC(REWRITE_RULE
17174        [RIGHT_IMP_FORALL_THM; IMP_IMP] INFINITE_IMAGE_INJ) THEN
17175       REWRITE_TAC[num_INFINITE] THEN MATCH_MP_TAC WLOG_LT THEN SIMP_TAC[] THEN
17176       CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
17177       MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN
17178       REWRITE_TAC[EXTENSION] THEN
17179       DISCH_THEN(MP_TAC o SPEC `inv(&n + &1) % basis 1:real^N`) THEN
17180       REWRITE_TAC[IN_BALL; DIST_0; NORM_MUL; REAL_ABS_INV] THEN
17181       SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL; REAL_MUL_RID] THEN
17182       ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN
17183       REWRITE_TAC[REAL_ARITH `abs(&n + &1) = &n + &1`; REAL_LT_REFL] THEN
17184       MATCH_MP_TAC REAL_LT_INV2 THEN
17185       REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC;
17186       REWRITE_TAC[INFINITE; SIMPLE_IMAGE] THEN
17187       MATCH_MP_TAC FINITE_SUBSET THEN
17188       EXISTS_TAC `IMAGE UNIONS {u | u SUBSET bb} :(real^N->bool)->bool` THEN
17189       ASM_SIMP_TAC[FINITE_IMAGE; FINITE_POWERSET] THEN
17190       GEN_REWRITE_TAC I [SUBSET] THEN SIMP_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN
17191       X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN
17192       ASM_MESON_TAC[OPEN_BALL]];
17193     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:num->real^N->bool` THEN
17194     DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN
17195     RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE; IN_UNIV]) THEN
17196     REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN
17197     X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN
17198     FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`) THEN
17199     ASM_REWRITE_TAC[SUBSET_IMAGE; LEFT_AND_EXISTS_THM; SUBSET_UNIV] THEN
17200     ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
17201     REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[SIMPLE_IMAGE]]);;
17202
17203 let SUBSET_SECOND_COUNTABLE = prove
17204  (`!s:real^N->bool.
17205        ?b. COUNTABLE b /\
17206            (!c. c IN b ==> ~(c = {}) /\ open_in(subtopology euclidean s) c) /\
17207            !t. open_in(subtopology euclidean s) t
17208                ==> ?u. u SUBSET b /\ t = UNIONS u`,
17209   GEN_TAC THEN
17210   SUBGOAL_THEN
17211    `?b. COUNTABLE b /\
17212            (!c:real^N->bool. c IN b ==> open_in(subtopology euclidean s) c) /\
17213            !t. open_in(subtopology euclidean s) t
17214                ==> ?u. u SUBSET b /\ t = UNIONS u`
17215   STRIP_ASSUME_TAC THENL
17216    [X_CHOOSE_THEN `B:(real^N->bool)->bool` STRIP_ASSUME_TAC
17217       UNIV_SECOND_COUNTABLE THEN
17218     EXISTS_TAC `{s INTER c :real^N->bool | c IN B}` THEN
17219     ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE] THEN
17220     ASM_SIMP_TAC[FORALL_IN_IMAGE; EXISTS_SUBSET_IMAGE; OPEN_IN_OPEN_INTER] THEN
17221     REWRITE_TAC[OPEN_IN_OPEN] THEN
17222     X_GEN_TAC `t:real^N->bool` THEN
17223     DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN
17224     FIRST_X_ASSUM SUBST_ALL_TAC THEN
17225     SUBGOAL_THEN `?b. b SUBSET B /\ u:real^N->bool = UNIONS b`
17226     STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
17227     FIRST_X_ASSUM SUBST_ALL_TAC THEN
17228     EXISTS_TAC `b:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[] THEN
17229     REWRITE_TAC[INTER_UNIONS] THEN AP_TERM_TAC THEN SET_TAC[];
17230     EXISTS_TAC `b DELETE ({}:real^N->bool)` THEN
17231     ASM_SIMP_TAC[COUNTABLE_DELETE; IN_DELETE; SUBSET_DELETE] THEN
17232     X_GEN_TAC `t:real^N->bool` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN
17233     DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
17234     EXISTS_TAC `u DELETE ({}:real^N->bool)` THEN
17235     REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
17236     FIRST_X_ASSUM SUBST_ALL_TAC THEN
17237     REWRITE_TAC[EXTENSION; IN_UNIONS] THEN
17238     GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
17239     REWRITE_TAC[IN_DELETE] THEN SET_TAC[]]);;
17240
17241 let SEPARABLE = prove
17242  (`!s:real^N->bool.
17243         ?t. COUNTABLE t /\ t SUBSET s /\ s SUBSET closure t`,
17244   MP_TAC SUBSET_SECOND_COUNTABLE THEN
17245   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `s:real^N->bool` THEN
17246   REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_AND_EXISTS_THM] THEN
17247   DISCH_THEN(X_CHOOSE_THEN `B:(real^N->bool)->bool`
17248    (CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC))) THEN
17249   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
17250   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
17251   X_GEN_TAC `f:(real^N->bool)->real^N` THEN DISCH_TAC THEN
17252   EXISTS_TAC `IMAGE (f:(real^N->bool)->real^N) B` THEN
17253   ASM_SIMP_TAC[COUNTABLE_IMAGE] THEN CONJ_TAC THENL
17254    [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
17255     X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN
17256     FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN
17257     ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
17258     FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SUBSET) THEN
17259     REWRITE_TAC[TOPSPACE_SUBTOPOLOGY; TOPSPACE_EUCLIDEAN] THEN ASM SET_TAC[];
17260     REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE; EXISTS_IN_IMAGE] THEN
17261     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
17262     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
17263     UNDISCH_THEN
17264      `!t:real^N->bool.
17265         open_in (subtopology euclidean s) t
17266         ==> (?u. u SUBSET B /\ t = UNIONS u)`
17267      (MP_TAC o SPEC `s INTER ball(x:real^N,e)`) THEN
17268     SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; LEFT_IMP_EXISTS_THM] THEN
17269     X_GEN_TAC `b:(real^N->bool)->bool` THEN
17270     ASM_CASES_TAC `b:(real^N->bool)->bool = {}` THENL
17271      [MATCH_MP_TAC(TAUT `~b ==> a /\ b ==> c`) THEN
17272       ASM_REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; UNIONS_0] THEN
17273       ASM_MESON_TAC[CENTRE_IN_BALL];
17274       STRIP_TAC THEN
17275       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
17276       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N->bool` THEN
17277       DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
17278       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN
17279       DISCH_THEN(MP_TAC o SPEC `(f:(real^N->bool)->real^N) c`) THEN
17280       ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[IN_INTER; IN_BALL] THEN
17281       MATCH_MP_TAC(TAUT `a /\ c ==> (a /\ b <=> c) ==> b`) THEN
17282       CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
17283       FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN
17284       ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN
17285       FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SUBSET) THEN
17286       REWRITE_TAC[TOPSPACE_SUBTOPOLOGY; TOPSPACE_EUCLIDEAN] THEN
17287       ASM SET_TAC[]]]);;
17288
17289 let OPEN_SET_RATIONAL_COORDINATES = prove
17290  (`!s. open s /\ ~(s = {})
17291        ==> ?x:real^N. x IN s /\
17292                       !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)`,
17293   REPEAT STRIP_TAC THEN
17294   SUBGOAL_THEN
17295    `~(closure { x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) } INTER
17296     (s:real^N->bool) = {})`
17297   MP_TAC THENL
17298    [ASM_REWRITE_TAC[CLOSURE_RATIONAL_COORDINATES; INTER_UNIV]; ALL_TAC] THEN
17299   REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; CLOSURE_APPROACHABLE; IN_INTER;
17300               IN_ELIM_THM] THEN
17301   DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
17302   FIRST_X_ASSUM(MP_TAC o SPEC `a:real^N` o REWRITE_RULE[open_def]) THEN
17303   ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);;
17304
17305 let OPEN_COUNTABLE_UNION_OPEN_INTERVALS,
17306     OPEN_COUNTABLE_UNION_CLOSED_INTERVALS = (CONJ_PAIR o prove)
17307  (`(!s:real^N->bool.
17308         open s
17309         ==> ?D. COUNTABLE D /\
17310                 (!i. i IN D ==> i SUBSET s /\ ?a b. i = interval(a,b)) /\
17311                 UNIONS D = s) /\
17312    (!s:real^N->bool.
17313         open s
17314         ==> ?D. COUNTABLE D /\
17315                 (!i. i IN D ==> i SUBSET s /\ ?a b. i = interval[a,b]) /\
17316                 UNIONS D = s)`,
17317   REPEAT STRIP_TAC THENL
17318    [EXISTS_TAC
17319      `{i | i IN IMAGE (\(a:real^N,b). interval(a,b))
17320             ({x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)} CROSS
17321              {x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)}) /\
17322            i SUBSET s}`;
17323     EXISTS_TAC
17324      `{i | i IN IMAGE (\(a:real^N,b). interval[a,b])
17325             ({x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)} CROSS
17326              {x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)}) /\
17327            i SUBSET s}`] THEN
17328   (SIMP_TAC[COUNTABLE_RESTRICT; COUNTABLE_IMAGE; COUNTABLE_CROSS;
17329            COUNTABLE_RATIONAL_COORDINATES] THEN
17330    REWRITE_TAC[IN_ELIM_THM; UNIONS_GSPEC; IMP_CONJ; GSYM CONJ_ASSOC] THEN
17331    REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN
17332    REWRITE_TAC[FORALL_PAIR_THM; EXISTS_PAIR_THM; IN_CROSS; IN_ELIM_THM] THEN
17333    CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
17334    REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN
17335    X_GEN_TAC `x:real^N` THEN EQ_TAC THENL [SET_TAC[]; DISCH_TAC] THEN
17336    FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o REWRITE_RULE[open_def]) THEN
17337    ASM_REWRITE_TAC[] THEN
17338    DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
17339    SUBGOAL_THEN
17340     `!i. 1 <= i /\ i <= dimindex(:N)
17341          ==> ?a b. rational a /\ rational b /\
17342                    a < (x:real^N)$i /\ (x:real^N)$i < b /\
17343                    abs(b - a) < e / &(dimindex(:N))`
17344    MP_TAC THENL
17345     [REPEAT STRIP_TAC THEN MATCH_MP_TAC RATIONAL_APPROXIMATION_STRADDLE THEN
17346      ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1];
17347      REWRITE_TAC[LAMBDA_SKOLEM]] THEN
17348    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN
17349    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN
17350    DISCH_TAC THEN ASM_SIMP_TAC[SUBSET; IN_INTERVAL; REAL_LT_IMP_LE] THEN
17351    X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
17352    REWRITE_TAC[dist] THEN MP_TAC(ISPEC `y - x:real^N` NORM_LE_L1) THEN
17353    MATCH_MP_TAC(REAL_ARITH `s < e ==> n <= s ==> n < e`) THEN
17354    MATCH_MP_TAC SUM_BOUND_LT_GEN THEN
17355    REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; CARD_NUMSEG_1] THEN
17356    REWRITE_TAC[DIMINDEX_GE_1; IN_NUMSEG; VECTOR_SUB_COMPONENT] THEN
17357    X_GEN_TAC `k:num` THEN STRIP_TAC THEN
17358    REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `k:num`)) THEN ASM_REWRITE_TAC[] THEN
17359    ASM_REAL_ARITH_TAC));;
17360
17361 let LINDELOF = prove
17362  (`!f:(real^N->bool)->bool.
17363         (!s. s IN f ==> open s)
17364         ==> ?f'. f' SUBSET f /\ COUNTABLE f' /\ UNIONS f' = UNIONS f`,
17365   REPEAT STRIP_TAC THEN
17366   SUBGOAL_THEN
17367    `?b. COUNTABLE b /\
17368         (!c:real^N->bool. c IN b ==> open c) /\
17369         (!s. open s ==> ?u. u SUBSET b /\ s = UNIONS u)`
17370   STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[UNIV_SECOND_COUNTABLE]; ALL_TAC] THEN
17371   ABBREV_TAC
17372    `d = {s:real^N->bool | s IN b /\ ?u. u IN f /\ s SUBSET u}` THEN
17373   SUBGOAL_THEN
17374    `COUNTABLE d /\ UNIONS f :real^N->bool = UNIONS d`
17375   STRIP_ASSUME_TAC THENL
17376    [EXPAND_TAC "d" THEN ASM_SIMP_TAC[COUNTABLE_RESTRICT] THEN ASM SET_TAC[];
17377     ALL_TAC] THEN
17378   SUBGOAL_THEN
17379    `!s:real^N->bool. ?u. s IN d ==> u IN f /\ s SUBSET u`
17380   MP_TAC THENL [EXPAND_TAC "d" THEN SET_TAC[]; ALL_TAC] THEN
17381   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
17382   X_GEN_TAC `g:(real^N->bool)->(real^N->bool)` THEN STRIP_TAC THEN
17383   EXISTS_TAC `IMAGE (g:(real^N->bool)->(real^N->bool)) d` THEN
17384   ASM_SIMP_TAC[COUNTABLE_IMAGE; UNIONS_IMAGE] THEN
17385   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM SET_TAC[]);;
17386
17387 let LINDELOF_OPEN_IN = prove
17388  (`!f u:real^N->bool.
17389         (!s. s IN f ==> open_in (subtopology euclidean u) s)
17390         ==> ?f'. f' SUBSET f /\ COUNTABLE f' /\ UNIONS f' = UNIONS f`,
17391   REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN
17392   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
17393   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
17394   X_GEN_TAC `v:(real^N->bool)->real^N->bool` THEN DISCH_TAC THEN
17395   MP_TAC(ISPEC `IMAGE (v:(real^N->bool)->real^N->bool) f` LINDELOF) THEN
17396   ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN
17397   ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
17398   REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN
17399   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f':(real^N->bool)->bool` THEN
17400   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
17401   SUBGOAL_THEN
17402   `!f'. f' SUBSET f ==> UNIONS f' = (u:real^N->bool) INTER UNIONS (IMAGE v f')`
17403   MP_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[SUBSET_REFL]]);;
17404
17405 let COUNTABLE_DISJOINT_OPEN_SUBSETS = prove
17406  (`!f. (!s:real^N->bool. s IN f ==> open s) /\ pairwise DISJOINT f
17407        ==> COUNTABLE f`,
17408   REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LINDELOF) THEN
17409   DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
17410   MATCH_MP_TAC COUNTABLE_SUBSET THEN
17411   EXISTS_TAC `({}:real^N->bool) INSERT g` THEN
17412   ASM_REWRITE_TAC[COUNTABLE_INSERT] THEN
17413   REWRITE_TAC[SUBSET; IN_INSERT] THEN
17414   REPEAT(POP_ASSUM MP_TAC) THEN
17415   REWRITE_TAC[EXTENSION; SUBSET] THEN
17416   REWRITE_TAC[IN_UNIONS; pairwise] THEN
17417   REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. ~(x IN s /\ x IN t)`] THEN
17418   REWRITE_TAC[NOT_IN_EMPTY] THEN MESON_TAC[]);;
17419
17420 let CARD_EQ_OPEN_SETS = prove
17421  (`{s:real^N->bool | open s} =_c (:real)`,
17422   REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
17423    [X_CHOOSE_THEN `b:(real^N->bool)->bool` STRIP_ASSUME_TAC
17424       UNIV_SECOND_COUNTABLE THEN
17425     TRANS_TAC CARD_LE_TRANS `{s:(real^N->bool)->bool | s SUBSET b}` THEN
17426     CONJ_TAC THENL
17427      [REWRITE_TAC[LE_C] THEN
17428       EXISTS_TAC `UNIONS:((real^N->bool)->bool)->real^N->bool` THEN
17429       REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[];
17430       TRANS_TAC CARD_LE_TRANS `{s | s SUBSET (:num)}` THEN CONJ_TAC THENL
17431        [MATCH_MP_TAC CARD_LE_POWERSET THEN ASM_REWRITE_TAC[GSYM COUNTABLE_ALT];
17432         REWRITE_TAC[SUBSET_UNIV; UNIV_GSPEC] THEN
17433         MESON_TAC[CARD_EQ_IMP_LE; CARD_EQ_SYM; CARD_EQ_REAL]]];
17434     REWRITE_TAC[le_c; IN_UNIV; IN_ELIM_THM] THEN
17435     EXISTS_TAC `\x. ball(x % basis 1:real^N,&1)` THEN
17436     REWRITE_TAC[OPEN_BALL; GSYM SUBSET_ANTISYM_EQ; SUBSET_BALLS] THEN
17437     CONV_TAC REAL_RAT_REDUCE_CONV THEN
17438     REWRITE_TAC[NORM_ARITH `dist(p:real^N,q) + &1 <= &1 <=> p = q`] THEN
17439     REWRITE_TAC[VECTOR_MUL_RCANCEL; EQ_SYM_EQ] THEN
17440     SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; ARITH]]);;
17441
17442 let CARD_EQ_CLOSED_SETS = prove
17443  (`{s:real^N->bool | closed s} =_c (:real)`,
17444   SUBGOAL_THEN
17445    `{s:real^N->bool | closed s} =
17446     IMAGE (\s. (:real^N) DIFF s) {s | open s}`
17447   SUBST1_TAC THENL
17448    [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
17449     REWRITE_TAC[IN_ELIM_THM; GSYM OPEN_CLOSED] THEN
17450     MESON_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`];
17451     TRANS_TAC CARD_EQ_TRANS `{s:real^N->bool | open s}` THEN
17452     REWRITE_TAC[CARD_EQ_OPEN_SETS] THEN
17453     MATCH_MP_TAC CARD_EQ_IMAGE THEN SET_TAC[]]);;
17454
17455 let CARD_EQ_COMPACT_SETS = prove
17456  (`{s:real^N->bool | compact s} =_c (:real)`,
17457   REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL
17458    [TRANS_TAC CARD_LE_TRANS `{s:real^N->bool | closed s}` THEN
17459     SIMP_TAC[CARD_EQ_IMP_LE; CARD_EQ_CLOSED_SETS] THEN
17460     MATCH_MP_TAC CARD_LE_SUBSET THEN
17461     SIMP_TAC[SUBSET; IN_ELIM_THM; COMPACT_IMP_CLOSED];
17462     REWRITE_TAC[le_c; IN_UNIV; IN_ELIM_THM] THEN
17463     EXISTS_TAC `\x. {x % basis 1:real^N}` THEN
17464     REWRITE_TAC[COMPACT_SING; SET_RULE `{x} = {y} <=> x = y`] THEN
17465     SIMP_TAC[VECTOR_MUL_RCANCEL; BASIS_NONZERO; DIMINDEX_GE_1; ARITH]]);;
17466
17467 let COUNTABLE_NON_CONDENSATION_POINTS = prove
17468  (`!s:real^N->bool. COUNTABLE(s DIFF {x | x condensation_point_of s})`,
17469   REPEAT STRIP_TAC THEN REWRITE_TAC[condensation_point_of] THEN
17470   MATCH_MP_TAC COUNTABLE_SUBSET THEN
17471   X_CHOOSE_THEN `b:(real^N->bool)->bool` STRIP_ASSUME_TAC
17472    UNIV_SECOND_COUNTABLE THEN
17473   EXISTS_TAC
17474    `s INTER UNIONS { u:real^N->bool | u IN b /\ COUNTABLE(s INTER u)}` THEN
17475   REWRITE_TAC[INTER_UNIONS; IN_ELIM_THM] THEN CONJ_TAC THENL
17476    [MATCH_MP_TAC COUNTABLE_UNIONS THEN SIMP_TAC[FORALL_IN_GSPEC] THEN
17477     ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
17478     ASM_SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_RESTRICT];
17479     SIMP_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM; IN_INTER; IN_DIFF] THEN
17480     X_GEN_TAC `x:real^N` THEN
17481     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
17482     REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN
17483     X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
17484     SUBGOAL_THEN `?u:real^N->bool. x IN u /\ u IN b /\ u SUBSET t` MP_TAC THENL
17485      [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN
17486     REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
17487     MATCH_MP_TAC COUNTABLE_SUBSET THEN
17488     EXISTS_TAC `s INTER t:real^N->bool` THEN ASM SET_TAC[]]);;
17489
17490 let CARD_EQ_CONDENSATION_POINTS_IN_SET = prove
17491  (`!s:real^N->bool.
17492      ~(COUNTABLE s) ==> {x | x IN s /\ x condensation_point_of s} =_c s`,
17493   REPEAT STRIP_TAC THEN
17494   TRANS_TAC CARD_EQ_TRANS
17495    `(s DIFF {x | x condensation_point_of s}) +_c
17496     {x:real^N | x IN s /\ x condensation_point_of s}` THEN
17497   CONJ_TAC THENL
17498    [ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN MATCH_MP_TAC CARD_ADD_ABSORB THEN
17499     MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
17500      [POP_ASSUM MP_TAC THEN REWRITE_TAC[INFINITE; CONTRAPOS_THM] THEN
17501       DISCH_THEN(MP_TAC o CONJ (SPEC `s:real^N->bool`
17502        COUNTABLE_NON_CONDENSATION_POINTS) o MATCH_MP FINITE_IMP_COUNTABLE) THEN
17503       REWRITE_TAC[GSYM COUNTABLE_UNION] THEN MATCH_MP_TAC EQ_IMP THEN
17504       AP_TERM_TAC THEN SET_TAC[];
17505       REWRITE_TAC[INFINITE_CARD_LE] THEN
17506       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CARD_LE_TRANS) THEN
17507       REWRITE_TAC[GSYM COUNTABLE_ALT; COUNTABLE_NON_CONDENSATION_POINTS]];
17508     ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN
17509     W(MP_TAC o PART_MATCH (rand o rand) CARD_DISJOINT_UNION o rand o snd) THEN
17510     ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN
17511     MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SET_TAC[]]);;
17512
17513 let LIMPT_OF_CONDENSATION_POINTS,CONDENSATION_POINT_OF_CONDENSATION_POINTS =
17514   (CONJ_PAIR o prove)
17515  (`(!x:real^N s.
17516         x limit_point_of {y | y condensation_point_of s} <=>
17517         x condensation_point_of s) /\
17518    (!x:real^N s.
17519         x condensation_point_of {y | y condensation_point_of s} <=>
17520         x condensation_point_of s)`,
17521   REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT
17522    `(r ==> q) /\ (q ==> p) /\ (p ==> r)
17523     ==> (q <=> p) /\ (r <=> p)`) THEN
17524   REWRITE_TAC[CONDENSATION_POINT_IMP_LIMPT] THEN CONJ_TAC THENL
17525    [REWRITE_TAC[LIMPT_APPROACHABLE; CONDENSATION_POINT_INFINITE_BALL] THEN
17526     REPEAT GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN
17527     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
17528     FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
17529     DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
17530     FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
17531     ASM_REWRITE_TAC[REAL_HALF; CONTRAPOS_THM] THEN
17532     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN
17533     SIMP_TAC[SUBSET; IN_INTER; IN_BALL] THEN
17534     REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC;
17535     ONCE_REWRITE_TAC[CONDENSATION_POINT_INFINITE_BALL] THEN DISCH_TAC THEN
17536     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
17537     FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN
17538     ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(MP_TAC o MATCH_MP
17539      (MESON[CARD_EQ_CONDENSATION_POINTS_IN_SET; CARD_COUNTABLE_CONG]
17540         `~COUNTABLE s
17541          ==> ~COUNTABLE {x | x IN s /\ x condensation_point_of s}`)) THEN
17542     REWRITE_TAC[UNCOUNTABLE_REAL; CONTRAPOS_THM] THEN
17543     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN
17544     REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTER] THEN X_GEN_TAC `y:real^N` THEN
17545     REPEAT STRIP_TAC THENL
17546      [ASM_MESON_TAC[CONDENSATION_POINT_OF_SUBSET; INTER_SUBSET]; ALL_TAC] THEN
17547     MATCH_MP_TAC(SET_RULE `!s. x IN s /\ s SUBSET t ==> x IN t`) THEN
17548     EXISTS_TAC `closure(s INTER ball(x:real^N,e / &2))` THEN CONJ_TAC THENL
17549      [REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM] THEN DISJ2_TAC THEN
17550       ASM_SIMP_TAC[CONDENSATION_POINT_IMP_LIMPT];
17551       TRANS_TAC SUBSET_TRANS `closure(ball(x:real^N,e / &2))` THEN
17552       SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN
17553       ASM_SIMP_TAC[CLOSURE_BALL; REAL_HALF; SUBSET_BALLS; DIST_REFL] THEN
17554       ASM_REAL_ARITH_TAC]]);;
17555
17556 let CLOSED_CONDENSATION_POINTS = prove
17557  (`!s:real^N->bool. closed {x | x condensation_point_of s}`,
17558   SIMP_TAC[CLOSED_LIMPT; LIMPT_OF_CONDENSATION_POINTS; IN_ELIM_THM]);;
17559
17560 let CANTOR_BENDIXSON = prove
17561  (`!s:real^N->bool.
17562         closed s
17563         ==> ?t u. closed t /\ (!x. x IN t ==> x limit_point_of t) /\
17564                   COUNTABLE u /\ s = t UNION u`,
17565   REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC
17566    [`{x:real^N | x condensation_point_of s}`;
17567     `s DIFF {x:real^N | x condensation_point_of s}`] THEN
17568   REWRITE_TAC[COUNTABLE_NON_CONDENSATION_POINTS; CLOSED_CONDENSATION_POINTS;
17569               IN_ELIM_THM; LIMPT_OF_CONDENSATION_POINTS] THEN
17570   REWRITE_TAC[SET_RULE `s = t UNION (s DIFF t) <=> t SUBSET s`] THEN
17571   RULE_ASSUM_TAC(REWRITE_RULE[CLOSED_LIMPT]) THEN
17572   REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
17573   ASM_MESON_TAC[CONDENSATION_POINT_IMP_LIMPT]);;
17574
17575 (* ------------------------------------------------------------------------- *)
17576 (* A discrete set is countable, and an uncountable set has a limit point.    *)
17577 (* ------------------------------------------------------------------------- *)
17578
17579 let DISCRETE_IMP_COUNTABLE = prove
17580  (`!s:real^N->bool.
17581         (!x. x IN s ==> ?e. &0 < e /\
17582                             !y. y IN s /\ ~(y = x) ==> e <= norm(y - x))
17583         ==> COUNTABLE s`,
17584   REPEAT STRIP_TAC THEN
17585   SUBGOAL_THEN
17586    `!x. x IN s
17587         ==> ?q. (!i. 1 <= i /\ i <= dimindex(:N) ==> rational(q$i)) /\
17588                 !y:real^N. y IN s /\ ~(y = x) ==> norm(x - q) < norm(y - q)`
17589   MP_TAC THENL
17590    [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
17591     FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
17592     DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
17593     MP_TAC(SET_RULE `x IN (:real^N)`) THEN
17594     REWRITE_TAC[GSYM CLOSURE_RATIONAL_COORDINATES] THEN
17595     REWRITE_TAC[CLOSURE_APPROACHABLE; IN_ELIM_THM] THEN
17596     DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN
17597     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^N` THEN
17598     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
17599     X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN
17600     FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN
17601     REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC;
17602     POP_ASSUM(K ALL_TAC) THEN
17603     REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
17604     X_GEN_TAC `q:real^N->real^N` THEN DISCH_TAC THEN
17605     MP_TAC(ISPECL
17606      [`s:real^N->bool`;
17607       `{ x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) }`;
17608       `(:num)`] CARD_LE_TRANS) THEN
17609     REWRITE_TAC[COUNTABLE; ge_c] THEN DISCH_THEN MATCH_MP_TAC THEN
17610     SIMP_TAC[REWRITE_RULE[COUNTABLE; ge_c] COUNTABLE_RATIONAL_COORDINATES] THEN
17611     REWRITE_TAC[le_c] THEN EXISTS_TAC `q:real^N->real^N` THEN
17612     ASM_SIMP_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_LT_ANTISYM]]);;
17613
17614 let UNCOUNTABLE_CONTAINS_LIMIT_POINT = prove
17615  (`!s. ~(COUNTABLE s) ==> ?x. x IN s /\ x limit_point_of s`,
17616   GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP
17617    (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] DISCRETE_IMP_COUNTABLE)) THEN
17618   REWRITE_TAC[LIMPT_APPROACHABLE; GSYM REAL_NOT_LT; dist] THEN
17619   MESON_TAC[]);;
17620
17621 (* ------------------------------------------------------------------------- *)
17622 (* The Brouwer reduction theorem.                                            *)
17623 (* ------------------------------------------------------------------------- *)
17624
17625 let BROUWER_REDUCTION_THEOREM_GEN = prove
17626  (`!P s:real^N->bool.
17627         (!f. (!n. closed(f n) /\ P(f n)) /\ (!n. f(SUC n) SUBSET f(n))
17628               ==> P(INTERS {f n | n IN (:num)})) /\
17629         closed s /\ P s
17630         ==> ?t. t SUBSET s /\ closed t /\ P t /\
17631                 (!u. u SUBSET s /\ closed u /\ P u ==> ~(u PSUBSET t))`,
17632   REPEAT STRIP_TAC THEN
17633   SUBGOAL_THEN
17634    `?b:num->real^N->bool.
17635         (!m n. b m = b n <=> m = n) /\
17636         (!n. open (b n)) /\
17637         (!s. open s ==> (?k. s = UNIONS {b n | n IN k}))`
17638   STRIP_ASSUME_TAC THENL
17639    [REWRITE_TAC[UNIV_SECOND_COUNTABLE_SEQUENCE]; ALL_TAC] THEN
17640   X_CHOOSE_THEN `a:num->real^N->bool` MP_TAC
17641    (prove_recursive_functions_exist num_RECURSION
17642    `a 0 = (s:real^N->bool) /\
17643     (!n. a(SUC n) =
17644          if ?u. u SUBSET a(n) /\ closed u /\ P u /\ u INTER (b n) = {}
17645          then @u. u SUBSET a(n) /\ closed u /\ P u /\ u INTER (b n) = {}
17646          else a(n))`) THEN
17647   DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "base") (LABEL_TAC "step")) THEN
17648   EXISTS_TAC `INTERS {a n :real^N->bool | n IN (:num)}` THEN
17649   SUBGOAL_THEN `!n. (a:num->real^N->bool)(SUC n) SUBSET a(n)` ASSUME_TAC THENL
17650    [GEN_TAC THEN ASM_REWRITE_TAC[] THEN
17651     COND_CASES_TAC THEN REWRITE_TAC[SUBSET_REFL] THEN
17652     FIRST_X_ASSUM(MP_TAC o SELECT_RULE) THEN MESON_TAC[];
17653     ALL_TAC] THEN
17654   SUBGOAL_THEN `!n. (a:num->real^N->bool) n SUBSET s` ASSUME_TAC THENL
17655    [INDUCT_TAC THEN ASM_MESON_TAC[SUBSET_REFL; SUBSET_TRANS]; ALL_TAC] THEN
17656   SUBGOAL_THEN `!n. closed((a:num->real^N->bool) n) /\ P(a n)` ASSUME_TAC THENL
17657    [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN
17658     COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
17659     FIRST_X_ASSUM(MP_TAC o SELECT_RULE) THEN MESON_TAC[];
17660     ALL_TAC] THEN
17661   REPEAT CONJ_TAC THENL
17662    [ASM SET_TAC[];
17663     MATCH_MP_TAC CLOSED_INTERS THEN
17664     ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN SET_TAC[];
17665     FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[];
17666     X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
17667     REWRITE_TAC[PSUBSET_ALT] THEN
17668     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
17669     REWRITE_TAC[INTERS_GSPEC; EXISTS_IN_GSPEC; IN_UNIV] THEN
17670     DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN
17671     SUBGOAL_THEN
17672      `?n. x IN (b:num->real^N->bool)(n) /\ t INTER b n = {}`
17673     STRIP_ASSUME_TAC THENL
17674      [MP_TAC(ISPEC `(:real^N) DIFF t` OPEN_CONTAINS_BALL) THEN
17675       ASM_REWRITE_TAC[GSYM closed] THEN
17676       DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
17677       ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN
17678       REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> t INTER s = {}`] THEN
17679       X_GEN_TAC `e:real` THEN
17680       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
17681       MP_TAC(ISPECL [`x:real^N`; `e:real`] CENTRE_IN_BALL) THEN
17682       FIRST_X_ASSUM(MP_TAC o SPEC `ball(x:real^N,e)`) THEN
17683       ASM_REWRITE_TAC[OPEN_BALL; LEFT_IMP_EXISTS_THM] THEN
17684       X_GEN_TAC `k:num->bool` THEN DISCH_THEN SUBST1_TAC THEN
17685       REWRITE_TAC[IN_UNIONS; INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN
17686       SET_TAC[];
17687       REMOVE_THEN "step" (MP_TAC o SPEC `n:num`) THEN
17688       COND_CASES_TAC THENL
17689        [DISCH_THEN(ASSUME_TAC o SYM) THEN
17690         FIRST_X_ASSUM(MP_TAC o SELECT_RULE) THEN ASM_REWRITE_TAC[] THEN
17691         ASM SET_TAC[];
17692         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN
17693         DISCH_THEN(MP_TAC o SPEC `t:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN
17694         ASM SET_TAC[]]]]);;
17695
17696 let BROUWER_REDUCTION_THEOREM = prove
17697  (`!P s:real^N->bool.
17698         (!f. (!n. compact(f n) /\ ~(f n = {}) /\ P(f n)) /\
17699              (!n. f(SUC n) SUBSET f(n))
17700              ==> P(INTERS {f n | n IN (:num)})) /\
17701         compact s /\ ~(s = {}) /\ P s
17702         ==> ?t. t SUBSET s /\ compact t /\ ~(t = {}) /\ P t /\
17703                 (!u. u SUBSET s /\ closed u /\ ~(u = {}) /\ P u
17704                      ==> ~(u PSUBSET t))`,
17705   REPEAT STRIP_TAC THEN
17706   MP_TAC(ISPECL [`\t:real^N->bool. ~(t = {}) /\ t SUBSET s /\ P t`;
17707                  `s:real^N->bool`]
17708         BROUWER_REDUCTION_THEOREM_GEN) THEN
17709   ASM_SIMP_TAC[COMPACT_IMP_CLOSED; SUBSET_REFL] THEN ANTS_TAC THENL
17710    [GEN_TAC THEN STRIP_TAC THEN
17711     SUBGOAL_THEN `!n. compact((f:num->real^N->bool) n)` ASSUME_TAC THENL
17712      [ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET]; ALL_TAC] THEN
17713     REPEAT CONJ_TAC THENL
17714      [MATCH_MP_TAC COMPACT_NEST THEN ASM_REWRITE_TAC[] THEN
17715       MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_SIMP_TAC[] THEN SET_TAC[];
17716       ASM SET_TAC[];
17717       FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]];
17718     MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[] THEN
17719     ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET]]);;
17720
17721 (* ------------------------------------------------------------------------- *)
17722 (* The Arzela-Ascoli theorem.                                                *)
17723 (* ------------------------------------------------------------------------- *)
17724
17725 let SUBSEQUENCE_DIAGONALIZATION_LEMMA = prove
17726  (`!P:num->(num->A)->bool.
17727     (!i r:num->A. ?k. (!m n. m < n ==> k m < k n) /\ P i (r o k)) /\
17728     (!i r:num->A k1 k2 N.
17729         P i (r o k1) /\ (!j. N <= j ==> ?j'. j <= j' /\ k2 j = k1 j')
17730         ==> P i (r o k2))
17731     ==> !r:num->A. ?k. (!m n. m < n ==> k m < k n) /\ (!i. P i (r o k))`,
17732   REPEAT GEN_TAC THEN
17733   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
17734   GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [SKOLEM_THM] THEN
17735   REWRITE_TAC[FORALL_AND_THM; TAUT
17736    `(p ==> q /\ r) <=> (p ==> q) /\ (p ==> r)`] THEN
17737   DISCH_THEN(X_CHOOSE_THEN
17738    `kk:num->(num->A)->num->num` STRIP_ASSUME_TAC) THEN
17739   X_GEN_TAC `r:num->A` THEN
17740   (STRIP_ASSUME_TAC o prove_recursive_functions_exist num_RECURSION)
17741     `(rr 0 = (kk:num->(num->A)->num->num) 0 r) /\
17742      (!n. rr(SUC n) = rr n o kk (SUC n) (r o rr n))` THEN
17743   EXISTS_TAC `\n. (rr:num->num->num) n n` THEN REWRITE_TAC[ETA_AX] THEN
17744   SUBGOAL_THEN
17745    `(!i. (!m n. m < n ==> (rr:num->num->num) i m < rr i n)) /\
17746     (!i. (P:num->(num->A)->bool) i (r o rr i))`
17747   STRIP_ASSUME_TAC THENL
17748    [REWRITE_TAC[AND_FORALL_THM] THEN
17749     INDUCT_TAC THEN ASM_REWRITE_TAC[o_ASSOC] THEN
17750     REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[];
17751     ALL_TAC] THEN
17752   SUBGOAL_THEN `!i j n. i <= j ==> (rr:num->num->num) i n <= rr j n`
17753   ASSUME_TAC THENL
17754    [REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [LE_EXISTS] THEN
17755     SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN SPEC_TAC(`j:num`,`j:num`) THEN
17756     ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN SIMP_TAC[FORALL_UNWIND_THM2] THEN
17757     INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; LE_REFL] THEN
17758     ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
17759      (REWRITE_RULE[IMP_CONJ] LE_TRANS)) THEN REWRITE_TAC[o_THM] THEN
17760     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
17761      (MESON[LE_LT]
17762        `!f:num->num.
17763         (!m n. m < n ==> f m < f n) ==> (!m n. m <= n ==> f m <= f n)`) o
17764        SPEC `i + d:num`) THEN
17765     SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC MONOTONE_BIGGER THEN
17766     ASM_SIMP_TAC[];
17767     ALL_TAC] THEN
17768   CONJ_TAC THENL
17769    [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN
17770     MATCH_MP_TAC LET_TRANS THEN
17771     EXISTS_TAC `(rr:num->num->num) n m` THEN
17772     ASM_MESON_TAC[LT_IMP_LE];
17773     ALL_TAC] THEN
17774   SUBGOAL_THEN
17775    `!m n i. n <= m ==> ?j. i <= j /\ (rr:num->num->num) m i = rr n j`
17776   ASSUME_TAC THENL
17777    [ALL_TAC;
17778     X_GEN_TAC `i:num` THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
17779     EXISTS_TAC `(rr:num->num->num) i` THEN ASM_REWRITE_TAC[] THEN
17780     EXISTS_TAC `i:num` THEN ASM_MESON_TAC[]] THEN
17781   SUBGOAL_THEN
17782    `!p d i. ?j. i <= j /\ (rr:num->num->num) (p + d) i = rr p j`
17783    (fun th -> MESON_TAC[LE_EXISTS; th]) THEN
17784   X_GEN_TAC `p:num` THEN  MATCH_MP_TAC num_INDUCTION THEN
17785   ASM_REWRITE_TAC[ADD_CLAUSES] THEN CONJ_TAC THENL
17786    [MESON_TAC[LE_REFL]; ALL_TAC] THEN
17787   X_GEN_TAC `d:num` THEN DISCH_THEN(LABEL_TAC "+") THEN
17788   X_GEN_TAC `i:num` THEN ASM_REWRITE_TAC[o_THM] THEN
17789   REMOVE_THEN "+" (MP_TAC o SPEC
17790    `(kk:num->(num->A)->num->num) (SUC(p + d))
17791         ((r:num->A) o (rr:num->num->num) (p + d)) i`) THEN
17792   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `j:num` THEN
17793   MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN
17794   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LE_TRANS) THEN
17795   SPEC_TAC(`i:num`,`i:num`) THEN MATCH_MP_TAC MONOTONE_BIGGER THEN
17796   ASM_REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]);;
17797
17798 let FUNCTION_CONVERGENT_SUBSEQUENCE = prove
17799  (`!f:num->real^M->real^N s M.
17800         COUNTABLE s /\ (!n x. x IN s ==> norm(f n x) <= M)
17801         ==> ?k. (!m n:num. m < n ==> k m < k n) /\
17802                 !x. x IN s ==> ?l. ((\n. f (k n) x) --> l) sequentially`,
17803   REPEAT STRIP_TAC THEN
17804   ASM_CASES_TAC `s:real^M->bool = {}` THENL
17805    [EXISTS_TAC `\n:num. n` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY];
17806     ALL_TAC] THEN
17807   MP_TAC(ISPEC `s:real^M->bool` COUNTABLE_AS_IMAGE) THEN
17808   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
17809   X_GEN_TAC `X:num->real^M` THEN DISCH_THEN SUBST_ALL_TAC THEN
17810   MP_TAC(ISPEC
17811     `\i r. ?l. ((\n. ((f:num->real^M->real^N) o (r:num->num)) n
17812                      ((X:num->real^M) i)) --> l) sequentially`
17813    SUBSEQUENCE_DIAGONALIZATION_LEMMA) THEN
17814   REWRITE_TAC[FORALL_IN_IMAGE; o_THM; IN_UNIV] THEN
17815   ANTS_TAC THENL [ALL_TAC; DISCH_THEN MATCH_ACCEPT_TAC] THEN CONJ_TAC THENL
17816    [RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE; IN_UNIV]) THEN
17817     MAP_EVERY X_GEN_TAC [`i:num`; `r:num->num`] THEN
17818     MP_TAC(ISPEC `cball(vec 0:real^N,M)` compact) THEN
17819     REWRITE_TAC[COMPACT_CBALL] THEN DISCH_THEN(MP_TAC o SPEC
17820      `\n. (f:num->real^M->real^N) ((r:num->num) n) (X(i:num))`) THEN
17821     ASM_REWRITE_TAC[IN_CBALL_0; o_DEF] THEN MESON_TAC[];
17822     REPEAT GEN_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY; GE] THEN
17823     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
17824     MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
17825     MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
17826     MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
17827     ASM_MESON_TAC[LE_TRANS; ARITH_RULE `MAX a b <= c <=> a <= c /\ b <= c`]]);;
17828
17829 let ARZELA_ASCOLI = prove
17830  (`!f:num->real^M->real^N s M.
17831         compact s /\
17832         (!n x. x IN s ==> norm(f n x) <= M) /\
17833         (!x e. x IN s /\ &0 < e
17834                ==> ?d. &0 < d /\
17835                        !n y. y IN s /\ norm(x - y) < d
17836                              ==> norm(f n x - f n y) < e)
17837         ==> ?g. g continuous_on s /\
17838                 ?r. (!m n:num. m < n ==> r m < r n) /\
17839                     !e. &0 < e
17840                         ==> ?N. !n x. n >= N /\ x IN s
17841                                       ==> norm(f(r n) x - g x) < e`,
17842   REPEAT STRIP_TAC THEN REWRITE_TAC[GE] THEN
17843   MATCH_MP_TAC(MESON[]
17844    `(!k g. V k g ==> N g) /\ (?k. M k /\ ?g. V k g)
17845     ==> ?g. N g /\ ?k. M k /\ V k g`) THEN
17846   CONJ_TAC THENL
17847    [MAP_EVERY X_GEN_TAC [`k:num->num`; `g:real^M->real^N`] THEN
17848     STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially`
17849       CONTINUOUS_UNIFORM_LIMIT) THEN
17850     EXISTS_TAC `(f:num->real^M->real^N) o (k:num->num)` THEN
17851     ASM_SIMP_TAC[EVENTUALLY_SEQUENTIALLY; o_THM; TRIVIAL_LIMIT_SEQUENTIALLY;
17852                  RIGHT_IMP_FORALL_THM; IMP_IMP] THEN
17853     EXISTS_TAC `0` THEN REWRITE_TAC[continuous_on; dist] THEN
17854     ASM_MESON_TAC[NORM_SUB];
17855     ALL_TAC] THEN
17856   MP_TAC(ISPECL
17857    [`IMAGE (f:num->real^M->real^N) (:num)`;
17858     `s:real^M->bool`]
17859    COMPACT_UNIFORMLY_EQUICONTINUOUS) THEN
17860   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_UNIV] THEN
17861   ANTS_TAC THENL
17862    [REWRITE_TAC[dist] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_MESON_TAC[];
17863     ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(K ALL_TAC o SPEC `x:real^M`)] THEN
17864   REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
17865   REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; dist] THEN
17866   DISCH_THEN(ASSUME_TAC o ONCE_REWRITE_RULE[NORM_SUB]) THEN
17867   REWRITE_TAC[GSYM dist; UNIFORMLY_CONVERGENT_EQ_CAUCHY] THEN
17868   X_CHOOSE_THEN `r:real^M->bool` STRIP_ASSUME_TAC
17869    (ISPEC `s:real^M->bool` SEPARABLE) THEN
17870   MP_TAC(ISPECL [`f:num->real^M->real^N`; `r:real^M->bool`; `M:real`]
17871         FUNCTION_CONVERGENT_SUBSEQUENCE) THEN
17872   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
17873   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num->num` THEN
17874   REWRITE_TAC[CONVERGENT_EQ_CAUCHY; cauchy] THEN
17875   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN
17876   ASM_REWRITE_TAC[] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
17877   FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN
17878   ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
17879   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
17880   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL]) THEN
17881   DISCH_THEN(MP_TAC o SPEC `IMAGE (\x:real^M. ball(x,d)) r`) THEN
17882   REWRITE_TAC[FORALL_IN_IMAGE; OPEN_BALL] THEN
17883   ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN
17884   REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN ANTS_TAC THENL
17885    [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `closure r:real^M->bool` THEN
17886     ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE] THEN
17887     X_GEN_TAC `x:real^M` THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN
17888     ASM_REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; IN_BALL];
17889     DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC)] THEN
17890   REMOVE_THEN "*" MP_TAC THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
17891   GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN
17892   DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN
17893   ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN
17894   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
17895   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
17896   X_GEN_TAC `M:real^M->num` THEN DISCH_THEN(LABEL_TAC "*") THEN
17897   MP_TAC(ISPECL [`M:real^M->num`; `t:real^M->bool`]
17898     UPPER_BOUND_FINITE_SET) THEN
17899   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
17900   DISCH_TAC THEN
17901   MAP_EVERY X_GEN_TAC [`m:num`; `n:num`; `x:real^M`] THEN STRIP_TAC THEN
17902   UNDISCH_TAC `s SUBSET UNIONS (IMAGE (\x:real^M. ball (x,d)) t)` THEN
17903   REWRITE_TAC[SUBSET; UNIONS_IMAGE; IN_ELIM_THM] THEN
17904   DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN
17905   ASM_REWRITE_TAC[IN_BALL; LEFT_IMP_EXISTS_THM; dist] THEN
17906   X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN
17907   MATCH_MP_TAC(NORM_ARITH
17908    `norm(f (k(m:num)) y - f (k m) x) < e / &3 /\
17909     norm(f (k n) y - f (k n) x) < e / &3 /\
17910     norm(f (k m) y - f (k n) y) < e / &3
17911     ==> norm(f (k m) x - f (k n) x :real^M) < e`) THEN
17912   ASM_SIMP_TAC[] THEN REMOVE_THEN "*" (MP_TAC o SPEC `y:real^M`) THEN
17913   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
17914   DISCH_THEN(MP_TAC o SPECL [`m:num`; `n:num`]) THEN
17915   ASM_REWRITE_TAC[dist; GE] THEN ASM_MESON_TAC[SUBSET; LE_TRANS]);;
17916
17917 (* ------------------------------------------------------------------------- *)
17918 (* Two forms of the Baire propery of dense sets.                             *)
17919 (* ------------------------------------------------------------------------- *)
17920
17921 let BAIRE = prove
17922  (`!g s:real^N->bool.
17923         closed s /\ COUNTABLE g /\
17924         (!t. t IN g
17925              ==> open_in (subtopology euclidean s) t /\ s SUBSET closure t)
17926         ==> s SUBSET closure(INTERS g)`,
17927   REPEAT STRIP_TAC THEN ASM_CASES_TAC `g:(real^N->bool)->bool = {}` THEN
17928   ASM_REWRITE_TAC[INTERS_0; CLOSURE_UNIV; SUBSET_UNIV] THEN
17929   MP_TAC(ISPEC `g:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN
17930   ASM_REWRITE_TAC[] THEN
17931   MAP_EVERY (C UNDISCH_THEN (K ALL_TAC))
17932    [`COUNTABLE(g:(real^N->bool)->bool)`;
17933     `~(g:(real^N->bool)->bool = {})`] THEN
17934   DISCH_THEN(X_CHOOSE_THEN `g:num->real^N->bool` SUBST_ALL_TAC) THEN
17935   RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE; IN_UNIV]) THEN
17936   REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE] THEN
17937   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
17938   X_GEN_TAC `e:real` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN
17939   REWRITE_TAC[GSYM IN_BALL; GSYM IN_INTER; MEMBER_NOT_EMPTY] THEN
17940   SUBGOAL_THEN
17941    `?t:num->real^N->bool.
17942         (!n. open_in (subtopology euclidean s) (t n) /\ ~(t n = {}) /\
17943              s INTER closure(t n) SUBSET g n /\
17944              closure(t n) SUBSET ball(x,e)) /\
17945         (!n. t(SUC n) SUBSET t n)`
17946   STRIP_ASSUME_TAC THENL
17947    [SUBGOAL_THEN
17948      `!u n. open_in (subtopology euclidean s) u /\ ~(u = {}) /\
17949             closure u SUBSET ball(x,e)
17950             ==> ?y. open_in (subtopology euclidean s) y /\
17951                     ~(y = {}) /\
17952                     s INTER closure y SUBSET (g:num->real^N->bool) n /\
17953                     closure y SUBSET ball(x,e) /\
17954                     y SUBSET u`
17955     ASSUME_TAC THENL
17956      [MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `n:num`] THEN STRIP_TAC THEN
17957       SUBGOAL_THEN `?y:real^N. y IN u /\ y IN g(n:num)` STRIP_ASSUME_TAC THENL
17958        [FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC o SPEC `n:num`) THEN
17959         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
17960         FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
17961         DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
17962         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_in]) THEN
17963         DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `y:real^N`)) THEN
17964         ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN
17965         STRIP_TAC THEN REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE] THEN
17966         ASM SET_TAC[];
17967         ALL_TAC] THEN
17968       SUBGOAL_THEN
17969        `open_in (subtopology euclidean s) (u INTER g(n:num):real^N->bool)`
17970       MP_TAC THENL [ASM_SIMP_TAC[OPEN_IN_INTER]; ALL_TAC] THEN
17971       GEN_REWRITE_TAC LAND_CONV [OPEN_IN_CONTAINS_BALL] THEN
17972       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `y:real^N`)) THEN
17973       ASM_REWRITE_TAC[IN_INTER] THEN
17974       DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
17975       EXISTS_TAC `s INTER ball(y:real^N,d / &2)` THEN
17976       SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN REPEAT CONJ_TAC THENL
17977        [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `y:real^N` THEN
17978         ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_HALF; IN_INTER] THEN
17979         ASM SET_TAC[];
17980         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
17981          `b SUBSET u INTER g ==> !s. s SUBSET b ==> s SUBSET g`)) THEN
17982         MATCH_MP_TAC(SET_RULE
17983          `closure(s INTER b) SUBSET closure b /\ closure b SUBSET c
17984           ==> s INTER closure(s INTER b) SUBSET c INTER s`) THEN
17985         SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN
17986         ASM_SIMP_TAC[CLOSURE_BALL; SUBSET_BALLS; REAL_HALF; DIST_REFL] THEN
17987         ASM_REAL_ARITH_TAC;
17988         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
17989           SUBSET_TRANS)) THEN MATCH_MP_TAC SUBSET_CLOSURE;
17990         ALL_TAC] THEN
17991       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
17992        `b INTER s SUBSET u INTER g ==> c SUBSET b
17993         ==> s INTER c SUBSET u`)) THEN
17994       REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC;
17995       MATCH_MP_TAC DEPENDENT_CHOICE THEN ASM_SIMP_TAC[GSYM CONJ_ASSOC] THEN
17996       FIRST_X_ASSUM(MP_TAC o SPECL [`s INTER ball(x:real^N,e / &2)`; `0`]) THEN
17997       ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; GSYM MEMBER_NOT_EMPTY] THEN
17998       ANTS_TAC THENL [REWRITE_TAC[LEFT_AND_EXISTS_THM]; MESON_TAC[]] THEN
17999       EXISTS_TAC `x:real^N` THEN
18000       ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_HALF; IN_INTER] THEN
18001       TRANS_TAC SUBSET_TRANS `closure(ball(x:real^N,e / &2))` THEN
18002       SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN
18003       ASM_SIMP_TAC[CLOSURE_BALL; SUBSET_BALLS; REAL_HALF; DIST_REFL] THEN
18004       ASM_REAL_ARITH_TAC];
18005     MP_TAC(ISPEC
18006      `(\n. s INTER closure(t n)):num->real^N->bool` COMPACT_NEST) THEN
18007     ANTS_TAC THENL
18008      [REWRITE_TAC[FORALL_AND_THM] THEN REPEAT CONJ_TAC THENL
18009        [GEN_TAC THEN MATCH_MP_TAC CLOSED_INTER_COMPACT THEN
18010         ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL; COMPACT_EQ_BOUNDED_CLOSED;
18011                       CLOSED_CLOSURE];
18012         GEN_TAC THEN MATCH_MP_TAC(SET_RULE
18013          `~(t = {}) /\ t SUBSET s /\ t SUBSET closure t
18014           ==> ~(s INTER closure t = {})`) THEN
18015         ASM_MESON_TAC[CLOSURE_SUBSET; OPEN_IN_IMP_SUBSET];
18016         MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN
18017         ASM_SIMP_TAC[SUBSET_CLOSURE; SET_RULE
18018          `t SUBSET u ==> s INTER t SUBSET s INTER u`] THEN
18019         SET_TAC[]];
18020       MATCH_MP_TAC(SET_RULE `s SUBSET t ==> ~(s = {}) ==> ~(t = {})`) THEN
18021       REWRITE_TAC[SUBSET_INTER] THEN
18022       REWRITE_TAC[SUBSET; IN_INTERS; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
18023       ASM SET_TAC[]]]);;
18024
18025 let BAIRE_ALT = prove
18026  (`!g s:real^N->bool.
18027         closed s /\ ~(s = {}) /\ COUNTABLE g /\ UNIONS g = s
18028         ==> ?t u. t IN g /\ open_in (subtopology euclidean s) u /\
18029                   u SUBSET (closure t)`,
18030   REPEAT STRIP_TAC THEN MP_TAC(ISPECL
18031   [`IMAGE (\t:real^N->bool. s DIFF closure t) g`; `s:real^N->bool`] BAIRE) THEN
18032   ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN
18033   MATCH_MP_TAC(TAUT `~q /\ (~r ==> p) ==> (p ==> q) ==> r`) THEN
18034   CONJ_TAC THENL
18035    [MATCH_MP_TAC(SET_RULE
18036      `~(s = {}) /\ (t = {} ==> closure t = {}) /\ t = {}
18037       ==> ~(s SUBSET closure t)`) THEN
18038     ASM_SIMP_TAC[CLOSURE_EMPTY] THEN
18039     MATCH_MP_TAC(SET_RULE `i SUBSET s /\ s DIFF i = s ==> i = {}`) THEN
18040     CONJ_TAC THENL [REWRITE_TAC[INTERS_IMAGE] THEN ASM SET_TAC[]; ALL_TAC] THEN
18041     REWRITE_TAC[DIFF_INTERS] THEN
18042     REWRITE_TAC[SET_RULE `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`] THEN
18043     REWRITE_TAC[SET_RULE `s DIFF (s DIFF t) = s INTER t`] THEN
18044     REWRITE_TAC[SET_RULE `{s INTER closure t | t IN g} =
18045                           {s INTER t | t IN IMAGE closure g}`] THEN
18046     SIMP_TAC[GSYM INTER_UNIONS; SET_RULE `s INTER t = s <=> s SUBSET t`] THEN
18047     FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
18048     GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM IMAGE_ID] THEN
18049     MATCH_MP_TAC UNIONS_MONO_IMAGE THEN REWRITE_TAC[CLOSURE_SUBSET];
18050     REWRITE_TAC[NOT_EXISTS_THM] THEN STRIP_TAC THEN
18051     X_GEN_TAC `t:real^N->bool` THEN REPEAT STRIP_TAC THENL
18052      [ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN
18053       MATCH_MP_TAC OPEN_IN_DIFF THEN
18054       ASM_SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_CLOSURE; OPEN_IN_REFL];
18055       REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
18056       REWRITE_TAC[CLOSURE_APPROACHABLE] THEN
18057       X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
18058        [`t:real^N->bool`; `s INTER ball(x:real^N,e)`]) THEN
18059       ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; SUBSET; IN_INTER; IN_BALL;
18060                    IN_DIFF] THEN
18061       MESON_TAC[DIST_SYM]]]);;
18062
18063 (* ------------------------------------------------------------------------- *)
18064 (* Several variants of paracompactness.                                      *)
18065 (* ------------------------------------------------------------------------- *)
18066
18067 let PARACOMPACT = prove
18068  (`!s c. (!t:real^N->bool. t IN c ==> open t) /\ s SUBSET UNIONS c
18069          ==> ?c'. s SUBSET UNIONS c' /\
18070                   (!u. u IN c'
18071                        ==> open u /\ ?t. t IN c /\ u SUBSET t) /\
18072                   (!x. x IN s
18073                        ==> ?v. open v /\ x IN v /\
18074                                FINITE {u | u IN c' /\ ~(u INTER v = {})})`,
18075   REPEAT STRIP_TAC THEN
18076   ASM_CASES_TAC `s:real^N->bool = {}` THENL
18077    [EXISTS_TAC `{}:(real^N->bool)->bool` THEN
18078     ASM_REWRITE_TAC[EMPTY_SUBSET; NOT_IN_EMPTY];
18079     ALL_TAC] THEN
18080   SUBGOAL_THEN
18081    `!x:real^N. x IN s
18082                ==> ?t u. x IN u /\ open u /\ closure u SUBSET t /\ t IN c`
18083   MP_TAC THENL
18084    [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
18085     FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN
18086     ASM_REWRITE_TAC[IN_UNIONS] THEN MATCH_MP_TAC MONO_EXISTS THEN
18087     X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN
18088     FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`) THEN
18089     ASM_REWRITE_TAC[] THEN
18090     GEN_REWRITE_TAC LAND_CONV [OPEN_CONTAINS_CBALL] THEN
18091     DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
18092     DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
18093     EXISTS_TAC `ball(x:real^N,e)` THEN
18094     ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL; CLOSURE_BALL];
18095     GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
18096     REWRITE_TAC[LEFT_IMP_EXISTS_THM; SKOLEM_THM] THEN
18097     MAP_EVERY X_GEN_TAC
18098       [`f:real^N->real^N->bool`; `e:real^N->real^N->bool`] THEN
18099     STRIP_TAC] THEN
18100   MP_TAC(ISPEC `IMAGE (e:real^N->real^N->bool) s` LINDELOF) THEN
18101   ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN
18102   ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
18103   REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN
18104   DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool`
18105     (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
18106   ASM_CASES_TAC `k:real^N->bool = {}` THENL
18107    [ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN
18108   MP_TAC(ISPEC `k:real^N->bool` COUNTABLE_AS_IMAGE) THEN
18109   ASM_REWRITE_TAC[] THEN
18110   DISCH_THEN(X_CHOOSE_THEN `a:num->real^N` SUBST_ALL_TAC) THEN
18111   STRIP_TAC THEN EXISTS_TAC
18112   `{ f(a n:real^N) DIFF UNIONS {closure(e(a m)):real^N->bool | m < n} |
18113      n IN (:num)}` THEN
18114   REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN REPEAT CONJ_TAC THENL
18115    [X_GEN_TAC `n:num` THEN CONJ_TAC THENL
18116      [MATCH_MP_TAC OPEN_DIFF THEN
18117       CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
18118       MATCH_MP_TAC CLOSED_UNIONS THEN
18119       REWRITE_TAC[FORALL_IN_GSPEC; CLOSED_CLOSURE] THEN
18120       ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
18121       SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT];
18122       EXISTS_TAC `f((a:num->real^N) n):real^N->bool` THEN ASM SET_TAC[]];
18123     REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM; IN_DIFF] THEN
18124     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
18125     SUBGOAL_THEN `?n. x IN (f((a:num->real^N) n):real^N->bool)` MP_TAC THENL
18126      [RULE_ASSUM_TAC(REWRITE_RULE[UNIONS_IMAGE; EXISTS_IN_IMAGE]) THEN
18127       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN
18128       DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
18129       ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN
18130       DISCH_THEN(MP_TAC o snd o EQ_IMP_RULE) THEN
18131       ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
18132       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN
18133       STRIP_TAC THEN
18134       FIRST_X_ASSUM(MP_TAC o SPEC `(a:num->real^N) n`) THEN
18135       ANTS_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET]];
18136       GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN
18137       MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]];
18138     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
18139     RULE_ASSUM_TAC(REWRITE_RULE[UNIONS_IMAGE; EXISTS_IN_IMAGE]) THEN
18140     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN
18141     DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
18142     ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN
18143     DISCH_THEN(MP_TAC o snd o EQ_IMP_RULE) THEN
18144     ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
18145     DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN
18146     EXISTS_TAC `e((a:num->real^N) n):real^N->bool` THEN
18147     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
18148     REWRITE_TAC[SET_RULE
18149      `{u | (?n. u = f n) /\ P u} = IMAGE f {n |n| P(f n) /\ n IN (:num)}`] THEN
18150     MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_SUBSET THEN
18151     EXISTS_TAC `{m:num | m <= n}` THEN REWRITE_TAC[FINITE_NUMSEG_LE] THEN
18152     REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIV] THEN
18153     X_GEN_TAC `m:num` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
18154     REWRITE_TAC[NOT_LE] THEN DISCH_TAC THEN
18155     MATCH_MP_TAC(SET_RULE `u SUBSET t ==> (s DIFF t) INTER u = {}`) THEN
18156     REWRITE_TAC[SUBSET; IN_UNIONS; EXISTS_IN_GSPEC] THEN
18157     ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET]]);;
18158
18159 let PARACOMPACT_CLOSED_IN = prove
18160  (`!u:real^N->bool s c.
18161         closed_in (subtopology euclidean u) s /\
18162         (!t:real^N->bool. t IN c ==> open_in (subtopology euclidean u) t) /\
18163         s SUBSET UNIONS c
18164          ==> ?c'. s SUBSET UNIONS c' /\
18165                   (!v. v IN c'
18166                        ==> open_in (subtopology euclidean u) v /\
18167                            ?t. t IN c /\ v SUBSET t) /\
18168                   (!x. x IN u
18169                        ==> ?v. open_in (subtopology euclidean u) v /\ x IN v /\
18170                                FINITE {n | n IN c' /\ ~(n INTER v = {})})`,
18171   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
18172    (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN
18173   REWRITE_TAC[OPEN_IN_OPEN] THEN
18174   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
18175   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
18176   X_GEN_TAC `uu:(real^N->bool)->(real^N->bool)` THEN
18177   DISCH_THEN(ASSUME_TAC o GSYM) THEN
18178   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN
18179   DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool`
18180    (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN
18181   MP_TAC(ISPECL
18182    [`u:real^N->bool`;
18183     `((:real^N) DIFF k) INSERT IMAGE (uu:(real^N->bool)->(real^N->bool)) c`]
18184    PARACOMPACT) THEN
18185   ASM_SIMP_TAC[FORALL_IN_IMAGE; UNIONS_IMAGE; UNIONS_INSERT; FORALL_IN_INSERT;
18186                EXISTS_IN_IMAGE; EXISTS_IN_INSERT; GSYM closed] THEN
18187   ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
18188   DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
18189   EXISTS_TAC `{u INTER v:real^N->bool | v IN d /\ ~(v INTER k = {})}` THEN
18190   REPEAT CONJ_TAC THENL
18191    [REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[];
18192     REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM SET_TAC[];
18193     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
18194     FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
18195     DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN
18196     EXISTS_TAC `u INTER v:real^N->bool` THEN ASM_REWRITE_TAC[IN_INTER] THEN
18197     CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
18198     ONCE_REWRITE_TAC[SET_RULE
18199      `{y | y IN {f x | P x} /\ Q y} = IMAGE f {x | P x /\ Q(f x)}`] THEN
18200     MATCH_MP_TAC FINITE_IMAGE THEN
18201     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
18202      (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN SET_TAC[]]);;
18203
18204 let PARACOMPACT_CLOSED = prove
18205  (`!s:real^N->bool c.
18206         closed s /\ (!t:real^N->bool. t IN c ==> open t) /\ s SUBSET UNIONS c
18207         ==> ?c'. s SUBSET UNIONS c' /\
18208                  (!u. u IN c' ==> open u /\ ?t. t IN c /\ u SUBSET t) /\
18209                  (!x. ?v. open v /\ x IN v /\
18210                           FINITE {u | u IN c' /\ ~(u INTER v = {})})`,
18211   REPEAT STRIP_TAC THEN
18212   MP_TAC(ISPECL [`(:real^N)`; `s:real^N->bool`; `c:(real^N->bool)->bool`]
18213         PARACOMPACT_CLOSED_IN) THEN
18214   ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; GSYM CLOSED_IN; IN_UNIV]);;
18215
18216 (* ------------------------------------------------------------------------- *)
18217 (* Partitions of unity subordinate to locally finite open coverings.         *)
18218 (* ------------------------------------------------------------------------- *)
18219
18220 let SUBORDINATE_PARTITION_OF_UNITY = prove
18221  (`!c s. s SUBSET UNIONS c /\ (!u. u IN c ==> open u) /\
18222          (!x. x IN s
18223               ==> ?v. open v /\ x IN v /\
18224                       FINITE {u | u IN c /\ ~(u INTER v = {})})
18225          ==> ?f:(real^N->bool)->real^N->real.
18226                       (!u. u IN c
18227                            ==> (lift o f u) continuous_on s /\
18228                                !x. x IN s ==> &0 <= f u x) /\
18229                       (!x u. u IN c /\ x IN s /\ ~(x IN u) ==> f u x = &0) /\
18230                       (!x. x IN s ==> sum c (\u. f u x) = &1) /\
18231                       (!x. x IN s
18232                            ==> ?n. open n /\ x IN n /\
18233                                    FINITE {u | u IN c /\
18234                                            ~(!x. x IN n ==> f u x = &0)})`,
18235   REPEAT STRIP_TAC THEN
18236   ASM_CASES_TAC `?u:real^N->bool. u IN c /\ s SUBSET u` THENL
18237    [FIRST_X_ASSUM(CHOOSE_THEN STRIP_ASSUME_TAC) THEN
18238     EXISTS_TAC `\v:real^N->bool x:real^N. if v = u then &1 else &0` THEN
18239     REWRITE_TAC[COND_RAND; COND_RATOR; o_DEF; REAL_POS;
18240                 REAL_OF_NUM_EQ; ARITH_EQ;
18241                 MESON[] `(if p then q else T) <=> p ==> q`] THEN
18242     ASM_SIMP_TAC[CONTINUOUS_ON_CONST; COND_ID; SUM_DELTA] THEN
18243     CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
18244     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
18245     EXISTS_TAC `ball(x:real^N,&1)` THEN
18246     REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; REAL_LT_01] THEN
18247     MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{u:real^N->bool}` THEN
18248     REWRITE_TAC[FINITE_SING; SUBSET; IN_ELIM_THM; IN_SING] THEN
18249     X_GEN_TAC `v:real^N->bool` THEN
18250     ASM_CASES_TAC `v:real^N->bool = u` THEN ASM_REWRITE_TAC[];
18251     ALL_TAC] THEN
18252   EXISTS_TAC `\u:real^N->bool x:real^N.
18253         if x IN s
18254         then setdist({x},s DIFF u) / sum c (\v. setdist({x},s DIFF v))
18255         else &0` THEN
18256   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
18257   SIMP_TAC[SUM_POS_LE; SETDIST_POS_LE; REAL_LE_DIV] THEN
18258   SIMP_TAC[SETDIST_SING_IN_SET; IN_DIFF; real_div; REAL_MUL_LZERO] THEN
18259   REWRITE_TAC[SUM_RMUL] THEN REWRITE_TAC[GSYM real_div] THEN
18260   MATCH_MP_TAC(TAUT `r /\ p /\ q ==> p /\ q /\ r`) THEN CONJ_TAC THENL
18261    [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
18262     FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
18263     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:real^N->bool` THEN
18264     REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
18265     ASM_REWRITE_TAC[] THEN
18266     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN
18267     REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `u:real^N->bool` THEN
18268     ASM_CASES_TAC `(u:real^N->bool) IN c` THEN
18269     ASM_REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN
18270     X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
18271     REWRITE_TAC[real_div; REAL_ENTIRE] THEN
18272     COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
18273     ASM_CASES_TAC `(y:real^N) IN u` THEN
18274     ASM_SIMP_TAC[SETDIST_SING_IN_SET; IN_DIFF; REAL_MUL_LZERO] THEN
18275     ASM SET_TAC[];
18276     ALL_TAC] THEN
18277   SUBGOAL_THEN
18278    `!v x:real^N. v IN c /\ x IN s /\ x IN v ==> &0 < setdist({x},s DIFF v)`
18279   ASSUME_TAC THENL
18280    [REPEAT STRIP_TAC THEN
18281     SIMP_TAC[SETDIST_POS_LE; REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN
18282     MP_TAC(ISPECL [`s:real^N->bool`; `s DIFF v:real^N->bool`; `x:real^N`]
18283         SETDIST_EQ_0_CLOSED_IN) THEN
18284     ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN
18285     ASM_SIMP_TAC[CLOSED_IN_CLOSED_INTER; GSYM OPEN_CLOSED] THEN
18286     DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN
18287     ASM_REWRITE_TAC[IN_INTER; IN_DIFF; IN_UNION] THEN ASM SET_TAC[];
18288     ALL_TAC] THEN
18289   SUBGOAL_THEN
18290    `!x:real^N. x IN s ==> &0 < sum c (\v. setdist ({x},s DIFF v))`
18291   ASSUME_TAC THENL
18292    [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
18293     ONCE_REWRITE_TAC[GSYM SUM_SUPPORT] THEN
18294     REWRITE_TAC[support; NEUTRAL_REAL_ADD] THEN
18295     MATCH_MP_TAC SUM_POS_LT THEN REWRITE_TAC[SETDIST_POS_LE] THEN
18296     CONJ_TAC THENL
18297      [FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
18298       DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
18299       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
18300       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN
18301       REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `u:real^N->bool` THEN
18302       ASM_CASES_TAC `(x:real^N) IN u` THEN
18303       ASM_SIMP_TAC[SETDIST_SING_IN_SET; IN_DIFF] THEN ASM SET_TAC[];
18304       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
18305       DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN REWRITE_TAC[IN_UNIONS] THEN
18306       ASM_REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
18307       ASM_MESON_TAC[REAL_LT_IMP_NZ]];
18308     ALL_TAC] THEN
18309   ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_DIV_REFL; o_DEF] THEN
18310   X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN
18311   MATCH_MP_TAC CONTINUOUS_ON_EQ THEN
18312   EXISTS_TAC `\x:real^N.
18313         lift(setdist({x},s DIFF u) / sum c (\v. setdist({x},s DIFF v)))` THEN
18314   SIMP_TAC[] THEN REWRITE_TAC[real_div; LIFT_CMUL] THEN
18315   MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
18316   SIMP_TAC[CONTINUOUS_ON_LIFT_SETDIST; o_DEF] THEN
18317   MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
18318   ASM_SIMP_TAC[REAL_LT_IMP_NZ; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
18319   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
18320   FIRST_X_ASSUM(fun th ->
18321     MP_TAC(SPEC `x:real^N` th) THEN ASM_REWRITE_TAC[] THEN
18322     DISCH_THEN(X_CHOOSE_THEN `n:real^N->bool` STRIP_ASSUME_TAC)) THEN
18323   MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN THEN
18324   MAP_EVERY EXISTS_TAC
18325    [`\x:real^N. lift(sum {v | v IN c /\ ~(v INTER n = {})}
18326                          (\v. setdist({x},s DIFF v)))`;
18327     `s INTER n:real^N->bool`] THEN
18328   ASM_SIMP_TAC[IN_INTER; OPEN_IN_OPEN_INTER] THEN CONJ_TAC THENL
18329    [X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN AP_TERM_TAC THEN
18330     CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_EQ_SUPERSET THEN
18331     ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN X_GEN_TAC `v:real^N->bool` THEN
18332     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
18333     ASM_REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN
18334     MATCH_MP_TAC SETDIST_SING_IN_SET THEN ASM SET_TAC[];
18335     ASM_SIMP_TAC[LIFT_SUM; o_DEF] THEN MATCH_MP_TAC CONTINUOUS_VSUM THEN
18336     ASM_SIMP_TAC[CONTINUOUS_AT_LIFT_SETDIST; CONTINUOUS_AT_WITHIN]]);;