colo12-c703.uibk.ac.at Git - Multivariate Analysis/.git/blob - Multivariate/realanalysis.ml

   1 (* ========================================================================= *)
   2 (* Some analytic concepts for R instead of R^1.                              *)
   3 (*                                                                           *)
   4 (*              (c) Copyright, John Harrison 1998-2008                       *)
   5 (* ========================================================================= *)
   6
   7 needs "Library/binomial.ml";;
   8 needs "Multivariate/measure.ml";;
   9 needs "Multivariate/polytope.ml";;
  10 needs "Multivariate/transcendentals.ml";;
  11
  12 (* ------------------------------------------------------------------------- *)
  13 (* Open-ness and closedness of a set of reals.                               *)
  14 (* ------------------------------------------------------------------------- *)
  15
  16 let real_open = new_definition
  17   `real_open s <=>
  18       !x. x IN s ==> ?e. &0 < e /\ !x'. abs(x' - x) < e ==> x' IN s`;;
  19
  20 let real_closed = new_definition
  21  `real_closed s <=> real_open((:real) DIFF s)`;;
  22
  23 let euclideanreal = new_definition
  24  `euclideanreal = topology real_open`;;
  25
  26 let REAL_OPEN_EMPTY = prove
  27  (`real_open {}`,
  28   REWRITE_TAC[real_open; NOT_IN_EMPTY]);;
  29
  30 let REAL_OPEN_UNIV = prove
  31  (`real_open(:real)`,
  32   REWRITE_TAC[real_open; IN_UNIV] THEN MESON_TAC[REAL_LT_01]);;
  33
  34 let REAL_OPEN_INTER = prove
  35  (`!s t. real_open s /\ real_open t ==> real_open (s INTER t)`,
  36   REPEAT GEN_TAC THEN REWRITE_TAC[real_open; AND_FORALL_THM; IN_INTER] THEN
  37   MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
  38   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
  39   ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2
  40    (X_CHOOSE_TAC `d1:real`) (X_CHOOSE_TAC `d2:real`)) THEN
  41   MP_TAC(SPECL [`d1:real`; `d2:real`] REAL_DOWN2) THEN
  42   ASM_MESON_TAC[REAL_LT_TRANS]);;
  43
  44 let REAL_OPEN_UNIONS = prove
  45  (`(!s. s IN f ==> real_open s) ==> real_open(UNIONS f)`,
  46   REWRITE_TAC[real_open; IN_UNIONS] THEN MESON_TAC[]);;
  47
  48 let REAL_OPEN_IN = prove
  49  (`!s. real_open s <=> open_in euclideanreal s`,
  50   GEN_TAC THEN REWRITE_TAC[euclideanreal] THEN CONV_TAC SYM_CONV THEN
  51   AP_THM_TAC THEN REWRITE_TAC[GSYM(CONJUNCT2 topology_tybij)] THEN
  52   REWRITE_TAC[REWRITE_RULE[IN] istopology] THEN
  53   REWRITE_TAC[REAL_OPEN_EMPTY; REAL_OPEN_INTER; SUBSET] THEN
  54   MESON_TAC[IN; REAL_OPEN_UNIONS]);;
  55
  56 let TOPSPACE_EUCLIDEANREAL = prove
  57  (`topspace euclideanreal = (:real)`,
  58   REWRITE_TAC[topspace; EXTENSION; IN_UNIV; IN_UNIONS; IN_ELIM_THM] THEN
  59   MESON_TAC[REAL_OPEN_UNIV; IN_UNIV; REAL_OPEN_IN]);;
  60
  61 let TOPSPACE_EUCLIDEANREAL_SUBTOPOLOGY = prove
  62  (`!s. topspace (subtopology euclideanreal s) = s`,
  63   REWRITE_TAC[TOPSPACE_EUCLIDEANREAL; TOPSPACE_SUBTOPOLOGY; INTER_UNIV]);;
  64
  65 let REAL_CLOSED_IN = prove
  66  (`!s. real_closed s <=> closed_in euclideanreal s`,
  67   REWRITE_TAC[real_closed; closed_in; TOPSPACE_EUCLIDEANREAL;
  68               REAL_OPEN_IN; SUBSET_UNIV]);;
  69
  70 let REAL_OPEN_UNION = prove
  71  (`!s t. real_open s /\ real_open t ==> real_open(s UNION t)`,
  72   REWRITE_TAC[REAL_OPEN_IN; OPEN_IN_UNION]);;
  73
  74 let REAL_OPEN_SUBREAL_OPEN = prove
  75  (`!s. real_open s <=> !x. x IN s ==> ?t. real_open t /\ x IN t /\ t SUBSET s`,
  76   REWRITE_TAC[REAL_OPEN_IN; GSYM OPEN_IN_SUBOPEN]);;
  77
  78 let REAL_CLOSED_EMPTY = prove
  79  (`real_closed {}`,
  80   REWRITE_TAC[REAL_CLOSED_IN; CLOSED_IN_EMPTY]);;
  81
  82 let REAL_CLOSED_UNIV = prove
  83  (`real_closed(:real)`,
  84   REWRITE_TAC[REAL_CLOSED_IN; GSYM TOPSPACE_EUCLIDEANREAL; CLOSED_IN_TOPSPACE]);;
  85
  86 let REAL_CLOSED_UNION = prove
  87  (`!s t. real_closed s /\ real_closed t ==> real_closed(s UNION t)`,
  88   REWRITE_TAC[REAL_CLOSED_IN; CLOSED_IN_UNION]);;
  89
  90 let REAL_CLOSED_INTER = prove
  91  (`!s t. real_closed s /\ real_closed t ==> real_closed(s INTER t)`,
  92   REWRITE_TAC[REAL_CLOSED_IN; CLOSED_IN_INTER]);;
  93
  94 let REAL_CLOSED_INTERS = prove
  95  (`!f. (!s. s IN f ==> real_closed s) ==> real_closed(INTERS f)`,
  96   REWRITE_TAC[REAL_CLOSED_IN] THEN REPEAT STRIP_TAC THEN
  97   ASM_CASES_TAC `f:(real->bool)->bool = {}` THEN
  98   ASM_SIMP_TAC[CLOSED_IN_INTERS; INTERS_0] THEN
  99   REWRITE_TAC[GSYM TOPSPACE_EUCLIDEANREAL; CLOSED_IN_TOPSPACE]);;
 100
 101 let REAL_OPEN_REAL_CLOSED = prove
 102  (`!s. real_open s <=> real_closed(UNIV DIFF s)`,
 103   SIMP_TAC[REAL_OPEN_IN; REAL_CLOSED_IN; TOPSPACE_EUCLIDEANREAL; SUBSET_UNIV;
 104            OPEN_IN_CLOSED_IN_EQ]);;
 105
 106 let REAL_OPEN_DIFF = prove
 107  (`!s t. real_open s /\ real_closed t ==> real_open(s DIFF t)`,
 108   REWRITE_TAC[REAL_OPEN_IN; REAL_CLOSED_IN; OPEN_IN_DIFF]);;
 109
 110 let REAL_CLOSED_DIFF = prove
 111  (`!s t. real_closed s /\ real_open t ==> real_closed(s DIFF t)`,
 112   REWRITE_TAC[REAL_OPEN_IN; REAL_CLOSED_IN; CLOSED_IN_DIFF]);;
 113
 114 let REAL_OPEN_INTERS = prove
 115  (`!s. FINITE s /\ (!t. t IN s ==> real_open t) ==> real_open(INTERS s)`,
 116   REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
 117   REWRITE_TAC[INTERS_INSERT; INTERS_0; REAL_OPEN_UNIV; IN_INSERT] THEN
 118   MESON_TAC[REAL_OPEN_INTER]);;
 119
 120 let REAL_CLOSED_UNIONS = prove
 121  (`!s. FINITE s /\ (!t. t IN s ==> real_closed t) ==> real_closed(UNIONS s)`,
 122   REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
 123   REWRITE_TAC[UNIONS_INSERT; UNIONS_0; REAL_CLOSED_EMPTY; IN_INSERT] THEN
 124   MESON_TAC[REAL_CLOSED_UNION]);;
 125
 126 let REAL_OPEN = prove
 127  (`!s. real_open s <=> open(IMAGE lift s)`,
 128   REWRITE_TAC[real_open; open_def; FORALL_IN_IMAGE; FORALL_LIFT; DIST_LIFT;
 129               LIFT_IN_IMAGE_LIFT]);;
 130
 131 let REAL_CLOSED = prove
 132  (`!s. real_closed s <=> closed(IMAGE lift s)`,
 133   GEN_TAC THEN REWRITE_TAC[real_closed; REAL_OPEN; closed] THEN
 134   AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DIFF; IN_UNIV] THEN
 135   MESON_TAC[LIFT_DROP]);;
 136
 137 let REAL_CLOSED_HALFSPACE_LE = prove
 138  (`!a. real_closed {x | x <= a}`,
 139   GEN_TAC THEN SUBGOAL_THEN `closed {x | drop x <= a}` MP_TAC THENL
 140    [REWRITE_TAC[drop; CLOSED_HALFSPACE_COMPONENT_LE]; ALL_TAC] THEN
 141   MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[REAL_CLOSED] THEN AP_TERM_TAC THEN
 142   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);;
 143
 144 let REAL_CLOSED_HALFSPACE_GE = prove
 145  (`!a. real_closed {x | x >= a}`,
 146   GEN_TAC THEN SUBGOAL_THEN `closed {x | drop x >= a}` MP_TAC THENL
 147    [REWRITE_TAC[drop; CLOSED_HALFSPACE_COMPONENT_GE]; ALL_TAC] THEN
 148   MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[REAL_CLOSED] THEN AP_TERM_TAC THEN
 149   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);;
 150
 151 let REAL_OPEN_HALFSPACE_LT = prove
 152  (`!a. real_open {x | x < a}`,
 153   GEN_TAC THEN SUBGOAL_THEN `open {x | drop x < a}` MP_TAC THENL
 154    [REWRITE_TAC[drop; OPEN_HALFSPACE_COMPONENT_LT]; ALL_TAC] THEN
 155   MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[REAL_OPEN] THEN AP_TERM_TAC THEN
 156   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);;
 157
 158 let REAL_OPEN_HALFSPACE_GT = prove
 159  (`!a. real_open {x | x > a}`,
 160   GEN_TAC THEN SUBGOAL_THEN `open {x | drop x > a}` MP_TAC THENL
 161    [REWRITE_TAC[drop; OPEN_HALFSPACE_COMPONENT_GT]; ALL_TAC] THEN
 162   MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[REAL_OPEN] THEN AP_TERM_TAC THEN
 163   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);;
 164
 165 (* ------------------------------------------------------------------------- *)
 166 (* Compactness of a set of reals.                                            *)
 167 (* ------------------------------------------------------------------------- *)
 168
 169 let real_bounded = new_definition
 170  `real_bounded s <=> ?B. !x. x IN s ==> abs(x) <= B`;;
 171
 172 let REAL_BOUNDED = prove
 173  (`real_bounded s <=> bounded(IMAGE lift s)`,
 174   REWRITE_TAC[BOUNDED_LIFT; real_bounded]);;
 175
 176 let REAL_BOUNDED_POS = prove
 177  (`!s. real_bounded s <=> ?B. &0 < B /\ !x. x IN s ==> abs(x) <= B`,
 178   REWRITE_TAC[real_bounded] THEN
 179   MESON_TAC[REAL_ARITH `&0 < &1 + abs B /\ (x <= B ==> x <= &1 + abs B)`]);;
 180
 181 let REAL_BOUNDED_POS_LT = prove
 182  (`!s. real_bounded s <=> ?b. &0 < b /\ !x. x IN s ==> abs(x) < b`,
 183   REWRITE_TAC[real_bounded] THEN
 184   MESON_TAC[REAL_LT_IMP_LE;
 185             REAL_ARITH `&0 < &1 + abs(y) /\ (x <= y ==> x < &1 + abs(y))`]);;
 186
 187 let REAL_BOUNDED_SUBSET = prove
 188  (`!s t. real_bounded t /\ s SUBSET t ==> real_bounded s`,
 189   MESON_TAC[REAL_BOUNDED; BOUNDED_SUBSET; IMAGE_SUBSET]);;
 190
 191 let REAL_BOUNDED_UNION = prove
 192  (`!s t. real_bounded(s UNION t) <=> real_bounded s /\ real_bounded t`,
 193   REWRITE_TAC[REAL_BOUNDED; IMAGE_UNION; BOUNDED_UNION]);;
 194
 195 let real_compact = new_definition
 196  `real_compact s <=> compact(IMAGE lift s)`;;
 197
 198 let REAL_COMPACT_IMP_BOUNDED = prove
 199  (`!s. real_compact s ==> real_bounded s`,
 200   REWRITE_TAC[real_compact; REAL_BOUNDED; COMPACT_IMP_BOUNDED]);;
 201
 202 let REAL_COMPACT_IMP_CLOSED = prove
 203  (`!s. real_compact s ==> real_closed s`,
 204   REWRITE_TAC[real_compact; REAL_CLOSED; COMPACT_IMP_CLOSED]);;
 205
 206 let REAL_COMPACT_EQ_BOUNDED_CLOSED = prove
 207  (`!s. real_compact s <=> real_bounded s /\ real_closed s`,
 208   REWRITE_TAC[real_compact; REAL_BOUNDED; REAL_CLOSED] THEN
 209   REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED]);;
 210
 211 let REAL_COMPACT_UNION = prove
 212  (`!s t. real_compact s /\ real_compact t ==> real_compact(s UNION t)`,
 213   REWRITE_TAC[real_compact; IMAGE_UNION; COMPACT_UNION]);;
 214
 215 let REAL_COMPACT_ATTAINS_INF = prove
 216  (`!s. real_compact s /\ ~(s = {}) ==> ?x. x IN s /\ !y. y IN s ==> x <= y`,
 217   REWRITE_TAC[real_compact; COMPACT_ATTAINS_INF]);;
 218
 219 let REAL_COMPACT_ATTAINS_SUP = prove
 220  (`!s. real_compact s /\ ~(s = {}) ==> ?x. x IN s /\ !y. y IN s ==> y <= x`,
 221   REWRITE_TAC[real_compact; COMPACT_ATTAINS_SUP]);;
 222
 223 (* ------------------------------------------------------------------------- *)
 224 (* Limits of functions with real range.                                      *)
 225 (* ------------------------------------------------------------------------- *)
 226
 227 parse_as_infix("--->",(12,"right"));;
 228
 229 let tendsto_real = new_definition
 230   `(f ---> l) net <=> !e. &0 < e ==> eventually (\x. abs(f(x) - l) < e) net`;;
 231
 232 let reallim = new_definition
 233  `reallim net f = @l. (f ---> l) net`;;
 234
 235 let TENDSTO_REAL = prove
 236  (`(s ---> l) = ((lift o s) --> lift l)`,
 237   REWRITE_TAC[FUN_EQ_THM; tendsto; tendsto_real; o_THM; DIST_LIFT]);;
 238
 239 let REAL_TENDSTO = prove
 240  (`(s --> l) = (drop o s ---> drop l)`,
 241   REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_DROP; ETA_AX]);;
 242
 243 let REALLIM_COMPLEX = prove
 244  (`(s ---> l) = ((Cx o s) --> Cx(l))`,
 245   REWRITE_TAC[FUN_EQ_THM; tendsto; tendsto_real; o_THM; dist;
 246               GSYM CX_SUB; COMPLEX_NORM_CX]);;
 247
 248 let REALLIM_UNIQUE = prove
 249  (`!net f l l'.
 250          ~trivial_limit net /\ (f ---> l) net /\ (f ---> l') net ==> l = l'`,
 251   REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN
 252   DISCH_THEN(MP_TAC o MATCH_MP LIM_UNIQUE) THEN REWRITE_TAC[LIFT_EQ]);;
 253
 254 let REALLIM_CONST = prove
 255  (`!net a. ((\x. a) ---> a) net`,
 256   REWRITE_TAC[TENDSTO_REAL; o_DEF; LIM_CONST]);;
 257
 258 let REALLIM_LMUL = prove
 259  (`!f l c. (f ---> l) net ==> ((\x. c * f x) ---> c * l) net`,
 260   REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_CMUL; LIM_CMUL]);;
 261
 262 let REALLIM_RMUL = prove
 263  (`!f l c. (f ---> l) net ==> ((\x. f x * c) ---> l * c) net`,
 264   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REALLIM_LMUL]);;
 265
 266 let REALLIM_LMUL_EQ = prove
 267  (`!net f l c.
 268         ~(c = &0) ==> (((\x. c * f x) ---> c * l) net <=> (f ---> l) net)`,
 269   REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[REALLIM_LMUL] THEN
 270   DISCH_THEN(MP_TAC o SPEC `inv c:real` o MATCH_MP REALLIM_LMUL) THEN
 271   ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_LID; ETA_AX]);;
 272
 273 let REALLIM_RMUL_EQ = prove
 274  (`!net f l c.
 275         ~(c = &0) ==> (((\x. f x * c) ---> l * c) net <=> (f ---> l) net)`,
 276   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REALLIM_LMUL_EQ]);;
 277
 278 let REALLIM_NEG = prove
 279  (`!net f l. (f ---> l) net ==> ((\x. --(f x)) ---> --l) net`,
 280   REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_NEG; LIM_NEG]);;
 281
 282 let REALLIM_NEG_EQ = prove
 283  (`!net f l. ((\x. --(f x)) ---> --l) net <=> (f ---> l) net`,
 284   REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_NEG; LIM_NEG_EQ]);;
 285
 286 let REALLIM_ADD = prove
 287  (`!net:(A)net f g l m.
 288     (f ---> l) net /\ (g ---> m) net ==> ((\x. f(x) + g(x)) ---> l + m) net`,
 289   REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_ADD; LIM_ADD]);;
 290
 291 let REALLIM_SUB = prove
 292  (`!net:(A)net f g l m.
 293     (f ---> l) net /\ (g ---> m) net ==> ((\x. f(x) - g(x)) ---> l - m) net`,
 294   REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_SUB; LIM_SUB]);;
 295
 296 let REALLIM_MUL = prove
 297  (`!net:(A)net f g l m.
 298     (f ---> l) net /\ (g ---> m) net ==> ((\x. f(x) * g(x)) ---> l * m) net`,
 299   REWRITE_TAC[REALLIM_COMPLEX; o_DEF; CX_MUL; LIM_COMPLEX_MUL]);;
 300
 301 let REALLIM_INV = prove
 302  (`!net f l.
 303          (f ---> l) net /\ ~(l = &0) ==> ((\x. inv(f x)) ---> inv l) net`,
 304   REWRITE_TAC[REALLIM_COMPLEX; o_DEF; CX_INV; LIM_COMPLEX_INV; GSYM CX_INJ]);;
 305
 306 let REALLIM_DIV = prove
 307  (`!net:(A)net f g l m.
 308     (f ---> l) net /\ (g ---> m) net /\ ~(m = &0)
 309     ==> ((\x. f(x) / g(x)) ---> l / m) net`,
 310   SIMP_TAC[real_div; REALLIM_MUL; REALLIM_INV]);;
 311
 312 let REALLIM_ABS = prove
 313  (`!net f l. (f ---> l) net ==> ((\x. abs(f x)) ---> abs l) net`,
 314   REPEAT GEN_TAC THEN REWRITE_TAC[tendsto_real] THEN
 315   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
 316   DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
 317   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
 318   REWRITE_TAC[] THEN REAL_ARITH_TAC);;
 319
 320 let REALLIM_POW = prove
 321  (`!net f l n. (f ---> l) net ==> ((\x. f x pow n) ---> l pow n) net`,
 322   REPLICATE_TAC 3 GEN_TAC THEN
 323   INDUCT_TAC THEN ASM_SIMP_TAC[real_pow; REALLIM_CONST; REALLIM_MUL]);;
 324
 325 let REALLIM_MAX = prove
 326  (`!net:(A)net f g l m.
 327     (f ---> l) net /\ (g ---> m) net
 328     ==> ((\x. max (f x) (g x)) ---> max l m) net`,
 329   REWRITE_TAC[REAL_ARITH `max x y = inv(&2) * ((x + y) + abs(x - y))`] THEN
 330   REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_LMUL THEN
 331   ASM_SIMP_TAC[REALLIM_ADD; REALLIM_ABS; REALLIM_SUB]);;
 332
 333 let REALLIM_MIN = prove
 334  (`!net:(A)net f g l m.
 335     (f ---> l) net /\ (g ---> m) net
 336     ==> ((\x. min (f x) (g x)) ---> min l m) net`,
 337   REWRITE_TAC[REAL_ARITH `min x y = inv(&2) * ((x + y) - abs(x - y))`] THEN
 338   REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_LMUL THEN
 339   ASM_SIMP_TAC[REALLIM_ADD; REALLIM_ABS; REALLIM_SUB]);;
 340
 341 let REALLIM_NULL = prove
 342  (`!net f l. (f ---> l) net <=> ((\x. f(x) - l) ---> &0) net`,
 343   REWRITE_TAC[tendsto_real; REAL_SUB_RZERO]);;
 344
 345 let REALLIM_NULL_ADD = prove
 346  (`!net:(A)net f g.
 347     (f ---> &0) net /\ (g ---> &0) net ==> ((\x. f(x) + g(x)) ---> &0) net`,
 348   REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REALLIM_ADD) THEN
 349   REWRITE_TAC[REAL_ADD_LID]);;
 350
 351 let REALLIM_NULL_LMUL = prove
 352  (`!net f c. (f ---> &0) net ==> ((\x. c * f x) ---> &0) net`,
 353   REPEAT GEN_TAC THEN
 354   DISCH_THEN(MP_TAC o SPEC `c:real` o MATCH_MP REALLIM_LMUL) THEN
 355   REWRITE_TAC[REAL_MUL_RZERO]);;
 356
 357 let REALLIM_NULL_RMUL = prove
 358  (`!net f c. (f ---> &0) net ==> ((\x. f x * c) ---> &0) net`,
 359   REPEAT GEN_TAC THEN
 360   DISCH_THEN(MP_TAC o SPEC `c:real` o MATCH_MP REALLIM_RMUL) THEN
 361   REWRITE_TAC[REAL_MUL_LZERO]);;
 362
 363 let REALLIM_NULL_POW = prove
 364  (`!net f n. (f ---> &0) net /\ ~(n = 0) ==> ((\x. f x pow n) ---> &0) net`,
 365   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2
 366    (MP_TAC o SPEC `n:num` o MATCH_MP REALLIM_POW) ASSUME_TAC) THEN
 367   ASM_REWRITE_TAC[REAL_POW_ZERO]);;
 368
 369 let REALLIM_NULL_LMUL_EQ = prove
 370  (`!net f c.
 371         ~(c = &0) ==> (((\x. c * f x) ---> &0) net <=> (f ---> &0) net)`,
 372   MESON_TAC[REALLIM_LMUL_EQ; REAL_MUL_RZERO]);;
 373
 374 let REALLIM_NULL_RMUL_EQ = prove
 375  (`!net f c.
 376         ~(c = &0) ==> (((\x. f x * c) ---> &0) net <=> (f ---> &0) net)`,
 377   MESON_TAC[REALLIM_RMUL_EQ; REAL_MUL_LZERO]);;
 378
 379 let REALLIM_RE = prove
 380  (`!net f l. (f --> l) net ==> ((Re o f) ---> Re l) net`,
 381   REWRITE_TAC[REALLIM_COMPLEX] THEN
 382   REWRITE_TAC[tendsto; dist; o_THM; GSYM CX_SUB; COMPLEX_NORM_CX] THEN
 383   REWRITE_TAC[GSYM RE_SUB; eventually] THEN
 384   MESON_TAC[REAL_LET_TRANS; COMPLEX_NORM_GE_RE_IM]);;
 385
 386 let REALLIM_IM = prove
 387  (`!net f l. (f --> l) net ==> ((Im o f) ---> Im l) net`,
 388   REWRITE_TAC[REALLIM_COMPLEX] THEN
 389   REWRITE_TAC[tendsto; dist; o_THM; GSYM CX_SUB; COMPLEX_NORM_CX] THEN
 390   REWRITE_TAC[GSYM IM_SUB; eventually] THEN
 391   MESON_TAC[REAL_LET_TRANS; COMPLEX_NORM_GE_RE_IM]);;
 392
 393 let REALLIM_TRANSFORM_EVENTUALLY = prove
 394  (`!net f g l.
 395         eventually (\x. f x = g x) net /\ (f ---> l) net ==> (g ---> l) net`,
 396   REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN
 397   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
 398   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN
 399   POP_ASSUM MP_TAC THEN
 400   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
 401   SIMP_TAC[o_THM]);;
 402
 403 let REALLIM_TRANSFORM = prove
 404  (`!net f g l.
 405         ((\x. f x - g x) ---> &0) net /\ (f ---> l) net ==> (g ---> l) net`,
 406   REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN
 407   REWRITE_TAC[o_DEF; LIFT_NUM; LIFT_SUB; LIM_TRANSFORM]);;
 408
 409 let REALLIM_TRANSFORM_EQ = prove
 410  (`!net f:A->real g l.
 411      ((\x. f x - g x) ---> &0) net ==> ((f ---> l) net <=> (g ---> l) net)`,
 412   REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN
 413   REWRITE_TAC[o_DEF; LIFT_NUM; LIFT_SUB; LIM_TRANSFORM_EQ]);;
 414
 415 let REAL_SEQ_OFFSET = prove
 416  (`!f l k. (f ---> l) sequentially ==> ((\i. f (i + k)) ---> l) sequentially`,
 417   REPEAT GEN_TAC THEN SIMP_TAC[TENDSTO_REAL; o_DEF] THEN
 418   DISCH_THEN(MP_TAC o MATCH_MP SEQ_OFFSET) THEN SIMP_TAC[]);;
 419
 420 let REAL_SEQ_OFFSET_REV = prove
 421  (`!f l k. ((\i. f (i + k)) ---> l) sequentially ==> (f ---> l) sequentially`,
 422   SIMP_TAC[TENDSTO_REAL; o_DEF] THEN REPEAT STRIP_TAC THEN
 423   MATCH_MP_TAC SEQ_OFFSET_REV THEN EXISTS_TAC `k:num` THEN ASM_SIMP_TAC[]);;
 424
 425 let REALLIM_TRANSFORM_STRADDLE = prove
 426  (`!f g h a.
 427         eventually (\n. f(n) <= g(n)) net /\ (f ---> a) net /\
 428         eventually (\n. g(n) <= h(n)) net /\ (h ---> a) net
 429         ==> (g ---> a) net`,
 430   REPEAT GEN_TAC THEN
 431   REWRITE_TAC[RIGHT_AND_FORALL_THM; tendsto_real; AND_FORALL_THM] THEN
 432   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
 433   ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
 434   REWRITE_TAC[GSYM EVENTUALLY_AND] THEN
 435   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
 436   REAL_ARITH_TAC);;
 437
 438 let REALLIM_TRANSFORM_BOUND = prove
 439  (`!f g. eventually (\n. abs(f n) <= g n) net /\ (g ---> &0) net
 440          ==> (f ---> &0) net`,
 441   REPEAT GEN_TAC THEN
 442   REWRITE_TAC[RIGHT_AND_FORALL_THM; tendsto_real; AND_FORALL_THM] THEN
 443   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
 444   ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
 445   REWRITE_TAC[GSYM EVENTUALLY_AND] THEN
 446   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
 447   REAL_ARITH_TAC);;
 448
 449 let REAL_CONVERGENT_IMP_BOUNDED = prove
 450  (`!s l. (s ---> l) sequentially ==> real_bounded (IMAGE s (:num))`,
 451   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_BOUNDED; TENDSTO_REAL] THEN
 452   DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN
 453   REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV] THEN
 454   REWRITE_TAC[o_DEF; NORM_LIFT]);;
 455
 456 let REALLIM = prove
 457  (`(f ---> l) net <=>
 458         trivial_limit net \/
 459         !e. &0 < e ==> ?y. (?x. netord(net) x y) /\
 460                            !x. netord(net) x y ==> abs(f(x) -l) < e`,
 461   REWRITE_TAC[tendsto_real; eventually] THEN MESON_TAC[]);;
 462
 463 let REALLIM_NULL_ABS = prove
 464  (`!net f. ((\x. abs(f x)) ---> &0) net <=> (f ---> &0) net`,
 465   REWRITE_TAC[REALLIM; REAL_SUB_RZERO; REAL_ABS_ABS]);;
 466
 467 let REALLIM_WITHIN_LE = prove
 468  (`!f:real^N->real l a s.
 469         (f ---> l) (at a within s) <=>
 470            !e. &0 < e ==> ?d. &0 < d /\
 471                               !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) <= d
 472                                    ==> abs(f(x) - l) < e`,
 473   REWRITE_TAC[tendsto_real; EVENTUALLY_WITHIN_LE]);;
 474
 475 let REALLIM_WITHIN = prove
 476  (`!f:real^N->real l a s.
 477       (f ---> l) (at a within s) <=>
 478         !e. &0 < e
 479             ==> ?d. &0 < d /\
 480                     !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) < d
 481                     ==> abs(f(x) - l) < e`,
 482   REWRITE_TAC[tendsto_real; EVENTUALLY_WITHIN] THEN MESON_TAC[]);;
 483
 484 let REALLIM_AT = prove
 485  (`!f l a:real^N.
 486       (f ---> l) (at a) <=>
 487               !e. &0 < e
 488                   ==> ?d. &0 < d /\ !x. &0 < dist(x,a) /\ dist(x,a) < d
 489                           ==> abs(f(x) - l) < e`,
 490   REWRITE_TAC[tendsto_real; EVENTUALLY_AT] THEN MESON_TAC[]);;
 491
 492 let REALLIM_AT_INFINITY = prove
 493  (`!f l. (f ---> l) at_infinity <=>
 494                !e. &0 < e ==> ?b. !x. norm(x) >= b ==> abs(f(x) - l) < e`,
 495   REWRITE_TAC[tendsto_real; EVENTUALLY_AT_INFINITY] THEN MESON_TAC[]);;
 496
 497 let REALLIM_SEQUENTIALLY = prove
 498  (`!s l. (s ---> l) sequentially <=>
 499           !e. &0 < e ==> ?N. !n. N <= n ==> abs(s(n) - l) < e`,
 500   REWRITE_TAC[tendsto_real; EVENTUALLY_SEQUENTIALLY] THEN MESON_TAC[]);;
 501
 502 let REALLIM_EVENTUALLY = prove
 503  (`!net f l. eventually (\x. f x = l) net ==> (f ---> l) net`,
 504   REWRITE_TAC[eventually; REALLIM] THEN
 505   MESON_TAC[REAL_ARITH `abs(x - x) = &0`]);;
 506
 507 let LIM_COMPONENTWISE = prove
 508  (`!net f:A->real^N.
 509         (f --> l) net <=>
 510         !i. 1 <= i /\ i <= dimindex(:N) ==> ((\x. (f x)$i) ---> l$i) net`,
 511   ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT] THEN
 512   REWRITE_TAC[TENDSTO_REAL; o_DEF]);;
 513
 514 let REALLIM_UBOUND = prove
 515  (`!(net:A net) f l b.
 516         (f ---> l) net /\
 517         ~trivial_limit net /\
 518         eventually (\x. f x <= b) net
 519         ==> l <= b`,
 520   REWRITE_TAC[FORALL_DROP; TENDSTO_REAL; LIFT_DROP] THEN
 521   REPEAT STRIP_TAC THEN
 522   MATCH_MP_TAC(ISPEC `net:A net` LIM_DROP_UBOUND) THEN
 523   EXISTS_TAC `lift o (f:A->real)` THEN
 524   ASM_REWRITE_TAC[o_THM; LIFT_DROP]);;
 525
 526 let REALLIM_LBOUND = prove
 527  (`!(net:A net) f l b.
 528         (f ---> l) net /\
 529         ~trivial_limit net /\
 530         eventually (\x. b <= f x) net
 531         ==> b <= l`,
 532   ONCE_REWRITE_TAC[GSYM REAL_LE_NEG2] THEN
 533   REPEAT STRIP_TAC THEN
 534   MATCH_MP_TAC(ISPEC `net:A net` REALLIM_UBOUND) THEN
 535   EXISTS_TAC `\a:A. --(f a:real)` THEN
 536   ASM_REWRITE_TAC[REALLIM_NEG_EQ]);;
 537
 538 let REALLIM_LE = prove
 539  (`!net f g l m.
 540            (f ---> l) net /\ (g ---> m) net /\
 541            ~trivial_limit net /\
 542            eventually (\x. f x <= g x) net
 543            ==> l <= m`,
 544   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN
 545   DISCH_THEN(CONJUNCTS_THEN2
 546    (MP_TAC o MATCH_MP REALLIM_SUB o ONCE_REWRITE_RULE[CONJ_SYM]) MP_TAC) THEN
 547   ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN
 548   REWRITE_TAC[GSYM IMP_CONJ_ALT; GSYM CONJ_ASSOC] THEN
 549   DISCH_THEN(ACCEPT_TAC o MATCH_MP REALLIM_LBOUND));;
 550
 551 let REALLIM_CONST_EQ = prove
 552  (`!net:(A net) c d. ((\x. c) ---> d) net <=> trivial_limit net \/ c = d`,
 553   REWRITE_TAC[TENDSTO_REAL; LIM_CONST_EQ; o_DEF; LIFT_EQ]);;
 554
 555 let REALLIM_SUM = prove
 556  (`!f:A->B->real s.
 557         FINITE s /\ (!i. i IN s ==> ((f i) ---> (l i)) net)
 558         ==> ((\x. sum s (\i. f i x)) ---> sum s l) net`,
 559   GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
 560   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
 561   SIMP_TAC[SUM_CLAUSES; REALLIM_CONST; REALLIM_ADD; IN_INSERT; ETA_AX]);;
 562
 563 let REALLIM_NULL_COMPARISON = prove
 564  (`!net:(A)net f g.
 565         eventually (\x. abs(f x) <= g x) net /\ (g ---> &0) net
 566         ==> (f ---> &0) net`,
 567   REWRITE_TAC[TENDSTO_REAL; LIFT_NUM; o_DEF] THEN REPEAT STRIP_TAC THEN
 568   MATCH_MP_TAC LIM_NULL_COMPARISON THEN
 569   EXISTS_TAC `g:A->real` THEN ASM_REWRITE_TAC[NORM_LIFT]);;
 570
 571 (* ------------------------------------------------------------------------- *)
 572 (* Real series.                                                              *)
 573 (* ------------------------------------------------------------------------- *)
 574
 575 parse_as_infix("real_sums",(12,"right"));;
 576
 577 let real_sums = new_definition
 578  `(f real_sums l) s <=> ((\n. sum (s INTER (0..n)) f) ---> l) sequentially`;;
 579
 580 let real_infsum = new_definition
 581  `real_infsum s f = @l. (f real_sums l) s`;;
 582
 583 let real_summable = new_definition
 584  `real_summable s f = ?l. (f real_sums l) s`;;
 585
 586 let REAL_SUMS = prove
 587  (`(f real_sums l) = ((lift o f) sums (lift l))`,
 588   REWRITE_TAC[FUN_EQ_THM; sums; real_sums; TENDSTO_REAL] THEN
 589   SIMP_TAC[LIFT_SUM; FINITE_INTER_NUMSEG; o_DEF]);;
 590
 591 let REAL_SUMS_RE = prove
 592  (`!f l s. (f sums l) s ==> ((Re o f) real_sums (Re l)) s`,
 593   REPEAT GEN_TAC THEN REWRITE_TAC[real_sums; sums] THEN
 594   DISCH_THEN(MP_TAC o MATCH_MP REALLIM_RE) THEN
 595   SIMP_TAC[o_DEF; RE_VSUM; FINITE_INTER_NUMSEG]);;
 596
 597 let REAL_SUMS_IM = prove
 598  (`!f l s. (f sums l) s ==> ((Im o f) real_sums (Im l)) s`,
 599   REPEAT GEN_TAC THEN REWRITE_TAC[real_sums; sums] THEN
 600   DISCH_THEN(MP_TAC o MATCH_MP REALLIM_IM) THEN
 601   SIMP_TAC[o_DEF; IM_VSUM; FINITE_INTER_NUMSEG]);;
 602
 603 let REAL_SUMS_COMPLEX = prove
 604  (`!f l s. (f real_sums l) s <=> ((Cx o f) sums (Cx l)) s`,
 605   REWRITE_TAC[real_sums; sums; REALLIM_COMPLEX] THEN
 606   SIMP_TAC[o_DEF; VSUM_CX; FINITE_INTER; FINITE_NUMSEG]);;
 607
 608 let REAL_SUMMABLE = prove
 609  (`real_summable s f <=> summable s (lift o f)`,
 610   REWRITE_TAC[real_summable; summable; REAL_SUMS; GSYM EXISTS_LIFT]);;
 611
 612 let REAL_SUMMABLE_COMPLEX = prove
 613  (`real_summable s f <=> summable s (Cx o f)`,
 614   REWRITE_TAC[real_summable; summable; REAL_SUMS_COMPLEX] THEN
 615   EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
 616   DISCH_THEN(X_CHOOSE_TAC `l:complex`) THEN EXISTS_TAC `Re l` THEN
 617   SUBGOAL_THEN `Cx(Re l) = l` (fun th -> ASM_REWRITE_TAC[th]) THEN
 618   REWRITE_TAC[GSYM REAL] THEN MATCH_MP_TAC REAL_SERIES THEN
 619   MAP_EVERY EXISTS_TAC [`Cx o (f:num->real)`; `s:num->bool`] THEN
 620   ASM_REWRITE_TAC[o_THM; REAL_CX]);;
 621
 622 let REAL_SERIES_CAUCHY = prove
 623  (`(?l. (f real_sums l) s) <=>
 624    (!e. &0 < e ==> ?N. !m n. m >= N ==> abs(sum(s INTER (m..n)) f) < e)`,
 625   REWRITE_TAC[REAL_SUMS; SERIES_CAUCHY; GSYM EXISTS_LIFT] THEN
 626   SIMP_TAC[NORM_REAL; GSYM drop; DROP_VSUM; FINITE_INTER_NUMSEG] THEN
 627   REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]);;
 628
 629 let REAL_SUMS_SUMMABLE = prove
 630  (`!f l s. (f real_sums l) s ==> real_summable s f`,
 631   REWRITE_TAC[real_summable] THEN MESON_TAC[]);;
 632
 633 let REAL_SUMS_INFSUM = prove
 634  (`!f s. (f real_sums (real_infsum s f)) s <=> real_summable s f`,
 635   REWRITE_TAC[real_infsum; real_summable] THEN MESON_TAC[]);;
 636
 637 let REAL_INFSUM_COMPLEX = prove
 638  (`!f s. real_summable s f ==> real_infsum s f = Re(infsum s (Cx o f))`,
 639   REPEAT GEN_TAC THEN
 640   REWRITE_TAC[GSYM REAL_SUMS_INFSUM; REAL_SUMS_COMPLEX] THEN
 641   DISCH_THEN(MP_TAC o MATCH_MP INFSUM_UNIQUE) THEN
 642   MESON_TAC[RE_CX]);;
 643
 644 let REAL_SERIES_FROM = prove
 645  (`!f l k. (f real_sums l) (from k) = ((\n. sum(k..n) f) ---> l) sequentially`,
 646   REPEAT GEN_TAC THEN REWRITE_TAC[real_sums] THEN
 647   AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
 648   AP_THM_TAC THEN AP_TERM_TAC THEN
 649   REWRITE_TAC[EXTENSION; numseg; from; IN_ELIM_THM; IN_INTER] THEN ARITH_TAC);;
 650
 651 let REAL_SERIES_UNIQUE = prove
 652  (`!f l l' s. (f real_sums l) s /\ (f real_sums l') s ==> l = l'`,
 653   REWRITE_TAC[real_sums] THEN
 654   MESON_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; REALLIM_UNIQUE]);;
 655
 656 let REAL_INFSUM_UNIQUE = prove
 657  (`!f l s. (f real_sums l) s ==> real_infsum s f = l`,
 658   MESON_TAC[REAL_SERIES_UNIQUE; REAL_SUMS_INFSUM; real_summable]);;
 659
 660 let REAL_SERIES_FINITE = prove
 661  (`!f s. FINITE s ==> (f real_sums (sum s f)) s`,
 662   REPEAT GEN_TAC THEN REWRITE_TAC[num_FINITE; LEFT_IMP_EXISTS_THM] THEN
 663   X_GEN_TAC `n:num` THEN REWRITE_TAC[real_sums; REALLIM_SEQUENTIALLY] THEN
 664   DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `n:num` THEN
 665   X_GEN_TAC `m:num` THEN DISCH_TAC THEN
 666   SUBGOAL_THEN `s INTER (0..m) = s`
 667    (fun th -> ASM_REWRITE_TAC[th; REAL_SUB_REFL; REAL_ABS_NUM]) THEN
 668   REWRITE_TAC[EXTENSION; IN_INTER; IN_NUMSEG; LE_0] THEN
 669   ASM_MESON_TAC[LE_TRANS]);;
 670
 671 let REAL_SUMMABLE_IFF_EVENTUALLY = prove
 672  (`!f g k. (?N. !n. N <= n /\ n IN k ==> f n = g n)
 673            ==> (real_summable k f <=> real_summable k g)`,
 674   REWRITE_TAC[REAL_SUMMABLE] THEN REPEAT STRIP_TAC THEN
 675   MATCH_MP_TAC SUMMABLE_IFF_EVENTUALLY THEN REWRITE_TAC[o_THM] THEN
 676   ASM_MESON_TAC[]);;
 677
 678 let REAL_SUMMABLE_EQ_EVENTUALLY = prove
 679  (`!f g k. (?N. !n. N <= n /\ n IN k ==> f n = g n) /\ real_summable k f
 680            ==> real_summable k g`,
 681   MESON_TAC[REAL_SUMMABLE_IFF_EVENTUALLY]);;
 682
 683 let REAL_SUMMABLE_IFF_COFINITE = prove
 684  (`!f s t. FINITE((s DIFF t) UNION (t DIFF s))
 685            ==> (real_summable s f <=> real_summable t f)`,
 686   SIMP_TAC[REAL_SUMMABLE] THEN MESON_TAC[SUMMABLE_IFF_COFINITE]);;
 687
 688 let REAL_SUMMABLE_EQ_COFINITE = prove
 689  (`!f s t. FINITE((s DIFF t) UNION (t DIFF s)) /\ real_summable s f
 690            ==> real_summable t f`,
 691   MESON_TAC[REAL_SUMMABLE_IFF_COFINITE]);;
 692
 693 let REAL_SUMMABLE_FROM_ELSEWHERE = prove
 694  (`!f m n. real_summable (from m) f ==> real_summable (from n) f`,
 695   REPEAT GEN_TAC THEN
 696   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_SUMMABLE_EQ_COFINITE) THEN
 697   MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..(m+n)` THEN
 698   SIMP_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; IN_UNION; IN_DIFF; IN_FROM] THEN
 699   ARITH_TAC);;
 700
 701 let REAL_SERIES_GOESTOZERO = prove
 702  (`!s x. real_summable s x
 703          ==> !e. &0 < e
 704                  ==> eventually (\n. n IN s ==> abs(x n) < e) sequentially`,
 705   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_SUMMABLE] THEN
 706   DISCH_THEN(MP_TAC o MATCH_MP SERIES_GOESTOZERO) THEN
 707   REWRITE_TAC[o_THM; NORM_LIFT]);;
 708
 709 let REAL_SUMMABLE_IMP_TOZERO = prove
 710  (`!f:num->real k.
 711        real_summable k f
 712        ==> ((\n. if n IN k then f(n) else &0) ---> &0) sequentially`,
 713   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_SUMMABLE] THEN
 714   DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_IMP_TOZERO) THEN
 715   REWRITE_TAC[TENDSTO_REAL] THEN
 716   REWRITE_TAC[o_DEF; GSYM LIFT_NUM; GSYM COND_RAND]);;
 717
 718 let REAL_SUMMABLE_IMP_BOUNDED = prove
 719  (`!f:num->real k. real_summable k f ==> real_bounded (IMAGE f k)`,
 720   REWRITE_TAC[REAL_BOUNDED; REAL_SUMMABLE; GSYM IMAGE_o;
 721               SUMMABLE_IMP_BOUNDED]);;
 722
 723 let REAL_SUMMABLE_IMP_REAL_SUMS_BOUNDED = prove
 724  (`!f:num->real k.
 725        real_summable (from k) f ==> real_bounded { sum(k..n) f | n IN (:num) }`,
 726   REWRITE_TAC[real_summable; real_sums; LEFT_IMP_EXISTS_THM] THEN
 727   REPEAT GEN_TAC THEN
 728   DISCH_THEN(MP_TAC o MATCH_MP REAL_CONVERGENT_IMP_BOUNDED) THEN
 729   REWRITE_TAC[FROM_INTER_NUMSEG; SIMPLE_IMAGE]);;
 730
 731 let REAL_SERIES_0 = prove
 732  (`!s. ((\n. &0) real_sums (&0)) s`,
 733   REWRITE_TAC[real_sums; SUM_0; REALLIM_CONST]);;
 734
 735 let REAL_SERIES_ADD = prove
 736  (`!x x0 y y0 s.
 737      (x real_sums x0) s /\ (y real_sums y0) s
 738      ==> ((\n. x n + y n) real_sums (x0 + y0)) s`,
 739   SIMP_TAC[real_sums; FINITE_INTER_NUMSEG; SUM_ADD; REALLIM_ADD]);;
 740
 741 let REAL_SERIES_SUB = prove
 742  (`!x x0 y y0 s.
 743      (x real_sums x0) s /\ (y real_sums y0) s
 744      ==> ((\n. x n - y n) real_sums (x0 - y0)) s`,
 745   SIMP_TAC[real_sums; FINITE_INTER_NUMSEG; SUM_SUB; REALLIM_SUB]);;
 746
 747 let REAL_SERIES_LMUL = prove
 748  (`!x x0 c s. (x real_sums x0) s ==> ((\n. c * x n) real_sums (c * x0)) s`,
 749   SIMP_TAC[real_sums; FINITE_INTER_NUMSEG; SUM_LMUL; REALLIM_LMUL]);;
 750
 751 let REAL_SERIES_RMUL = prove
 752  (`!x x0 c s. (x real_sums x0) s ==> ((\n. x n * c) real_sums (x0 * c)) s`,
 753   SIMP_TAC[real_sums; FINITE_INTER_NUMSEG; SUM_RMUL; REALLIM_RMUL]);;
 754
 755 let REAL_SERIES_NEG = prove
 756  (`!x x0 s. (x real_sums x0) s ==> ((\n. --(x n)) real_sums (--x0)) s`,
 757   SIMP_TAC[real_sums; FINITE_INTER_NUMSEG; SUM_NEG; REALLIM_NEG]);;
 758
 759 let REAL_SUMS_IFF = prove
 760  (`!f g k. (!x. x IN k ==> f x = g x)
 761            ==> ((f real_sums l) k <=> (g real_sums l) k)`,
 762   REPEAT STRIP_TAC THEN REWRITE_TAC[real_sums] THEN
 763   AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
 764   MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[IN_INTER]);;
 765
 766 let REAL_SUMS_EQ = prove
 767  (`!f g k. (!x. x IN k ==> f x = g x) /\ (f real_sums l) k
 768            ==> (g real_sums l) k`,
 769   MESON_TAC[REAL_SUMS_IFF]);;
 770
 771 let REAL_SERIES_FINITE_SUPPORT = prove
 772  (`!f s k.
 773      FINITE (s INTER k) /\ (!x. ~(x IN s INTER k) ==> f x = &0)
 774      ==> (f real_sums sum(s INTER k) f) k`,
 775   REWRITE_TAC[real_sums; REALLIM_SEQUENTIALLY] THEN REPEAT STRIP_TAC THEN
 776   FIRST_ASSUM(MP_TAC o ISPEC `\x:num. x` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN
 777   REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
 778   STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
 779   SUBGOAL_THEN `sum (k INTER (0..n)) (f:num->real) = sum(s INTER k) f`
 780    (fun th -> ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM; th]) THEN
 781   MATCH_MP_TAC SUM_SUPERSET THEN
 782   ASM_SIMP_TAC[SUBSET; IN_INTER; IN_NUMSEG; LE_0] THEN
 783   ASM_MESON_TAC[IN_INTER; LE_TRANS]);;
 784
 785 let REAL_SERIES_DIFFS = prove
 786  (`!f k. (f ---> &0) sequentially
 787          ==> ((\n. f(n) - f(n + 1)) real_sums f(k)) (from k)`,
 788   REWRITE_TAC[real_sums; FROM_INTER_NUMSEG; SUM_DIFFS] THEN
 789   REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN
 790   EXISTS_TAC `\n. (f:num->real) k - f(n + 1)` THEN CONJ_TAC THENL
 791    [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `k:num` THEN
 792     SIMP_TAC[];
 793     GEN_REWRITE_TAC LAND_CONV [GSYM REAL_SUB_RZERO] THEN
 794     MATCH_MP_TAC REALLIM_SUB THEN REWRITE_TAC[REALLIM_CONST] THEN
 795     MATCH_MP_TAC REAL_SEQ_OFFSET THEN ASM_REWRITE_TAC[]]);;
 796
 797 let REAL_SERIES_TRIVIAL = prove
 798  (`!f. (f real_sums &0) {}`,
 799   REWRITE_TAC[real_sums; INTER_EMPTY; SUM_CLAUSES; REALLIM_CONST]);;
 800
 801 let REAL_SERIES_RESTRICT = prove
 802  (`!f k l:real.
 803         ((\n. if n IN k then f(n) else &0) real_sums l) (:num) <=>
 804         (f real_sums l) k`,
 805   REPEAT GEN_TAC THEN REWRITE_TAC[real_sums] THEN
 806   AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
 807   REWRITE_TAC[FUN_EQ_THM; INTER_UNIV] THEN GEN_TAC THEN
 808   MATCH_MP_TAC(MESON[] `sum s f = sum t f /\ sum t f = sum t g
 809                         ==> sum s f = sum t g`) THEN
 810   CONJ_TAC THENL
 811    [MATCH_MP_TAC SUM_SUPERSET THEN SET_TAC[];
 812     MATCH_MP_TAC SUM_EQ THEN SIMP_TAC[IN_INTER]]);;
 813
 814 let REAL_SERIES_SUM = prove
 815  (`!f l k s. FINITE s /\ s SUBSET k /\ (!x. ~(x IN s) ==> f x = &0) /\
 816              sum s f = l ==> (f real_sums l) k`,
 817   REPEAT STRIP_TAC THEN EXPAND_TAC "l" THEN
 818   SUBGOAL_THEN `s INTER k = s:num->bool` ASSUME_TAC THENL
 819    [ASM SET_TAC[]; ASM_MESON_TAC [REAL_SERIES_FINITE_SUPPORT]]);;
 820
 821 let REAL_SUMS_LE2 = prove
 822  (`!f g s y z.
 823         (f real_sums y) s /\ (g real_sums z) s /\
 824         (!i. i IN s ==> f(i) <= g(i))
 825         ==> y <= z`,
 826   REPEAT GEN_TAC THEN REWRITE_TAC[real_sums] THEN
 827   ONCE_REWRITE_TAC[CONJ_ASSOC] THEN
 828   DISCH_THEN(CONJUNCTS_THEN2
 829    (MATCH_MP_TAC o MATCH_MP
 830      (ONCE_REWRITE_RULE[IMP_CONJ]
 831        (ONCE_REWRITE_RULE[CONJ_ASSOC] REALLIM_LE)))
 832    ASSUME_TAC) THEN
 833   ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN
 834   ASM_SIMP_TAC[SUM_LE; FINITE_INTER; IN_INTER; FINITE_NUMSEG] THEN
 835   REWRITE_TAC[EVENTUALLY_TRUE]);;
 836
 837 let REAL_SUMS_REINDEX = prove
 838  (`!k a l n.
 839      ((\x. a(x + k)) real_sums l) (from n) <=> (a real_sums l) (from(n + k))`,
 840   REPEAT GEN_TAC THEN REWRITE_TAC[real_sums; FROM_INTER_NUMSEG] THEN
 841   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUM_OFFSET] THEN
 842   REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN
 843   ASM_MESON_TAC[ARITH_RULE `N + k:num <= n ==> n = (n - k) + k /\ N <= n - k`;
 844                 ARITH_RULE `N + k:num <= n ==> N <= n + k`]);;
 845
 846 let REAL_INFSUM = prove
 847  (`!f s. real_summable s f ==> real_infsum s f = drop(infsum s (lift o f))`,
 848   REPEAT GEN_TAC THEN
 849   REWRITE_TAC[GSYM REAL_SUMS_INFSUM; REAL_SUMS] THEN
 850   DISCH_THEN(MP_TAC o MATCH_MP INFSUM_UNIQUE) THEN
 851   MESON_TAC[LIFT_DROP]);;
 852
 853 let REAL_PARTIAL_SUMS_LE_INFSUM = prove
 854  (`!f s n.
 855         (!i. i IN s ==> &0 <= f i) /\ real_summable s f
 856         ==> sum (s INTER (0..n)) f <= real_infsum s f`,
 857   REPEAT GEN_TAC THEN SIMP_TAC[REAL_INFSUM] THEN
 858   REWRITE_TAC[REAL_SUMMABLE] THEN
 859   GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o BINDER_CONV o RAND_CONV o RAND_CONV)
 860    [GSYM LIFT_DROP] THEN
 861   REWRITE_TAC[o_DEF] THEN DISCH_THEN(MP_TAC o MATCH_MP
 862     PARTIAL_SUMS_DROP_LE_INFSUM) THEN
 863   SIMP_TAC[DROP_VSUM; FINITE_INTER; FINITE_NUMSEG; o_DEF; LIFT_DROP; ETA_AX]);;
 864
 865 (* ------------------------------------------------------------------------- *)
 866 (* Similar combining theorems just for summability.                          *)
 867 (* ------------------------------------------------------------------------- *)
 868
 869 let REAL_SUMMABLE_0 = prove
 870  (`!s. real_summable s (\n. &0)`,
 871   REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SERIES_0]);;
 872
 873 let REAL_SUMMABLE_ADD = prove
 874  (`!x y s. real_summable s x /\ real_summable s y
 875            ==> real_summable s (\n. x n + y n)`,
 876   REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SERIES_ADD]);;
 877
 878 let REAL_SUMMABLE_SUB = prove
 879  (`!x y s. real_summable s x /\ real_summable s y
 880            ==> real_summable s (\n. x n - y n)`,
 881   REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SERIES_SUB]);;
 882
 883 let REAL_SUMMABLE_LMUL = prove
 884  (`!s x c. real_summable s x ==> real_summable s (\n. c * x n)`,
 885   REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SERIES_LMUL]);;
 886
 887 let REAL_SUMMABLE_RMUL = prove
 888  (`!s x c. real_summable s x ==> real_summable s (\n. x n * c)`,
 889   REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SERIES_RMUL]);;
 890
 891 let REAL_SUMMABLE_NEG = prove
 892  (`!x s. real_summable s x ==> real_summable s (\n. --(x n))`,
 893   REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SERIES_NEG]);;
 894
 895 let REAL_SUMMABLE_IFF = prove
 896  (`!f g k. (!x. x IN k ==> f x = g x)
 897            ==> (real_summable k f <=> real_summable k g)`,
 898   REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SUMS_IFF]);;
 899
 900 let REAL_SUMMABLE_EQ = prove
 901  (`!f g k. (!x. x IN k ==> f x = g x) /\ real_summable k f
 902            ==> real_summable k g`,
 903   REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SUMS_EQ]);;
 904
 905 let REAL_SERIES_SUBSET = prove
 906  (`!x s t l.
 907         s SUBSET t /\
 908         ((\i. if i IN s then x i else &0) real_sums l) t
 909         ==> (x real_sums l) s`,
 910   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
 911   REWRITE_TAC[real_sums] THEN MATCH_MP_TAC EQ_IMP THEN
 912   AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
 913   ASM_SIMP_TAC[GSYM SUM_RESTRICT_SET; FINITE_INTER_NUMSEG] THEN
 914   AP_THM_TAC THEN AP_TERM_TAC THEN POP_ASSUM MP_TAC THEN SET_TAC[]);;
 915
 916 let REAL_SUMMABLE_SUBSET = prove
 917  (`!x s t.
 918         s SUBSET t /\
 919         real_summable t (\i. if i IN s then x i else &0)
 920         ==> real_summable s x`,
 921   REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SERIES_SUBSET]);;
 922
 923 let REAL_SUMMABLE_TRIVIAL = prove
 924  (`!f. real_summable {} f`,
 925   GEN_TAC THEN REWRITE_TAC[real_summable] THEN EXISTS_TAC `&0` THEN
 926   REWRITE_TAC[REAL_SERIES_TRIVIAL]);;
 927
 928 let REAL_SUMMABLE_RESTRICT = prove
 929  (`!f k.
 930         real_summable (:num) (\n. if n IN k then f(n) else &0) <=>
 931         real_summable k f`,
 932   REWRITE_TAC[real_summable; REAL_SERIES_RESTRICT]);;
 933
 934 let REAL_SUMS_FINITE_DIFF = prove
 935  (`!f t s l.
 936         t SUBSET s /\ FINITE t /\ (f real_sums l) s
 937         ==> (f real_sums (l - sum t f)) (s DIFF t)`,
 938   REPEAT GEN_TAC THEN
 939   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
 940   FIRST_ASSUM(MP_TAC o ISPEC `f:num->real` o MATCH_MP REAL_SERIES_FINITE) THEN
 941   ONCE_REWRITE_TAC[GSYM REAL_SERIES_RESTRICT] THEN
 942   REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
 943   DISCH_THEN(MP_TAC o MATCH_MP REAL_SERIES_SUB) THEN
 944   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
 945   REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:num` THEN REWRITE_TAC[IN_DIFF] THEN
 946   FIRST_ASSUM(MP_TAC o SPEC `x:num` o GEN_REWRITE_RULE I [SUBSET]) THEN
 947   MAP_EVERY ASM_CASES_TAC [`(x:num) IN s`; `(x:num) IN t`] THEN
 948   ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);;
 949
 950 let REAL_SUMS_FINITE_UNION = prove
 951  (`!f s t l.
 952         FINITE t /\ (f real_sums l) s
 953         ==> (f real_sums (l + sum (t DIFF s) f)) (s UNION t)`,
 954   REPEAT GEN_TAC THEN
 955   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
 956   FIRST_ASSUM(MP_TAC o SPEC `s:num->bool` o MATCH_MP FINITE_DIFF) THEN
 957   DISCH_THEN(MP_TAC o ISPEC `f:num->real` o MATCH_MP REAL_SERIES_FINITE) THEN
 958   ONCE_REWRITE_TAC[GSYM REAL_SERIES_RESTRICT] THEN
 959   REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
 960   DISCH_THEN(MP_TAC o MATCH_MP REAL_SERIES_ADD) THEN
 961   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
 962   REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:num` THEN
 963   REWRITE_TAC[IN_DIFF; IN_UNION] THEN
 964   MAP_EVERY ASM_CASES_TAC [`(x:num) IN s`; `(x:num) IN t`] THEN
 965   ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);;
 966
 967 let REAL_SUMS_OFFSET = prove
 968  (`!f l m n.
 969         (f real_sums l) (from m) /\ m < n
 970         ==> (f real_sums (l - sum(m..(n-1)) f)) (from n)`,
 971   REPEAT STRIP_TAC THEN
 972   SUBGOAL_THEN `from n = from m DIFF (m..(n-1))` SUBST1_TAC THENL
 973    [REWRITE_TAC[EXTENSION; IN_FROM; IN_DIFF; IN_NUMSEG] THEN ASM_ARITH_TAC;
 974     MATCH_MP_TAC REAL_SUMS_FINITE_DIFF THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN
 975     SIMP_TAC[SUBSET; IN_FROM; IN_NUMSEG]]);;
 976
 977 let REAL_SUMS_OFFSET_REV = prove
 978  (`!f l m n.
 979         (f real_sums l) (from m) /\ n < m
 980         ==> (f real_sums (l + sum(n..m-1) f)) (from n)`,
 981   REPEAT STRIP_TAC THEN
 982   MP_TAC(ISPECL [`f:num->real`; `from m`; `n..m-1`; `l:real`]
 983                 REAL_SUMS_FINITE_UNION) THEN
 984   ASM_REWRITE_TAC[FINITE_NUMSEG] THEN MATCH_MP_TAC EQ_IMP THEN
 985   BINOP_TAC THENL [AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC; ALL_TAC] THEN
 986   REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNION; IN_FROM; IN_NUMSEG] THEN
 987   ASM_ARITH_TAC);;
 988
 989 (* ------------------------------------------------------------------------- *)
 990 (* Similar combining theorems for infsum.                                    *)
 991 (* ------------------------------------------------------------------------- *)
 992
 993 let REAL_INFSUM_0 = prove
 994  (`real_infsum s (\i. &0) = &0`,
 995   MATCH_MP_TAC REAL_INFSUM_UNIQUE THEN REWRITE_TAC[REAL_SERIES_0]);;
 996
 997 let REAL_INFSUM_ADD = prove
 998  (`!x y s. real_summable s x /\ real_summable s y
 999            ==> real_infsum s (\i. x i + y i) =
1000                real_infsum s x + real_infsum s y`,
1001   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INFSUM_UNIQUE THEN
1002   MATCH_MP_TAC REAL_SERIES_ADD THEN ASM_REWRITE_TAC[REAL_SUMS_INFSUM]);;
1003
1004 let REAL_INFSUM_SUB = prove
1005  (`!x y s. real_summable s x /\ real_summable s y
1006            ==> real_infsum s (\i. x i - y i) =
1007                real_infsum s x - real_infsum s y`,
1008   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INFSUM_UNIQUE THEN
1009   MATCH_MP_TAC REAL_SERIES_SUB THEN ASM_REWRITE_TAC[REAL_SUMS_INFSUM]);;
1010
1011 let REAL_INFSUM_LMUL = prove
1012  (`!s x c. real_summable s x
1013            ==> real_infsum s (\n. c * x n) = c * real_infsum s x`,
1014   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INFSUM_UNIQUE THEN
1015   MATCH_MP_TAC REAL_SERIES_LMUL THEN ASM_REWRITE_TAC[REAL_SUMS_INFSUM]);;
1016
1017 let REAL_INFSUM_RMUL = prove
1018  (`!s x c. real_summable s x
1019            ==> real_infsum s (\n. x n * c) = real_infsum s x * c`,
1020   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INFSUM_UNIQUE THEN
1021   MATCH_MP_TAC REAL_SERIES_RMUL THEN ASM_REWRITE_TAC[REAL_SUMS_INFSUM]);;
1022
1023 let REAL_INFSUM_NEG = prove
1024  (`!s x. real_summable s x
1025          ==> real_infsum s (\n. --(x n)) = --(real_infsum s x)`,
1026   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INFSUM_UNIQUE THEN
1027   MATCH_MP_TAC REAL_SERIES_NEG THEN ASM_REWRITE_TAC[REAL_SUMS_INFSUM]);;
1028
1029 let REAL_INFSUM_EQ = prove
1030  (`!f g k. real_summable k f /\ real_summable k g /\
1031            (!x. x IN k ==> f x = g x)
1032            ==> real_infsum k f = real_infsum k g`,
1033   REPEAT STRIP_TAC THEN REWRITE_TAC[real_infsum] THEN AP_TERM_TAC THEN
1034   ABS_TAC THEN ASM_MESON_TAC[REAL_SUMS_EQ; REAL_SUMS_INFSUM]);;
1035
1036 let REAL_INFSUM_RESTRICT = prove
1037  (`!k a. real_infsum (:num) (\n. if n IN k then a n else &0) =
1038          real_infsum k a`,
1039   REPEAT GEN_TAC THEN
1040   MP_TAC(ISPECL [`a:num->real`; `k:num->bool`] REAL_SUMMABLE_RESTRICT) THEN
1041   ASM_CASES_TAC `real_summable k a` THEN ASM_REWRITE_TAC[] THEN
1042   STRIP_TAC THENL
1043    [MATCH_MP_TAC REAL_INFSUM_UNIQUE THEN
1044     ASM_REWRITE_TAC[REAL_SERIES_RESTRICT; REAL_SUMS_INFSUM];
1045     RULE_ASSUM_TAC(REWRITE_RULE[real_summable; NOT_EXISTS_THM]) THEN
1046     ASM_REWRITE_TAC[real_infsum]]);;
1047
1048 (* ------------------------------------------------------------------------- *)
1049 (* Convergence tests for real series.                                        *)
1050 (* ------------------------------------------------------------------------- *)
1051
1052 let REAL_SERIES_CAUCHY_UNIFORM = prove
1053  (`!P:A->bool f k.
1054         (?l. !e. &0 < e
1055                  ==> ?N. !n x. N <= n /\ P x
1056                                ==> abs(sum(k INTER (0..n)) (f x) -
1057                                         l x) < e) <=>
1058         (!e. &0 < e ==> ?N. !m n x. N <= m /\ P x
1059                                     ==> abs(sum(k INTER (m..n)) (f x)) < e)`,
1060   REPEAT STRIP_TAC THEN
1061   MP_TAC(ISPECL [`P:A->bool`; `\x:A n:num. lift(f x n)`; `k:num->bool`]
1062         SERIES_CAUCHY_UNIFORM) THEN
1063   SIMP_TAC[VSUM_REAL; FINITE_INTER; FINITE_NUMSEG] THEN
1064   REWRITE_TAC[NORM_LIFT; o_DEF; LIFT_DROP; ETA_AX] THEN
1065   DISCH_THEN(SUBST1_TAC o SYM) THEN EQ_TAC THENL
1066    [DISCH_THEN(X_CHOOSE_TAC `l:A->real`) THEN
1067     EXISTS_TAC `lift o (l:A->real)` THEN
1068     ASM_SIMP_TAC[o_THM; DIST_LIFT];
1069     DISCH_THEN(X_CHOOSE_TAC `l:A->real^1`) THEN
1070     EXISTS_TAC `drop o (l:A->real^1)` THEN
1071     ASM_SIMP_TAC[SUM_VSUM; FINITE_INTER; FINITE_NUMSEG] THEN
1072     REWRITE_TAC[o_THM; GSYM DROP_SUB; GSYM ABS_DROP] THEN
1073     SIMP_TAC[GSYM dist; VSUM_REAL; FINITE_INTER; FINITE_NUMSEG] THEN
1074     ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]]);;
1075
1076 let REAL_SERIES_COMPARISON = prove
1077  (`!f g s. (?l. (g real_sums l) s) /\
1078            (?N. !n. n >= N /\ n IN s ==> abs(f n) <= g n)
1079            ==> ?l. (f real_sums l) s`,
1080   REWRITE_TAC[REAL_SUMS; GSYM EXISTS_LIFT] THEN
1081   REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_COMPARISON THEN
1082   EXISTS_TAC `g:num->real` THEN
1083   REWRITE_TAC[NORM_LIFT; o_THM] THEN ASM_MESON_TAC[]);;
1084
1085 let REAL_SUMMABLE_COMPARISON = prove
1086  (`!f g s. real_summable s g /\
1087            (?N. !n. n >= N /\ n IN s ==> abs(f n) <= g n)
1088            ==> real_summable s f`,
1089   REWRITE_TAC[real_summable; REAL_SERIES_COMPARISON]);;
1090
1091 let REAL_SERIES_COMPARISON_UNIFORM = prove
1092  (`!f g P s. (?l. (g real_sums l) s) /\
1093              (?N. !n x. N <= n /\ n IN s /\ P x ==> abs(f x n) <= g n)
1094              ==> ?l:A->real.
1095                     !e. &0 < e
1096                         ==> ?N. !n x. N <= n /\ P x
1097                                       ==> abs(sum(s INTER (0..n)) (f x) -
1098                                                l x) < e`,
1099   REPEAT GEN_TAC THEN
1100   SIMP_TAC[GE; REAL_SERIES_CAUCHY; REAL_SERIES_CAUCHY_UNIFORM] THEN
1101   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC `N1:num`)) THEN
1102   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
1103   MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN
1104   DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN
1105   EXISTS_TAC `N1 + N2:num` THEN
1106   MAP_EVERY X_GEN_TAC [`m:num`; `n:num`; `x:A`] THEN DISCH_TAC THEN
1107   MATCH_MP_TAC REAL_LET_TRANS THEN
1108   EXISTS_TAC `abs (sum (s INTER (m .. n)) g)` THEN CONJ_TAC THENL
1109    [SIMP_TAC[GSYM LIFT_SUM; FINITE_INTER_NUMSEG; NORM_LIFT] THEN
1110     MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs(a)`) THEN
1111     MATCH_MP_TAC SUM_ABS_LE THEN
1112     REWRITE_TAC[FINITE_INTER_NUMSEG; IN_INTER; IN_NUMSEG] THEN
1113     ASM_MESON_TAC[ARITH_RULE `N1 + N2:num <= m /\ m <= x ==> N1 <= x`];
1114     ASM_MESON_TAC[ARITH_RULE `N1 + N2:num <= m ==> N2 <= m`]]);;
1115
1116 let REAL_SERIES_RATIO = prove
1117  (`!c a s N.
1118       c < &1 /\
1119       (!n. n >= N ==> abs(a(SUC n)) <= c * abs(a(n)))
1120       ==> ?l:real. (a real_sums l) s`,
1121   REWRITE_TAC[REAL_SUMS; GSYM EXISTS_LIFT] THEN
1122   REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_RATIO THEN
1123   REWRITE_TAC[o_THM; NORM_LIFT] THEN ASM_MESON_TAC[]);;
1124
1125 let BOUNDED_PARTIAL_REAL_SUMS = prove
1126  (`!f:num->real k.
1127         real_bounded { sum(k..n) f | n IN (:num) }
1128         ==> real_bounded { sum(m..n) f | m IN (:num) /\ n IN (:num) }`,
1129   REWRITE_TAC[REAL_BOUNDED] THEN
1130   REWRITE_TAC[SET_RULE `IMAGE f {g x | P x} = {f(g x) | P x}`;
1131     SET_RULE `IMAGE f {g x y | P x /\ Q y} = {f(g x y) | P x /\ Q y}`] THEN
1132   SIMP_TAC[LIFT_SUM; FINITE_INTER; FINITE_NUMSEG] THEN
1133   REWRITE_TAC[BOUNDED_PARTIAL_SUMS]);;
1134
1135 let REAL_SERIES_DIRICHLET = prove
1136  (`!f:num->real g N k m.
1137         real_bounded { sum (m..n) f | n IN (:num)} /\
1138         (!n. N <= n ==> g(n + 1) <= g(n)) /\
1139         (g ---> &0) sequentially
1140         ==> real_summable (from k) (\n. g(n) * f(n))`,
1141   REWRITE_TAC[REAL_SUMMABLE; REAL_BOUNDED; TENDSTO_REAL] THEN
1142   REWRITE_TAC[LIFT_NUM; LIFT_CMUL; o_DEF] THEN
1143   REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_DIRICHLET THEN
1144   MAP_EVERY EXISTS_TAC [`N:num`; `m:num`] THEN
1145   ASM_REWRITE_TAC[o_DEF] THEN
1146   SIMP_TAC[VSUM_REAL; FINITE_INTER; FINITE_NUMSEG] THEN
1147   ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN
1148   ASM_REWRITE_TAC[SET_RULE `{lift(f x) | P x} = IMAGE lift {f x | P x}`]);;
1149
1150 let REAL_SERIES_ABSCONV_IMP_CONV = prove
1151  (`!x:num->real k. real_summable k (\n. abs(x n)) ==> real_summable k x`,
1152   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_SUMMABLE_COMPARISON THEN
1153   EXISTS_TAC `\n:num. abs(x n)` THEN ASM_REWRITE_TAC[REAL_LE_REFL]);;
1154
1155 let REAL_SUMS_GP = prove
1156  (`!n x. abs(x) < &1
1157          ==> ((\k. x pow k) real_sums (x pow n / (&1 - x))) (from n)`,
1158   REPEAT STRIP_TAC THEN MP_TAC(SPECL [`n:num`; `Cx x`] SUMS_GP) THEN
1159   ASM_REWRITE_TAC[REAL_SUMS_COMPLEX; GSYM CX_SUB; GSYM CX_POW; GSYM CX_DIV;
1160                   o_DEF; COMPLEX_NORM_CX]);;
1161
1162 let REAL_SUMMABLE_GP = prove
1163  (`!x k. abs(x) < &1 ==> real_summable k (\n. x pow n)`,
1164   REPEAT STRIP_TAC THEN MP_TAC(SPECL [`Cx x`; `k:num->bool`] SUMMABLE_GP) THEN
1165   ASM_REWRITE_TAC[REAL_SUMMABLE_COMPLEX] THEN
1166   ASM_REWRITE_TAC[COMPLEX_NORM_CX; o_DEF; CX_POW]);;
1167
1168 let REAL_ABEL_LEMMA = prove
1169  (`!a M r r0.
1170         &0 <= r /\ r < r0 /\
1171         (!n. n IN k ==> abs(a n) * r0 pow n <= M)
1172         ==> real_summable k (\n. abs(a(n)) * r pow n)`,
1173   REWRITE_TAC[REAL_SUMMABLE_COMPLEX] THEN
1174   REWRITE_TAC[o_DEF; CX_MUL; CX_ABS] THEN REWRITE_TAC[GSYM CX_MUL] THEN
1175   REPEAT STRIP_TAC THEN MATCH_MP_TAC ABEL_LEMMA THEN
1176   REWRITE_TAC[COMPLEX_NORM_CX] THEN ASM_MESON_TAC[]);;
1177
1178 let REAL_POWER_SERIES_CONV_IMP_ABSCONV = prove
1179  (`!a k w z.
1180         real_summable k (\n. a(n) * z pow n) /\ abs(w) < abs(z)
1181         ==> real_summable k (\n. abs(a(n) * w pow n))`,
1182   REWRITE_TAC[REAL_SUMMABLE_COMPLEX; o_DEF; CX_MUL; CX_ABS; CX_POW] THEN
1183   REPEAT STRIP_TAC THEN MATCH_MP_TAC POWER_SERIES_CONV_IMP_ABSCONV THEN
1184   EXISTS_TAC `Cx z` THEN ASM_REWRITE_TAC[COMPLEX_NORM_CX]);;
1185
1186 let POWER_REAL_SERIES_CONV_IMP_ABSCONV_WEAK = prove
1187  (`!a k w z.
1188         real_summable k (\n. a(n) * z pow n) /\ abs(w) < abs(z)
1189         ==> real_summable k (\n. abs(a n) * w pow n)`,
1190   REWRITE_TAC[REAL_SUMMABLE_COMPLEX; o_DEF; CX_MUL; CX_ABS; CX_POW] THEN
1191   REPEAT STRIP_TAC THEN MATCH_MP_TAC POWER_SERIES_CONV_IMP_ABSCONV_WEAK THEN
1192   EXISTS_TAC `Cx z` THEN ASM_REWRITE_TAC[COMPLEX_NORM_CX]);;
1193
1194 (* ------------------------------------------------------------------------- *)
1195 (* Some real limits involving transcendentals.                               *)
1196 (* ------------------------------------------------------------------------- *)
1197
1198 let REALLIM_1_OVER_N = prove
1199  (`((\n. inv(&n)) ---> &0) sequentially`,
1200   REWRITE_TAC[REALLIM_COMPLEX; o_DEF; CX_INV; LIM_INV_N]);;
1201
1202 let REALLIM_LOG_OVER_N = prove
1203  (`((\n. log(&n) / &n) ---> &0) sequentially`,
1204   REWRITE_TAC[REALLIM_COMPLEX] THEN MP_TAC LIM_LOG_OVER_N THEN
1205   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN
1206   REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN
1207   SIMP_TAC[o_DEF; CX_DIV; CX_LOG; REAL_OF_NUM_LT;
1208            ARITH_RULE `1 <= n ==> 0 < n`]);;
1209
1210 let REALLIM_1_OVER_LOG = prove
1211  (`((\n. inv(log(&n))) ---> &0) sequentially`,
1212   REWRITE_TAC[REALLIM_COMPLEX] THEN MP_TAC LIM_1_OVER_LOG THEN
1213   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN
1214   REWRITE_TAC[o_DEF; complex_div; COMPLEX_MUL_LID; CX_INV] THEN
1215   REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN
1216   SIMP_TAC[CX_LOG; REAL_OF_NUM_LT; ARITH_RULE `1 <= n ==> 0 < n`]);;
1217
1218 let REALLIM_POWN = prove
1219  (`!z. abs(z) < &1 ==> ((\n. z pow n) ---> &0) sequentially`,
1220   REWRITE_TAC[REALLIM_COMPLEX; o_DEF; CX_POW] THEN
1221   REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_POWN THEN
1222   ASM_REWRITE_TAC[COMPLEX_NORM_CX]);;
1223
1224 (* ------------------------------------------------------------------------- *)
1225 (* Nets for real limit.                                                      *)
1226 (* ------------------------------------------------------------------------- *)
1227
1228 let atreal = new_definition
1229  `atreal a = mk_net(\x y. &0 < abs(x - a) /\ abs(x - a) <= abs(y - a))`;;
1230
1231 let at_posinfinity = new_definition
1232   `at_posinfinity = mk_net(\x y:real. x >= y)`;;
1233
1234 let at_neginfinity = new_definition
1235   `at_neginfinity = mk_net(\x y:real. x <= y)`;;
1236
1237 let ATREAL = prove
1238  (`!a x y.
1239         netord(atreal a) x y <=> &0 < abs(x - a) /\ abs(x - a) <= abs(y - a)`,
1240   GEN_TAC THEN NET_PROVE_TAC[atreal] THEN
1241   MESON_TAC[REAL_LE_TOTAL; REAL_LE_REFL; REAL_LE_TRANS; REAL_LET_TRANS]);;
1242
1243 let AT_POSINFINITY = prove
1244  (`!x y. netord at_posinfinity x y <=> x >= y`,
1245   NET_PROVE_TAC[at_posinfinity] THEN
1246   REWRITE_TAC[real_ge; REAL_LE_REFL] THEN
1247   MESON_TAC[REAL_LE_TOTAL; REAL_LE_REFL; REAL_LE_TRANS]);;
1248
1249 let AT_NEGINFINITY = prove
1250  (`!x y. netord at_neginfinity x y <=> x <= y`,
1251   NET_PROVE_TAC[at_neginfinity] THEN
1252   REWRITE_TAC[real_ge; REAL_LE_REFL] THEN
1253   MESON_TAC[REAL_LE_TOTAL; REAL_LE_REFL; REAL_LE_TRANS]);;
1254
1255 let WITHINREAL_UNIV = prove
1256  (`!x. atreal x within (:real) = atreal x`,
1257   REWRITE_TAC[within; atreal; IN_UNIV] THEN REWRITE_TAC[ETA_AX; net_tybij]);;
1258
1259 let TRIVIAL_LIMIT_ATREAL = prove
1260  (`!a. ~(trivial_limit (atreal a))`,
1261   X_GEN_TAC `a:real` THEN SIMP_TAC[trivial_limit; ATREAL; DE_MORGAN_THM] THEN
1262   CONJ_TAC THENL
1263    [DISCH_THEN(MP_TAC o SPECL [`&0`; `&1`]) THEN REAL_ARITH_TAC; ALL_TAC] THEN
1264   REWRITE_TAC[NOT_EXISTS_THM] THEN
1265   MAP_EVERY X_GEN_TAC [`b:real`; `c:real`] THEN
1266   ASM_CASES_TAC `b:real = c` THEN ASM_REWRITE_TAC[] THEN
1267   REWRITE_TAC[GSYM DE_MORGAN_THM; GSYM NOT_EXISTS_THM] THEN
1268   SUBGOAL_THEN `~(b:real = a) \/ ~(c = a)` DISJ_CASES_TAC THENL
1269    [ASM_MESON_TAC[];
1270     EXISTS_TAC `(a + b) / &2` THEN ASM_REAL_ARITH_TAC;
1271     EXISTS_TAC `(a + c) / &2` THEN ASM_REAL_ARITH_TAC]);;
1272
1273 let TRIVIAL_LIMIT_AT_POSINFINITY = prove
1274  (`~(trivial_limit at_posinfinity)`,
1275   REWRITE_TAC[trivial_limit; AT_POSINFINITY; DE_MORGAN_THM] THEN
1276   CONJ_TAC THENL
1277    [DISCH_THEN(MP_TAC o SPECL [`&0`; `&1`]) THEN REAL_ARITH_TAC; ALL_TAC] THEN
1278   REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM; real_ge; REAL_NOT_LE] THEN
1279   MESON_TAC[REAL_LT_TOTAL; REAL_LT_ANTISYM]);;
1280
1281 let TRIVIAL_LIMIT_AT_NEGINFINITY = prove
1282  (`~(trivial_limit at_neginfinity)`,
1283   REWRITE_TAC[trivial_limit; AT_NEGINFINITY; DE_MORGAN_THM] THEN
1284   CONJ_TAC THENL
1285    [DISCH_THEN(MP_TAC o SPECL [`&0`; `&1`]) THEN REAL_ARITH_TAC; ALL_TAC] THEN
1286   REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM; real_ge; REAL_NOT_LE] THEN
1287   MESON_TAC[REAL_LT_TOTAL; REAL_LT_ANTISYM]);;
1288
1289 let NETLIMIT_WITHINREAL = prove
1290  (`!a s. ~(trivial_limit (atreal a within s))
1291          ==> (netlimit (atreal a within s) = a)`,
1292   REWRITE_TAC[trivial_limit; netlimit; ATREAL; WITHIN; DE_MORGAN_THM] THEN
1293   REPEAT STRIP_TAC THEN MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[] THEN
1294   SUBGOAL_THEN
1295    `!x. ~(&0 < abs(x - a) /\ abs(x - a) <= abs(a - a) /\ x IN s)`
1296   ASSUME_TAC THENL [REAL_ARITH_TAC; ASM_MESON_TAC[]]);;
1297
1298 let NETLIMIT_ATREAL = prove
1299  (`!a. netlimit(atreal a) = a`,
1300   GEN_TAC THEN ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
1301   MATCH_MP_TAC NETLIMIT_WITHINREAL THEN
1302   SIMP_TAC[TRIVIAL_LIMIT_ATREAL; WITHINREAL_UNIV]);;
1303
1304 let EVENTUALLY_WITHINREAL_LE = prove
1305  (`!s a p.
1306      eventually p (atreal a within s) <=>
1307         ?d. &0 < d /\
1308             !x. x IN s /\ &0 < abs(x - a) /\ abs(x - a) <= d ==> p(x)`,
1309   REWRITE_TAC[eventually; ATREAL; WITHIN; trivial_limit] THEN
1310   REWRITE_TAC[MESON[REAL_LT_01; REAL_LT_REFL] `~(!a b:real. a = b)`] THEN
1311   REPEAT GEN_TAC THEN EQ_TAC THENL
1312    [DISCH_THEN(DISJ_CASES_THEN(X_CHOOSE_THEN `b:real` MP_TAC)) THENL
1313      [DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN
1314       FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH
1315        `~(b = c) ==> &0 < abs(b - a) \/ &0 < abs(c - a)`)) THEN
1316       ASM_MESON_TAC[];
1317       MESON_TAC[REAL_LTE_TRANS]];
1318     DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
1319     ASM_CASES_TAC `?x. x IN s /\ &0 < abs(x - a) /\ abs(x - a) <= d` THENL
1320      [DISJ2_TAC THEN FIRST_X_ASSUM(X_CHOOSE_TAC `b:real`) THEN
1321       EXISTS_TAC `b:real` THEN ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL];
1322       DISJ1_TAC THEN MAP_EVERY EXISTS_TAC [`a + d:real`; `a:real`] THEN
1323       ASM_SIMP_TAC[REAL_ADD_SUB; REAL_EQ_ADD_LCANCEL_0; REAL_LT_IMP_NZ] THEN
1324       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN
1325       MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real` THEN
1326       ASM_CASES_TAC `(x:real) IN s` THEN ASM_REWRITE_TAC[] THEN
1327       ASM_REAL_ARITH_TAC]]);;
1328
1329 let EVENTUALLY_WITHINREAL = prove
1330  (`!s a p.
1331      eventually p (atreal a within s) <=>
1332         ?d. &0 < d /\ !x. x IN s /\ &0 < abs(x - a) /\ abs(x - a) < d ==> p(x)`,
1333   REWRITE_TAC[EVENTUALLY_WITHINREAL_LE] THEN
1334   ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN
1335   REWRITE_TAC[APPROACHABLE_LT_LE]);;
1336
1337 let EVENTUALLY_ATREAL = prove
1338  (`!a p. eventually p (atreal a) <=>
1339          ?d. &0 < d /\ !x. &0 < abs(x - a) /\ abs(x - a) < d ==> p(x)`,
1340   ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
1341   REWRITE_TAC[EVENTUALLY_WITHINREAL; IN_UNIV]);;
1342
1343 let EVENTUALLY_AT_POSINFINITY = prove
1344  (`!p. eventually p at_posinfinity <=> ?b. !x. x >= b ==> p x`,
1345   REWRITE_TAC[eventually; TRIVIAL_LIMIT_AT_POSINFINITY; AT_POSINFINITY] THEN
1346   MESON_TAC[REAL_ARITH `x >= x`]);;
1347
1348 let EVENTUALLY_AT_NEGINFINITY = prove
1349  (`!p. eventually p at_neginfinity <=> ?b. !x. x <= b ==> p x`,
1350   REWRITE_TAC[eventually; TRIVIAL_LIMIT_AT_NEGINFINITY; AT_NEGINFINITY] THEN
1351   MESON_TAC[REAL_LE_REFL]);;
1352
1353 (* ------------------------------------------------------------------------- *)
1354 (* Usual limit results with real domain and either vector or real range.     *)
1355 (* ------------------------------------------------------------------------- *)
1356
1357 let LIM_WITHINREAL_LE = prove
1358  (`!f:real->real^N l a s.
1359         (f --> l) (atreal a within s) <=>
1360            !e. &0 < e ==> ?d. &0 < d /\
1361                               !x. x IN s /\ &0 < abs(x - a) /\ abs(x - a) <= d
1362                                    ==> dist(f(x),l) < e`,
1363   REWRITE_TAC[tendsto; EVENTUALLY_WITHINREAL_LE]);;
1364
1365 let LIM_WITHINREAL = prove
1366  (`!f:real->real^N l a s.
1367       (f --> l) (atreal a within s) <=>
1368         !e. &0 < e
1369             ==> ?d. &0 < d /\
1370                     !x. x IN s /\ &0 < abs(x - a) /\ abs(x - a) < d
1371                     ==> dist(f(x),l) < e`,
1372   REWRITE_TAC[tendsto; EVENTUALLY_WITHINREAL] THEN MESON_TAC[]);;
1373
1374 let LIM_ATREAL = prove
1375  (`!f l:real^N a.
1376       (f --> l) (atreal a) <=>
1377               !e. &0 < e
1378                   ==> ?d. &0 < d /\ !x. &0 < abs(x - a) /\ abs(x - a) < d
1379                           ==> dist(f(x),l) < e`,
1380   REWRITE_TAC[tendsto; EVENTUALLY_ATREAL] THEN MESON_TAC[]);;
1381
1382 let LIM_AT_POSINFINITY = prove
1383  (`!f l. (f --> l) at_posinfinity <=>
1384                !e. &0 < e ==> ?b. !x. x >= b ==> dist(f(x),l) < e`,
1385   REWRITE_TAC[tendsto; EVENTUALLY_AT_POSINFINITY] THEN MESON_TAC[]);;
1386
1387 let LIM_AT_NEGINFINITY = prove
1388  (`!f l. (f --> l) at_neginfinity <=>
1389                !e. &0 < e ==> ?b. !x. x <= b ==> dist(f(x),l) < e`,
1390   REWRITE_TAC[tendsto; EVENTUALLY_AT_NEGINFINITY] THEN MESON_TAC[]);;
1391
1392 let REALLIM_WITHINREAL_LE = prove
1393  (`!f l a s.
1394         (f ---> l) (atreal a within s) <=>
1395            !e. &0 < e ==> ?d. &0 < d /\
1396                               !x. x IN s /\ &0 < abs(x - a) /\ abs(x - a) <= d
1397                                    ==> abs(f(x) - l) < e`,
1398   REWRITE_TAC[tendsto_real; EVENTUALLY_WITHINREAL_LE]);;
1399
1400 let REALLIM_WITHINREAL = prove
1401  (`!f l a s.
1402       (f ---> l) (atreal a within s) <=>
1403         !e. &0 < e
1404             ==> ?d. &0 < d /\
1405                     !x. x IN s /\ &0 < abs(x - a) /\ abs(x - a) < d
1406                     ==> abs(f(x) - l) < e`,
1407   REWRITE_TAC[tendsto_real; EVENTUALLY_WITHINREAL] THEN MESON_TAC[]);;
1408
1409 let REALLIM_ATREAL = prove
1410  (`!f l a.
1411       (f ---> l) (atreal a) <=>
1412               !e. &0 < e
1413                   ==> ?d. &0 < d /\ !x. &0 < abs(x - a) /\ abs(x - a) < d
1414                           ==> abs(f(x) - l) < e`,
1415   REWRITE_TAC[tendsto_real; EVENTUALLY_ATREAL] THEN MESON_TAC[]);;
1416
1417 let REALLIM_AT_POSINFINITY = prove
1418  (`!f l. (f ---> l) at_posinfinity <=>
1419                !e. &0 < e ==> ?b. !x. x >= b ==> abs(f(x) - l) < e`,
1420   REWRITE_TAC[tendsto_real; EVENTUALLY_AT_POSINFINITY] THEN MESON_TAC[]);;
1421
1422 let REALLIM_AT_NEGINFINITY = prove
1423  (`!f l. (f ---> l) at_neginfinity <=>
1424                !e. &0 < e ==> ?b. !x. x <= b ==> abs(f(x) - l) < e`,
1425   REWRITE_TAC[tendsto_real; EVENTUALLY_AT_NEGINFINITY] THEN MESON_TAC[]);;
1426
1427 let LIM_ATREAL_WITHINREAL = prove
1428  (`!f l a s. (f --> l) (atreal a) ==> (f --> l) (atreal a within s)`,
1429   REWRITE_TAC[LIM_ATREAL; LIM_WITHINREAL] THEN MESON_TAC[]);;
1430
1431 let REALLIM_ATREAL_WITHINREAL = prove
1432  (`!f l a s. (f ---> l) (atreal a) ==> (f ---> l) (atreal a within s)`,
1433   REWRITE_TAC[REALLIM_ATREAL; REALLIM_WITHINREAL] THEN MESON_TAC[]);;
1434
1435 let REALLIM_WITHIN_SUBSET = prove
1436  (`!f l a s t. (f ---> l) (at a within s) /\ t SUBSET s
1437                ==> (f ---> l) (at a within t)`,
1438   REWRITE_TAC[REALLIM_WITHIN; SUBSET] THEN MESON_TAC[]);;
1439
1440 let REALLIM_WITHINREAL_SUBSET = prove
1441  (`!f l a s t. (f ---> l) (atreal a within s) /\ t SUBSET s
1442                ==> (f ---> l) (atreal a within t)`,
1443   REWRITE_TAC[REALLIM_WITHINREAL; SUBSET] THEN MESON_TAC[]);;
1444
1445 let LIM_WITHINREAL_SUBSET = prove
1446  (`!f l a s t. (f --> l) (atreal a within s) /\ t SUBSET s
1447                ==> (f --> l) (atreal a within t)`,
1448   REWRITE_TAC[LIM_WITHINREAL; SUBSET] THEN MESON_TAC[]);;
1449
1450 let REALLIM_ATREAL_ID = prove
1451  (`((\x. x) ---> a) (atreal a)`,
1452   REWRITE_TAC[REALLIM_ATREAL] THEN MESON_TAC[]);;
1453
1454 let REALLIM_WITHINREAL_ID = prove
1455  (`!a. ((\x. x) ---> a) (atreal a within s)`,
1456   REWRITE_TAC[REALLIM_WITHINREAL] THEN MESON_TAC[]);;
1457
1458 let LIM_TRANSFORM_WITHINREAL_SET = prove
1459  (`!f a s t.
1460         eventually (\x. x IN s <=> x IN t) (atreal a)
1461         ==> ((f --> l) (atreal a within s) <=> (f --> l) (atreal a within t))`,
1462   REPEAT GEN_TAC THEN REWRITE_TAC[EVENTUALLY_ATREAL; LIM_WITHINREAL] THEN
1463   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
1464   EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
1465   FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
1466   DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN
1467   EXISTS_TAC `min d k:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
1468   ASM_MESON_TAC[]);;
1469
1470 let REALLIM_TRANSFORM_WITHIN_SET = prove
1471  (`!f a s t.
1472         eventually (\x. x IN s <=> x IN t) (at a)
1473         ==> ((f ---> l) (at a within s) <=> (f ---> l) (at a within t))`,
1474   REPEAT GEN_TAC THEN REWRITE_TAC[EVENTUALLY_AT; REALLIM_WITHIN] THEN
1475   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
1476   EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
1477   FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
1478   DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN
1479   EXISTS_TAC `min d k:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
1480   ASM_MESON_TAC[]);;
1481
1482 let REALLIM_TRANSFORM_WITHINREAL_SET = prove
1483  (`!f a s t.
1484         eventually (\x. x IN s <=> x IN t) (atreal a)
1485         ==> ((f ---> l) (atreal a within s) <=>
1486              (f ---> l) (atreal a within t))`,
1487   REPEAT GEN_TAC THEN REWRITE_TAC[EVENTUALLY_ATREAL; REALLIM_WITHINREAL] THEN
1488   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
1489   EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
1490   FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
1491   DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN
1492   EXISTS_TAC `min d k:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
1493   ASM_MESON_TAC[]);;
1494
1495 (* ------------------------------------------------------------------------- *)
1496 (* Relations between limits at real and complex limit points.                *)
1497 (* ------------------------------------------------------------------------- *)
1498
1499 let TRIVIAL_LIMIT_WITHINREAL_WITHIN = prove
1500  (`trivial_limit(atreal x within s) <=>
1501         trivial_limit(at (lift x) within (IMAGE lift s))`,
1502   REWRITE_TAC[trivial_limit; AT; WITHIN; ATREAL] THEN
1503   REWRITE_TAC[FORALL_LIFT; EXISTS_LIFT; LIFT_EQ; DIST_LIFT] THEN
1504   REWRITE_TAC[IN_IMAGE_LIFT_DROP; LIFT_DROP]);;
1505
1506 let TRIVIAL_LIMIT_WITHINREAL_WITHINCOMPLEX = prove
1507  (`trivial_limit(atreal x within s) <=>
1508         trivial_limit(at (Cx x) within (real INTER IMAGE Cx s))`,
1509   REWRITE_TAC[trivial_limit; AT; WITHIN; ATREAL] THEN
1510   REWRITE_TAC[SET_RULE `x IN real INTER s <=> real x /\ x IN s`] THEN
1511   REWRITE_TAC[TAUT `~(p /\ x /\ q) /\ ~(r /\ x /\ s) <=>
1512                     x ==> ~(p /\ q) /\ ~(r /\ s)`] THEN
1513   REWRITE_TAC[FORALL_REAL;
1514     MESON[IN_IMAGE; CX_INJ] `Cx x IN IMAGE Cx s <=> x IN s`] THEN
1515   REWRITE_TAC[dist; GSYM CX_SUB; o_THM; RE_CX; COMPLEX_NORM_CX] THEN
1516   MATCH_MP_TAC(TAUT `~p /\ ~q /\ (r <=> s) ==> (p \/ r <=> q \/ s)`) THEN
1517   REPEAT CONJ_TAC THEN TRY EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL
1518    [DISCH_THEN(MP_TAC o SPECL [`&0`; `&1`]) THEN CONV_TAC REAL_RING;
1519     DISCH_THEN(MP_TAC o SPECL [`Cx(&0)`; `Cx(&1)`]) THEN
1520     CONV_TAC COMPLEX_RING;
1521     MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN STRIP_TAC THEN
1522     MAP_EVERY EXISTS_TAC [`Cx a`; `Cx b`] THEN ASM_REWRITE_TAC[CX_INJ] THEN
1523     ASM_REWRITE_TAC[GSYM CX_SUB; COMPLEX_NORM_CX];
1524     MAP_EVERY X_GEN_TAC [`a:complex`; `b:complex`] THEN STRIP_TAC THEN
1525     SUBGOAL_THEN
1526      `?d. &0 < d /\
1527           !z. &0 < abs(z - x) /\ abs(z - x) <= d ==> ~(z IN s)`
1528     STRIP_ASSUME_TAC THENL
1529      [MATCH_MP_TAC(MESON[] `!a b. P a \/ P b ==> ?x. P x`) THEN
1530       MAP_EVERY EXISTS_TAC [`norm(a - Cx x)`; `norm(b - Cx x)`] THEN
1531       ASM_REWRITE_TAC[TAUT `a ==> ~b <=> ~(a /\ b)`] THEN
1532       UNDISCH_TAC `~(a:complex = b)` THEN NORM_ARITH_TAC;
1533       ALL_TAC] THEN
1534     MAP_EVERY EXISTS_TAC [`x + d:real`; `x - d:real`] THEN
1535     ASM_SIMP_TAC[REAL_ARITH `&0 < d ==> ~(x + d = x - d)`;
1536                  REAL_ARITH `&0 < d ==> abs((x + d) - x) = d`;
1537                  REAL_ARITH `&0 < d ==> abs(x - d - x) = d`] THEN
1538     ASM_MESON_TAC[]]);;
1539
1540 let LIM_WITHINREAL_WITHINCOMPLEX = prove
1541  (`(f --> a) (atreal x within s) <=>
1542    ((f o Re) --> a) (at(Cx x) within (real INTER IMAGE Cx s))`,
1543   REWRITE_TAC[LIM_WITHINREAL; LIM_WITHIN] THEN
1544   REWRITE_TAC[SET_RULE `x IN real INTER s <=> real x /\ x IN s`] THEN
1545   REWRITE_TAC[IMP_CONJ; FORALL_REAL;
1546     MESON[IN_IMAGE; CX_INJ] `Cx x IN IMAGE Cx s <=> x IN s`] THEN
1547   REWRITE_TAC[dist; GSYM CX_SUB; o_THM; RE_CX; COMPLEX_NORM_CX]);;
1548
1549 let LIM_ATREAL_ATCOMPLEX = prove
1550  (`(f --> a) (atreal x) <=> ((f o Re) --> a) (at (Cx x) within real)`,
1551   REWRITE_TAC[LIM_ATREAL; LIM_WITHIN] THEN
1552   REWRITE_TAC[IMP_CONJ; FORALL_REAL; IN; dist; GSYM CX_SUB; COMPLEX_NORM_CX;
1553               o_THM; RE_CX]);;
1554
1555 (* ------------------------------------------------------------------------- *)
1556 (* Simpler theorems relating limits in real and real^1.                      *)
1557 (* ------------------------------------------------------------------------- *)
1558
1559 let LIM_WITHINREAL_WITHIN = prove
1560  (`(f --> a) (atreal x within s) <=>
1561         ((f o drop) --> a) (at (lift x) within (IMAGE lift s))`,
1562   REWRITE_TAC[LIM_WITHINREAL; LIM_WITHIN] THEN
1563   REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; DIST_LIFT; o_THM; LIFT_DROP]);;
1564
1565 let LIM_ATREAL_AT = prove
1566  (`(f --> a) (atreal x) <=> ((f o drop) --> a) (at (lift x))`,
1567   REWRITE_TAC[LIM_ATREAL; LIM_AT; FORALL_LIFT] THEN
1568   REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; DIST_LIFT; o_THM; LIFT_DROP]);;
1569
1570 let REALLIM_WITHINREAL_WITHIN = prove
1571  (`(f ---> a) (atreal x within s) <=>
1572         ((f o drop) ---> a) (at (lift x) within (IMAGE lift s))`,
1573   REWRITE_TAC[REALLIM_WITHINREAL; REALLIM_WITHIN] THEN
1574   REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; DIST_LIFT; o_THM; LIFT_DROP]);;
1575
1576 let REALLIM_ATREAL_AT = prove
1577  (`(f ---> a) (atreal x) <=> ((f o drop) ---> a) (at (lift x))`,
1578   REWRITE_TAC[REALLIM_ATREAL; REALLIM_AT; FORALL_LIFT] THEN
1579   REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; DIST_LIFT; o_THM; LIFT_DROP]);;
1580
1581 let REALLIM_WITHIN_OPEN = prove
1582  (`!f:real^N->real l a s.
1583         a IN s /\ open s
1584         ==> ((f ---> l) (at a within s) <=> (f ---> l) (at a))`,
1585   REWRITE_TAC[TENDSTO_REAL; LIM_WITHIN_OPEN]);;
1586
1587 let LIM_WITHIN_REAL_OPEN = prove
1588  (`!f:real->real^N l a s.
1589         a IN s /\ real_open s
1590         ==> ((f --> l) (atreal a within s) <=> (f --> l) (atreal a))`,
1591   REWRITE_TAC[LIM_WITHINREAL_WITHIN; LIM_ATREAL_AT; REAL_OPEN] THEN
1592   REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_WITHIN_OPEN THEN ASM SET_TAC[]);;
1593
1594 let REALLIM_WITHIN_REAL_OPEN = prove
1595  (`!f l a s.
1596         a IN s /\ real_open s
1597         ==> ((f ---> l) (atreal a within s) <=> (f ---> l) (atreal a))`,
1598   REWRITE_TAC[TENDSTO_REAL; LIM_WITHIN_REAL_OPEN]);;
1599
1600 (* ------------------------------------------------------------------------- *)
1601 (* Additional congruence rules for simplifying limits.                       *)
1602 (* ------------------------------------------------------------------------- *)
1603
1604 let LIM_CONG_WITHINREAL = prove
1605  (`(!x. ~(x = a) ==> f x = g x)
1606    ==> (((\x. f x) --> l) (atreal a within s) <=>
1607         ((g --> l) (atreal a within s)))`,
1608   SIMP_TAC[LIM_WITHINREAL; GSYM REAL_ABS_NZ; REAL_SUB_0]);;
1609
1610 let LIM_CONG_ATREAL = prove
1611  (`(!x. ~(x = a) ==> f x = g x)
1612    ==> (((\x. f x) --> l) (atreal a) <=> ((g --> l) (atreal a)))`,
1613   SIMP_TAC[LIM_ATREAL; GSYM REAL_ABS_NZ; REAL_SUB_0]);;
1614
1615 extend_basic_congs [LIM_CONG_WITHINREAL; LIM_CONG_ATREAL];;
1616
1617 let REALLIM_CONG_WITHIN = prove
1618  (`(!x. ~(x = a) ==> f x = g x)
1619    ==> (((\x. f x) ---> l) (at a within s) <=> ((g ---> l) (at a within s)))`,
1620   REWRITE_TAC[REALLIM_WITHIN; GSYM DIST_NZ] THEN SIMP_TAC[]);;
1621
1622 let REALLIM_CONG_AT = prove
1623  (`(!x. ~(x = a) ==> f x = g x)
1624    ==> (((\x. f x) ---> l) (at a) <=> ((g ---> l) (at a)))`,
1625   REWRITE_TAC[REALLIM_AT; GSYM DIST_NZ] THEN SIMP_TAC[]);;
1626
1627 extend_basic_congs [REALLIM_CONG_WITHIN; REALLIM_CONG_AT];;
1628
1629 let REALLIM_CONG_WITHINREAL = prove
1630  (`(!x. ~(x = a) ==> f x = g x)
1631    ==> (((\x. f x) ---> l) (atreal a within s) <=>
1632         ((g ---> l) (atreal a within s)))`,
1633   SIMP_TAC[REALLIM_WITHINREAL; GSYM REAL_ABS_NZ; REAL_SUB_0]);;
1634
1635 let REALLIM_CONG_ATREAL = prove
1636  (`(!x. ~(x = a) ==> f x = g x)
1637    ==> (((\x. f x) ---> l) (atreal a) <=> ((g ---> l) (atreal a)))`,
1638   SIMP_TAC[REALLIM_ATREAL; GSYM REAL_ABS_NZ; REAL_SUB_0]);;
1639
1640 extend_basic_congs [REALLIM_CONG_WITHINREAL; REALLIM_CONG_ATREAL];;
1641
1642 (* ------------------------------------------------------------------------- *)
1643 (* Real version of Abel limit theorem.                                       *)
1644 (* ------------------------------------------------------------------------- *)
1645
1646 let REAL_ABEL_LIMIT_THEOREM = prove
1647  (`!s a. real_summable s a
1648          ==> (!r. abs(r) < &1 ==> real_summable s (\i. a i * r pow i)) /\
1649              ((\r. real_infsum s  (\i. a i * r pow i)) ---> real_infsum s a)
1650              (atreal (&1) within {z | z <= &1})`,
1651   REPEAT GEN_TAC THEN STRIP_TAC THEN
1652   MP_TAC(ISPECL [`&1`; `s:num->bool`; `Cx o (a:num->real)`]
1653         ABEL_LIMIT_THEOREM) THEN
1654   ASM_REWRITE_TAC[GSYM REAL_SUMMABLE_COMPLEX; REAL_LT_01] THEN STRIP_TAC THEN
1655   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
1656    [X_GEN_TAC `r:real` THEN STRIP_TAC THEN
1657     FIRST_X_ASSUM(MP_TAC o SPEC `Cx r`) THEN
1658     ASM_REWRITE_TAC[COMPLEX_NORM_CX; REAL_SUMMABLE_COMPLEX] THEN
1659     REWRITE_TAC[o_DEF; CX_MUL; CX_POW];
1660     DISCH_TAC] THEN
1661   REWRITE_TAC[REALLIM_COMPLEX; LIM_WITHINREAL_WITHINCOMPLEX] THEN
1662   MATCH_MP_TAC LIM_TRANSFORM_WITHIN THEN
1663   EXISTS_TAC `\z. infsum s (\i. (Cx o a) i * z pow i)` THEN
1664   EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN CONJ_TAC THENL
1665    [REWRITE_TAC[IMP_CONJ; IN_INTER; IN_ELIM_THM; IN_IMAGE] THEN
1666     REWRITE_TAC[IN; FORALL_REAL] THEN X_GEN_TAC `r:real` THEN
1667     REWRITE_TAC[CX_INJ; UNWIND_THM1; dist; GSYM CX_SUB; COMPLEX_NORM_CX] THEN
1668     DISCH_TAC THEN
1669     ASM_SIMP_TAC[REAL_ARITH `r <= &1 ==> (&0 < abs(r - &1) <=> r < &1)`] THEN
1670     REPEAT DISCH_TAC THEN SUBGOAL_THEN `abs(r) < &1` ASSUME_TAC THENL
1671      [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
1672     ASM_SIMP_TAC[REAL_INFSUM_COMPLEX; o_THM; RE_CX] THEN
1673     CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM REAL; o_DEF; CX_MUL; CX_POW] THEN
1674     MATCH_MP_TAC(ISPEC `sequentially` REAL_LIM) THEN
1675     EXISTS_TAC `\n. vsum(s INTER (0..n)) (\i. Cx(a i) * Cx r pow i)` THEN
1676     REWRITE_TAC[SEQUENTIALLY; TRIVIAL_LIMIT_SEQUENTIALLY; GSYM sums] THEN
1677     SIMP_TAC[GSYM CX_POW; GSYM CX_MUL; REAL_VSUM; FINITE_INTER; FINITE_NUMSEG;
1678              SUMS_INFSUM; REAL_CX; GE] THEN
1679     CONJ_TAC THENL [ALL_TAC; MESON_TAC[LE_REFL]] THEN
1680     ONCE_REWRITE_TAC[GSYM o_DEF] THEN
1681     ASM_SIMP_TAC[GSYM REAL_SUMMABLE_COMPLEX];
1682     ALL_TAC] THEN
1683   ASM_SIMP_TAC[REAL_INFSUM_COMPLEX] THEN
1684   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_WITHIN]) THEN
1685   REWRITE_TAC[LIM_WITHIN] THEN
1686   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
1687   ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
1688   REWRITE_TAC[REAL_MUL_LID; IN_ELIM_THM; IN_INTER; IN_IMAGE] THEN
1689   DISCH_THEN(X_CHOOSE_THEN `d:real`
1690    (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))) THEN
1691   EXISTS_TAC `min d (&1)` THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_01] THEN
1692   REWRITE_TAC[IMP_CONJ; IN; FORALL_REAL] THEN
1693   REWRITE_TAC[CX_INJ; UNWIND_THM1; dist; GSYM CX_SUB; COMPLEX_NORM_CX] THEN
1694   X_GEN_TAC `r:real` THEN DISCH_TAC THEN
1695   ASM_SIMP_TAC[REAL_ARITH `r <= &1 ==> (&0 < abs(r - &1) <=> r < &1)`] THEN
1696   REPEAT DISCH_TAC THEN SUBGOAL_THEN `abs(r) < &1` ASSUME_TAC THENL
1697    [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
1698   REMOVE_THEN "*" (MP_TAC o SPEC `Cx r`) THEN
1699   REWRITE_TAC[CX_INJ; UNWIND_THM1; dist; GSYM CX_SUB; COMPLEX_NORM_CX] THEN
1700   ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
1701   MATCH_MP_TAC(NORM_ARITH `b = a ==> norm(x - a) < e ==> norm(x - b) < e`) THEN
1702   REWRITE_TAC[GSYM REAL] THEN
1703   MATCH_MP_TAC(ISPEC `sequentially` REAL_LIM) THEN
1704   EXISTS_TAC `\n. vsum(s INTER (0..n)) (Cx o a)` THEN
1705   REWRITE_TAC[SEQUENTIALLY; TRIVIAL_LIMIT_SEQUENTIALLY; GSYM sums] THEN
1706   SIMP_TAC[GSYM CX_POW; GSYM CX_MUL; REAL_VSUM; FINITE_INTER; FINITE_NUMSEG;
1707            SUMS_INFSUM; REAL_CX; GE; o_DEF] THEN
1708   CONJ_TAC THENL [ALL_TAC; MESON_TAC[LE_REFL]] THEN
1709   ONCE_REWRITE_TAC[GSYM o_DEF] THEN
1710   ASM_SIMP_TAC[GSYM REAL_SUMMABLE_COMPLEX]);;
1711
1712 (* ------------------------------------------------------------------------- *)
1713 (* Continuity of a function into the reals.                                  *)
1714 (* ------------------------------------------------------------------------- *)
1715
1716 parse_as_infix ("real_continuous",(12,"right"));;
1717
1718 let real_continuous = new_definition
1719   `f real_continuous net <=> (f ---> f(netlimit net)) net`;;
1720
1721 let REAL_CONTINUOUS_TRIVIAL_LIMIT = prove
1722  (`!f net. trivial_limit net ==> f real_continuous net`,
1723   SIMP_TAC[real_continuous; REALLIM]);;
1724
1725 let REAL_CONTINUOUS_WITHIN = prove
1726  (`!f x:real^N s.
1727         f real_continuous (at x within s) <=>
1728                 (f ---> f(x)) (at x within s)`,
1729   REPEAT GEN_TAC THEN REWRITE_TAC[real_continuous] THEN
1730   ASM_CASES_TAC `trivial_limit(at(x:real^N) within s)` THENL
1731    [ASM_REWRITE_TAC[REALLIM]; ASM_SIMP_TAC[NETLIMIT_WITHIN]]);;
1732
1733 let REAL_CONTINUOUS_AT = prove
1734  (`!f x. f real_continuous (at x) <=> (f ---> f(x)) (at x)`,
1735   ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
1736   REWRITE_TAC[REAL_CONTINUOUS_WITHIN; IN_UNIV]);;
1737
1738 let REAL_CONTINUOUS_WITHINREAL = prove
1739  (`!f x s. f real_continuous (atreal x within s) <=>
1740                 (f ---> f(x)) (atreal x within s)`,
1741   REPEAT GEN_TAC THEN REWRITE_TAC[real_continuous] THEN
1742   ASM_CASES_TAC `trivial_limit(atreal x within s)` THENL
1743    [ASM_REWRITE_TAC[REALLIM]; ASM_SIMP_TAC[NETLIMIT_WITHINREAL]]);;
1744
1745 let REAL_CONTINUOUS_ATREAL = prove
1746  (`!f x. f real_continuous (atreal x) <=> (f ---> f(x)) (atreal x)`,
1747   ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
1748   REWRITE_TAC[REAL_CONTINUOUS_WITHINREAL; IN_UNIV]);;
1749
1750 let CONTINUOUS_WITHINREAL = prove
1751  (`!f x s. f continuous (atreal x within s) <=>
1752                  (f --> f(x)) (atreal x within s)`,
1753   REPEAT GEN_TAC THEN REWRITE_TAC[continuous] THEN
1754   ASM_CASES_TAC `trivial_limit(atreal x within s)` THENL
1755    [ASM_REWRITE_TAC[LIM]; ASM_SIMP_TAC[NETLIMIT_WITHINREAL]]);;
1756
1757 let CONTINUOUS_ATREAL = prove
1758  (`!f x. f continuous (atreal x) <=> (f --> f(x)) (atreal x)`,
1759   ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
1760   REWRITE_TAC[CONTINUOUS_WITHINREAL; IN_UNIV]);;
1761
1762 let real_continuous_within = prove
1763  (`f real_continuous (at x within s) <=>
1764         !e. &0 < e
1765             ==> ?d. &0 < d /\
1766                     (!x'. x' IN s /\ dist(x',x) < d ==> abs(f x' - f x) < e)`,
1767   REWRITE_TAC[REAL_CONTINUOUS_WITHIN; REALLIM_WITHIN] THEN
1768   REWRITE_TAC[GSYM DIST_NZ] THEN
1769   EQ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
1770   ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
1771   MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
1772   MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN
1773   ASM_MESON_TAC[REAL_ARITH `abs(x - x) = &0`]);;
1774
1775 let real_continuous_at = prove
1776  (`f real_continuous (at x) <=>
1777         !e. &0 < e
1778             ==> ?d. &0 < d /\
1779                     (!x'. dist(x',x) < d ==> abs(f x' - f x) < e)`,
1780   ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
1781   REWRITE_TAC[real_continuous_within; IN_UNIV]);;
1782
1783 let real_continuous_withinreal = prove
1784  (`f real_continuous (atreal x within s) <=>
1785         !e. &0 < e
1786             ==> ?d. &0 < d /\
1787                     (!x'. x' IN s /\ abs(x' - x) < d ==> abs(f x' - f x) < e)`,
1788   REWRITE_TAC[REAL_CONTINUOUS_WITHINREAL; REALLIM_WITHINREAL] THEN
1789   REWRITE_TAC[REAL_ARITH `&0 < abs(x - y) <=> ~(x = y)`] THEN
1790   EQ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
1791   ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
1792   MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
1793   MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN
1794   ASM_MESON_TAC[REAL_ARITH `abs(x - x) = &0`]);;
1795
1796 let real_continuous_atreal = prove
1797  (`f real_continuous (atreal x) <=>
1798         !e. &0 < e
1799             ==> ?d. &0 < d /\
1800                     (!x'. abs(x' - x) < d ==> abs(f x' - f x) < e)`,
1801   ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
1802   REWRITE_TAC[real_continuous_withinreal; IN_UNIV]);;
1803
1804 let REAL_CONTINUOUS_AT_WITHIN = prove
1805  (`!f s x. f real_continuous (at x)
1806            ==> f real_continuous (at x within s)`,
1807   REWRITE_TAC[real_continuous_within; real_continuous_at] THEN
1808   MESON_TAC[]);;
1809
1810 let REAL_CONTINUOUS_ATREAL_WITHINREAL = prove
1811  (`!f s x. f real_continuous (atreal x)
1812            ==> f real_continuous (atreal x within s)`,
1813   REWRITE_TAC[real_continuous_withinreal; real_continuous_atreal] THEN
1814   MESON_TAC[]);;
1815
1816 let REAL_CONTINUOUS_WITHINREAL_SUBSET = prove
1817  (`!f s t. f real_continuous (atreal x within s) /\ t SUBSET s
1818              ==> f real_continuous (atreal x within t)`,
1819   REWRITE_TAC[REAL_CONTINUOUS_WITHINREAL; REALLIM_WITHINREAL_SUBSET]);;
1820
1821 let REAL_CONTINUOUS_WITHIN_SUBSET = prove
1822  (`!f s t. f real_continuous (at x within s) /\ t SUBSET s
1823              ==> f real_continuous (at x within t)`,
1824   REWRITE_TAC[REAL_CONTINUOUS_WITHIN; REALLIM_WITHIN_SUBSET]);;
1825
1826 let CONTINUOUS_WITHINREAL_SUBSET = prove
1827  (`!f s t. f continuous (atreal x within s) /\ t SUBSET s
1828              ==> f continuous (atreal x within t)`,
1829   REWRITE_TAC[CONTINUOUS_WITHINREAL; LIM_WITHINREAL_SUBSET]);;
1830
1831 let continuous_withinreal = prove
1832  (`f continuous (atreal x within s) <=>
1833         !e. &0 < e
1834             ==> ?d. &0 < d /\
1835                     (!x'. x' IN s /\ abs(x' - x) < d ==> dist(f x',f x) < e)`,
1836   REWRITE_TAC[CONTINUOUS_WITHINREAL; LIM_WITHINREAL] THEN
1837   REWRITE_TAC[REAL_ARITH `&0 < abs(x - y) <=> ~(x = y)`] THEN
1838   AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN
1839   ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
1840   AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `d:real` THEN
1841   ASM_CASES_TAC `&0 < d` THEN ASM_REWRITE_TAC[] THEN
1842   AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[DIST_REFL]);;
1843
1844 let continuous_atreal = prove
1845  (`f continuous (atreal x) <=>
1846         !e. &0 < e
1847             ==> ?d. &0 < d /\
1848                     (!x'. abs(x' - x) < d ==> dist(f x',f x) < e)`,
1849   ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
1850   REWRITE_TAC[continuous_withinreal; IN_UNIV]);;
1851
1852 let CONTINUOUS_ATREAL_WITHINREAL = prove
1853  (`!f x s. f continuous (atreal x) ==> f continuous (atreal x within s)`,
1854   SIMP_TAC[continuous_atreal; continuous_withinreal] THEN MESON_TAC[]);;
1855
1856 let CONTINUOUS_CX_ATREAL = prove
1857  (`!x. Cx continuous (atreal x)`,
1858   GEN_TAC THEN REWRITE_TAC[continuous_atreal; dist] THEN
1859   REWRITE_TAC[COMPLEX_NORM_CX; GSYM CX_SUB] THEN MESON_TAC[]);;
1860
1861 let CONTINUOUS_CX_WITHINREAL = prove
1862  (`!s x. Cx continuous (atreal x within s)`,
1863   SIMP_TAC[CONTINUOUS_ATREAL_WITHINREAL; CONTINUOUS_CX_ATREAL]);;
1864
1865 (* ------------------------------------------------------------------------- *)
1866 (* Arithmetic combining theorems.                                            *)
1867 (* ------------------------------------------------------------------------- *)
1868
1869 let REAL_CONTINUOUS_CONST = prove
1870  (`!net c. (\x. c) real_continuous net`,
1871   REWRITE_TAC[real_continuous; REALLIM_CONST]);;
1872
1873 let REAL_CONTINUOUS_LMUL = prove
1874  (`!f c net. f real_continuous net ==> (\x. c * f(x)) real_continuous net`,
1875   REWRITE_TAC[real_continuous; REALLIM_LMUL]);;
1876
1877 let REAL_CONTINUOUS_RMUL = prove
1878  (`!f c net. f real_continuous net ==> (\x. f(x) * c) real_continuous net`,
1879   REWRITE_TAC[real_continuous; REALLIM_RMUL]);;
1880
1881 let REAL_CONTINUOUS_NEG = prove
1882  (`!f net. f real_continuous net ==> (\x. --(f x)) real_continuous net`,
1883   REWRITE_TAC[real_continuous; REALLIM_NEG]);;
1884
1885 let REAL_CONTINUOUS_ADD = prove
1886  (`!f g net. f real_continuous net /\ g real_continuous net
1887            ==> (\x. f(x) + g(x)) real_continuous net`,
1888   REWRITE_TAC[real_continuous; REALLIM_ADD]);;
1889
1890 let REAL_CONTINUOUS_SUB = prove
1891  (`!f g net. f real_continuous net /\ g real_continuous net
1892            ==> (\x. f(x) - g(x)) real_continuous net`,
1893   REWRITE_TAC[real_continuous; REALLIM_SUB]);;
1894
1895 let REAL_CONTINUOUS_MUL = prove
1896  (`!net f g.
1897      f real_continuous net /\ g real_continuous net
1898      ==> (\x. f(x) * g(x)) real_continuous net`,
1899   SIMP_TAC[real_continuous; REALLIM_MUL]);;
1900
1901 let REAL_CONTINUOUS_INV = prove
1902  (`!net f.
1903     f real_continuous net /\ ~(f(netlimit net) = &0)
1904     ==> (\x. inv(f x)) real_continuous net`,
1905   SIMP_TAC[real_continuous; REALLIM_INV]);;
1906
1907 let REAL_CONTINUOUS_DIV = prove
1908  (`!net f g.
1909     f real_continuous net /\ g real_continuous net /\ ~(g(netlimit net) = &0)
1910     ==> (\x. f(x) / g(x)) real_continuous net`,
1911   SIMP_TAC[real_continuous; REALLIM_DIV]);;
1912
1913 let REAL_CONTINUOUS_POW = prove
1914  (`!net f n. f real_continuous net ==> (\x. f(x) pow n) real_continuous net`,
1915   SIMP_TAC[real_continuous; REALLIM_POW]);;
1916
1917 let REAL_CONTINUOUS_ABS = prove
1918  (`!net f. f real_continuous net ==> (\x. abs(f(x))) real_continuous net`,
1919   REWRITE_TAC[real_continuous; REALLIM_ABS]);;
1920
1921 let REAL_CONTINUOUS_MAX = prove
1922  (`!f g net. f real_continuous net /\ g real_continuous net
1923            ==> (\x. max (f x) (g x)) real_continuous net`,
1924   REWRITE_TAC[real_continuous; REALLIM_MAX]);;
1925
1926 let REAL_CONTINUOUS_MIN = prove
1927  (`!f g net. f real_continuous net /\ g real_continuous net
1928            ==> (\x. min (f x) (g x)) real_continuous net`,
1929   REWRITE_TAC[real_continuous; REALLIM_MIN]);;
1930
1931 (* ------------------------------------------------------------------------- *)
1932 (* Some of these without netlimit, but with many different cases.            *)
1933 (* ------------------------------------------------------------------------- *)
1934
1935 let REAL_CONTINUOUS_WITHIN_ID = prove
1936  (`!x s. (\x. x) real_continuous (atreal x within s)`,
1937   REWRITE_TAC[real_continuous_withinreal] THEN MESON_TAC[]);;
1938
1939 let REAL_CONTINUOUS_AT_ID = prove
1940  (`!x. (\x. x) real_continuous (atreal x)`,
1941   REWRITE_TAC[real_continuous_atreal] THEN MESON_TAC[]);;
1942
1943 let REAL_CONTINUOUS_INV_WITHIN = prove
1944  (`!f s a. f real_continuous (at a within s) /\ ~(f a = &0)
1945            ==> (\x. inv(f x)) real_continuous (at a within s)`,
1946   MESON_TAC[REAL_CONTINUOUS_INV; REAL_CONTINUOUS_TRIVIAL_LIMIT;
1947             NETLIMIT_WITHIN]);;
1948
1949 let REAL_CONTINUOUS_INV_AT = prove
1950  (`!f a. f real_continuous (at a) /\ ~(f a = &0)
1951          ==> (\x. inv(f x)) real_continuous (at a)`,
1952   ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
1953   REWRITE_TAC[REAL_CONTINUOUS_INV_WITHIN]);;
1954
1955 let REAL_CONTINUOUS_INV_WITHINREAL = prove
1956  (`!f s a. f real_continuous (atreal a within s) /\ ~(f a = &0)
1957            ==> (\x. inv(f x)) real_continuous (atreal a within s)`,
1958   MESON_TAC[REAL_CONTINUOUS_INV; REAL_CONTINUOUS_TRIVIAL_LIMIT;
1959             NETLIMIT_WITHINREAL]);;
1960
1961 let REAL_CONTINUOUS_INV_ATREAL = prove
1962  (`!f a. f real_continuous (atreal a) /\ ~(f a = &0)
1963          ==> (\x. inv(f x)) real_continuous (atreal a)`,
1964   ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
1965   REWRITE_TAC[REAL_CONTINUOUS_INV_WITHINREAL]);;
1966
1967 let REAL_CONTINUOUS_DIV_WITHIN = prove
1968  (`!f s a. f real_continuous (at a within s) /\
1969            g real_continuous (at a within s) /\ ~(g a = &0)
1970            ==> (\x. f x / g x) real_continuous (at a within s)`,
1971   MESON_TAC[REAL_CONTINUOUS_DIV; REAL_CONTINUOUS_TRIVIAL_LIMIT;
1972             NETLIMIT_WITHIN]);;
1973
1974 let REAL_CONTINUOUS_DIV_AT = prove
1975  (`!f a. f real_continuous (at a) /\
1976          g real_continuous (at a) /\ ~(g a = &0)
1977          ==> (\x. f x / g x) real_continuous (at a)`,
1978   ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
1979   REWRITE_TAC[REAL_CONTINUOUS_DIV_WITHIN]);;
1980
1981 let REAL_CONTINUOUS_DIV_WITHINREAL = prove
1982  (`!f s a. f real_continuous (atreal a within s) /\
1983            g real_continuous (atreal a within s) /\ ~(g a = &0)
1984            ==> (\x. f x / g x) real_continuous (atreal a within s)`,
1985   MESON_TAC[REAL_CONTINUOUS_DIV; REAL_CONTINUOUS_TRIVIAL_LIMIT;
1986             NETLIMIT_WITHINREAL]);;
1987
1988 let REAL_CONTINUOUS_DIV_ATREAL = prove
1989  (`!f a. f real_continuous (atreal a) /\
1990          g real_continuous (atreal a) /\ ~(g a = &0)
1991          ==> (\x. f x / g x) real_continuous (atreal a)`,
1992   ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
1993   REWRITE_TAC[REAL_CONTINUOUS_DIV_WITHINREAL]);;
1994
1995 (* ------------------------------------------------------------------------- *)
1996 (* Composition of (real->real) o (real->real) functions.                     *)
1997 (* ------------------------------------------------------------------------- *)
1998
1999 let REAL_CONTINUOUS_WITHINREAL_COMPOSE = prove
2000  (`!f g x s. f real_continuous (atreal x within s) /\
2001              g real_continuous (atreal (f x) within IMAGE f s)
2002              ==> (g o f) real_continuous (atreal x within s)`,
2003   REPEAT GEN_TAC THEN
2004   REWRITE_TAC[real_continuous_withinreal; o_THM; IN_IMAGE] THEN
2005   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
2006   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
2007   ASM_MESON_TAC[]);;
2008
2009 let REAL_CONTINUOUS_ATREAL_COMPOSE = prove
2010  (`!f g x. f real_continuous (atreal x) /\ g real_continuous (atreal (f x))
2011            ==> (g o f) real_continuous (atreal x)`,
2012   REPEAT GEN_TAC THEN
2013   REWRITE_TAC[real_continuous_atreal; o_THM; IN_IMAGE] THEN
2014   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
2015   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
2016   ASM_MESON_TAC[]);;
2017
2018 (* ------------------------------------------------------------------------- *)
2019 (* Composition of (real->real) o (real^N->real) functions.                   *)
2020 (* ------------------------------------------------------------------------- *)
2021
2022 let REAL_CONTINUOUS_WITHIN_COMPOSE = prove
2023  (`!f g x s. f real_continuous (at x within s) /\
2024              g real_continuous (atreal (f x) within IMAGE f s)
2025              ==> (g o f) real_continuous (at x within s)`,
2026   REPEAT GEN_TAC THEN
2027   REWRITE_TAC[real_continuous_withinreal; real_continuous_within;
2028               o_THM; IN_IMAGE] THEN
2029   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
2030   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
2031   ASM_MESON_TAC[]);;
2032
2033 let REAL_CONTINUOUS_AT_COMPOSE = prove
2034  (`!f g x. f real_continuous (at x) /\
2035            g real_continuous (atreal (f x) within IMAGE f (:real^N))
2036            ==> (g o f) real_continuous (at x)`,
2037   ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
2038   REWRITE_TAC[REAL_CONTINUOUS_WITHIN_COMPOSE]);;
2039
2040 (* ------------------------------------------------------------------------- *)
2041 (* Composition of (real^N->real) o (real^M->real^N) functions.               *)
2042 (* ------------------------------------------------------------------------- *)
2043
2044 let REAL_CONTINUOUS_CONTINUOUS_WITHIN_COMPOSE = prove
2045  (`!f g x s. f continuous (at x within s) /\
2046              g real_continuous (at (f x) within IMAGE f s)
2047              ==> (g o f) real_continuous (at x within s)`,
2048   REPEAT GEN_TAC THEN
2049   REWRITE_TAC[real_continuous_within; continuous_within; o_THM; IN_IMAGE] THEN
2050   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
2051   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
2052   ASM_MESON_TAC[]);;
2053
2054 let REAL_CONTINUOUS_CONTINUOUS_AT_COMPOSE = prove
2055  (`!f g x. f continuous (at x) /\
2056            g real_continuous (at (f x) within IMAGE f (:real^N))
2057            ==> (g o f) real_continuous (at x)`,
2058   REPEAT GEN_TAC THEN
2059   ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
2060   REWRITE_TAC[WITHIN_WITHIN; INTER_UNIV] THEN
2061   REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS_WITHIN_COMPOSE]);;
2062
2063 (* ------------------------------------------------------------------------- *)
2064 (* Composition of (real^N->real) o (real->real^N) functions.                 *)
2065 (* ------------------------------------------------------------------------- *)
2066
2067 let REAL_CONTINUOUS_CONTINUOUS_WITHINREAL_COMPOSE = prove
2068  (`!f g x s. f continuous (atreal x within s) /\
2069              g real_continuous (at (f x) within IMAGE f s)
2070              ==> (g o f) real_continuous (atreal x within s)`,
2071   REPEAT GEN_TAC THEN
2072   REWRITE_TAC[real_continuous_within; continuous_withinreal;
2073               real_continuous_withinreal; o_THM; IN_IMAGE] THEN
2074   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
2075   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
2076   ASM_MESON_TAC[]);;
2077
2078 let REAL_CONTINUOUS_CONTINUOUS_ATREAL_COMPOSE = prove
2079  (`!f g x. f continuous (atreal x) /\
2080            g real_continuous (at (f x) within IMAGE f (:real))
2081            ==> (g o f) real_continuous (atreal x)`,
2082   REPEAT GEN_TAC THEN
2083   ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
2084   REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS_WITHINREAL_COMPOSE]);;
2085
2086 (* ------------------------------------------------------------------------- *)
2087 (* Composition of (real->real^N) o (real->real) functions.                   *)
2088 (* ------------------------------------------------------------------------- *)
2089
2090 let CONTINUOUS_REAL_CONTINUOUS_WITHINREAL_COMPOSE = prove
2091  (`!f g x s. f real_continuous (atreal x within s) /\
2092              g continuous (atreal (f x) within IMAGE f s)
2093              ==> (g o f) continuous (atreal x within s)`,
2094   REPEAT GEN_TAC THEN
2095   REWRITE_TAC[real_continuous_within; continuous_withinreal;
2096               real_continuous_withinreal; o_THM; IN_IMAGE] THEN
2097   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
2098   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
2099   ASM_MESON_TAC[]);;
2100
2101 let CONTINUOUS_REAL_CONTINUOUS_ATREAL_COMPOSE = prove
2102  (`!f g x. f real_continuous (atreal x) /\
2103            g continuous (atreal (f x) within IMAGE f (:real))
2104            ==> (g o f) continuous (atreal x)`,
2105   REPEAT GEN_TAC THEN
2106   ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
2107   REWRITE_TAC[WITHIN_WITHIN; INTER_UNIV] THEN
2108   REWRITE_TAC[CONTINUOUS_REAL_CONTINUOUS_WITHINREAL_COMPOSE]);;
2109
2110 (* ------------------------------------------------------------------------- *)
2111 (* Composition of (real^M->real^N) o (real->real^M) functions.               *)
2112 (* ------------------------------------------------------------------------- *)
2113
2114 let CONTINUOUS_WITHINREAL_COMPOSE = prove
2115  (`!f g x s. f continuous (atreal x within s) /\
2116              g continuous (at (f x) within IMAGE f s)
2117              ==> (g o f) continuous (atreal x within s)`,
2118   REPEAT GEN_TAC THEN
2119   REWRITE_TAC[continuous_within; continuous_withinreal; o_THM; IN_IMAGE] THEN
2120   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
2121   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
2122   ASM_MESON_TAC[]);;
2123
2124 let CONTINUOUS_ATREAL_COMPOSE = prove
2125  (`!f g x. f continuous (atreal x) /\
2126            g continuous (at (f x) within IMAGE f (:real))
2127            ==> (g o f) continuous (atreal x)`,
2128   REPEAT GEN_TAC THEN
2129   ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
2130   REWRITE_TAC[WITHIN_WITHIN; INTER_UNIV] THEN
2131   REWRITE_TAC[CONTINUOUS_WITHINREAL_COMPOSE]);;
2132
2133 (* ------------------------------------------------------------------------- *)
2134 (* Composition of (real->real^N) o (real^M->real) functions.                 *)
2135 (* ------------------------------------------------------------------------- *)
2136
2137 let CONTINUOUS_REAL_CONTINUOUS_WITHIN_COMPOSE = prove
2138  (`!f g x s. f real_continuous (at x within s) /\
2139              g continuous (atreal (f x) within IMAGE f s)
2140              ==> (g o f) continuous (at x within s)`,
2141   REPEAT GEN_TAC THEN
2142   REWRITE_TAC[continuous_within; real_continuous_within; continuous_withinreal;
2143               o_THM; IN_IMAGE] THEN
2144   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
2145   MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
2146   ASM_MESON_TAC[]);;
2147
2148 let CONTINUOUS_REAL_CONTINUOUS_AT_COMPOSE = prove
2149  (`!f g x. f real_continuous (at x) /\
2150            g continuous (atreal (f x) within IMAGE f (:real^M))
2151            ==> (g o f) continuous (at x)`,
2152   REPEAT GEN_TAC THEN
2153   ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN
2154   REWRITE_TAC[WITHIN_WITHIN; INTER_UNIV] THEN
2155   REWRITE_TAC[CONTINUOUS_REAL_CONTINUOUS_WITHIN_COMPOSE]);;
2156
2157 (* ------------------------------------------------------------------------- *)
2158 (* Continuity of a real->real function on a set.                             *)
2159 (* ------------------------------------------------------------------------- *)
2160
2161 parse_as_infix ("real_continuous_on",(12,"right"));;
2162
2163 let real_continuous_on = new_definition
2164   `f real_continuous_on s <=>
2165         !x. x IN s ==> !e. &0 < e
2166                            ==> ?d. &0 < d /\
2167                                    !x'. x' IN s /\ abs(x' - x) < d
2168                                         ==> abs(f(x') - f(x)) < e`;;
2169
2170 let REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN = prove
2171  (`!f s. f real_continuous_on s <=>
2172               !x. x IN s ==> f real_continuous (atreal x within s)`,
2173   REWRITE_TAC[real_continuous_on; real_continuous_withinreal]);;
2174
2175 let REAL_CONTINUOUS_ON_SUBSET = prove
2176  (`!f s t. f real_continuous_on s /\ t SUBSET s ==> f real_continuous_on t`,
2177   REWRITE_TAC[real_continuous_on; SUBSET] THEN MESON_TAC[]);;
2178
2179 let REAL_CONTINUOUS_ON_COMPOSE = prove
2180  (`!f g s. f real_continuous_on s /\ g real_continuous_on (IMAGE f s)
2181            ==> (g o f) real_continuous_on s`,
2182   REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
2183   MESON_TAC[IN_IMAGE; REAL_CONTINUOUS_WITHINREAL_COMPOSE]);;
2184
2185 let REAL_CONTINUOUS_ON = prove
2186  (`!f s. f real_continuous_on s <=>
2187           (lift o f o drop) continuous_on (IMAGE lift s)`,
2188   REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN;
2189               CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN;
2190               REAL_CONTINUOUS_WITHINREAL; CONTINUOUS_WITHIN;
2191               FORALL_IN_IMAGE; REALLIM_WITHINREAL_WITHIN; TENDSTO_REAL] THEN
2192   REWRITE_TAC[o_THM; LIFT_DROP]);;
2193
2194 let REAL_CONTINUOUS_ON_CONST = prove
2195  (`!s c. (\x. c) real_continuous_on s`,
2196   SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_CONST]);;
2197
2198 let REAL_CONTINUOUS_ON_ID = prove
2199  (`!s. (\x. x) real_continuous_on s`,
2200   REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN;
2201               REAL_CONTINUOUS_WITHIN_ID]);;
2202
2203 let REAL_CONTINUOUS_ON_LMUL = prove
2204  (`!f c s. f real_continuous_on s ==> (\x. c * f(x)) real_continuous_on s`,
2205   SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_LMUL]);;
2206
2207 let REAL_CONTINUOUS_ON_RMUL = prove
2208  (`!f c s. f real_continuous_on s ==> (\x. f(x) * c) real_continuous_on s`,
2209   SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_RMUL]);;
2210
2211 let REAL_CONTINUOUS_ON_NEG = prove
2212  (`!f s. f real_continuous_on s
2213          ==> (\x. --(f x)) real_continuous_on s`,
2214   SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_NEG]);;
2215
2216 let REAL_CONTINUOUS_ON_ADD = prove
2217  (`!f g s. f real_continuous_on s /\ g real_continuous_on s
2218            ==> (\x. f(x) + g(x)) real_continuous_on s`,
2219   SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_ADD]);;
2220
2221 let REAL_CONTINUOUS_ON_SUB = prove
2222  (`!f g s. f real_continuous_on s /\ g real_continuous_on s
2223            ==> (\x. f(x) - g(x)) real_continuous_on s`,
2224   SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_SUB]);;
2225
2226 let REAL_CONTINUOUS_ON_MUL = prove
2227  (`!f g s. f real_continuous_on s /\ g real_continuous_on s
2228            ==> (\x. f(x) * g(x)) real_continuous_on s`,
2229   SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_MUL]);;
2230
2231 let REAL_CONTINUOUS_ON_POW = prove
2232  (`!f n s. f real_continuous_on s
2233            ==> (\x. f(x) pow n) real_continuous_on s`,
2234   SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_POW]);;
2235
2236 let REAL_CONTINUOUS_ON_EQ = prove
2237  (`!f g s. (!x. x IN s ==> f(x) = g(x)) /\ f real_continuous_on s
2238            ==> g real_continuous_on s`,
2239   SIMP_TAC[real_continuous_on; IMP_CONJ]);;
2240
2241 let REAL_CONTINUOUS_ON_UNION = prove
2242  (`!f s t.
2243          real_closed s /\ real_closed t /\
2244          f real_continuous_on s /\ f real_continuous_on t
2245          ==> f real_continuous_on (s UNION t)`,
2246   REWRITE_TAC[REAL_CLOSED; REAL_CONTINUOUS_ON; IMAGE_UNION;
2247               CONTINUOUS_ON_UNION]);;
2248
2249 let REAL_CONTINUOUS_ON_UNION_OPEN = prove
2250  (`!f s t.
2251          real_open s /\ real_open t /\
2252          f real_continuous_on s /\ f real_continuous_on t
2253          ==> f real_continuous_on (s UNION t)`,
2254   REWRITE_TAC[REAL_OPEN; REAL_CONTINUOUS_ON; IMAGE_UNION;
2255               CONTINUOUS_ON_UNION_OPEN]);;
2256
2257 let REAL_CONTINUOUS_ON_CASES = prove
2258  (`!P f g s t.
2259         real_closed s /\ real_closed t /\
2260         f real_continuous_on s /\ g real_continuous_on t /\
2261         (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x)
2262         ==> (\x. if P x then f x else g x) real_continuous_on (s UNION t)`,
2263   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_UNION THEN
2264   ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_EQ THENL
2265    [EXISTS_TAC `f:real->real`; EXISTS_TAC `g:real->real`] THEN
2266   ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);;
2267
2268 let REAL_CONTINUOUS_ON_CASES_OPEN = prove
2269  (`!P f g s t.
2270         real_open s /\ real_open t /\
2271         f real_continuous_on s /\ g real_continuous_on t /\
2272         (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x)
2273         ==> (\x. if P x then f x else g x) real_continuous_on (s UNION t)`,
2274   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_UNION_OPEN THEN
2275   ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_EQ THENL
2276    [EXISTS_TAC `f:real->real`; EXISTS_TAC `g:real->real`] THEN
2277   ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);;
2278
2279 let REAL_CONTINUOUS_ON_SUM = prove
2280  (`!t f s.
2281          FINITE s /\ (!a. a IN s ==> f a real_continuous_on t)
2282          ==> (\x. sum s (\a. f a x)) real_continuous_on t`,
2283   REPEAT GEN_TAC THEN SIMP_TAC[REAL_CONTINUOUS_ON; o_DEF; LIFT_SUM] THEN
2284   DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_VSUM) THEN
2285   REWRITE_TAC[]);;
2286
2287 let REALLIM_CONTINUOUS_FUNCTION = prove
2288  (`!f net g l.
2289         f continuous (atreal l) /\ (g ---> l) net
2290         ==> ((\x. f(g x)) --> f l) net`,
2291   REWRITE_TAC[tendsto_real; tendsto; continuous_atreal; eventually] THEN
2292   MESON_TAC[]);;
2293
2294 let LIM_REAL_CONTINUOUS_FUNCTION = prove
2295  (`!f net g l.
2296         f real_continuous (at l) /\ (g --> l) net
2297         ==> ((\x. f(g x)) ---> f l) net`,
2298   REWRITE_TAC[tendsto_real; tendsto; real_continuous_at; eventually] THEN
2299   MESON_TAC[]);;
2300
2301 let REALLIM_REAL_CONTINUOUS_FUNCTION = prove
2302  (`!f net g l.
2303         f real_continuous (atreal l) /\ (g ---> l) net
2304         ==> ((\x. f(g x)) ---> f l) net`,
2305   REWRITE_TAC[tendsto_real; real_continuous_atreal; eventually] THEN
2306   MESON_TAC[]);;
2307
2308 let REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT = prove
2309  (`!f s. real_open s
2310          ==> (f real_continuous_on s <=>
2311               !x. x IN s ==> f real_continuous atreal x)`,
2312   SIMP_TAC[REAL_CONTINUOUS_ATREAL; REAL_CONTINUOUS_WITHINREAL;
2313         REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REALLIM_WITHIN_REAL_OPEN]);;
2314
2315 let REAL_CONTINUOUS_ATTAINS_SUP = prove
2316  (`!f s. real_compact s /\ ~(s = {}) /\ f real_continuous_on s
2317          ==> ?x. x IN s /\ (!y. y IN s ==> f y <= f x)`,
2318   REPEAT STRIP_TAC THEN
2319   MP_TAC(ISPECL [`(f:real->real) o drop`; `IMAGE lift s`]
2320         CONTINUOUS_ATTAINS_SUP) THEN
2321   ASM_REWRITE_TAC[GSYM REAL_CONTINUOUS_ON; GSYM real_compact] THEN
2322   ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; EXISTS_IN_IMAGE; FORALL_IN_IMAGE] THEN
2323   REWRITE_TAC[o_THM; LIFT_DROP]);;
2324
2325 let REAL_CONTINUOUS_ATTAINS_INF = prove
2326  (`!f s. real_compact s /\ ~(s = {}) /\ f real_continuous_on s
2327          ==> ?x. x IN s /\ (!y. y IN s ==> f x <= f y)`,
2328   REPEAT STRIP_TAC THEN
2329   MP_TAC(ISPECL [`(f:real->real) o drop`; `IMAGE lift s`]
2330         CONTINUOUS_ATTAINS_INF) THEN
2331   ASM_REWRITE_TAC[GSYM REAL_CONTINUOUS_ON; GSYM real_compact] THEN
2332   ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; EXISTS_IN_IMAGE; FORALL_IN_IMAGE] THEN
2333   REWRITE_TAC[o_THM; LIFT_DROP]);;
2334
2335 (* ------------------------------------------------------------------------- *)
2336 (* Real version of uniform continuity.                                       *)
2337 (* ------------------------------------------------------------------------- *)
2338
2339 parse_as_infix ("real_uniformly_continuous_on",(12,"right"));;
2340
2341 let real_uniformly_continuous_on = new_definition
2342   `f real_uniformly_continuous_on s <=>
2343         !e. &0 < e
2344             ==> ?d. &0 < d /\
2345                     !x x'. x IN s /\ x' IN s /\ abs(x' - x) < d
2346                            ==> abs(f x' - f x) < e`;;
2347
2348 let REAL_UNIFORMLY_CONTINUOUS_ON = prove
2349  (`!f s. f real_uniformly_continuous_on s <=>
2350           (lift o f o drop) uniformly_continuous_on (IMAGE lift s)`,
2351   REWRITE_TAC[real_uniformly_continuous_on; uniformly_continuous_on] THEN
2352   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
2353   REWRITE_TAC[o_THM; DIST_LIFT; LIFT_DROP]);;
2354
2355 let REAL_UNIFORMLY_CONTINUOUS_IMP_REAL_CONTINUOUS = prove
2356  (`!f s. f real_uniformly_continuous_on s ==> f real_continuous_on s`,
2357   REWRITE_TAC[real_uniformly_continuous_on; real_continuous_on] THEN
2358   MESON_TAC[]);;
2359
2360 let REAL_UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY = prove
2361  (`!f s. f real_uniformly_continuous_on s <=>
2362                 !x y. (!n. x(n) IN s) /\ (!n. y(n) IN s) /\
2363                       ((\n. x(n) - y(n)) ---> &0) sequentially
2364                       ==> ((\n. f(x(n)) - f(y(n))) ---> &0) sequentially`,
2365   REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON] THEN
2366   REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY; REAL_TENDSTO] THEN
2367   REWRITE_TAC[o_DEF; LIFT_DROP; IN_IMAGE_LIFT_DROP; DROP_SUB; DROP_VEC] THEN
2368   REWRITE_TAC[FORALL_LIFT_FUN; o_THM; LIFT_DROP]);;
2369
2370 let REAL_UNIFORMLY_CONTINUOUS_ON_SUBSET = prove
2371  (`!f s t. f real_uniformly_continuous_on s /\ t SUBSET s
2372            ==> f real_uniformly_continuous_on t`,
2373   REWRITE_TAC[real_uniformly_continuous_on; SUBSET] THEN MESON_TAC[]);;
2374
2375 let REAL_UNIFORMLY_CONTINUOUS_ON_COMPOSE = prove
2376  (`!f g s. f real_uniformly_continuous_on s /\
2377            g real_uniformly_continuous_on (IMAGE f s)
2378            ==> (g o f) real_uniformly_continuous_on s`,
2379   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON] THEN
2380   SUBGOAL_THEN
2381    `IMAGE lift (IMAGE f s) = IMAGE (lift o f o drop) (IMAGE lift s)`
2382   SUBST1_TAC THENL
2383    [ALL_TAC;
2384     DISCH_THEN(MP_TAC o MATCH_MP UNIFORMLY_CONTINUOUS_ON_COMPOSE)] THEN
2385   REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP]);;
2386
2387 let REAL_UNIFORMLY_CONTINUOUS_ON_CONST = prove
2388  (`!s c. (\x. c) real_uniformly_continuous_on s`,
2389   REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY; o_DEF;
2390               REAL_SUB_REFL; REALLIM_CONST]);;
2391
2392 let REAL_UNIFORMLY_CONTINUOUS_ON_LMUL = prove
2393  (`!f c s. f real_uniformly_continuous_on s
2394            ==> (\x. c * f(x)) real_uniformly_continuous_on s`,
2395   REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON] THEN
2396   REWRITE_TAC[o_DEF; LIFT_CMUL; UNIFORMLY_CONTINUOUS_ON_CMUL]);;
2397
2398 let REAL_UNIFORMLY_CONTINUOUS_ON_RMUL = prove
2399  (`!f c s. f real_uniformly_continuous_on s
2400            ==> (\x. f(x) * c) real_uniformly_continuous_on s`,
2401   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
2402   REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON_LMUL]);;
2403
2404 let REAL_UNIFORMLY_CONTINUOUS_ON_ID = prove
2405  (`!s. (\x. x) real_uniformly_continuous_on s`,
2406   REWRITE_TAC[real_uniformly_continuous_on] THEN MESON_TAC[]);;
2407
2408 let REAL_UNIFORMLY_CONTINUOUS_ON_NEG = prove
2409  (`!f s. f real_uniformly_continuous_on s
2410          ==> (\x. --(f x)) real_uniformly_continuous_on s`,
2411   ONCE_REWRITE_TAC[REAL_ARITH `--x = -- &1 * x`] THEN
2412   REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON_LMUL]);;
2413
2414 let REAL_UNIFORMLY_CONTINUOUS_ON_ADD = prove
2415  (`!f g s. f real_uniformly_continuous_on s /\
2416            g real_uniformly_continuous_on s
2417            ==> (\x. f(x) + g(x)) real_uniformly_continuous_on s`,
2418   REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON; o_DEF; LIFT_ADD] THEN
2419   REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_ADD]);;
2420
2421 let REAL_UNIFORMLY_CONTINUOUS_ON_SUB = prove
2422  (`!f g s. f real_uniformly_continuous_on s /\
2423            g real_uniformly_continuous_on s
2424            ==> (\x. f(x) - g(x)) real_uniformly_continuous_on s`,
2425   REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON; o_DEF; LIFT_SUB] THEN
2426   REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SUB]);;
2427
2428 let REAL_UNIFORMLY_CONTINUOUS_ON_SUM = prove
2429  (`!t f s.
2430          FINITE s /\ (!a. a IN s ==> f a real_uniformly_continuous_on t)
2431          ==> (\x. sum s (\a. f a x)) real_uniformly_continuous_on t`,
2432   REPEAT GEN_TAC THEN
2433   SIMP_TAC[REAL_UNIFORMLY_CONTINUOUS_ON; o_DEF; LIFT_SUM] THEN
2434   DISCH_THEN(MP_TAC o MATCH_MP UNIFORMLY_CONTINUOUS_ON_VSUM) THEN
2435   REWRITE_TAC[]);;
2436
2437 let REAL_COMPACT_UNIFORMLY_CONTINUOUS = prove
2438  (`!f s. f real_continuous_on s /\ real_compact s
2439          ==> f real_uniformly_continuous_on s`,
2440   REWRITE_TAC[real_compact; REAL_CONTINUOUS_ON; REAL_UNIFORMLY_CONTINUOUS_ON;
2441               COMPACT_UNIFORMLY_CONTINUOUS]);;
2442
2443 let REAL_COMPACT_CONTINUOUS_IMAGE = prove
2444  (`!f s. f real_continuous_on s /\ real_compact s
2445          ==> real_compact (IMAGE f s)`,
2446   REPEAT GEN_TAC THEN REWRITE_TAC[real_compact; REAL_CONTINUOUS_ON] THEN
2447   DISCH_THEN(MP_TAC o MATCH_MP COMPACT_CONTINUOUS_IMAGE) THEN
2448   REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP]);;
2449
2450 let REAL_DINI = prove
2451  (`!f g s.
2452         real_compact s /\ (!n. (f n) real_continuous_on s) /\
2453         g real_continuous_on s /\
2454         (!x. x IN s ==> ((\n. (f n x)) ---> g x) sequentially) /\
2455         (!n x. x IN s ==> f n x <= f (n + 1) x)
2456         ==> !e. &0 < e
2457                 ==> eventually (\n. !x. x IN s ==> abs(f n x - g x) < e)
2458                                sequentially`,
2459   REPEAT STRIP_TAC THEN
2460   MP_TAC(ISPECL [`\n:num. lift o f n o drop`; `lift o g o drop`;
2461                  `IMAGE lift s`] DINI) THEN
2462   ASM_REWRITE_TAC[GSYM real_compact; GSYM REAL_CONTINUOUS_ON] THEN
2463   ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_DEF; LIFT_DROP; REAL_TENDSTO] THEN
2464   ASM_SIMP_TAC[GSYM LIFT_SUB; NORM_LIFT]);;
2465
2466 (* ------------------------------------------------------------------------- *)
2467 (* Continuity versus componentwise continuity.                               *)
2468 (* ------------------------------------------------------------------------- *)
2469
2470 let CONTINUOUS_COMPONENTWISE = prove
2471  (`!net f:A->real^N.
2472         f continuous net <=>
2473         !i. 1 <= i /\ i <= dimindex(:N)
2474             ==> (\x. (f x)$i) real_continuous net`,
2475   REWRITE_TAC[real_continuous; continuous; LIM_COMPONENTWISE]);;
2476
2477 let REAL_CONTINUOUS_COMPLEX_COMPONENTS_AT = prove
2478  (`!z. Re real_continuous (at z) /\ Im real_continuous (at z)`,
2479   GEN_TAC THEN MP_TAC(ISPECL
2480    [`at(z:complex)`; `\z:complex. z`] CONTINUOUS_COMPONENTWISE) THEN
2481   REWRITE_TAC[CONTINUOUS_AT_ID; DIMINDEX_2; FORALL_2] THEN
2482   REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF; ETA_AX]);;
2483
2484 let REAL_CONTINUOUS_COMPLEX_COMPONENTS_WITHIN = prove
2485  (`!s z. Re real_continuous (at z within s) /\
2486          Im real_continuous (at z within s)`,
2487   MESON_TAC[REAL_CONTINUOUS_COMPLEX_COMPONENTS_AT;
2488               REAL_CONTINUOUS_AT_WITHIN]);;
2489
2490 let REAL_CONTINUOUS_NORM_AT = prove
2491  (`!z. norm real_continuous (at z)`,
2492   REWRITE_TAC[real_continuous_at; dist] THEN
2493   GEN_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
2494   EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);;
2495
2496 let REAL_CONTINUOUS_NORM_WITHIN = prove
2497  (`!s z. norm real_continuous (at z within s)`,
2498   MESON_TAC[REAL_CONTINUOUS_NORM_AT; REAL_CONTINUOUS_AT_WITHIN]);;
2499
2500 let REAL_CONTINUOUS_DIST_AT = prove
2501  (`!a z. (\x. dist(a,x)) real_continuous (at z)`,
2502   REWRITE_TAC[real_continuous_at; dist] THEN
2503   GEN_TAC THEN GEN_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
2504   EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);;
2505
2506 let REAL_CONTINUOUS_DIST_WITHIN = prove
2507  (`!a s z. (\x. dist(a,x)) real_continuous (at z within s)`,
2508   MESON_TAC[REAL_CONTINUOUS_DIST_AT; REAL_CONTINUOUS_AT_WITHIN]);;
2509
2510 (* ------------------------------------------------------------------------- *)
2511 (* Derivative of real->real function.                                        *)
2512 (* ------------------------------------------------------------------------- *)
2513
2514 parse_as_infix ("has_real_derivative",(12,"right"));;
2515 parse_as_infix ("real_differentiable",(12,"right"));;
2516 parse_as_infix ("real_differentiable_on",(12,"right"));;
2517
2518 let has_real_derivative = new_definition
2519  `(f has_real_derivative f') net <=>
2520         ((\x. inv(x - netlimit net) *
2521               (f x - (f(netlimit net) + f' * (x - netlimit net))))
2522          ---> &0) net`;;
2523
2524 let real_differentiable = new_definition
2525  `f real_differentiable net <=> ?f'. (f has_real_derivative f') net`;;
2526
2527 let real_derivative = new_definition
2528  `real_derivative f x = @f'. (f has_real_derivative f') (atreal x)`;;
2529
2530 let higher_real_derivative = define
2531  `higher_real_derivative 0 f = f /\
2532   (!n. higher_real_derivative (SUC n) f =
2533                 real_derivative (higher_real_derivative n f))`;;
2534
2535 let real_differentiable_on = new_definition
2536  `f real_differentiable_on s <=>
2537      !x. x IN s ==> ?f'. (f has_real_derivative f') (atreal x within s)`;;
2538
2539 (* ------------------------------------------------------------------------- *)
2540 (* Basic limit definitions in the useful cases.                              *)
2541 (* ------------------------------------------------------------------------- *)
2542
2543 let HAS_REAL_DERIVATIVE_WITHINREAL = prove
2544  (`(f has_real_derivative f') (atreal a within s) <=>
2545            ((\x. (f x - f a) / (x - a)) ---> f') (atreal a within s)`,
2546   REWRITE_TAC[has_real_derivative] THEN
2547   ASM_CASES_TAC `trivial_limit(atreal a within s)` THENL
2548    [ASM_REWRITE_TAC[REALLIM]; ALL_TAC] THEN
2549   ASM_SIMP_TAC[NETLIMIT_WITHINREAL] THEN
2550   GEN_REWRITE_TAC RAND_CONV [REALLIM_NULL] THEN
2551   REWRITE_TAC[REALLIM_WITHINREAL; REAL_SUB_RZERO] THEN
2552   SIMP_TAC[REAL_FIELD
2553    `&0 < abs(x - a) ==> (fy - fa) / (x - a) - f' =
2554                         inv(x - a) * (fy - (fa + f' * (x - a)))`]);;
2555
2556 let HAS_REAL_DERIVATIVE_ATREAL = prove
2557  (`(f has_real_derivative f') (atreal a) <=>
2558            ((\x. (f x - f a) / (x - a)) ---> f') (atreal a)`,
2559   ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
2560   REWRITE_TAC[HAS_REAL_DERIVATIVE_WITHINREAL]);;
2561
2562 (* ------------------------------------------------------------------------- *)
2563 (* Relation to Frechet derivative.                                           *)
2564 (* ------------------------------------------------------------------------- *)
2565
2566 let HAS_REAL_FRECHET_DERIVATIVE_WITHIN = prove
2567  (`(f has_real_derivative f') (atreal x within s) <=>
2568         ((lift o f o drop) has_derivative (\x. f' % x))
2569         (at (lift x) within (IMAGE lift s))`,
2570   REWRITE_TAC[has_derivative_within; HAS_REAL_DERIVATIVE_WITHINREAL] THEN
2571   REWRITE_TAC[o_THM; LIFT_DROP; LIM_WITHIN; REALLIM_WITHINREAL] THEN
2572   SIMP_TAC[LINEAR_COMPOSE_CMUL; LINEAR_ID; IMP_CONJ] THEN
2573   REWRITE_TAC[FORALL_IN_IMAGE; DIST_LIFT; GSYM LIFT_SUB; LIFT_DROP;
2574     NORM_ARITH `dist(x,vec 0) = norm x`; GSYM LIFT_CMUL; GSYM LIFT_ADD;
2575     NORM_LIFT] THEN
2576   SIMP_TAC[REAL_FIELD
2577    `&0 < abs(y - x)
2578     ==> fy - (fx + f' * (y - x)) = (y - x) * ((fy - fx) / (y - x) - f')`] THEN
2579   REWRITE_TAC[REAL_ABS_MUL; REAL_MUL_ASSOC; REAL_ABS_INV; REAL_ABS_ABS] THEN
2580   SIMP_TAC[REAL_LT_IMP_NZ; REAL_MUL_LINV; REAL_MUL_LID]);;
2581
2582 let HAS_REAL_FRECHET_DERIVATIVE_AT = prove
2583  (`(f has_real_derivative f') (atreal x) <=>
2584         ((lift o f o drop) has_derivative (\x. f' % x)) (at (lift x))`,
2585   ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV; GSYM WITHIN_UNIV] THEN
2586   REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN] THEN
2587   REWRITE_TAC[IMAGE_LIFT_UNIV]);;
2588
2589 let HAS_REAL_VECTOR_DERIVATIVE_WITHIN = prove
2590  (`(f has_real_derivative f') (atreal x within s) <=>
2591         ((lift o f o drop) has_vector_derivative (lift f'))
2592         (at (lift x) within (IMAGE lift s))`,
2593   REWRITE_TAC[has_vector_derivative; HAS_REAL_FRECHET_DERIVATIVE_WITHIN] THEN
2594   AP_THM_TAC THEN AP_TERM_TAC THEN
2595   REWRITE_TAC[FUN_EQ_THM; FORALL_LIFT; GSYM LIFT_CMUL] THEN
2596   REWRITE_TAC[LIFT_DROP; LIFT_EQ; REAL_MUL_SYM]);;
2597
2598 let HAS_REAL_VECTOR_DERIVATIVE_AT = prove
2599  (`(f has_real_derivative f') (atreal x) <=>
2600         ((lift o f o drop) has_vector_derivative (lift f')) (at (lift x))`,
2601   REWRITE_TAC[has_vector_derivative; HAS_REAL_FRECHET_DERIVATIVE_AT] THEN
2602   AP_THM_TAC THEN AP_TERM_TAC THEN
2603   REWRITE_TAC[FUN_EQ_THM; FORALL_LIFT; GSYM LIFT_CMUL] THEN
2604   REWRITE_TAC[LIFT_DROP; LIFT_EQ; REAL_MUL_SYM]);;
2605
2606 let REAL_DIFFERENTIABLE_AT = prove
2607  (`!f a. f real_differentiable (atreal x) <=>
2608          (lift o f o drop) differentiable (at(lift x))`,
2609   REWRITE_TAC[real_differentiable; HAS_REAL_FRECHET_DERIVATIVE_AT] THEN
2610   REWRITE_TAC[differentiable; has_derivative; LINEAR_SCALING] THEN
2611   REWRITE_TAC[LINEAR_1; LEFT_AND_EXISTS_THM] THEN
2612   ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2]);;
2613
2614 let REAL_DIFFERENTIABLE_WITHIN = prove
2615  (`!f a s.
2616         f real_differentiable (atreal x within s) <=>
2617         (lift o f o drop) differentiable (at(lift x) within IMAGE lift s)`,
2618   REWRITE_TAC[real_differentiable; HAS_REAL_FRECHET_DERIVATIVE_WITHIN] THEN
2619   REWRITE_TAC[differentiable; has_derivative; LINEAR_SCALING] THEN
2620   REWRITE_TAC[LINEAR_1; LEFT_AND_EXISTS_THM] THEN
2621   ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2]);;
2622
2623 (* ------------------------------------------------------------------------- *)
2624 (* Relation to complex derivative.                                           *)
2625 (* ------------------------------------------------------------------------- *)
2626
2627 let HAS_REAL_COMPLEX_DERIVATIVE_WITHIN = prove
2628  (`(f has_real_derivative f') (atreal a within s) <=>
2629         ((Cx o f o Re) has_complex_derivative (Cx f'))
2630                 (at (Cx a) within {z | real z /\ Re z IN s})`,
2631   REWRITE_TAC[HAS_REAL_DERIVATIVE_WITHINREAL; HAS_COMPLEX_DERIVATIVE_WITHIN;
2632               LIM_WITHIN; IN_ELIM_THM; IMP_CONJ; FORALL_REAL] THEN
2633   REWRITE_TAC[RE_CX; dist; GSYM CX_SUB; COMPLEX_NORM_CX; o_THM; GSYM CX_DIV;
2634               REALLIM_WITHINREAL] THEN
2635   MESON_TAC[]);;
2636
2637 let HAS_REAL_COMPLEX_DERIVATIVE_AT = prove
2638  (`(f has_real_derivative f') (atreal a) <=>
2639        ((Cx o f o Re) has_complex_derivative (Cx f')) (at (Cx a) within real)`,
2640   ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
2641   REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN
2642   AP_TERM_TAC THEN AP_TERM_TAC THEN SET_TAC[]);;
2643
2644 let REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE = prove
2645  (`!f s. f real_differentiable_on s <=>
2646          !x. x IN s ==> f real_differentiable (atreal x within s)`,
2647   REWRITE_TAC[real_differentiable_on; real_differentiable]);;
2648
2649 let REAL_DIFFERENTIABLE_ON_REAL_OPEN = prove
2650  (`!f s. real_open s
2651          ==> (f real_differentiable_on s <=>
2652               !x. x IN s ==> ?f'. (f has_real_derivative f') (atreal x))`,
2653   REWRITE_TAC[real_differentiable_on; HAS_REAL_DERIVATIVE_WITHINREAL;
2654               HAS_REAL_DERIVATIVE_ATREAL] THEN
2655   SIMP_TAC[REALLIM_WITHIN_REAL_OPEN]);;
2656
2657 let REAL_DIFFERENTIABLE_ON_IMP_DIFFERENTIABLE_WITHIN = prove
2658  (`!f s x. f real_differentiable_on s /\ x IN s
2659            ==> f real_differentiable (atreal x within s)`,
2660   MESON_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE]);;
2661
2662 let REAL_DIFFERENTIABLE_ON_IMP_DIFFERENTIABLE_ATREAL = prove
2663  (`!f s x. f real_differentiable_on s /\ real_open s /\ x IN s
2664            ==> f real_differentiable (atreal x)`,
2665   MESON_TAC[REAL_DIFFERENTIABLE_ON_REAL_OPEN; real_differentiable]);;
2666
2667 let HAS_COMPLEX_REAL_DERIVATIVE_WITHIN_GEN = prove
2668  (`!f g h s d.
2669         &0 < d /\ x IN s /\
2670         (h has_complex_derivative Cx(g))
2671         (at (Cx x) within {z | real z /\ Re(z) IN s}) /\
2672         (!y. y IN s /\ abs(y - x) < d ==>  h(Cx y) = Cx(f y))
2673         ==> (f has_real_derivative g) (atreal x within s)`,
2674   REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN
2675   MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN THEN
2676   MAP_EVERY EXISTS_TAC [`h:complex->complex`; `d:real`] THEN
2677   ASM_REWRITE_TAC[IN_ELIM_THM; o_THM; REAL_CX; RE_CX; dist] THEN
2678   X_GEN_TAC `w:complex` THEN STRIP_TAC THEN
2679   FIRST_X_ASSUM(MP_TAC o SPEC `Re w`) THEN
2680   FIRST_X_ASSUM(SUBST_ALL_TAC o SYM o GEN_REWRITE_RULE I [REAL]) THEN
2681   RULE_ASSUM_TAC(REWRITE_RULE[GSYM CX_SUB; COMPLEX_NORM_CX]) THEN
2682   ASM_REWRITE_TAC[RE_CX]);;
2683
2684 let HAS_COMPLEX_REAL_DERIVATIVE_AT_GEN = prove
2685  (`!f g h d.
2686         &0 < d /\
2687         (h has_complex_derivative Cx(g)) (at (Cx x) within real) /\
2688         (!y. abs(y - x) < d ==>  h(Cx y) = Cx(f y))
2689         ==> (f has_real_derivative g) (atreal x)`,
2690   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
2691   MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_WITHIN_GEN THEN
2692   MAP_EVERY EXISTS_TAC [`h:complex->complex`; `d:real`] THEN
2693   ASM_REWRITE_TAC[IN_UNIV; ETA_AX; SET_RULE `{x | r x} = r`]);;
2694
2695 let HAS_COMPLEX_REAL_DERIVATIVE_WITHIN = prove
2696  (`!f g h s.
2697         x IN s /\
2698         (h has_complex_derivative Cx(g))
2699         (at (Cx x) within {z | real z /\ Re(z) IN s}) /\
2700         (!y. y IN s ==>  h(Cx y) = Cx(f y))
2701         ==> (f has_real_derivative g) (atreal x within s)`,
2702   REPEAT STRIP_TAC THEN
2703   MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_WITHIN_GEN THEN
2704   MAP_EVERY EXISTS_TAC [`h:complex->complex`; `&1`] THEN
2705   ASM_SIMP_TAC[REAL_LT_01]);;
2706
2707 let HAS_COMPLEX_REAL_DERIVATIVE_AT = prove
2708  (`!f g h.
2709         (h has_complex_derivative Cx(g)) (at (Cx x) within real) /\
2710         (!y. h(Cx y) = Cx(f y))
2711         ==> (f has_real_derivative g) (atreal x)`,
2712   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
2713   MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_WITHIN THEN
2714   EXISTS_TAC `h:complex->complex` THEN
2715   ASM_REWRITE_TAC[IN_UNIV; ETA_AX; SET_RULE `{x | r x} = r`]);;
2716
2717 (* ------------------------------------------------------------------------- *)
2718 (* Caratheodory characterization.                                            *)
2719 (* ------------------------------------------------------------------------- *)
2720
2721 let HAS_REAL_DERIVATIVE_CARATHEODORY_ATREAL = prove
2722  (`!f f' z.
2723         (f has_real_derivative f') (atreal z) <=>
2724         ?g. (!w. f(w) - f(z) = g(w) * (w - z)) /\
2725             g real_continuous atreal z /\ g(z) = f'`,
2726   REPEAT GEN_TAC THEN
2727   REWRITE_TAC[REAL_RING `w' - z':real = a <=> w' = z' + a`] THEN
2728   SIMP_TAC[GSYM FUN_EQ_THM; HAS_REAL_DERIVATIVE_ATREAL;
2729            REAL_CONTINUOUS_ATREAL] THEN
2730   EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
2731    [EXISTS_TAC `\w. if w = z then f':real else (f(w) - f(z)) / (w - z)` THEN
2732     ASM_SIMP_TAC[FUN_EQ_THM; COND_RAND; COND_RATOR; REAL_SUB_REFL] THEN
2733     CONV_TAC REAL_FIELD;
2734     FIRST_X_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM SUBST1_TAC THEN
2735     ASM_SIMP_TAC[REAL_RING `(z + a) - (z + b * (w - w)):real = a`] THEN
2736     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
2737       REALLIM_TRANSFORM)) THEN
2738     SIMP_TAC[REALLIM_CONST; REAL_FIELD
2739      `~(w = z) ==> x - (x * (w - z)) / (w - z) = &0`]]);;
2740
2741 let HAS_REAL_DERIVATIVE_CARATHEODORY_WITHINREAL = prove
2742  (`!f f' z s.
2743         (f has_real_derivative f') (atreal z within s) <=>
2744         ?g. (!w. f(w) - f(z) = g(w) * (w - z)) /\
2745             g real_continuous (atreal z within s) /\ g(z) = f'`,
2746   REPEAT GEN_TAC THEN
2747   REWRITE_TAC[REAL_RING `w' - z':real = a <=> w' = z' + a`] THEN
2748   SIMP_TAC[GSYM FUN_EQ_THM; HAS_REAL_DERIVATIVE_WITHINREAL;
2749            REAL_CONTINUOUS_WITHINREAL] THEN
2750   EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL
2751    [EXISTS_TAC `\w. if w = z then f':real else (f(w) - f(z)) / (w - z)` THEN
2752     ASM_SIMP_TAC[FUN_EQ_THM; COND_RAND; COND_RATOR; REAL_SUB_REFL] THEN
2753     CONV_TAC REAL_FIELD;
2754     FIRST_X_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM SUBST1_TAC THEN
2755     ASM_SIMP_TAC[REAL_RING `(z + a) - (z + b * (w - w)):real = a`] THEN
2756     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
2757       REALLIM_TRANSFORM)) THEN
2758     SIMP_TAC[REALLIM_CONST; REAL_FIELD
2759      `~(w = z) ==> x - (x * (w - z)) / (w - z) = &0`]]);;
2760
2761 let REAL_DIFFERENTIABLE_CARATHEODORY_ATREAL = prove
2762  (`!f z. f real_differentiable atreal z <=>
2763          ?g. (!w. f(w) - f(z) = g(w) * (w - z)) /\ g real_continuous atreal z`,
2764   SIMP_TAC[real_differentiable; HAS_REAL_DERIVATIVE_CARATHEODORY_ATREAL] THEN
2765   MESON_TAC[]);;
2766
2767 let REAL_DIFFERENTIABLE_CARATHEODORY_WITHINREAL = prove
2768  (`!f z s.
2769       f real_differentiable (atreal z within s) <=>
2770       ?g. (!w. f(w) - f(z) = g(w) * (w - z)) /\
2771           g real_continuous (atreal z within s)`,
2772   SIMP_TAC[real_differentiable;
2773            HAS_REAL_DERIVATIVE_CARATHEODORY_WITHINREAL] THEN
2774   MESON_TAC[]);;
2775
2776 (* ------------------------------------------------------------------------- *)
2777 (* Property of being an interval (equivalent to convex or connected).        *)
2778 (* ------------------------------------------------------------------------- *)
2779
2780 let is_realinterval = new_definition
2781  `is_realinterval s <=>
2782         !a b c. a IN s /\ b IN s /\ a <= c /\ c <= b ==> c IN s`;;
2783
2784 let IS_REALINTERVAL_IS_INTERVAL = prove
2785  (`!s. is_realinterval s <=> is_interval(IMAGE lift s)`,
2786   REWRITE_TAC[IS_INTERVAL_1; is_realinterval] THEN
2787   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
2788   REWRITE_TAC[LIFT_DROP; IN_IMAGE; EXISTS_DROP; UNWIND_THM1] THEN
2789   REWRITE_TAC[GSYM FORALL_DROP]);;
2790
2791 let IS_REALINTERVAL_CONVEX = prove
2792  (`!s. is_realinterval s <=> convex(IMAGE lift s)`,
2793   REWRITE_TAC[IS_REALINTERVAL_IS_INTERVAL; IS_INTERVAL_CONVEX_1]);;
2794
2795 let IS_REALINTERVAL_CONNECTED = prove
2796  (`!s. is_realinterval s <=> connected(IMAGE lift s)`,
2797   REWRITE_TAC[IS_REALINTERVAL_IS_INTERVAL; IS_INTERVAL_CONNECTED_1]);;
2798
2799 let TRIVIAL_LIMIT_WITHIN_REALINTERVAL = prove
2800  (`!s x. is_realinterval s /\ x IN s
2801          ==> (trivial_limit(atreal x within s) <=> s = {x})`,
2802   REWRITE_TAC[TRIVIAL_LIMIT_WITHINREAL_WITHIN; IS_REALINTERVAL_CONVEX] THEN
2803   REWRITE_TAC[FORALL_DROP; GSYM IN_IMAGE_LIFT_DROP; LIFT_DROP] THEN
2804   SIMP_TAC[TRIVIAL_LIMIT_WITHIN_CONVEX] THEN REPEAT STRIP_TAC THEN
2805   REWRITE_TAC[EXTENSION; IN_IMAGE_LIFT_DROP; IN_SING] THEN
2806   MESON_TAC[LIFT_DROP]);;
2807
2808 let IS_REALINTERVAL_EMPTY = prove
2809  (`is_realinterval {}`,
2810   REWRITE_TAC[is_realinterval; NOT_IN_EMPTY]);;
2811
2812 let IS_REALINTERVAL_UNION = prove
2813  (`!s t. is_realinterval s /\ is_realinterval t /\ ~(s INTER t = {})
2814          ==> is_realinterval(s UNION t)`,
2815   REWRITE_TAC[is_realinterval; IN_UNION; IN_INTER;
2816               NOT_IN_EMPTY; EXTENSION] THEN
2817   MESON_TAC[REAL_LE_TRANS; REAL_LE_TOTAL]);;
2818
2819 let IS_REALINTERVAL_UNIV = prove
2820  (`is_realinterval (:real)`,
2821   REWRITE_TAC[is_realinterval; IN_UNIV]);;
2822
2823 let IS_REAL_INTERVAL_CASES = prove
2824  (`!s. is_realinterval s <=>
2825         s = {} \/
2826         s = (:real) \/
2827         (?a. s = {x | a < x}) \/
2828         (?a. s = {x | a <= x}) \/
2829         (?b. s = {x | x <= b}) \/
2830         (?b. s = {x | x < b}) \/
2831         (?a b. s = {x | a < x /\ x < b}) \/
2832         (?a b. s = {x | a < x /\ x <= b}) \/
2833         (?a b. s = {x | a <= x /\ x < b}) \/
2834         (?a b. s = {x | a <= x /\ x <= b})`,
2835   REWRITE_TAC[IS_REALINTERVAL_IS_INTERVAL; IS_INTERVAL_1_CASES] THEN
2836   REWRITE_TAC[EXTENSION; IN_IMAGE_LIFT_DROP; IN_ELIM_THM] THEN
2837   REWRITE_TAC[GSYM FORALL_DROP; IN_UNIV; NOT_IN_EMPTY]);;
2838
2839 (* ------------------------------------------------------------------------- *)
2840 (* Some relations with the complex numbers can also be useful.               *)
2841 (* ------------------------------------------------------------------------- *)
2842
2843 let IS_REALINTERVAL_CONVEX_COMPLEX = prove
2844  (`!s. is_realinterval s <=> convex {z | real z /\ Re z IN s}`,
2845   GEN_TAC THEN
2846   REWRITE_TAC[GSYM IMAGE_CX; IS_REALINTERVAL_CONVEX] THEN EQ_TAC THENL
2847    [DISCH_THEN(MP_TAC o ISPEC `Cx o drop` o MATCH_MP
2848      (REWRITE_RULE[IMP_CONJ] CONVEX_LINEAR_IMAGE)) THEN
2849     REWRITE_TAC[GSYM IMAGE_o; GSYM o_ASSOC] THEN
2850     ONCE_REWRITE_TAC[IMAGE_o] THEN REWRITE_TAC[IMAGE_LIFT_DROP] THEN
2851     DISCH_THEN MATCH_MP_TAC THEN
2852     REWRITE_TAC[linear; o_THM; CX_ADD; CX_MUL; DROP_ADD; DROP_CMUL;
2853                 COMPLEX_CMUL];
2854     DISCH_THEN(MP_TAC o ISPEC `lift o Re` o MATCH_MP
2855      (REWRITE_RULE[IMP_CONJ] CONVEX_LINEAR_IMAGE)) THEN
2856     REWRITE_TAC[GSYM IMAGE_o; GSYM o_ASSOC] THEN
2857     ONCE_REWRITE_TAC[IMAGE_o] THEN
2858     REWRITE_TAC[o_DEF; RE_CX; SET_RULE `IMAGE (\x. x) s = s`] THEN
2859     DISCH_THEN MATCH_MP_TAC THEN
2860     REWRITE_TAC[linear; o_THM; RE_CMUL;
2861                 RE_ADD; RE_MUL_CX; LIFT_ADD; LIFT_CMUL]]);;
2862
2863 (* ------------------------------------------------------------------------- *)
2864 (* The same tricks to define closed and open intervals.                      *)
2865 (* ------------------------------------------------------------------------- *)
2866
2867 let open_real_interval = new_definition
2868   `open_real_interval(a:real,b:real) = {x:real | a < x /\ x < b}`;;
2869
2870 let closed_real_interval = define
2871   `closed_real_interval[a:real,b:real] = {x:real | a <= x /\ x <= b}`;;
2872
2873 make_overloadable "real_interval" `:A`;;
2874
2875 overload_interface("real_interval",`open_real_interval`);;
2876 overload_interface("real_interval",`closed_real_interval`);;
2877
2878 let real_interval = prove
2879  (`real_interval(a,b) = {x | a < x /\ x < b} /\
2880    real_interval[a,b] = {x | a <= x /\ x <= b}`,
2881   REWRITE_TAC[open_real_interval; closed_real_interval]);;
2882
2883 let IN_REAL_INTERVAL = prove
2884  (`!a b x. (x IN real_interval[a,b] <=> a <= x /\ x <= b) /\
2885            (x IN real_interval(a,b) <=> a < x /\ x < b)`,
2886   REWRITE_TAC[real_interval; IN_ELIM_THM]);;
2887
2888 let REAL_INTERVAL_INTERVAL = prove
2889  (`real_interval[a,b] = IMAGE drop (interval[lift a,lift b]) /\
2890    real_interval(a,b) = IMAGE drop (interval(lift a,lift b))`,
2891   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_INTERVAL_1; IN_REAL_INTERVAL] THEN
2892   REWRITE_TAC[EXISTS_LIFT; LIFT_DROP; UNWIND_THM1]);;
2893
2894 let INTERVAL_REAL_INTERVAL = prove
2895  (`interval[a,b] = IMAGE lift (real_interval[drop a,drop b]) /\
2896    interval(a,b) = IMAGE lift (real_interval(drop a,drop b))`,
2897   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_INTERVAL_1; IN_REAL_INTERVAL] THEN
2898   REWRITE_TAC[EXISTS_DROP; LIFT_DROP; UNWIND_THM1]);;
2899
2900 let EMPTY_AS_REAL_INTERVAL = prove
2901  (`{} = real_interval[&1,&0]`,
2902   REWRITE_TAC[REAL_INTERVAL_INTERVAL; LIFT_NUM; GSYM EMPTY_AS_INTERVAL] THEN
2903   REWRITE_TAC[IMAGE_CLAUSES]);;
2904
2905 let IMAGE_LIFT_REAL_INTERVAL = prove
2906  (`IMAGE lift (real_interval[a,b]) = interval[lift a,lift b] /\
2907    IMAGE lift (real_interval(a,b)) = interval(lift a,lift b)`,
2908   REWRITE_TAC[REAL_INTERVAL_INTERVAL; GSYM IMAGE_o; o_DEF; LIFT_DROP] THEN
2909   SET_TAC[]);;
2910
2911 let IMAGE_DROP_INTERVAL = prove
2912  (`IMAGE drop (interval[a,b]) = real_interval[drop a,drop b] /\
2913    IMAGE drop (interval(a,b)) = real_interval(drop a,drop b)`,
2914   REWRITE_TAC[INTERVAL_REAL_INTERVAL; GSYM IMAGE_o; o_DEF; LIFT_DROP] THEN
2915   SET_TAC[]);;
2916
2917 let SUBSET_REAL_INTERVAL = prove
2918  (`!a b c d.
2919         (real_interval[a,b] SUBSET real_interval[c,d] <=>
2920                 b < a \/ c <= a /\ a <= b /\ b <= d) /\
2921         (real_interval[a,b] SUBSET real_interval(c,d) <=>
2922                 b < a \/ c < a /\ a <= b /\ b < d) /\
2923         (real_interval(a,b) SUBSET real_interval[c,d] <=>
2924                 b <= a \/ c <= a /\ a < b /\ b <= d) /\
2925         (real_interval(a,b) SUBSET real_interval(c,d) <=>
2926                 b <= a \/ c <= a /\ a < b /\ b <= d)`,
2927   let lemma = prove
2928    (`IMAGE drop s SUBSET IMAGE drop t <=> s SUBSET t`,
2929     SET_TAC[LIFT_DROP]) in
2930   REWRITE_TAC[REAL_INTERVAL_INTERVAL; lemma; SUBSET_INTERVAL_1] THEN
2931   REWRITE_TAC[LIFT_DROP]);;
2932
2933 let REAL_INTERVAL_OPEN_SUBSET_CLOSED = prove
2934  (`!a b. real_interval(a,b) SUBSET real_interval[a,b]`,
2935   REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN REAL_ARITH_TAC);;
2936
2937 let REAL_INTERVAL_EQ_EMPTY = prove
2938  (`(!a b. real_interval[a,b] = {} <=> b < a) /\
2939    (!a b. real_interval(a,b) = {} <=> b <= a)`,
2940   REWRITE_TAC[REAL_INTERVAL_INTERVAL; IMAGE_EQ_EMPTY] THEN
2941   REWRITE_TAC[INTERVAL_EQ_EMPTY_1; LIFT_DROP]);;
2942
2943 let REAL_INTERVAL_NE_EMPTY = prove
2944  (`(!a b. ~(real_interval[a,b] = {}) <=> a <= b) /\
2945    (!a b. ~(real_interval(a,b) = {}) <=> a < b)`,
2946   REWRITE_TAC[REAL_INTERVAL_EQ_EMPTY; REAL_NOT_LE; REAL_NOT_LT]);;
2947
2948 let REAL_OPEN_CLOSED_INTERVAL = prove
2949  (`!a b. real_interval(a,b) = real_interval[a,b] DIFF {a,b}`,
2950   SIMP_TAC[EXTENSION; IN_DIFF; IN_REAL_INTERVAL; IN_INSERT; NOT_IN_EMPTY] THEN
2951   REAL_ARITH_TAC);;
2952
2953 let REAL_CLOSED_OPEN_INTERVAL = prove
2954  (`!a b. a <= b ==> real_interval[a,b] = real_interval(a,b) UNION {a,b}`,
2955   SIMP_TAC[EXTENSION; IN_UNION; IN_REAL_INTERVAL; IN_INSERT; NOT_IN_EMPTY] THEN
2956   REAL_ARITH_TAC);;
2957
2958 let REAL_CLOSED_REAL_INTERVAL = prove
2959  (`!a b. real_closed(real_interval[a,b])`,
2960   REWRITE_TAC[REAL_CLOSED; IMAGE_LIFT_REAL_INTERVAL; CLOSED_INTERVAL]);;
2961
2962 let REAL_OPEN_REAL_INTERVAL = prove
2963  (`!a b. real_open(real_interval(a,b))`,
2964   REWRITE_TAC[REAL_OPEN; IMAGE_LIFT_REAL_INTERVAL; OPEN_INTERVAL]);;
2965
2966 let REAL_INTERVAL_SING = prove
2967  (`!a. real_interval[a,a] = {a} /\ real_interval(a,a) = {}`,
2968   REWRITE_TAC[EXTENSION; IN_SING; NOT_IN_EMPTY; IN_REAL_INTERVAL] THEN
2969   REAL_ARITH_TAC);;
2970
2971 let REAL_COMPACT_INTERVAL = prove
2972  (`!a b. real_compact(real_interval[a,b])`,
2973   REWRITE_TAC[REAL_INTERVAL_INTERVAL; real_compact] THEN
2974   REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_ID; COMPACT_INTERVAL]);;
2975
2976 let IS_REALINTERVAL_INTERVAL = prove
2977  (`!a b. is_realinterval(real_interval(a,b)) /\
2978          is_realinterval(real_interval[a,b])`,
2979   REWRITE_TAC[is_realinterval; IN_REAL_INTERVAL] THEN REAL_ARITH_TAC);;
2980
2981 let REAL_BOUNDED_REAL_INTERVAL = prove
2982  (`(!a b. real_bounded(real_interval[a,b])) /\
2983    (!a b. real_bounded(real_interval(a,b)))`,
2984   REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; REAL_BOUNDED; BOUNDED_INTERVAL]);;
2985
2986 let ENDS_IN_REAL_INTERVAL = prove
2987  (`(!a b. a IN real_interval[a,b] <=> ~(real_interval[a,b] = {})) /\
2988    (!a b. b IN real_interval[a,b] <=> ~(real_interval[a,b] = {})) /\
2989    (!a b. ~(a IN real_interval(a,b))) /\
2990    (!a b. ~(b IN real_interval(a,b)))`,
2991   REWRITE_TAC[IN_REAL_INTERVAL; REAL_INTERVAL_EQ_EMPTY] THEN REAL_ARITH_TAC);;
2992
2993 let IMAGE_AFFINITY_REAL_INTERVAL = prove
2994  (`!a b m c.
2995          IMAGE (\x. m * x + c) (real_interval[a,b]) =
2996          (if real_interval[a,b] = {}
2997           then {}
2998           else if &0 <= m
2999                then real_interval[m * a + c,m * b + c]
3000                else real_interval[m * b + c,m * a + c])`,
3001   REWRITE_TAC[REAL_INTERVAL_INTERVAL; GSYM IMAGE_o; o_DEF; IMAGE_EQ_EMPTY] THEN
3002   REWRITE_TAC[FORALL_DROP; LIFT_DROP; GSYM DROP_CMUL; GSYM DROP_ADD] THEN
3003   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN
3004   REWRITE_TAC[IMAGE_o; IMAGE_AFFINITY_INTERVAL] THEN
3005   MESON_TAC[IMAGE_CLAUSES]);;
3006
3007 let IMAGE_STRETCH_REAL_INTERVAL = prove
3008  (`!a b m.
3009          IMAGE (\x. m * x) (real_interval[a,b]) =
3010          (if real_interval[a,b] = {}
3011           then {}
3012           else if &0 <= m
3013                then real_interval[m * a,m * b]
3014                else real_interval[m * b,m * a])`,
3015   ONCE_REWRITE_TAC[REAL_ARITH `m * x = m * x + &0`] THEN
3016   REWRITE_TAC[IMAGE_AFFINITY_REAL_INTERVAL]);;
3017
3018 let REAL_INTERVAL_TRANSLATION = prove
3019  (`(!c a b. real_interval[c + a,c + b] =
3020             IMAGE (\x. c + x) (real_interval[a,b])) /\
3021    (!c a b. real_interval(c + a,c + b) =
3022             IMAGE (\x. c + x) (real_interval(a,b)))`,
3023   REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
3024   MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
3025   REWRITE_TAC[REAL_ARITH `c + x:real = y <=> x = y - c`; EXISTS_REFL] THEN
3026   REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC);;
3027
3028 let IN_REAL_INTERVAL_REFLECT = prove
3029  (`(!a b x. --x IN real_interval[--b,--a] <=> x IN real_interval[a,b]) /\
3030    (!a b x. --x IN real_interval(--b,--a) <=> x IN real_interval(a,b))`,
3031   REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC);;
3032
3033 let REFLECT_REAL_INTERVAL = prove
3034  (`(!a b. IMAGE (--) (real_interval[a,b]) = real_interval[--b,--a]) /\
3035    (!a b. IMAGE (--) (real_interval(a,b)) = real_interval(--b,--a))`,
3036   REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_REAL_INTERVAL] THEN
3037   ONCE_REWRITE_TAC[REAL_ARITH `x:real = --y <=> --x = y`] THEN
3038   REWRITE_TAC[UNWIND_THM1] THEN REAL_ARITH_TAC);;
3039
3040 (* ------------------------------------------------------------------------- *)
3041 (* Real continuity and differentiability.                                    *)
3042 (* ------------------------------------------------------------------------- *)
3043
3044 let REAL_CONTINUOUS_CONTINUOUS = prove
3045  (`f real_continuous net <=> (Cx o f) continuous net`,
3046   REWRITE_TAC[real_continuous; continuous; REALLIM_COMPLEX; o_THM]);;
3047
3048 let REAL_CONTINUOUS_CONTINUOUS1 = prove
3049  (`f real_continuous net <=> (lift o f) continuous net`,
3050   REWRITE_TAC[real_continuous; continuous; TENDSTO_REAL; o_THM]);;
3051
3052 let REAL_CONTINUOUS_CONTINUOUS_ATREAL = prove
3053  (`f real_continuous (atreal x) <=> (lift o f o drop) continuous (at(lift x))`,
3054   REWRITE_TAC[REAL_CONTINUOUS_ATREAL; REALLIM_ATREAL_AT; CONTINUOUS_AT;
3055               TENDSTO_REAL; o_THM; LIFT_DROP]);;
3056
3057 let REAL_CONTINUOUS_CONTINUOUS_WITHINREAL = prove
3058  (`f real_continuous (atreal x within s) <=>
3059    (lift o f o drop) continuous (at(lift x) within IMAGE lift s)`,
3060   REWRITE_TAC[REAL_CONTINUOUS_WITHINREAL; REALLIM_WITHINREAL_WITHIN] THEN
3061   REWRITE_TAC[TENDSTO_REAL; CONTINUOUS_WITHIN; o_THM; LIFT_DROP]);;
3062
3063 let REAL_COMPLEX_CONTINUOUS_WITHINREAL = prove
3064  (`f real_continuous (atreal x within s) <=>
3065        (Cx o f o Re) continuous (at (Cx x) within (real INTER IMAGE Cx s))`,
3066   REWRITE_TAC[real_continuous; continuous; REALLIM_COMPLEX;
3067          LIM_WITHINREAL_WITHINCOMPLEX; NETLIMIT_WITHINREAL; GSYM o_ASSOC] THEN
3068   ASM_CASES_TAC `trivial_limit(at(Cx x) within (real INTER IMAGE Cx s))` THENL
3069    [ASM_REWRITE_TAC[LIM];
3070     ASM_SIMP_TAC[TRIVIAL_LIMIT_WITHINREAL_WITHINCOMPLEX;
3071         NETLIMIT_WITHIN; NETLIMIT_WITHINREAL; RE_CX; o_THM]]);;
3072
3073 let REAL_COMPLEX_CONTINUOUS_ATREAL = prove
3074  (`f real_continuous (atreal x) <=>
3075        (Cx o f o Re) continuous (at (Cx x) within real)`,
3076   REWRITE_TAC[real_continuous; continuous; REALLIM_COMPLEX;
3077               LIM_ATREAL_ATCOMPLEX; NETLIMIT_ATREAL; GSYM o_ASSOC] THEN
3078   ASM_CASES_TAC `trivial_limit(at(Cx x) within real)` THENL
3079    [ASM_REWRITE_TAC[LIM];
3080     ASM_SIMP_TAC[NETLIMIT_WITHIN; RE_CX; o_THM]]);;
3081
3082 let CONTINUOUS_CONTINUOUS_WITHINREAL = prove
3083  (`!f x s. f continuous (atreal x within s) <=>
3084            (f o drop) continuous (at (lift x) within IMAGE lift s)`,
3085   REWRITE_TAC[REALLIM_WITHINREAL_WITHIN; CONTINUOUS_WITHIN;
3086           CONTINUOUS_WITHINREAL; o_DEF; LIFT_DROP; LIM_WITHINREAL_WITHIN]);;
3087
3088 let CONTINUOUS_CONTINUOUS_ATREAL = prove
3089  (`!f x. f continuous (atreal x) <=> (f o drop) continuous (at (lift x))`,
3090   REWRITE_TAC[REALLIM_ATREAL_AT; CONTINUOUS_AT;
3091           CONTINUOUS_ATREAL; o_DEF; LIFT_DROP; LIM_ATREAL_AT]);;
3092
3093 let REAL_CONTINUOUS_REAL_CONTINUOUS_WITHINREAL = prove
3094  (`!f x s. f real_continuous (atreal x within s) <=>
3095            (f o drop) real_continuous (at (lift x) within IMAGE lift s)`,
3096   REWRITE_TAC[REALLIM_WITHINREAL_WITHIN; REAL_CONTINUOUS_WITHIN;
3097               REAL_CONTINUOUS_WITHINREAL; o_DEF; LIFT_DROP;
3098               LIM_WITHINREAL_WITHIN]);;
3099
3100 let REAL_CONTINUOUS_REAL_CONTINUOUS_ATREAL = prove
3101  (`!f x. f real_continuous (atreal x) <=>
3102          (f o drop) real_continuous (at (lift x))`,
3103   REWRITE_TAC[REALLIM_ATREAL_AT; REAL_CONTINUOUS_AT;
3104           REAL_CONTINUOUS_ATREAL; o_DEF; LIFT_DROP; LIM_ATREAL_AT]);;
3105 let HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_WITHINREAL = prove
3106  (`!f f' x s. (f has_real_derivative f') (atreal x within s)
3107               ==> f real_continuous (atreal x within s)`,
3108   REPEAT GEN_TAC THEN
3109   REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN;
3110               REAL_COMPLEX_CONTINUOUS_WITHINREAL] THEN
3111   DISCH_THEN(MP_TAC o
3112     MATCH_MP HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_WITHIN) THEN
3113   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
3114   REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; IN_IMAGE] THEN
3115   MESON_TAC[REAL; RE_CX; REAL_CX; IN]);;
3116
3117 let REAL_DIFFERENTIABLE_IMP_CONTINUOUS_WITHINREAL = prove
3118  (`!f x s. f real_differentiable (atreal x within s)
3119            ==> f real_continuous (atreal x within s)`,
3120   MESON_TAC[HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_WITHINREAL;
3121             real_differentiable]);;
3122
3123 let HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL = prove
3124  (`!f f' x. (f has_real_derivative f') (atreal x)
3125             ==> f real_continuous (atreal x)`,
3126   REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_AT;
3127               REAL_COMPLEX_CONTINUOUS_ATREAL;
3128               HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_WITHIN]);;
3129
3130 let REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL = prove
3131  (`!f x. f real_differentiable atreal x ==> f real_continuous atreal x`,
3132   MESON_TAC[HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL; real_differentiable]);;
3133
3134 let REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON = prove
3135  (`!f s. f real_differentiable_on s ==> f real_continuous_on s`,
3136   REWRITE_TAC[real_differentiable_on;
3137               REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
3138   MESON_TAC[REAL_DIFFERENTIABLE_IMP_CONTINUOUS_WITHINREAL;
3139             real_differentiable]);;
3140
3141 let REAL_CONTINUOUS_AT_COMPONENT = prove
3142  (`!i a. 1 <= i /\ i <= dimindex(:N)
3143          ==> (\x:real^N. x$i) real_continuous at a`,
3144   REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF;
3145               CONTINUOUS_AT_LIFT_COMPONENT]);;
3146
3147 let REAL_CONTINUOUS_AT_TRANSLATION = prove
3148  (`!a z f:real^N->real.
3149     f real_continuous at (a + z) <=> (\x. f(a + x)) real_continuous at z`,
3150   REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF; CONTINUOUS_AT_TRANSLATION]);;
3151
3152 add_translation_invariants [REAL_CONTINUOUS_AT_TRANSLATION];;
3153
3154 let REAL_CONTINUOUS_AT_LINEAR_IMAGE = prove
3155  (`!h:real^N->real^N z f:real^N->real.
3156         linear h /\ (!x. norm(h x) = norm x)
3157         ==> (f real_continuous at (h z) <=> (\x. f(h x)) real_continuous at z)`,
3158   REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF;
3159               CONTINUOUS_AT_LINEAR_IMAGE]);;
3160
3161 add_linear_invariants [REAL_CONTINUOUS_AT_LINEAR_IMAGE];;
3162
3163 let REAL_CONTINUOUS_AT_ARG = prove
3164  (`!z. ~(real z /\ &0 <= Re z) ==> Arg real_continuous (at z)`,
3165   REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS; CONTINUOUS_AT_ARG]);;
3166
3167 (* ------------------------------------------------------------------------- *)
3168 (* More basics about real derivatives.                                       *)
3169 (* ------------------------------------------------------------------------- *)
3170
3171 let HAS_REAL_DERIVATIVE_WITHIN_SUBSET = prove
3172  (`!f s t x. (f has_real_derivative f') (atreal x within s) /\ t SUBSET s
3173              ==> (f has_real_derivative f') (atreal x within t)`,
3174   REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN
3175   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
3176   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT]
3177    HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET) THEN ASM SET_TAC[]);;
3178
3179 let REAL_DIFFERENTIABLE_ON_SUBSET = prove
3180  (`!f s t. f real_differentiable_on s /\ t SUBSET s
3181            ==> f real_differentiable_on t`,
3182   REWRITE_TAC[real_differentiable_on] THEN
3183   MESON_TAC[SUBSET; HAS_REAL_DERIVATIVE_WITHIN_SUBSET]);;
3184
3185 let REAL_DIFFERENTIABLE_WITHIN_SUBSET = prove
3186  (`!f s t. f real_differentiable (atreal x within s) /\ t SUBSET s
3187            ==> f real_differentiable (atreal x within t)`,
3188   REWRITE_TAC[real_differentiable] THEN
3189   MESON_TAC[HAS_REAL_DERIVATIVE_WITHIN_SUBSET]);;
3190
3191 let HAS_REAL_DERIVATIVE_ATREAL_WITHIN = prove
3192  (`!f f' x s. (f has_real_derivative f') (atreal x)
3193               ==> (f has_real_derivative f') (atreal x within s)`,
3194   REPEAT GEN_TAC THEN
3195   REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN;
3196               HAS_REAL_COMPLEX_DERIVATIVE_AT] THEN
3197   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT]
3198      HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET) THEN ASM SET_TAC[]);;
3199
3200 let HAS_REAL_DERIVATIVE_WITHIN_REAL_OPEN = prove
3201  (`!f f' a s.
3202          a IN s /\ real_open s
3203          ==> ((f has_real_derivative f') (atreal a within s) <=>
3204               (f has_real_derivative f') (atreal a))`,
3205   REPEAT GEN_TAC THEN
3206   ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_WITHINREAL; HAS_REAL_DERIVATIVE_ATREAL;
3207                REALLIM_WITHIN_REAL_OPEN]);;
3208
3209 let REAL_DIFFERENTIABLE_ATREAL_WITHIN = prove
3210  (`!f s z. f real_differentiable (atreal z)
3211            ==> f real_differentiable (atreal z within s)`,
3212   REWRITE_TAC[real_differentiable] THEN
3213   MESON_TAC[HAS_REAL_DERIVATIVE_ATREAL_WITHIN]);;
3214
3215 let HAS_REAL_DERIVATIVE_TRANSFORM_WITHIN = prove
3216  (`!f f' g x s d.
3217        &0 < d /\ x IN s /\
3218        (!x'. x' IN s /\ abs(x' - x) < d ==> f x' = g x') /\
3219        (f has_real_derivative f') (atreal x within s)
3220        ==> (g has_real_derivative f') (atreal x within s)`,
3221   REPEAT GEN_TAC THEN
3222   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
3223   REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN
3224   MATCH_MP_TAC(ONCE_REWRITE_RULE
3225     [TAUT `a /\ b /\ c /\ d ==> e <=> a /\ b /\ c ==> d ==> e`]
3226     HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN) THEN
3227   EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[IN_ELIM_THM; REAL_CX; RE_CX] THEN
3228   REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM] THEN AP_TERM_TAC THEN
3229   FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
3230   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH
3231    `dist(a,b) < d ==> z <= norm(a - b) ==> z < d`)) THEN
3232   W(MP_TAC o PART_MATCH (rand o rand) COMPLEX_NORM_GE_RE_IM o rand o snd) THEN
3233   SIMP_TAC[RE_SUB; RE_CX]);;
3234
3235 let HAS_REAL_DERIVATIVE_TRANSFORM_ATREAL = prove
3236  (`!f f' g x d.
3237        &0 < d /\ (!x'. abs(x' - x) < d ==> f x' = g x') /\
3238        (f has_real_derivative f') (atreal x)
3239        ==> (g has_real_derivative f') (atreal x)`,
3240   ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
3241   MESON_TAC[HAS_REAL_DERIVATIVE_TRANSFORM_WITHIN; IN_UNIV]);;
3242
3243 let HAS_REAL_DERIVATIVE_ZERO_CONSTANT = prove
3244  (`!f s.
3245         is_realinterval s /\
3246         (!x. x IN s ==> (f has_real_derivative (&0)) (atreal x within s))
3247         ==> ?c. !x. x IN s ==> f(x) = c`,
3248   REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN
3249   REPEAT STRIP_TAC THEN
3250   MP_TAC(ISPECL [`Cx o f o Re`; `{z | real z /\ Re z IN s}`]
3251     HAS_COMPLEX_DERIVATIVE_ZERO_CONSTANT) THEN
3252   ASM_REWRITE_TAC[IN_ELIM_THM; IMP_CONJ; FORALL_REAL; RE_CX; o_THM] THEN
3253   ASM_REWRITE_TAC[GSYM IS_REALINTERVAL_CONVEX_COMPLEX] THEN MESON_TAC[RE_CX]);;
3254
3255 let HAS_REAL_DERIVATIVE_ZERO_UNIQUE = prove
3256  (`!f s c a.
3257         is_realinterval s /\ a IN s /\ f a = c /\
3258         (!x. x IN s ==> (f has_real_derivative (&0)) (atreal x within s))
3259         ==> !x. x IN s ==> f(x) = c`,
3260   MESON_TAC[HAS_REAL_DERIVATIVE_ZERO_CONSTANT]);;
3261
3262 let REAL_DIFF_CHAIN_WITHIN = prove
3263  (`!f g f' g' x s.
3264         (f has_real_derivative f') (atreal x within s) /\
3265         (g has_real_derivative g') (atreal (f x) within (IMAGE f s))
3266         ==> ((g o f) has_real_derivative (g' * f'))(atreal x within s)`,
3267   REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN REPEAT STRIP_TAC THEN
3268   SUBGOAL_THEN `Cx o (g o f) o Re = (Cx o g o Re) o (Cx o f o Re)`
3269   SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_DEF; RE_CX]; ALL_TAC] THEN
3270   REWRITE_TAC[CX_MUL] THEN MATCH_MP_TAC COMPLEX_DIFF_CHAIN_WITHIN THEN
3271   ASM_REWRITE_TAC[o_THM; RE_CX] THEN
3272   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP
3273    (REWRITE_RULE[IMP_CONJ] HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET)) THEN
3274   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
3275   REWRITE_TAC[IN_ELIM_THM; o_THM; REAL_CX; RE_CX] THEN SET_TAC[]);;
3276
3277 let REAL_DIFF_CHAIN_ATREAL = prove
3278  (`!f g f' g' x.
3279         (f has_real_derivative f') (atreal x) /\
3280         (g has_real_derivative g') (atreal (f x))
3281         ==> ((g o f) has_real_derivative (g' * f')) (atreal x)`,
3282   ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
3283   ASM_MESON_TAC[REAL_DIFF_CHAIN_WITHIN; SUBSET_UNIV;
3284                 HAS_REAL_DERIVATIVE_WITHIN_SUBSET]);;
3285
3286 let HAS_REAL_DERIVATIVE_CHAIN = prove
3287  (`!P f g.
3288         (!x. P x ==> (g has_real_derivative g'(x)) (atreal x))
3289         ==> (!x s. (f has_real_derivative f') (atreal x within s) /\ P(f x)
3290                    ==> ((\x. g(f x)) has_real_derivative f' * g'(f x))
3291                        (atreal x within s)) /\
3292             (!x. (f has_real_derivative f') (atreal x) /\ P(f x)
3293                  ==> ((\x. g(f x)) has_real_derivative f' * g'(f x))
3294                      (atreal x))`,
3295   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM o_DEF] THEN
3296   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
3297   ASM_MESON_TAC[REAL_DIFF_CHAIN_WITHIN; REAL_DIFF_CHAIN_ATREAL;
3298                 HAS_REAL_DERIVATIVE_ATREAL_WITHIN]);;
3299
3300 let HAS_REAL_DERIVATIVE_CHAIN_UNIV = prove
3301  (`!f g. (!x. (g has_real_derivative g'(x)) (atreal x))
3302          ==> (!x s. (f has_real_derivative f') (atreal x within s)
3303                     ==> ((\x. g(f x)) has_real_derivative f' * g'(f x))
3304                         (atreal x within s)) /\
3305              (!x. (f has_real_derivative f') (atreal x)
3306                   ==> ((\x. g(f x)) has_real_derivative f' * g'(f x))
3307                       (atreal x))`,
3308   MP_TAC(SPEC `\x:real. T` HAS_REAL_DERIVATIVE_CHAIN) THEN SIMP_TAC[]);;
3309
3310 let REAL_DERIVATIVE_UNIQUE_ATREAL = prove
3311  (`!f z f' f''.
3312         (f has_real_derivative f') (atreal z) /\
3313         (f has_real_derivative f'') (atreal z)
3314         ==> f' = f''`,
3315   REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_AT] THEN
3316   DISCH_THEN(MP_TAC o MATCH_MP FRECHET_DERIVATIVE_UNIQUE_AT) THEN
3317   DISCH_THEN(MP_TAC o C AP_THM `vec 1:real^1`) THEN
3318   REWRITE_TAC[VECTOR_MUL_RCANCEL; VEC_EQ; ARITH_EQ]);;
3319
3320 (* ------------------------------------------------------------------------- *)
3321 (* Some handy theorems about the actual differentition function.             *)
3322 (* ------------------------------------------------------------------------- *)
3323
3324 let HAS_REAL_DERIVATIVE_DERIVATIVE = prove
3325  (`!f f' x. (f has_real_derivative f') (atreal x)
3326             ==> real_derivative f x = f'`,
3327   REWRITE_TAC[real_derivative] THEN
3328   MESON_TAC[REAL_DERIVATIVE_UNIQUE_ATREAL]);;
3329
3330 let HAS_REAL_DERIVATIVE_DIFFERENTIABLE = prove
3331  (`!f x. (f has_real_derivative (real_derivative f x)) (atreal x) <=>
3332          f real_differentiable atreal x`,
3333   REWRITE_TAC[real_differentiable; real_derivative] THEN MESON_TAC[]);;
3334
3335 (* ------------------------------------------------------------------------- *)
3336 (* Arithmetical combining theorems.                                          *)
3337 (* ------------------------------------------------------------------------- *)
3338
3339 let HAS_REAL_DERIVATIVE_LMUL_WITHIN = prove
3340  (`!f f' c x s.
3341         (f has_real_derivative f') (atreal x within s)
3342         ==> ((\x. c * f(x)) has_real_derivative (c * f')) (atreal x within s)`,
3343   REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN
3344   REWRITE_TAC[o_DEF; CX_MUL; HAS_COMPLEX_DERIVATIVE_LMUL_WITHIN]);;
3345
3346 let HAS_REAL_DERIVATIVE_LMUL_ATREAL = prove
3347  (`!f f' c x.
3348         (f has_real_derivative f') (atreal x)
3349         ==> ((\x. c * f(x)) has_real_derivative (c * f')) (atreal x)`,
3350   ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
3351   REWRITE_TAC[HAS_REAL_DERIVATIVE_LMUL_WITHIN]);;
3352
3353 let HAS_REAL_DERIVATIVE_RMUL_WITHIN = prove
3354  (`!f f' c x s.
3355         (f has_real_derivative f') (atreal x within s)
3356         ==> ((\x. f(x) * c) has_real_derivative (f' * c)) (atreal x within s)`,
3357   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
3358   REWRITE_TAC[HAS_REAL_DERIVATIVE_LMUL_WITHIN]);;
3359
3360 let HAS_REAL_DERIVATIVE_RMUL_ATREAL = prove
3361  (`!f f' c x.
3362         (f has_real_derivative f') (atreal x)
3363         ==> ((\x. f(x) * c) has_real_derivative (f' * c)) (atreal x)`,
3364   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
3365   REWRITE_TAC[HAS_REAL_DERIVATIVE_LMUL_ATREAL]);;
3366
3367 let HAS_REAL_DERIVATIVE_CDIV_WITHIN = prove
3368  (`!f f' c x s.
3369         (f has_real_derivative f') (atreal x within s)
3370         ==> ((\x. f(x) / c) has_real_derivative (f' / c)) (atreal x within s)`,
3371   SIMP_TAC[real_div; HAS_REAL_DERIVATIVE_RMUL_WITHIN]);;
3372
3373 let HAS_REAL_DERIVATIVE_CDIV_ATREAL = prove
3374  (`!f f' c x.
3375         (f has_real_derivative f') (atreal x)
3376         ==> ((\x. f(x) / c) has_real_derivative (f' / c)) (atreal x)`,
3377   SIMP_TAC[real_div; HAS_REAL_DERIVATIVE_RMUL_ATREAL]);;
3378
3379 let HAS_REAL_DERIVATIVE_ID = prove
3380  (`!net. ((\x. x) has_real_derivative &1) net`,
3381   REWRITE_TAC[has_real_derivative; TENDSTO_REAL;
3382               REAL_ARITH `x - (a + &1 * (x - a)) = &0`] THEN
3383   REWRITE_TAC[REAL_MUL_RZERO; LIM_CONST; o_DEF]);;
3384
3385 let HAS_REAL_DERIVATIVE_CONST = prove
3386  (`!c net. ((\x. c) has_real_derivative &0) net`,
3387   REWRITE_TAC[has_real_derivative; REAL_MUL_LZERO; REAL_ADD_RID; REAL_SUB_REFL;
3388               REAL_MUL_RZERO; REALLIM_CONST]);;
3389
3390 let HAS_REAL_DERIVATIVE_NEG = prove
3391  (`!f f' net. (f has_real_derivative f') net
3392             ==> ((\x. --(f(x))) has_real_derivative (--f')) net`,
3393   REPEAT GEN_TAC THEN REWRITE_TAC[has_real_derivative] THEN
3394   DISCH_THEN(MP_TAC o MATCH_MP REALLIM_NEG) THEN
3395   REWRITE_TAC[REAL_NEG_0; REAL_ARITH
3396    `a * (--b - (--c + --d * e:real)) = --(a * (b - (c + d * e)))`]);;
3397
3398 let HAS_REAL_DERIVATIVE_ADD = prove
3399  (`!f f' g g' net.
3400         (f has_real_derivative f') net /\ (g has_real_derivative g') net
3401         ==> ((\x. f(x) + g(x)) has_real_derivative (f' + g')) net`,
3402   REPEAT GEN_TAC THEN REWRITE_TAC[has_real_derivative] THEN
3403   DISCH_THEN(MP_TAC o MATCH_MP REALLIM_ADD) THEN
3404   REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; REAL_ADD_RID] THEN
3405   REWRITE_TAC[REAL_ARITH
3406    `(fx - (fa + f' * (x - a))) + (gx - (ga + g' * (x - a))):real =
3407     (fx + gx) - ((fa + ga) + (f' + g') * (x - a))`]);;
3408
3409 let HAS_REAL_DERIVATIVE_SUB = prove
3410  (`!f f' g g' net.
3411         (f has_real_derivative f') net /\ (g has_real_derivative g') net
3412         ==> ((\x. f(x) - g(x)) has_real_derivative (f' - g')) net`,
3413   SIMP_TAC[real_sub; HAS_REAL_DERIVATIVE_ADD; HAS_REAL_DERIVATIVE_NEG]);;
3414
3415 let HAS_REAL_DERIVATIVE_MUL_WITHIN = prove
3416  (`!f f' g g' x s.
3417         (f has_real_derivative f') (atreal x within s) /\
3418         (g has_real_derivative g') (atreal x within s)
3419         ==> ((\x. f(x) * g(x)) has_real_derivative
3420              (f(x) * g' + f' * g(x))) (atreal x within s)`,
3421   REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN
3422   DISCH_THEN(MP_TAC o MATCH_MP HAS_COMPLEX_DERIVATIVE_MUL_WITHIN) THEN
3423   REWRITE_TAC[o_DEF; CX_MUL; CX_ADD; RE_CX]);;
3424
3425 let HAS_REAL_DERIVATIVE_MUL_ATREAL = prove
3426  (`!f f' g g' x.
3427         (f has_real_derivative f') (atreal x) /\
3428         (g has_real_derivative g') (atreal x)
3429         ==> ((\x. f(x) * g(x)) has_real_derivative
3430              (f(x) * g' + f' * g(x))) (atreal x)`,
3431   ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
3432   REWRITE_TAC[HAS_REAL_DERIVATIVE_MUL_WITHIN]);;
3433
3434 let HAS_REAL_DERIVATIVE_POW_WITHIN = prove
3435  (`!f f' x s n. (f has_real_derivative f') (atreal x within s)
3436                 ==> ((\x. f(x) pow n) has_real_derivative
3437                      (&n * f(x) pow (n - 1) * f')) (atreal x within s)`,
3438   REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN
3439   DISCH_THEN(MP_TAC o SPEC `n:num` o
3440     MATCH_MP HAS_COMPLEX_DERIVATIVE_POW_WITHIN) THEN
3441   REWRITE_TAC[o_DEF; CX_MUL; CX_POW; RE_CX]);;
3442
3443 let HAS_REAL_DERIVATIVE_POW_ATREAL = prove
3444  (`!f f' x n. (f has_real_derivative f') (atreal x)
3445               ==> ((\x. f(x) pow n) has_real_derivative
3446                    (&n * f(x) pow (n - 1) * f')) (atreal x)`,
3447   ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
3448   REWRITE_TAC[HAS_REAL_DERIVATIVE_POW_WITHIN]);;
3449
3450 let HAS_REAL_DERIVATIVE_INV_BASIC = prove
3451  (`!x. ~(x = &0)
3452          ==> ((inv) has_real_derivative (--inv(x pow 2))) (atreal x)`,
3453   REPEAT STRIP_TAC THEN
3454   REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_AT] THEN
3455   MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN THEN
3456   EXISTS_TAC `inv:complex->complex` THEN
3457   ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_INV_BASIC; CX_INJ; CX_NEG; CX_INV;
3458                CX_POW; HAS_COMPLEX_DERIVATIVE_AT_WITHIN] THEN
3459   SIMP_TAC[IN; FORALL_REAL; IMP_CONJ; o_DEF; REAL_CX; RE_CX; CX_INV] THEN
3460   MESON_TAC[REAL_LT_01]);;
3461
3462 let HAS_REAL_DERIVATIVE_INV_WITHIN = prove
3463  (`!f f' x s. (f has_real_derivative f') (atreal x within s) /\
3464               ~(f x = &0)
3465               ==> ((\x. inv(f(x))) has_real_derivative (--f' / f(x) pow 2))
3466                   (atreal x within s)`,
3467   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN
3468   ASM_SIMP_TAC[REAL_FIELD
3469    `~(g = &0) ==> --f / g pow 2 = --inv(g pow 2) * f`] THEN
3470   MATCH_MP_TAC REAL_DIFF_CHAIN_WITHIN THEN ASM_REWRITE_TAC[] THEN
3471   MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN
3472   ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_INV_BASIC]);;
3473
3474 let HAS_REAL_DERIVATIVE_INV_ATREAL = prove
3475  (`!f f' x. (f has_real_derivative f') (atreal x) /\
3476             ~(f x = &0)
3477             ==> ((\x. inv(f(x))) has_real_derivative (--f' / f(x) pow 2))
3478                 (atreal x)`,
3479   ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
3480   REWRITE_TAC[HAS_REAL_DERIVATIVE_INV_WITHIN]);;
3481
3482 let HAS_REAL_DERIVATIVE_DIV_WITHIN = prove
3483  (`!f f' g g' x s.
3484         (f has_real_derivative f') (atreal x within s) /\
3485         (g has_real_derivative g') (atreal x within s) /\
3486         ~(g(x) = &0)
3487         ==> ((\x. f(x) / g(x)) has_real_derivative
3488              (f' * g(x) - f(x) * g') / g(x) pow 2) (atreal x within s)`,
3489   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3490   DISCH_THEN(fun th -> ASSUME_TAC(CONJUNCT2 th) THEN MP_TAC th) THEN
3491   DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_DERIVATIVE_INV_WITHIN) THEN
3492   UNDISCH_TAC `(f has_real_derivative f') (atreal x within s)` THEN
3493   REWRITE_TAC[IMP_IMP] THEN
3494   DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_DERIVATIVE_MUL_WITHIN) THEN
3495   REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC EQ_IMP THEN
3496   AP_THM_TAC THEN AP_TERM_TAC THEN
3497   POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD);;
3498
3499 let HAS_REAL_DERIVATIVE_DIV_ATREAL = prove
3500  (`!f f' g g' x.
3501         (f has_real_derivative f') (atreal x) /\
3502         (g has_real_derivative g') (atreal x) /\
3503         ~(g(x) = &0)
3504         ==> ((\x. f(x) / g(x)) has_real_derivative
3505              (f' * g(x) - f(x) * g') / g(x) pow 2) (atreal x)`,
3506   ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
3507   REWRITE_TAC[HAS_REAL_DERIVATIVE_DIV_WITHIN]);;
3508
3509 let HAS_REAL_DERIVATIVE_SUM = prove
3510  (`!f net s.
3511          FINITE s /\ (!a. a IN s ==> (f a has_real_derivative f' a) net)
3512          ==> ((\x. sum s (\a. f a x)) has_real_derivative (sum s f'))
3513              net`,
3514   GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
3515   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
3516   SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; SUM_CLAUSES] THEN
3517   SIMP_TAC[HAS_REAL_DERIVATIVE_CONST; HAS_REAL_DERIVATIVE_ADD; ETA_AX]);;
3518
3519 (* ------------------------------------------------------------------------- *)
3520 (* Same thing just for real differentiability.                               *)
3521 (* ------------------------------------------------------------------------- *)
3522
3523 let REAL_DIFFERENTIABLE_CONST = prove
3524  (`!c net. (\z. c) real_differentiable net`,
3525   REWRITE_TAC[real_differentiable] THEN
3526   MESON_TAC[HAS_REAL_DERIVATIVE_CONST]);;
3527
3528 let REAL_DIFFERENTIABLE_ID = prove
3529  (`!net. (\z. z) real_differentiable net`,
3530   REWRITE_TAC[real_differentiable] THEN
3531   MESON_TAC[HAS_REAL_DERIVATIVE_ID]);;
3532
3533 let REAL_DIFFERENTIABLE_NEG = prove
3534  (`!f net.
3535         f real_differentiable net
3536         ==> (\z. --(f z)) real_differentiable net`,
3537   REWRITE_TAC[real_differentiable] THEN
3538   MESON_TAC[HAS_REAL_DERIVATIVE_NEG]);;
3539
3540 let REAL_DIFFERENTIABLE_ADD = prove
3541  (`!f g net.
3542         f real_differentiable net /\
3543         g real_differentiable net
3544         ==> (\z. f z + g z) real_differentiable net`,
3545   REWRITE_TAC[real_differentiable] THEN
3546   MESON_TAC[HAS_REAL_DERIVATIVE_ADD]);;
3547
3548 let REAL_DIFFERENTIABLE_SUB = prove
3549  (`!f g net.
3550         f real_differentiable net /\
3551         g real_differentiable net
3552         ==> (\z. f z - g z) real_differentiable net`,
3553   REWRITE_TAC[real_differentiable] THEN
3554   MESON_TAC[HAS_REAL_DERIVATIVE_SUB]);;
3555
3556 let REAL_DIFFERENTIABLE_INV_WITHIN = prove
3557  (`!f z s.
3558         f real_differentiable (atreal z within s) /\ ~(f z = &0)
3559         ==> (\z. inv(f z)) real_differentiable (atreal z within s)`,
3560   REWRITE_TAC[real_differentiable] THEN
3561   MESON_TAC[HAS_REAL_DERIVATIVE_INV_WITHIN]);;
3562
3563 let REAL_DIFFERENTIABLE_MUL_WITHIN = prove
3564  (`!f g z s.
3565         f real_differentiable (atreal z within s) /\
3566         g real_differentiable (atreal z within s)
3567         ==> (\z. f z * g z) real_differentiable (atreal z within s)`,
3568   REWRITE_TAC[real_differentiable] THEN
3569   MESON_TAC[HAS_REAL_DERIVATIVE_MUL_WITHIN]);;
3570
3571 let REAL_DIFFERENTIABLE_DIV_WITHIN = prove
3572  (`!f g z s.
3573         f real_differentiable (atreal z within s) /\
3574         g real_differentiable (atreal z within s) /\
3575         ~(g z = &0)
3576         ==> (\z. f z / g z) real_differentiable (atreal z within s)`,
3577   REWRITE_TAC[real_differentiable] THEN
3578   MESON_TAC[HAS_REAL_DERIVATIVE_DIV_WITHIN]);;
3579
3580 let REAL_DIFFERENTIABLE_POW_WITHIN = prove
3581  (`!f n z s.
3582         f real_differentiable (atreal z within s)
3583         ==> (\z. f z pow n) real_differentiable (atreal z within s)`,
3584   REWRITE_TAC[real_differentiable] THEN
3585   MESON_TAC[HAS_REAL_DERIVATIVE_POW_WITHIN]);;
3586
3587 let REAL_DIFFERENTIABLE_TRANSFORM_WITHIN = prove
3588  (`!f g x s d.
3589         &0 < d /\
3590         x IN s /\
3591         (!x'. x' IN s /\ abs(x' - x) < d ==> f x' = g x') /\
3592         f real_differentiable (atreal x within s)
3593         ==> g real_differentiable (atreal x within s)`,
3594   REWRITE_TAC[real_differentiable] THEN
3595   MESON_TAC[HAS_REAL_DERIVATIVE_TRANSFORM_WITHIN]);;
3596
3597 let REAL_DIFFERENTIABLE_TRANSFORM = prove
3598  (`!f g s. (!x. x IN s ==> f x = g x) /\ f real_differentiable_on s
3599            ==> g real_differentiable_on s`,
3600   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3601   REWRITE_TAC[real_differentiable_on; GSYM real_differentiable] THEN
3602   MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
3603   DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
3604   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
3605   MATCH_MP_TAC REAL_DIFFERENTIABLE_TRANSFORM_WITHIN THEN
3606   MAP_EVERY EXISTS_TAC [`f:real->real`; `&1`] THEN
3607   ASM_SIMP_TAC[REAL_LT_01]);;
3608
3609 let REAL_DIFFERENTIABLE_EQ = prove
3610  (`!f g s. (!x. x IN s ==> f x = g x)
3611            ==> (f real_differentiable_on s <=> g real_differentiable_on s)`,
3612   MESON_TAC[REAL_DIFFERENTIABLE_TRANSFORM]);;
3613
3614 let REAL_DIFFERENTIABLE_INV_ATREAL = prove
3615  (`!f z.
3616         f real_differentiable atreal z /\ ~(f z = &0)
3617         ==> (\z. inv(f z)) real_differentiable atreal z`,
3618   REWRITE_TAC[real_differentiable] THEN
3619   MESON_TAC[HAS_REAL_DERIVATIVE_INV_ATREAL]);;
3620
3621 let REAL_DIFFERENTIABLE_MUL_ATREAL = prove
3622  (`!f g z.
3623         f real_differentiable atreal z /\
3624         g real_differentiable atreal z
3625         ==> (\z. f z * g z) real_differentiable atreal z`,
3626   REWRITE_TAC[real_differentiable] THEN
3627   MESON_TAC[HAS_REAL_DERIVATIVE_MUL_ATREAL]);;
3628
3629 let REAL_DIFFERENTIABLE_DIV_ATREAL = prove
3630  (`!f g z.
3631         f real_differentiable atreal z /\
3632         g real_differentiable atreal z /\
3633         ~(g z = &0)
3634         ==> (\z. f z / g z) real_differentiable atreal z`,
3635   REWRITE_TAC[real_differentiable] THEN
3636   MESON_TAC[HAS_REAL_DERIVATIVE_DIV_ATREAL]);;
3637
3638 let REAL_DIFFERENTIABLE_POW_ATREAL = prove
3639  (`!f n z.
3640         f real_differentiable atreal z
3641         ==> (\z. f z pow n) real_differentiable atreal z`,
3642   REWRITE_TAC[real_differentiable] THEN
3643   MESON_TAC[HAS_REAL_DERIVATIVE_POW_ATREAL]);;
3644
3645 let REAL_DIFFERENTIABLE_TRANSFORM_ATREAL = prove
3646  (`!f g x d.
3647         &0 < d /\
3648         (!x'. abs(x' - x) < d ==> f x' = g x') /\
3649         f real_differentiable atreal x
3650         ==> g real_differentiable atreal x`,
3651   REWRITE_TAC[real_differentiable] THEN
3652   MESON_TAC[HAS_REAL_DERIVATIVE_TRANSFORM_ATREAL]);;
3653
3654 let REAL_DIFFERENTIABLE_COMPOSE_WITHIN = prove
3655  (`!f g x s.
3656          f real_differentiable (atreal x within s) /\
3657          g real_differentiable (atreal (f x) within IMAGE f s)
3658          ==> (g o f) real_differentiable (atreal x within s)`,
3659   REWRITE_TAC[real_differentiable] THEN
3660   MESON_TAC[REAL_DIFF_CHAIN_WITHIN]);;
3661
3662 let REAL_DIFFERENTIABLE_COMPOSE_ATREAL = prove
3663  (`!f g x.
3664          f real_differentiable (atreal x) /\
3665          g real_differentiable (atreal (f x))
3666          ==> (g o f) real_differentiable (atreal x)`,
3667   REWRITE_TAC[real_differentiable] THEN
3668   MESON_TAC[REAL_DIFF_CHAIN_ATREAL]);;
3669
3670 (* ------------------------------------------------------------------------- *)
3671 (* Same again for being differentiable on a set.                             *)
3672 (* ------------------------------------------------------------------------- *)
3673
3674 let REAL_DIFFERENTIABLE_ON_CONST = prove
3675  (`!c s. (\z. c) real_differentiable_on s`,
3676   REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE;
3677               REAL_DIFFERENTIABLE_CONST]);;
3678
3679 let REAL_DIFFERENTIABLE_ON_ID = prove
3680  (`!s. (\z. z) real_differentiable_on s`,
3681   REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; REAL_DIFFERENTIABLE_ID]);;
3682
3683 let REAL_DIFFERENTIABLE_ON_COMPOSE = prove
3684  (`!f g s. f real_differentiable_on s /\ g real_differentiable_on (IMAGE f s)
3685            ==> (g o f) real_differentiable_on s`,
3686   SIMP_TAC[real_differentiable_on; GSYM real_differentiable;
3687            FORALL_IN_IMAGE] THEN
3688   MESON_TAC[REAL_DIFFERENTIABLE_COMPOSE_WITHIN]);;
3689
3690 let REAL_DIFFERENTIABLE_ON_NEG = prove
3691  (`!f s. f real_differentiable_on s ==> (\z. --(f z)) real_differentiable_on s`,
3692   SIMP_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; REAL_DIFFERENTIABLE_NEG]);;
3693
3694 let REAL_DIFFERENTIABLE_ON_ADD = prove
3695  (`!f g s.
3696         f real_differentiable_on s /\ g real_differentiable_on s
3697         ==> (\z. f z + g z) real_differentiable_on s`,
3698   SIMP_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; REAL_DIFFERENTIABLE_ADD]);;
3699
3700 let REAL_DIFFERENTIABLE_ON_SUB = prove
3701  (`!f g s.
3702         f real_differentiable_on s /\ g real_differentiable_on s
3703         ==> (\z. f z - g z) real_differentiable_on s`,
3704   SIMP_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; REAL_DIFFERENTIABLE_SUB]);;
3705
3706 let REAL_DIFFERENTIABLE_ON_MUL = prove
3707  (`!f g s.
3708         f real_differentiable_on s /\ g real_differentiable_on s
3709         ==> (\z. f z * g z) real_differentiable_on s`,
3710   SIMP_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE;
3711            REAL_DIFFERENTIABLE_MUL_WITHIN]);;
3712
3713 let REAL_DIFFERENTIABLE_ON_INV = prove
3714  (`!f s. f real_differentiable_on s /\ (!z. z IN s ==> ~(f z = &0))
3715          ==> (\z. inv(f z)) real_differentiable_on s`,
3716   SIMP_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE;
3717            REAL_DIFFERENTIABLE_INV_WITHIN]);;
3718
3719 let REAL_DIFFERENTIABLE_ON_DIV = prove
3720  (`!f g s.
3721         f real_differentiable_on s /\ g real_differentiable_on s /\
3722         (!z. z IN s ==> ~(g z = &0))
3723         ==> (\z. f z / g z) real_differentiable_on s`,
3724   SIMP_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE;
3725            REAL_DIFFERENTIABLE_DIV_WITHIN]);;
3726
3727 let REAL_DIFFERENTIABLE_ON_POW = prove
3728  (`!f s n. f real_differentiable_on s
3729            ==> (\z. (f z) pow n) real_differentiable_on s`,
3730   SIMP_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE;
3731            REAL_DIFFERENTIABLE_POW_WITHIN]);;
3732
3733 let REAL_DIFFERENTIABLE_ON_SUM = prove
3734  (`!f s k. FINITE k /\ (!a. a IN k ==> (f a) real_differentiable_on s)
3735            ==> (\x. sum k (\a. f a x)) real_differentiable_on s`,
3736   GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
3737   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES] THEN
3738   SIMP_TAC[REAL_DIFFERENTIABLE_ON_CONST; IN_INSERT; NOT_IN_EMPTY] THEN
3739   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_ADD THEN
3740   ASM_SIMP_TAC[ETA_AX]);;
3741
3742 (* ------------------------------------------------------------------------- *)
3743 (* Derivative (and continuity) theorems for real transcendental functions.   *)
3744 (* ------------------------------------------------------------------------- *)
3745
3746 let HAS_REAL_DERIVATIVE_EXP = prove
3747  (`!x. (exp has_real_derivative exp(x)) (atreal x)`,
3748   GEN_TAC THEN MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT THEN
3749   EXISTS_TAC `cexp` THEN
3750   ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN;
3751                HAS_COMPLEX_DERIVATIVE_CEXP; CX_EXP]);;
3752
3753 let REAL_DIFFERENTIABLE_AT_EXP = prove
3754  (`!x. exp real_differentiable (atreal x)`,
3755   REWRITE_TAC[real_differentiable] THEN
3756   MESON_TAC[HAS_REAL_DERIVATIVE_EXP]);;
3757
3758 let REAL_DIFFERENTIABLE_WITHIN_EXP = prove
3759  (`!s x. exp real_differentiable (atreal x within s)`,
3760   MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN;
3761             REAL_DIFFERENTIABLE_AT_EXP]);;
3762
3763 let REAL_CONTINUOUS_AT_EXP = prove
3764  (`!x. exp real_continuous (atreal x)`,
3765   MESON_TAC[HAS_REAL_DERIVATIVE_EXP;
3766             HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);;
3767
3768 let REAL_CONTINUOUS_WITHIN_EXP = prove
3769  (`!s x. exp real_continuous (atreal x within s)`,
3770   MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL;
3771             REAL_CONTINUOUS_AT_EXP]);;
3772
3773 let REAL_CONTINUOUS_ON_EXP = prove
3774  (`!s. exp real_continuous_on s`,
3775   REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN;
3776               REAL_CONTINUOUS_WITHIN_EXP]);;
3777
3778 let HAS_REAL_DERIVATIVE_SIN = prove
3779  (`!x. (sin has_real_derivative cos(x)) (atreal x)`,
3780   GEN_TAC THEN MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT THEN
3781   EXISTS_TAC `csin` THEN
3782   ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN;
3783                HAS_COMPLEX_DERIVATIVE_CSIN; CX_SIN; CX_COS]);;
3784
3785 let REAL_DIFFERENTIABLE_AT_SIN = prove
3786  (`!x. sin real_differentiable (atreal x)`,
3787   REWRITE_TAC[real_differentiable] THEN
3788   MESON_TAC[HAS_REAL_DERIVATIVE_SIN]);;
3789
3790 let REAL_DIFFERENTIABLE_WITHIN_SIN = prove
3791  (`!s x. sin real_differentiable (atreal x within s)`,
3792   MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN;
3793             REAL_DIFFERENTIABLE_AT_SIN]);;
3794
3795 let REAL_CONTINUOUS_AT_SIN = prove
3796  (`!x. sin real_continuous (atreal x)`,
3797   MESON_TAC[HAS_REAL_DERIVATIVE_SIN;
3798             HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);;
3799
3800 let REAL_CONTINUOUS_WITHIN_SIN = prove
3801  (`!s x. sin real_continuous (atreal x within s)`,
3802   MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL;
3803             REAL_CONTINUOUS_AT_SIN]);;
3804
3805 let REAL_CONTINUOUS_ON_SIN = prove
3806  (`!s. sin real_continuous_on s`,
3807   REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN;
3808               REAL_CONTINUOUS_WITHIN_SIN]);;
3809
3810 let HAS_REAL_DERIVATIVE_COS = prove
3811  (`!x. (cos has_real_derivative --sin(x)) (atreal x)`,
3812   GEN_TAC THEN MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT THEN
3813   EXISTS_TAC `ccos` THEN
3814   ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN;
3815                HAS_COMPLEX_DERIVATIVE_CCOS; CX_SIN; CX_COS; CX_NEG]);;
3816
3817 let REAL_DIFFERENTIABLE_AT_COS = prove
3818  (`!x. cos real_differentiable (atreal x)`,
3819   REWRITE_TAC[real_differentiable] THEN
3820   MESON_TAC[HAS_REAL_DERIVATIVE_COS]);;
3821
3822 let REAL_DIFFERENTIABLE_WITHIN_COS = prove
3823  (`!s x. cos real_differentiable (atreal x within s)`,
3824   MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN;
3825             REAL_DIFFERENTIABLE_AT_COS]);;
3826
3827 let REAL_CONTINUOUS_AT_COS = prove
3828  (`!x. cos real_continuous (atreal x)`,
3829   MESON_TAC[HAS_REAL_DERIVATIVE_COS;
3830             HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);;
3831
3832 let REAL_CONTINUOUS_WITHIN_COS = prove
3833  (`!s x. cos real_continuous (atreal x within s)`,
3834   MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL;
3835             REAL_CONTINUOUS_AT_COS]);;
3836
3837 let REAL_CONTINUOUS_ON_COS = prove
3838  (`!s. cos real_continuous_on s`,
3839   REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN;
3840               REAL_CONTINUOUS_WITHIN_COS]);;
3841
3842 let HAS_REAL_DERIVATIVE_TAN = prove
3843  (`!x. ~(cos x = &0)
3844        ==> (tan has_real_derivative inv(cos(x) pow 2)) (atreal x)`,
3845   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT THEN
3846   EXISTS_TAC `ctan` THEN REWRITE_TAC[CX_INV; CX_POW; CX_COS] THEN
3847   ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN;
3848                HAS_COMPLEX_DERIVATIVE_CTAN; GSYM CX_COS; CX_INJ; CX_TAN]);;
3849
3850 let REAL_DIFFERENTIABLE_AT_TAN = prove
3851  (`!x. ~(cos x = &0) ==> tan real_differentiable (atreal x)`,
3852   REWRITE_TAC[real_differentiable] THEN
3853   MESON_TAC[HAS_REAL_DERIVATIVE_TAN]);;
3854
3855 let REAL_DIFFERENTIABLE_WITHIN_TAN = prove
3856  (`!s x. ~(cos x = &0) ==> tan real_differentiable (atreal x within s)`,
3857   MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN;
3858             REAL_DIFFERENTIABLE_AT_TAN]);;
3859
3860 let REAL_CONTINUOUS_AT_TAN = prove
3861  (`!x. ~(cos x = &0) ==> tan real_continuous (atreal x)`,
3862   MESON_TAC[HAS_REAL_DERIVATIVE_TAN;
3863             HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);;
3864
3865 let REAL_CONTINUOUS_WITHIN_TAN = prove
3866  (`!s x. ~(cos x = &0) ==> tan real_continuous (atreal x within s)`,
3867   MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL;
3868             REAL_CONTINUOUS_AT_TAN]);;
3869
3870 let REAL_CONTINUOUS_ON_TAN = prove
3871  (`!s. (!x. x IN s ==> ~(cos x = &0)) ==> tan real_continuous_on s`,
3872   MESON_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN;
3873             REAL_CONTINUOUS_WITHIN_TAN]);;
3874
3875 let HAS_REAL_DERIVATIVE_LOG = prove
3876  (`!x. &0 < x ==> (log has_real_derivative inv(x)) (atreal x)`,
3877   REPEAT STRIP_TAC THEN
3878   MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT_GEN THEN
3879   MAP_EVERY EXISTS_TAC [`clog`; `x:real`] THEN ASM_REWRITE_TAC[] THEN
3880   REPEAT STRIP_TAC THENL
3881    [REWRITE_TAC[CX_INV] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN
3882     MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_CLOG THEN ASM_REWRITE_TAC[RE_CX];
3883     MATCH_MP_TAC(GSYM CX_LOG) THEN ASM_REAL_ARITH_TAC]);;
3884
3885 let REAL_DIFFERENTIABLE_AT_LOG = prove
3886  (`!x. &0 < x ==> log real_differentiable (atreal x)`,
3887   REWRITE_TAC[real_differentiable] THEN
3888   MESON_TAC[HAS_REAL_DERIVATIVE_LOG]);;
3889
3890 let REAL_DIFFERENTIABLE_WITHIN_LOG = prove
3891  (`!s x. &0 < x ==> log real_differentiable (atreal x within s)`,
3892   MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN;
3893             REAL_DIFFERENTIABLE_AT_LOG]);;
3894
3895 let REAL_CONTINUOUS_AT_LOG = prove
3896  (`!x. &0 < x ==> log real_continuous (atreal x)`,
3897   MESON_TAC[HAS_REAL_DERIVATIVE_LOG;
3898             HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);;
3899
3900 let REAL_CONTINUOUS_WITHIN_LOG = prove
3901  (`!s x. &0 < x ==> log real_continuous (atreal x within s)`,
3902   MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL;
3903             REAL_CONTINUOUS_AT_LOG]);;
3904
3905 let REAL_CONTINUOUS_ON_LOG = prove
3906  (`!s. (!x. x IN s ==> &0 < x) ==> log real_continuous_on s`,
3907   MESON_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN;
3908             REAL_CONTINUOUS_WITHIN_LOG]);;
3909
3910 let HAS_REAL_DERIVATIVE_SQRT = prove
3911  (`!x. &0 < x ==> (sqrt has_real_derivative inv(&2 * sqrt x)) (atreal x)`,
3912   REPEAT STRIP_TAC THEN
3913   MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT_GEN THEN
3914   MAP_EVERY EXISTS_TAC [`csqrt`; `x:real`] THEN ASM_REWRITE_TAC[] THEN
3915   REPEAT STRIP_TAC THENL
3916    [ASM_SIMP_TAC[CX_INV; CX_MUL; CX_SQRT; REAL_LT_IMP_LE] THEN
3917     MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN
3918     MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_CSQRT THEN
3919     ASM_SIMP_TAC[RE_CX];
3920     MATCH_MP_TAC(GSYM CX_SQRT) THEN ASM_REAL_ARITH_TAC]);;
3921
3922 let REAL_DIFFERENTIABLE_AT_SQRT = prove
3923  (`!x. &0 < x ==> sqrt real_differentiable (atreal x)`,
3924   REWRITE_TAC[real_differentiable] THEN
3925   MESON_TAC[HAS_REAL_DERIVATIVE_SQRT]);;
3926
3927 let REAL_DIFFERENTIABLE_WITHIN_SQRT = prove
3928  (`!s x. &0 < x ==> sqrt real_differentiable (atreal x within s)`,
3929   MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN;
3930             REAL_DIFFERENTIABLE_AT_SQRT]);;
3931
3932 let REAL_CONTINUOUS_AT_SQRT = prove
3933  (`!x. &0 < x ==> sqrt real_continuous (atreal x)`,
3934   MESON_TAC[HAS_REAL_DERIVATIVE_SQRT;
3935             HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);;
3936
3937 let REAL_CONTINUOUS_WITHIN_SQRT = prove
3938  (`!s x. &0 < x ==> sqrt real_continuous (atreal x within s)`,
3939   MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL;
3940             REAL_CONTINUOUS_AT_SQRT]);;
3941
3942 let REAL_CONTINUOUS_WITHIN_SQRT_COMPOSE = prove
3943  (`!f s a:real^N.
3944         f real_continuous (at a within s) /\
3945         (&0 < f a \/ !x. x IN s ==> &0 <= f x)
3946         ==> (\x. sqrt(f x)) real_continuous (at a within s)`,
3947   REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF] THEN
3948   REWRITE_TAC[CONTINUOUS_WITHIN_SQRT_COMPOSE]);;
3949
3950 let REAL_CONTINUOUS_AT_SQRT_COMPOSE = prove
3951  (`!f a:real^N.
3952         f real_continuous (at a) /\
3953         (&0 < f a \/ !x. &0 <= f x)
3954         ==> (\x. sqrt(f x)) real_continuous (at a)`,
3955   REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF] THEN
3956   REWRITE_TAC[CONTINUOUS_AT_SQRT_COMPOSE]);;
3957
3958 let CONTINUOUS_WITHINREAL_SQRT_COMPOSE = prove
3959  (`!f s a. (\x. lift(f x)) continuous (atreal a within s) /\
3960            (&0 < f a \/ !x. x IN s ==> &0 <= f x)
3961            ==> (\x. lift(sqrt(f x))) continuous (atreal a within s)`,
3962   REWRITE_TAC[CONTINUOUS_CONTINUOUS_WITHINREAL] THEN
3963   REWRITE_TAC[o_DEF] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN
3964   MATCH_MP_TAC CONTINUOUS_WITHIN_SQRT_COMPOSE THEN
3965   ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP]);;
3966
3967 let CONTINUOUS_ATREAL_SQRT_COMPOSE = prove
3968  (`!f a. (\x. lift(f x)) continuous (atreal a) /\ (&0 < f a \/ !x. &0 <= f x)
3969          ==> (\x. lift(sqrt(f x))) continuous (atreal a)`,
3970   REPEAT GEN_TAC THEN
3971   MP_TAC(ISPECL [`f:real->real`; `(:real)`; `a:real`]
3972         CONTINUOUS_WITHINREAL_SQRT_COMPOSE) THEN
3973   REWRITE_TAC[WITHINREAL_UNIV; IN_UNIV]);;
3974
3975 let REAL_CONTINUOUS_WITHINREAL_SQRT_COMPOSE = prove
3976  (`!f s a. f real_continuous (atreal a within s) /\
3977            (&0 < f a \/ !x. x IN s ==> &0 <= f x)
3978            ==> (\x. sqrt(f x)) real_continuous (atreal a within s)`,
3979   REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF] THEN
3980   REWRITE_TAC[CONTINUOUS_WITHINREAL_SQRT_COMPOSE]);;
3981
3982 let REAL_CONTINUOUS_ATREAL_SQRT_COMPOSE = prove
3983  (`!f a. f real_continuous (atreal a) /\
3984          (&0 < f a \/ !x. &0 <= f x)
3985          ==> (\x. sqrt(f x)) real_continuous (atreal a)`,
3986   REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF] THEN
3987   REWRITE_TAC[CONTINUOUS_ATREAL_SQRT_COMPOSE]);;
3988
3989 let HAS_REAL_DERIVATIVE_ATN = prove
3990  (`!x. (atn has_real_derivative inv(&1 + x pow 2)) (atreal x)`,
3991   GEN_TAC THEN MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT THEN
3992   EXISTS_TAC `catn` THEN REWRITE_TAC[CX_INV; CX_ADD; CX_ATN; CX_POW] THEN
3993   ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CATN;
3994                IM_CX; REAL_ABS_NUM; REAL_LT_01]);;
3995
3996 let REAL_DIFFERENTIABLE_AT_ATN = prove
3997  (`!x. atn real_differentiable (atreal x)`,
3998   REWRITE_TAC[real_differentiable] THEN
3999   MESON_TAC[HAS_REAL_DERIVATIVE_ATN]);;
4000
4001 let REAL_DIFFERENTIABLE_WITHIN_ATN = prove
4002  (`!s x. atn real_differentiable (atreal x within s)`,
4003   MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN;
4004             REAL_DIFFERENTIABLE_AT_ATN]);;
4005
4006 let REAL_CONTINUOUS_AT_ATN = prove
4007  (`!x. atn real_continuous (atreal x)`,
4008   MESON_TAC[HAS_REAL_DERIVATIVE_ATN;
4009             HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);;
4010
4011 let REAL_CONTINUOUS_WITHIN_ATN = prove
4012  (`!s x. atn real_continuous (atreal x within s)`,
4013   MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL;
4014             REAL_CONTINUOUS_AT_ATN]);;
4015
4016 let REAL_CONTINUOUS_ON_ATN = prove
4017  (`!s. atn real_continuous_on s`,
4018   REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN;
4019               REAL_CONTINUOUS_WITHIN_ATN]);;
4020
4021 let HAS_REAL_DERIVATIVE_ASN_COS = prove
4022  (`!x. abs(x) < &1 ==> (asn has_real_derivative inv(cos(asn x))) (atreal x)`,
4023   REPEAT STRIP_TAC THEN
4024   MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT_GEN THEN
4025   MAP_EVERY EXISTS_TAC [`casn`; `&1 - abs x`] THEN
4026   ASM_REWRITE_TAC[REAL_SUB_LT] THEN REPEAT STRIP_TAC THENL
4027    [ASM_SIMP_TAC[CX_INV; CX_COS; CX_ASN; REAL_LT_IMP_LE] THEN
4028     MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN
4029     MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_CASN THEN ASM_REWRITE_TAC[RE_CX];
4030     MATCH_MP_TAC(GSYM CX_ASN) THEN ASM_REAL_ARITH_TAC]);;
4031
4032 let HAS_REAL_DERIVATIVE_ASN = prove
4033  (`!x. abs(x) < &1
4034        ==> (asn has_real_derivative inv(sqrt(&1 - x pow 2))) (atreal x)`,
4035   REPEAT STRIP_TAC THEN
4036   FIRST_ASSUM(MP_TAC o MATCH_MP HAS_REAL_DERIVATIVE_ASN_COS) THEN
4037   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
4038   AP_TERM_TAC THEN MATCH_MP_TAC COS_ASN THEN ASM_REAL_ARITH_TAC);;
4039
4040 let REAL_DIFFERENTIABLE_AT_ASN = prove
4041  (`!x. abs(x) < &1 ==> asn real_differentiable (atreal x)`,
4042   REWRITE_TAC[real_differentiable] THEN
4043   MESON_TAC[HAS_REAL_DERIVATIVE_ASN]);;
4044
4045 let REAL_DIFFERENTIABLE_WITHIN_ASN = prove
4046  (`!s x. abs(x) < &1 ==> asn real_differentiable (atreal x within s)`,
4047   MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN;
4048             REAL_DIFFERENTIABLE_AT_ASN]);;
4049
4050 let REAL_CONTINUOUS_AT_ASN = prove
4051  (`!x. abs(x) < &1 ==> asn real_continuous (atreal x)`,
4052   MESON_TAC[HAS_REAL_DERIVATIVE_ASN;
4053             HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);;
4054
4055 let REAL_CONTINUOUS_WITHIN_ASN = prove
4056  (`!s x. abs(x) < &1 ==> asn real_continuous (atreal x within s)`,
4057   MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL;
4058             REAL_CONTINUOUS_AT_ASN]);;
4059
4060 let HAS_REAL_DERIVATIVE_ACS_SIN = prove
4061  (`!x. abs(x) < &1 ==> (acs has_real_derivative --inv(sin(acs x))) (atreal x)`,
4062   REPEAT STRIP_TAC THEN
4063   MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT_GEN THEN
4064   MAP_EVERY EXISTS_TAC [`cacs`; `&1 - abs x`] THEN
4065   ASM_REWRITE_TAC[REAL_SUB_LT] THEN REPEAT STRIP_TAC THENL
4066    [ASM_SIMP_TAC[CX_INV; CX_SIN; CX_ACS; CX_NEG; REAL_LT_IMP_LE] THEN
4067     MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN
4068     MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_CACS THEN ASM_REWRITE_TAC[RE_CX];
4069     MATCH_MP_TAC(GSYM CX_ACS) THEN ASM_REAL_ARITH_TAC]);;
4070
4071 let HAS_REAL_DERIVATIVE_ACS = prove
4072  (`!x. abs(x) < &1
4073        ==> (acs has_real_derivative --inv(sqrt(&1 - x pow 2))) (atreal x)`,
4074   REPEAT STRIP_TAC THEN
4075   FIRST_ASSUM(MP_TAC o MATCH_MP HAS_REAL_DERIVATIVE_ACS_SIN) THEN
4076   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
4077   AP_TERM_TAC THEN AP_TERM_TAC THEN
4078   MATCH_MP_TAC SIN_ACS THEN ASM_REAL_ARITH_TAC);;
4079
4080 let REAL_DIFFERENTIABLE_AT_ACS = prove
4081  (`!x. abs(x) < &1 ==> acs real_differentiable (atreal x)`,
4082   REWRITE_TAC[real_differentiable] THEN
4083   MESON_TAC[HAS_REAL_DERIVATIVE_ACS]);;
4084
4085 let REAL_DIFFERENTIABLE_WITHIN_ACS = prove
4086  (`!s x. abs(x) < &1 ==> acs real_differentiable (atreal x within s)`,
4087   MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN;
4088             REAL_DIFFERENTIABLE_AT_ACS]);;
4089
4090 let REAL_CONTINUOUS_AT_ACS = prove
4091  (`!x. abs(x) < &1 ==> acs real_continuous (atreal x)`,
4092   MESON_TAC[HAS_REAL_DERIVATIVE_ACS;
4093             HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);;
4094
4095 let REAL_CONTINUOUS_WITHIN_ACS = prove
4096  (`!s x. abs(x) < &1 ==> acs real_continuous (atreal x within s)`,
4097   MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL;
4098             REAL_CONTINUOUS_AT_ACS]);;
4099
4100 (* ------------------------------------------------------------------------- *)
4101 (* Hence differentiation of the norm.                                        *)
4102 (* ------------------------------------------------------------------------- *)
4103
4104 let DIFFERENTIABLE_NORM_AT = prove
4105  (`!a:real^N. ~(a = vec 0) ==> (\x. lift(norm x)) differentiable (at a)`,
4106   REPEAT STRIP_TAC THEN REWRITE_TAC[vector_norm] THEN
4107   SUBGOAL_THEN
4108    `(\x:real^N. lift(sqrt(x dot x))) =
4109     (lift o sqrt o drop) o (\x. lift(x dot x))`
4110   SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN
4111   MATCH_MP_TAC DIFFERENTIABLE_CHAIN_AT THEN
4112   REWRITE_TAC[DIFFERENTIABLE_SQNORM_AT; GSYM NORM_POW_2] THEN
4113   MP_TAC(ISPEC `norm(a:real^N) pow 2` REAL_DIFFERENTIABLE_AT_SQRT) THEN
4114   ASM_SIMP_TAC[REAL_POW_LT; NORM_POS_LT; REAL_DIFFERENTIABLE_AT]);;
4115
4116 let DIFFERENTIABLE_ON_NORM = prove
4117  (`!s:real^N->bool. ~(vec 0 IN s) ==> (\x. lift(norm x)) differentiable_on s`,
4118   REPEAT STRIP_TAC THEN
4119   MATCH_MP_TAC DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON THEN
4120   REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFFERENTIABLE_NORM_AT THEN
4121   ASM_MESON_TAC[]);;
4122
4123 (* ------------------------------------------------------------------------- *)
4124 (* Some somewhat sharper continuity theorems including endpoints.            *)
4125 (* ------------------------------------------------------------------------- *)
4126
4127 let REAL_CONTINUOUS_WITHIN_SQRT_STRONG = prove
4128  (`!x. sqrt real_continuous (atreal x within {t | &0 <= t})`,
4129   GEN_TAC THEN REWRITE_TAC[REAL_COMPLEX_CONTINUOUS_WITHINREAL] THEN
4130   ASM_CASES_TAC `x IN {t | &0 <= t}` THENL
4131    [MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN THEN
4132     MAP_EVERY EXISTS_TAC [`csqrt`; `&1`] THEN
4133     REWRITE_TAC[IMAGE_CX; IN_ELIM_THM; REAL_LT_01;
4134       CONTINUOUS_WITHIN_CSQRT_POSREAL;
4135       SET_RULE `real INTER {z | real z /\ P z} = {z | real z /\ P z}`] THEN
4136     RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM]) THEN
4137     ASM_REWRITE_TAC[REAL_CX; RE_CX; IMP_CONJ; FORALL_REAL; o_THM] THEN
4138     SIMP_TAC[CX_SQRT];
4139     MATCH_MP_TAC CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL THEN CONJ_TAC THENL
4140      [SUBGOAL_THEN `real INTER IMAGE Cx {t | &0 <= t} =
4141                     real INTER {t | Re t >= &0}`
4142        (fun th -> SIMP_TAC[th; CLOSED_INTER; CLOSED_REAL;
4143                            CLOSED_HALFSPACE_RE_GE]) THEN
4144      REWRITE_TAC[EXTENSION; IMAGE_CX; IN_ELIM_THM; IN_CBALL; IN_INTER] THEN
4145      REWRITE_TAC[real_ge; IN; CONJ_ACI];
4146       MATCH_MP_TAC(SET_RULE
4147        `(!x y. f x = f y ==> x = y) /\ ~(x IN s)
4148         ==> ~(f x IN t INTER IMAGE f s)`) THEN
4149       ASM_REWRITE_TAC[CX_INJ]]]);;
4150
4151 let REAL_CONTINUOUS_ON_SQRT = prove
4152  (`!s. (!x. x IN s ==> &0 <= x) ==> sqrt real_continuous_on s`,
4153   REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
4154   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_SUBSET THEN
4155   EXISTS_TAC `{x | &0 <= x}` THEN
4156   ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM; REAL_CONTINUOUS_WITHIN_SQRT_STRONG]);;
4157
4158 let REAL_CONTINUOUS_WITHIN_ASN_STRONG = prove
4159  (`!x. asn real_continuous (atreal x within {t | abs(t) <= &1})`,
4160   GEN_TAC THEN REWRITE_TAC[REAL_COMPLEX_CONTINUOUS_WITHINREAL] THEN
4161   ASM_CASES_TAC `x IN {t | abs(t) <= &1}` THENL
4162    [MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN THEN
4163     MAP_EVERY EXISTS_TAC [`casn`; `&1`] THEN
4164     REWRITE_TAC[IMAGE_CX; IN_ELIM_THM; CONTINUOUS_WITHIN_CASN_REAL; REAL_LT_01;
4165      SET_RULE `real INTER {z | real z /\ P z} = {z | real z /\ P z}`] THEN
4166     RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM]) THEN
4167     ASM_REWRITE_TAC[REAL_CX; RE_CX; IMP_CONJ; FORALL_REAL; o_THM] THEN
4168     SIMP_TAC[CX_ASN];
4169     MATCH_MP_TAC CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL THEN CONJ_TAC THENL
4170      [SUBGOAL_THEN `real INTER IMAGE Cx {t | abs t <= &1} =
4171                     real INTER cball(Cx(&0),&1)`
4172        (fun th -> SIMP_TAC[th; CLOSED_INTER; CLOSED_REAL; CLOSED_CBALL]) THEN
4173       REWRITE_TAC[EXTENSION; IMAGE_CX; IN_ELIM_THM; IN_CBALL; IN_INTER] THEN
4174       REWRITE_TAC[dist; COMPLEX_SUB_LZERO; NORM_NEG; IN] THEN
4175       MESON_TAC[REAL_NORM];
4176       MATCH_MP_TAC(SET_RULE
4177        `(!x y. f x = f y ==> x = y) /\ ~(x IN s)
4178         ==> ~(f x IN t INTER IMAGE f s)`) THEN
4179       ASM_REWRITE_TAC[CX_INJ]]]);;
4180
4181 let REAL_CONTINUOUS_ON_ASN = prove
4182  (`!s. (!x. x IN s ==> abs(x) <= &1) ==> asn real_continuous_on s`,
4183   REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
4184   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_SUBSET THEN
4185   EXISTS_TAC `{x | abs(x) <= &1}` THEN
4186   ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM; REAL_CONTINUOUS_WITHIN_ASN_STRONG]);;
4187
4188 let REAL_CONTINUOUS_WITHIN_ACS_STRONG = prove
4189  (`!x. acs real_continuous (atreal x within {t | abs(t) <= &1})`,
4190   GEN_TAC THEN REWRITE_TAC[REAL_COMPLEX_CONTINUOUS_WITHINREAL] THEN
4191   ASM_CASES_TAC `x IN {t | abs(t) <= &1}` THENL
4192    [MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN THEN
4193     MAP_EVERY EXISTS_TAC [`cacs`; `&1`] THEN
4194     REWRITE_TAC[IMAGE_CX; IN_ELIM_THM; CONTINUOUS_WITHIN_CACS_REAL; REAL_LT_01;
4195      SET_RULE `real INTER {z | real z /\ P z} = {z | real z /\ P z}`] THEN
4196     RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM]) THEN
4197     ASM_REWRITE_TAC[REAL_CX; RE_CX; IMP_CONJ; FORALL_REAL; o_THM] THEN
4198     SIMP_TAC[CX_ACS];
4199     MATCH_MP_TAC CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL THEN CONJ_TAC THENL
4200      [SUBGOAL_THEN `real INTER IMAGE Cx {t | abs t <= &1} =
4201                     real INTER cball(Cx(&0),&1)`
4202        (fun th -> SIMP_TAC[th; CLOSED_INTER; CLOSED_REAL; CLOSED_CBALL]) THEN
4203       REWRITE_TAC[EXTENSION; IMAGE_CX; IN_ELIM_THM; IN_CBALL; IN_INTER] THEN
4204       REWRITE_TAC[dist; COMPLEX_SUB_LZERO; NORM_NEG; IN] THEN
4205       MESON_TAC[REAL_NORM];
4206       MATCH_MP_TAC(SET_RULE
4207        `(!x y. f x = f y ==> x = y) /\ ~(x IN s)
4208         ==> ~(f x IN t INTER IMAGE f s)`) THEN
4209       ASM_REWRITE_TAC[CX_INJ]]]);;
4210
4211 let REAL_CONTINUOUS_ON_ACS = prove
4212  (`!s. (!x. x IN s ==> abs(x) <= &1) ==> acs real_continuous_on s`,
4213   REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
4214   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_SUBSET THEN
4215   EXISTS_TAC `{x | abs(x) <= &1}` THEN
4216   ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM; REAL_CONTINUOUS_WITHIN_ACS_STRONG]);;
4217
4218 (* ------------------------------------------------------------------------- *)
4219 (* Differentiation conversion.                                               *)
4220 (* ------------------------------------------------------------------------- *)
4221
4222 let real_differentiation_theorems = ref [];;
4223
4224 let add_real_differentiation_theorems =
4225   let ETA_THM = prove
4226    (`(f has_real_derivative f') net <=>
4227      ((\x. f x) has_real_derivative f') net`,
4228     REWRITE_TAC[ETA_AX]) in
4229   let ETA_TWEAK =
4230     PURE_REWRITE_RULE [IMP_CONJ] o
4231     GEN_REWRITE_RULE (LAND_CONV o ONCE_DEPTH_CONV) [ETA_THM] o
4232     SPEC_ALL in
4233   fun l -> real_differentiation_theorems :=
4234               !real_differentiation_theorems @ map ETA_TWEAK l;;
4235
4236 add_real_differentiation_theorems
4237  ([HAS_REAL_DERIVATIVE_LMUL_WITHIN; HAS_REAL_DERIVATIVE_LMUL_ATREAL;
4238    HAS_REAL_DERIVATIVE_RMUL_WITHIN; HAS_REAL_DERIVATIVE_RMUL_ATREAL;
4239    HAS_REAL_DERIVATIVE_CDIV_WITHIN; HAS_REAL_DERIVATIVE_CDIV_ATREAL;
4240    HAS_REAL_DERIVATIVE_ID;
4241    HAS_REAL_DERIVATIVE_CONST;
4242    HAS_REAL_DERIVATIVE_NEG;
4243    HAS_REAL_DERIVATIVE_ADD;
4244    HAS_REAL_DERIVATIVE_SUB;
4245    HAS_REAL_DERIVATIVE_MUL_WITHIN; HAS_REAL_DERIVATIVE_MUL_ATREAL;
4246    HAS_REAL_DERIVATIVE_DIV_WITHIN; HAS_REAL_DERIVATIVE_DIV_ATREAL;
4247    HAS_REAL_DERIVATIVE_POW_WITHIN; HAS_REAL_DERIVATIVE_POW_ATREAL;
4248    HAS_REAL_DERIVATIVE_INV_WITHIN; HAS_REAL_DERIVATIVE_INV_ATREAL] @
4249   (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM]
4250     (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN_UNIV
4251               HAS_REAL_DERIVATIVE_EXP))) @
4252   (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM]
4253     (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN_UNIV
4254               HAS_REAL_DERIVATIVE_SIN))) @
4255   (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM]
4256     (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN_UNIV
4257               HAS_REAL_DERIVATIVE_COS))) @
4258   (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM]
4259     (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN
4260               HAS_REAL_DERIVATIVE_TAN))) @
4261   (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM]
4262     (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN
4263               HAS_REAL_DERIVATIVE_LOG))) @
4264   (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM]
4265     (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN
4266               HAS_REAL_DERIVATIVE_SQRT))) @
4267   (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM]
4268     (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN_UNIV
4269               HAS_REAL_DERIVATIVE_ATN))) @
4270   (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM]
4271     (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN
4272               HAS_REAL_DERIVATIVE_ASN))) @
4273   (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM]
4274     (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN
4275               HAS_REAL_DERIVATIVE_ACS))));;
4276
4277 let rec REAL_DIFF_CONV =
4278   let partfn tm = let l,r = dest_comb tm in mk_pair(lhand l,r)
4279   and is_deriv = can (term_match [] `(f has_real_derivative f') net`) in
4280   let rec REAL_DIFF_CONV tm =
4281     try tryfind (fun th -> PART_MATCH partfn th (partfn tm))
4282                 (!real_differentiation_theorems)
4283     with Failure _ ->
4284         let ith = tryfind (fun th ->
4285          PART_MATCH (partfn o repeat (snd o dest_imp)) th (partfn tm))
4286                     (!real_differentiation_theorems) in
4287         REAL_DIFF_ELIM ith
4288   and REAL_DIFF_ELIM th =
4289     let tm = concl th in
4290     if not(is_imp tm) then th else
4291     let t = lhand tm in
4292     if not(is_deriv t) then UNDISCH th
4293     else REAL_DIFF_ELIM (MATCH_MP th (REAL_DIFF_CONV t)) in
4294   REAL_DIFF_CONV;;
4295
4296 (* ------------------------------------------------------------------------- *)
4297 (* Hence a tactic.                                                           *)
4298 (* ------------------------------------------------------------------------- *)
4299
4300 let REAL_DIFF_TAC =
4301   let pth = MESON[]
4302    `(f has_real_derivative f') net
4303     ==> f' = g'
4304         ==> (f has_real_derivative g') net` in
4305   W(fun (asl,w) -> let th = MATCH_MP pth (REAL_DIFF_CONV w) in
4306        MATCH_MP_TAC(repeat (GEN_REWRITE_RULE I [IMP_IMP]) (DISCH_ALL th)));;
4307
4308 let REAL_DIFFERENTIABLE_TAC =
4309   let DISCH_FIRST th = DISCH (hd(hyp th)) th in
4310   GEN_REWRITE_TAC I [real_differentiable] THEN
4311   W(fun (asl,w) ->
4312         let th = REAL_DIFF_CONV(snd(dest_exists w)) in
4313         let f' = rand(rator(concl th)) in
4314         EXISTS_TAC f' THEN
4315         (if hyp th = [] then MATCH_ACCEPT_TAC th else
4316          let th' = repeat (GEN_REWRITE_RULE I [IMP_IMP] o DISCH_FIRST)
4317                           (DISCH_FIRST th) in
4318          MATCH_MP_TAC th'));;
4319
4320 (* ------------------------------------------------------------------------- *)
4321 (* Analytic results for real power function.                                 *)
4322 (* ------------------------------------------------------------------------- *)
4323
4324 let HAS_REAL_DERIVATIVE_RPOW = prove
4325  (`!x y.
4326     &0 < x
4327     ==> ((\x. x rpow y) has_real_derivative y * x rpow (y - &1)) (atreal x)`,
4328   REPEAT STRIP_TAC THEN
4329   MATCH_MP_TAC HAS_REAL_DERIVATIVE_TRANSFORM_ATREAL THEN
4330   EXISTS_TAC `\x. exp(y * log x)` THEN EXISTS_TAC `x:real` THEN
4331   ASM_SIMP_TAC[rpow; REAL_ARITH
4332     `&0 < x ==> (abs(y - x) < x <=> &0 < y /\ y < &2 * x)`] THEN
4333   REAL_DIFF_TAC THEN
4334   ASM_SIMP_TAC[REAL_SUB_RDISTRIB; REAL_EXP_SUB; REAL_MUL_LID; EXP_LOG] THEN
4335   REAL_ARITH_TAC);;
4336
4337 add_real_differentiation_theorems
4338  (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM]
4339    (GEN `y:real` (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN
4340     (SPEC `y:real`
4341       (ONCE_REWRITE_RULE[SWAP_FORALL_THM] HAS_REAL_DERIVATIVE_RPOW))))));;
4342
4343 let REAL_DIFFERENTIABLE_AT_RPOW = prove
4344  (`!x y. ~(x = &0) ==> (\x. x rpow y) real_differentiable atreal x`,
4345   REPEAT GEN_TAC THEN
4346   REWRITE_TAC[REAL_ARITH `~(x = &0) <=> &0 < x \/ &0 < --x`] THEN
4347   STRIP_TAC THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_TRANSFORM_ATREAL THEN
4348   REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
4349   EXISTS_TAC `abs x` THENL
4350    [EXISTS_TAC `\x. exp(y * log x)` THEN
4351     ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> &0 < abs x`] THEN CONJ_TAC THENL
4352      [X_GEN_TAC `z:real` THEN DISCH_TAC THEN
4353       SUBGOAL_THEN `&0 < z` (fun th -> REWRITE_TAC[rpow; th]) THEN
4354       ASM_REAL_ARITH_TAC;
4355       REAL_DIFFERENTIABLE_TAC THEN ASM_REAL_ARITH_TAC];
4356     ASM_CASES_TAC `?m n. ODD m /\ ODD n /\ abs y = &m / &n` THENL
4357      [EXISTS_TAC `\x. --(exp(y * log(--x)))`;
4358       EXISTS_TAC `\x. exp(y * log(--x))`] THEN
4359     (ASM_SIMP_TAC[REAL_ARITH `&0 < --x ==> &0 < abs x`] THEN CONJ_TAC THENL
4360       [X_GEN_TAC `z:real` THEN DISCH_TAC THEN
4361        SUBGOAL_THEN `~(&0 < z) /\ ~(z = &0)`
4362          (fun th -> ASM_REWRITE_TAC[rpow; th]) THEN
4363        ASM_REAL_ARITH_TAC;
4364        REAL_DIFFERENTIABLE_TAC THEN ASM_REAL_ARITH_TAC])]);;
4365
4366 let REAL_CONTINUOUS_AT_RPOW = prove
4367  (`!x y. (x = &0 ==> &0 <= y)
4368          ==> (\x. x rpow y) real_continuous (atreal x)`,
4369   REPEAT GEN_TAC THEN ASM_CASES_TAC `y = &0` THEN
4370   ASM_REWRITE_TAC[RPOW_POW; real_pow; REAL_CONTINUOUS_CONST] THEN
4371   ASM_CASES_TAC `x = &0` THENL
4372    [ASM_REWRITE_TAC[real_continuous_atreal; RPOW_ZERO] THEN
4373     REWRITE_TAC[REAL_SUB_RZERO; REAL_ABS_RPOW] THEN STRIP_TAC THEN
4374     X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e rpow inv(y)` THEN
4375     ASM_SIMP_TAC[RPOW_POS_LT] THEN X_GEN_TAC `z:real` THEN DISCH_TAC THEN
4376     MATCH_MP_TAC REAL_LTE_TRANS THEN
4377     EXISTS_TAC `e rpow inv y rpow y` THEN CONJ_TAC THENL
4378      [MATCH_MP_TAC RPOW_LT2 THEN ASM_REAL_ARITH_TAC;
4379       ASM_SIMP_TAC[RPOW_RPOW; REAL_LT_IMP_LE; REAL_MUL_LINV] THEN
4380       REWRITE_TAC[RPOW_POW; REAL_POW_1; REAL_LE_REFL]];
4381     ASM_SIMP_TAC[REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL;
4382                  REAL_DIFFERENTIABLE_AT_RPOW]]);;
4383
4384 let REAL_CONTINUOUS_WITHIN_RPOW = prove
4385  (`!s x y. (x = &0 ==> &0 <= y)
4386            ==> (\x. x rpow y) real_continuous (atreal x within s)`,
4387   MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL;
4388             REAL_CONTINUOUS_AT_RPOW]);;
4389
4390 let REAL_CONTINUOUS_ON_RPOW = prove
4391  (`!s y. (&0 IN s ==> &0 <= y) ==> (\x. x rpow y) real_continuous_on s`,
4392   REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
4393   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_WITHIN_RPOW THEN
4394   ASM_MESON_TAC[]);;
4395
4396 let REALLIM_RPOW = prove
4397  (`!net f l n.
4398         (f ---> l) net /\ (l = &0 ==> &0 <= n)
4399         ==> ((\x. f x rpow n) ---> l rpow n) net`,
4400   REPEAT STRIP_TAC THEN MATCH_MP_TAC
4401   (REWRITE_RULE[] (ISPEC `\x. x rpow n` REALLIM_REAL_CONTINUOUS_FUNCTION)) THEN
4402   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_CONTINUOUS_AT_RPOW THEN
4403   ASM_REWRITE_TAC[]);;
4404
4405 let REALLIM_NULL_POW_EQ = prove
4406  (`!net f n.
4407         ~(n = 0)
4408         ==> (((\x. f x pow n) ---> &0) net <=> (f ---> &0) net)`,
4409   REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[REALLIM_NULL_POW] THEN
4410   DISCH_THEN(MP_TAC o ISPEC `(\x. x rpow (inv(&n))) o abs` o
4411     MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] REALLIM_REAL_CONTINUOUS_FUNCTION)) THEN
4412   REWRITE_TAC[o_THM] THEN
4413   ASM_REWRITE_TAC[RPOW_ZERO; REAL_INV_EQ_0; REAL_OF_NUM_EQ; REAL_ABS_NUM] THEN
4414   SIMP_TAC[GSYM RPOW_POW; RPOW_RPOW; REAL_ABS_POS; REAL_ABS_RPOW] THEN
4415   ASM_SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ] THEN
4416   REWRITE_TAC[REALLIM_NULL_ABS; RPOW_POW; REAL_POW_1] THEN
4417   DISCH_THEN MATCH_MP_TAC THEN
4418   ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN
4419   MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_COMPOSE THEN CONJ_TAC THENL
4420    [GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN
4421     MATCH_MP_TAC REAL_CONTINUOUS_ABS THEN
4422     REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID];
4423     MATCH_MP_TAC REAL_CONTINUOUS_WITHIN_RPOW THEN
4424     REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS]]);;
4425
4426 let LIM_NULL_COMPLEX_POW_EQ = prove
4427  (`!net f n.
4428         ~(n = 0)
4429         ==> (((\x. f x pow n) --> Cx(&0)) net <=> (f --> Cx(&0)) net)`,
4430   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN
4431   ONCE_REWRITE_TAC[LIM_NULL_NORM] THEN
4432   REWRITE_TAC[COMPLEX_NORM_POW; REAL_TENDSTO; o_DEF; LIFT_DROP] THEN
4433   ASM_SIMP_TAC[REALLIM_NULL_POW_EQ; DROP_VEC]);;
4434
4435 (* ------------------------------------------------------------------------- *)
4436 (* Intermediate Value Theorem.                                               *)
4437 (* ------------------------------------------------------------------------- *)
4438
4439 let REAL_IVT_INCREASING = prove
4440  (`!f a b y.
4441         a <= b /\ f real_continuous_on real_interval[a,b] /\
4442         f a <= y /\ y <= f b
4443         ==> ?x. x IN real_interval [a,b] /\ f x = y`,
4444   REWRITE_TAC[REAL_CONTINUOUS_ON; IMAGE_LIFT_REAL_INTERVAL] THEN
4445   REPEAT STRIP_TAC THEN
4446   MP_TAC(ISPECL [`lift o f o drop`; `lift a`; `lift b`; `y:real`; `1`]
4447         IVT_INCREASING_COMPONENT_ON_1) THEN
4448   ASM_REWRITE_TAC[GSYM drop; o_THM; LIFT_DROP; DIMINDEX_1; LE_REFL] THEN
4449   REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; EXISTS_IN_IMAGE; LIFT_DROP]);;
4450
4451 let REAL_IVT_DECREASING = prove
4452  (`!f a b y.
4453         a <= b /\ f real_continuous_on real_interval[a,b] /\
4454         f b <= y /\ y <= f a
4455         ==> ?x. x IN real_interval [a,b] /\ f x = y`,
4456   REWRITE_TAC[REAL_CONTINUOUS_ON; IMAGE_LIFT_REAL_INTERVAL] THEN
4457   REPEAT STRIP_TAC THEN
4458   MP_TAC(ISPECL [`lift o f o drop`; `lift a`; `lift b`; `y:real`; `1`]
4459         IVT_DECREASING_COMPONENT_ON_1) THEN
4460   ASM_REWRITE_TAC[GSYM drop; o_THM; LIFT_DROP; DIMINDEX_1; LE_REFL] THEN
4461   REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; EXISTS_IN_IMAGE; LIFT_DROP]);;
4462
4463 let IS_REALINTERVAL_CONTINUOUS_IMAGE = prove
4464  (`!s. f real_continuous_on s /\ is_realinterval s
4465        ==> is_realinterval(IMAGE f s)`,
4466   GEN_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_ON; IS_REALINTERVAL_CONNECTED] THEN
4467   DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_CONTINUOUS_IMAGE) THEN
4468   REWRITE_TAC[IMAGE_o; REWRITE_RULE[IMAGE_o] IMAGE_LIFT_DROP]);;
4469
4470 (* ------------------------------------------------------------------------- *)
4471 (* Zeroness (or sign at boundary) of derivative at local extremum.           *)
4472 (* ------------------------------------------------------------------------- *)
4473
4474 let REAL_DERIVATIVE_POS_LEFT_MINIMUM = prove
4475  (`!f f' a b e.
4476         a < b /\ &0 < e /\
4477         (f has_real_derivative f') (atreal a within real_interval[a,b]) /\
4478         (!x. x IN real_interval[a,b] /\ abs(x - a) < e ==> f a <= f x)
4479         ==> &0 <= f'`,
4480   REPEAT STRIP_TAC THEN
4481   MP_TAC(ISPECL [`lift o f o drop`; `\x:real^1. f' % x`;
4482                  `lift a`; `interval[lift a,lift b]`; `e:real`]
4483         DROP_DIFFERENTIAL_POS_AT_MINIMUM) THEN
4484   ASM_REWRITE_TAC[ENDS_IN_INTERVAL; CONVEX_INTERVAL; IN_INTER; IMP_CONJ] THEN
4485   ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY;
4486                   GSYM HAS_REAL_FRECHET_DERIVATIVE_WITHIN] THEN
4487   ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; IN_BALL; DIST_LIFT;
4488                REAL_INTERVAL_NE_EMPTY; REAL_LT_IMP_LE] THEN
4489   ANTS_TAC THENL [ASM_MESON_TAC[REAL_ABS_SUB]; ALL_TAC] THEN
4490   DISCH_THEN(MP_TAC o SPEC `b:real`) THEN
4491   ASM_SIMP_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_NE_EMPTY;
4492                REAL_LT_IMP_LE] THEN
4493   ASM_SIMP_TAC[DROP_CMUL; DROP_SUB; LIFT_DROP; REAL_LE_MUL_EQ;
4494                REAL_SUB_LT]);;
4495
4496 let REAL_DERIVATIVE_NEG_LEFT_MAXIMUM = prove
4497  (`!f f' a b e.
4498         a < b /\ &0 < e /\
4499         (f has_real_derivative f') (atreal a within real_interval[a,b]) /\
4500         (!x. x IN real_interval[a,b] /\ abs(x - a) < e ==> f x <= f a)
4501         ==> f' <= &0`,
4502   REPEAT STRIP_TAC THEN
4503   MP_TAC(ISPECL [`lift o f o drop`; `\x:real^1. f' % x`;
4504                  `lift a`; `interval[lift a,lift b]`; `e:real`]
4505         DROP_DIFFERENTIAL_NEG_AT_MAXIMUM) THEN
4506   ASM_REWRITE_TAC[ENDS_IN_INTERVAL; CONVEX_INTERVAL; IN_INTER; IMP_CONJ] THEN
4507   ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY;
4508                   GSYM HAS_REAL_FRECHET_DERIVATIVE_WITHIN] THEN
4509   ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; IN_BALL; DIST_LIFT;
4510                REAL_INTERVAL_NE_EMPTY; REAL_LT_IMP_LE] THEN
4511   ANTS_TAC THENL [ASM_MESON_TAC[REAL_ABS_SUB]; ALL_TAC] THEN
4512   DISCH_THEN(MP_TAC o SPEC `b:real`) THEN
4513   ASM_SIMP_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_NE_EMPTY;
4514                REAL_LT_IMP_LE] THEN
4515   ASM_SIMP_TAC[DROP_CMUL; DROP_SUB; LIFT_DROP; REAL_LE_MUL_EQ;
4516                REAL_SUB_LT; REAL_ARITH `f * ba <= &0 <=> &0 <= --f * ba`] THEN
4517   REAL_ARITH_TAC);;
4518
4519 let REAL_DERIVATIVE_POS_RIGHT_MAXIMUM = prove
4520  (`!f f' a b e.
4521         a < b /\ &0 < e /\
4522         (f has_real_derivative f') (atreal b within real_interval[a,b]) /\
4523         (!x. x IN real_interval[a,b] /\ abs(x - b) < e ==> f x <= f b)
4524         ==> &0 <= f'`,
4525   REPEAT STRIP_TAC THEN
4526   MP_TAC(ISPECL [`lift o f o drop`; `\x:real^1. f' % x`;
4527                  `lift b`; `interval[lift a,lift b]`; `e:real`]
4528         DROP_DIFFERENTIAL_NEG_AT_MAXIMUM) THEN
4529   ASM_REWRITE_TAC[ENDS_IN_INTERVAL; CONVEX_INTERVAL; IN_INTER; IMP_CONJ] THEN
4530   ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY;
4531                   GSYM HAS_REAL_FRECHET_DERIVATIVE_WITHIN] THEN
4532   ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; IN_BALL; DIST_LIFT;
4533                REAL_INTERVAL_NE_EMPTY; REAL_LT_IMP_LE] THEN
4534   ANTS_TAC THENL [ASM_MESON_TAC[REAL_ABS_SUB]; ALL_TAC] THEN
4535   DISCH_THEN(MP_TAC o SPEC `a:real`) THEN
4536   ASM_SIMP_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_NE_EMPTY;
4537                REAL_LT_IMP_LE] THEN
4538   ASM_SIMP_TAC[DROP_CMUL; DROP_SUB; LIFT_DROP; REAL_LE_MUL_EQ; REAL_SUB_LT;
4539                REAL_ARITH `f * (a - b) <= &0 <=> &0 <= f * (b - a)`]);;
4540
4541 let REAL_DERIVATIVE_NEG_RIGHT_MINIMUM = prove
4542  (`!f f' a b e.
4543         a < b /\ &0 < e /\
4544         (f has_real_derivative f') (atreal b within real_interval[a,b]) /\
4545         (!x. x IN real_interval[a,b] /\ abs(x - b) < e ==> f b <= f x)
4546         ==> f' <= &0`,
4547   REPEAT STRIP_TAC THEN
4548   MP_TAC(ISPECL [`lift o f o drop`; `\x:real^1. f' % x`;
4549                  `lift b`; `interval[lift a,lift b]`; `e:real`]
4550         DROP_DIFFERENTIAL_POS_AT_MINIMUM) THEN
4551   ASM_REWRITE_TAC[ENDS_IN_INTERVAL; CONVEX_INTERVAL; IN_INTER; IMP_CONJ] THEN
4552   ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY;
4553                   GSYM HAS_REAL_FRECHET_DERIVATIVE_WITHIN] THEN
4554   ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; IN_BALL; DIST_LIFT;
4555                REAL_INTERVAL_NE_EMPTY; REAL_LT_IMP_LE] THEN
4556   ANTS_TAC THENL [ASM_MESON_TAC[REAL_ABS_SUB]; ALL_TAC] THEN
4557   DISCH_THEN(MP_TAC o SPEC `a:real`) THEN
4558   ASM_SIMP_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_NE_EMPTY;
4559                REAL_LT_IMP_LE] THEN
4560   ASM_SIMP_TAC[DROP_CMUL; DROP_SUB; LIFT_DROP] THEN
4561   ONCE_REWRITE_TAC[REAL_ARITH `&0 <= f * (a - b) <=> &0 <= --f * (b - a)`] THEN
4562   ASM_SIMP_TAC[REAL_LE_MUL_EQ; REAL_SUB_LT] THEN REAL_ARITH_TAC);;
4563
4564 let REAL_DERIVATIVE_ZERO_MAXMIN = prove
4565  (`!f f' x s.
4566         x IN s /\ real_open s /\
4567         (f has_real_derivative f') (atreal x) /\
4568         ((!y. y IN s ==> f y <= f x) \/ (!y. y IN s ==> f x <= f y))
4569         ==> f' = &0`,
4570   REPEAT STRIP_TAC THEN
4571   MP_TAC(ISPECL [`lift o f o drop`; `\x:real^1. f' % x`;
4572                  `lift x`; `IMAGE lift s`]
4573         DIFFERENTIAL_ZERO_MAXMIN) THEN
4574   ASM_REWRITE_TAC[GSYM HAS_REAL_FRECHET_DERIVATIVE_AT; GSYM REAL_OPEN] THEN
4575   ASM_SIMP_TAC[FUN_IN_IMAGE; FORALL_IN_IMAGE] THEN
4576   ASM_REWRITE_TAC[o_DEF; LIFT_DROP] THEN
4577   DISCH_THEN(MP_TAC o C AP_THM `vec 1:real^1`) THEN
4578   REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_VEC; REAL_MUL_RID]);;
4579
4580 (* ------------------------------------------------------------------------- *)
4581 (* Rolle and Mean Value Theorem.                                             *)
4582 (* ------------------------------------------------------------------------- *)
4583
4584 let REAL_ROLLE = prove
4585  (`!f f' a b.
4586         a < b /\ f a = f b /\
4587         f real_continuous_on real_interval[a,b] /\
4588         (!x. x IN real_interval(a,b)
4589              ==> (f has_real_derivative f'(x)) (atreal x))
4590         ==> ?x. x IN real_interval(a,b) /\ f'(x) = &0`,
4591   REWRITE_TAC[REAL_INTERVAL_INTERVAL; FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN
4592   REWRITE_TAC[REAL_CONTINUOUS_ON; HAS_REAL_VECTOR_DERIVATIVE_AT] THEN
4593   REWRITE_TAC[GSYM IMAGE_o; IMAGE_LIFT_DROP; has_vector_derivative] THEN
4594   REWRITE_TAC[LIFT_DROP] THEN REPEAT STRIP_TAC THEN
4595   MP_TAC(ISPECL [`lift o f o drop`; `\x:real^1 h:real^1. f'(drop x) % h`;
4596                  `lift a`; `lift b`] ROLLE) THEN
4597   ASM_REWRITE_TAC[o_THM; LIFT_DROP] THEN ANTS_TAC THENL
4598    [X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN
4599     FIRST_X_ASSUM(MP_TAC o SPEC `t:real^1`) THEN
4600     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN
4601     AP_THM_TAC THEN AP_TERM_TAC THEN
4602     REWRITE_TAC[FUN_EQ_THM; FORALL_LIFT; LIFT_DROP; GSYM LIFT_CMUL] THEN
4603     REWRITE_TAC[REAL_MUL_AC];
4604     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^1` THEN
4605     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
4606     FIRST_X_ASSUM(MP_TAC o C AP_THM `lift(&1)`) THEN
4607     REWRITE_TAC[GSYM LIFT_CMUL; GSYM LIFT_NUM; LIFT_EQ; REAL_MUL_RID]]);;
4608
4609 let REAL_MVT = prove
4610  (`!f f' a b.
4611         a < b /\
4612         f real_continuous_on real_interval[a,b] /\
4613         (!x. x IN real_interval(a,b)
4614              ==> (f has_real_derivative f'(x)) (atreal x))
4615         ==> ?x. x IN real_interval(a,b) /\ f(b) - f(a) = f'(x) * (b - a)`,
4616   REPEAT STRIP_TAC THEN
4617   MP_TAC(SPECL [`\x:real. f(x) - (f b - f a) / (b - a) * x`;
4618                 `(\x. f'(x) - (f b - f a) / (b - a)):real->real`;
4619                  `a:real`; `b:real`]
4620                REAL_ROLLE) THEN
4621   ASM_SIMP_TAC[REAL_FIELD
4622    `a < b ==> (fx - fba / (b - a) = &0 <=> fba = fx * (b - a))`] THEN
4623   DISCH_THEN MATCH_MP_TAC THEN
4624   ASM_SIMP_TAC[REAL_CONTINUOUS_ON_SUB; REAL_CONTINUOUS_ON_LMUL;
4625                REAL_CONTINUOUS_ON_ID] THEN
4626   CONJ_TAC THENL [UNDISCH_TAC `a < b` THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN
4627   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_SUB THEN
4628   ASM_SIMP_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN
4629   ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_LMUL_ATREAL; HAS_REAL_DERIVATIVE_ID]);;
4630
4631 let REAL_MVT_SIMPLE = prove
4632  (`!f f' a b.
4633         a < b /\
4634         (!x. x IN real_interval[a,b]
4635              ==> (f has_real_derivative f'(x))
4636                  (atreal x within real_interval[a,b]))
4637         ==> ?x. x IN real_interval(a,b) /\ f(b) - f(a) = f'(x) * (b - a)`,
4638   MP_TAC REAL_MVT THEN
4639   REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
4640   REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
4641   CONJ_TAC THENL
4642    [MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN
4643     ASM_MESON_TAC[real_differentiable_on; real_differentiable];
4644     ASM_MESON_TAC[HAS_REAL_DERIVATIVE_WITHIN_REAL_OPEN; REAL_OPEN_REAL_INTERVAL;
4645                   REAL_INTERVAL_OPEN_SUBSET_CLOSED;
4646                   HAS_REAL_DERIVATIVE_WITHIN_SUBSET; SUBSET]]);;
4647
4648 let REAL_MVT_VERY_SIMPLE = prove
4649  (`!f f' a b.
4650         a <= b /\
4651         (!x. x IN real_interval[a,b]
4652              ==> (f has_real_derivative f'(x))
4653                  (atreal x within real_interval[a,b]))
4654         ==> ?x. x IN real_interval[a,b] /\ f(b) - f(a) = f'(x) * (b - a)`,
4655   REPEAT GEN_TAC THEN ASM_CASES_TAC `b:real = a` THENL
4656    [ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO] THEN
4657     REWRITE_TAC[REAL_INTERVAL_SING; IN_SING; EXISTS_REFL];
4658     ASM_REWRITE_TAC[REAL_LE_LT] THEN
4659     DISCH_THEN(MP_TAC o MATCH_MP REAL_MVT_SIMPLE) THEN
4660     MATCH_MP_TAC MONO_EXISTS THEN
4661     SIMP_TAC[REWRITE_RULE[SUBSET] REAL_INTERVAL_OPEN_SUBSET_CLOSED]]);;
4662
4663 let REAL_ROLLE_SIMPLE = prove
4664  (`!f f' a b.
4665         a < b /\ f a = f b /\
4666         (!x. x IN real_interval[a,b]
4667              ==> (f has_real_derivative f'(x))
4668                  (atreal x within real_interval[a,b]))
4669         ==> ?x. x IN real_interval(a,b) /\ f'(x) = &0`,
4670   MP_TAC REAL_MVT_SIMPLE THEN
4671   REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
4672   DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
4673   MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN
4674   REWRITE_TAC[REAL_RING `a - a = b * (c - d) <=> b = &0 \/ c = d`] THEN
4675   ASM_MESON_TAC[REAL_LT_REFL]);;
4676
4677 (* ------------------------------------------------------------------------- *)
4678 (* Cauchy MVT and l'Hospital's rule.                                         *)
4679 (* ------------------------------------------------------------------------- *)
4680
4681 let REAL_MVT_CAUCHY = prove
4682  (`!f g f' g' a b.
4683            a < b /\
4684            f real_continuous_on real_interval[a,b] /\
4685            g real_continuous_on real_interval[a,b] /\
4686            (!x. x IN real_interval(a,b)
4687                 ==> (f has_real_derivative f' x) (atreal x) /\
4688                     (g has_real_derivative g' x) (atreal x))
4689            ==> ?x. x IN real_interval(a,b) /\
4690                    (f b - f a) * g'(x) = (g b - g a) * f'(x)`,
4691   REPEAT STRIP_TAC THEN MP_TAC(SPECL
4692    [`\x. (f:real->real)(x) * (g(b:real) - g(a)) - g(x) * (f(b) - f(a))`;
4693     `\x. (f':real->real)(x) * (g(b:real) - g(a)) - g'(x) * (f(b) - f(a))`;
4694     `a:real`; `b:real`] REAL_MVT) THEN
4695   ASM_SIMP_TAC[REAL_CONTINUOUS_ON_SUB; REAL_CONTINUOUS_ON_RMUL;
4696                HAS_REAL_DERIVATIVE_SUB; HAS_REAL_DERIVATIVE_RMUL_ATREAL] THEN
4697   MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN
4698   UNDISCH_TAC `a < b` THEN CONV_TAC REAL_FIELD);;
4699
4700 let LHOSPITAL = prove
4701  (`!f g f' g' c l d.
4702         &0 < d /\
4703         (!x. &0 < abs(x - c) /\ abs(x - c) < d
4704              ==> (f has_real_derivative f'(x)) (atreal x) /\
4705                  (g has_real_derivative g'(x)) (atreal x) /\
4706                  ~(g'(x) = &0)) /\
4707         (f ---> &0) (atreal c) /\ (g ---> &0) (atreal c) /\
4708         ((\x. f'(x) / g'(x)) ---> l) (atreal c)
4709         ==> ((\x. f(x) / g(x)) ---> l) (atreal c)`,
4710   SUBGOAL_THEN
4711     `!f g f' g' c l d.
4712         &0 < d /\
4713         (!x. &0 < abs(x - c) /\ abs(x - c) < d
4714              ==> (f has_real_derivative f'(x)) (atreal x) /\
4715                  (g has_real_derivative g'(x)) (atreal x) /\
4716                  ~(g'(x) = &0)) /\
4717         f(c) = &0 /\ g(c) = &0 /\
4718         (f ---> &0) (atreal c) /\ (g ---> &0) (atreal c) /\
4719         ((\x. f'(x) / g'(x)) ---> l) (atreal c)
4720         ==> ((\x. f(x) / g(x)) ---> l) (atreal c)`
4721   ASSUME_TAC THENL
4722    [REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN
4723     REWRITE_TAC[FORALL_AND_THM] THEN REPEAT STRIP_TAC THEN
4724     SUBGOAL_THEN
4725      `(!x. abs(x - c) < d ==> f real_continuous atreal x) /\
4726       (!x. abs(x - c) < d ==> g real_continuous atreal x)`
4727     STRIP_ASSUME_TAC THENL
4728      [REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `x:real` THEN
4729       DISJ_CASES_TAC(REAL_ARITH `x = c \/ &0 < abs(x - c)`) THENL
4730        [ASM_REWRITE_TAC[REAL_CONTINUOUS_ATREAL]; ALL_TAC] THEN
4731       REPEAT STRIP_TAC THEN
4732       MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN
4733       REWRITE_TAC[real_differentiable] THEN ASM_MESON_TAC[];
4734       ALL_TAC] THEN
4735     SUBGOAL_THEN
4736      `!x.  &0 < abs(x - c) /\ abs(x - c) < d ==> ~(g x = &0)`
4737     STRIP_ASSUME_TAC THENL
4738      [REPEAT STRIP_TAC THEN
4739       SUBGOAL_THEN `c < x \/ x < c` DISJ_CASES_TAC THENL
4740        [ASM_REAL_ARITH_TAC;
4741         MP_TAC(ISPECL [`g:real->real`; `g':real->real`; `c:real`; `x:real`]
4742           REAL_ROLLE);
4743         MP_TAC(ISPECL [`g:real->real`; `g':real->real`; `x:real`; `c:real`]
4744           REAL_ROLLE)] THEN
4745       ASM_REWRITE_TAC[NOT_IMP; NOT_EXISTS_THM] THEN
4746       (REPEAT CONJ_TAC THENL
4747         [REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
4748          REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN
4749          MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL;
4750          REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC;
4751          X_GEN_TAC `y:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN
4752          DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
4753          REWRITE_TAC[]] THEN
4754        FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC);
4755       ALL_TAC] THEN
4756     UNDISCH_TAC `((\x. f' x / g' x) ---> l) (atreal c)` THEN
4757     REWRITE_TAC[REALLIM_ATREAL] THEN MATCH_MP_TAC MONO_FORALL THEN
4758     X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
4759     DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN
4760     EXISTS_TAC `min d k:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN
4761     X_GEN_TAC `x:real` THEN STRIP_TAC THEN
4762     SUBGOAL_THEN
4763      `?y. &0 < abs(y - c) /\ abs(y - c) < abs(x - c) /\
4764           (f:real->real) x / g x = f' y / g' y`
4765     STRIP_ASSUME_TAC THENL
4766      [ALL_TAC; ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LT_TRANS]] THEN
4767     SUBGOAL_THEN `c < x \/ x < c` DISJ_CASES_TAC THENL
4768      [ASM_REAL_ARITH_TAC;
4769       MP_TAC(ISPECL
4770        [`f:real->real`; `g:real->real`; `f':real->real`; `g':real->real`;
4771         `c:real`; `x:real`] REAL_MVT_CAUCHY);
4772       MP_TAC(ISPECL
4773        [`f:real->real`; `g:real->real`; `f':real->real`; `g':real->real`;
4774         `x:real`; `c:real`] REAL_MVT_CAUCHY)] THEN
4775     (ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN ANTS_TAC THENL
4776       [REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
4777         [CONJ_TAC THEN
4778          REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
4779          REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN
4780          MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL;
4781          REPEAT STRIP_TAC] THEN
4782        FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC;
4783        MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[REAL_SUB_RZERO] THEN
4784        GEN_TAC THEN STRIP_TAC THEN
4785         REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
4786        MATCH_MP_TAC(REAL_FIELD
4787         `f * g' = g * f' /\ ~(g = &0) /\ ~(g' = &0) ==> f / g = f' / g'`) THEN
4788        CONJ_TAC THENL [ASM_REAL_ARITH_TAC; CONJ_TAC] THEN
4789        FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]);
4790     REPEAT GEN_TAC THEN
4791     FIRST_X_ASSUM(MP_TAC o SPECL
4792      [`\x:real. if x = c then &0 else f(x)`;
4793                 `\x:real. if x = c then &0 else g(x)`;
4794                 `f':real->real`; `g':real->real`;
4795                 `c:real`; `l:real`; `d:real`]) THEN
4796     REWRITE_TAC[] THEN MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THEN
4797     REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN
4798     TRY(SIMP_TAC[REALLIM_ATREAL;REAL_ARITH `&0 < abs(x - c) ==> ~(x = c)`] THEN
4799         NO_TAC) THEN
4800     DISCH_TAC THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN
4801     FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[] THEN
4802     REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN REWRITE_TAC[] THEN
4803     MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`]
4804           HAS_REAL_DERIVATIVE_TRANSFORM_ATREAL) THEN
4805     EXISTS_TAC `abs(x - c)` THEN ASM_REAL_ARITH_TAC]);;
4806
4807 (* ------------------------------------------------------------------------- *)
4808 (* Darboux's theorem (intermediate value property for derivatives).          *)
4809 (* ------------------------------------------------------------------------- *)
4810
4811 let REAL_DERIVATIVE_IVT_INCREASING = prove
4812  (`!f f' a b.
4813    a <= b /\
4814    (!x. x IN real_interval[a,b]
4815         ==> (f has_real_derivative f'(x)) (atreal x within real_interval[a,b]))
4816    ==> !t. f'(a) <= t /\ t <= f'(b)
4817            ==> ?x. x IN real_interval[a,b] /\ f' x = t`,
4818   REPEAT GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN
4819   ASM_CASES_TAC `(f':real->real) a = t` THENL
4820    [ASM_MESON_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_NE_EMPTY];
4821     ALL_TAC] THEN
4822   ASM_CASES_TAC `(f':real->real) b = t` THENL
4823    [ASM_MESON_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_NE_EMPTY];
4824     ALL_TAC] THEN
4825   ASM_CASES_TAC `b:real = a` THEN ASM_REWRITE_TAC[REAL_LE_ANTISYM] THEN
4826   SUBGOAL_THEN `a < b` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
4827   ASM_REWRITE_TAC[REAL_LE_LT] THEN STRIP_TAC THEN
4828   MP_TAC(ISPECL [`\x:real. f x - t * x`; `real_interval[a,b]`]
4829         REAL_CONTINUOUS_ATTAINS_INF) THEN
4830   ASM_REWRITE_TAC[REAL_INTERVAL_NE_EMPTY; REAL_COMPACT_INTERVAL] THEN
4831   ANTS_TAC THENL
4832    [MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN
4833     MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_SUB THEN
4834     SIMP_TAC[REAL_DIFFERENTIABLE_ON_MUL; REAL_DIFFERENTIABLE_ON_ID;
4835              REAL_DIFFERENTIABLE_ON_CONST] THEN
4836     ASM_MESON_TAC[real_differentiable_on];
4837     ALL_TAC] THEN
4838   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real` THEN
4839   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
4840   MP_TAC(SPECL
4841    [`\x:real. f x - t * x`; `(f':real->real) x - t:real`;
4842     `x:real`; `real_interval(a,b)`]
4843         REAL_DERIVATIVE_ZERO_MAXMIN) THEN
4844   ASM_REWRITE_TAC[REAL_SUB_0] THEN DISCH_THEN MATCH_MP_TAC THEN
4845   REWRITE_TAC[REAL_OPEN_REAL_INTERVAL] THEN
4846   ASM_SIMP_TAC[REAL_OPEN_CLOSED_INTERVAL; IN_DIFF] THEN
4847   ASM_CASES_TAC `x:real = a` THENL
4848    [FIRST_X_ASSUM SUBST_ALL_TAC THEN
4849     MP_TAC(ISPECL[`\x:real. f x - t * x`; `(f':real->real) a - t:real`;
4850                   `a:real`; `b:real`; `&1`]
4851         REAL_DERIVATIVE_POS_LEFT_MINIMUM) THEN
4852     ASM_SIMP_TAC[REAL_LT_01; REAL_SUB_LE] THEN
4853     MATCH_MP_TAC(TAUT `~q /\ p ==> (p ==> q) ==> r`) THEN
4854     ASM_REWRITE_TAC[REAL_NOT_LE] THEN
4855     MATCH_MP_TAC HAS_REAL_DERIVATIVE_SUB THEN
4856     CONJ_TAC THENL [ALL_TAC; REAL_DIFF_TAC THEN REWRITE_TAC[REAL_MUL_RID]] THEN
4857     FIRST_X_ASSUM MATCH_MP_TAC THEN
4858     ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY];
4859     ALL_TAC] THEN
4860   ASM_CASES_TAC `x:real = b` THENL
4861    [FIRST_X_ASSUM SUBST_ALL_TAC THEN
4862     MP_TAC(ISPECL[`\x:real. f x - t * x`; `(f':real->real) b - t:real`;
4863                   `a:real`; `b:real`; `&1`]
4864         REAL_DERIVATIVE_NEG_RIGHT_MINIMUM) THEN
4865     ASM_SIMP_TAC[REAL_LT_01; REAL_SUB_LE] THEN
4866     MATCH_MP_TAC(TAUT `~q /\ p ==> (p ==> q) ==> r`) THEN
4867     ASM_REWRITE_TAC[REAL_NOT_LE; REAL_SUB_LT] THEN
4868     MATCH_MP_TAC HAS_REAL_DERIVATIVE_SUB THEN
4869     CONJ_TAC THENL [ALL_TAC; REAL_DIFF_TAC THEN REWRITE_TAC[REAL_MUL_RID]] THEN
4870     FIRST_X_ASSUM MATCH_MP_TAC THEN
4871     ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY];
4872     ALL_TAC] THEN
4873   ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN
4874   MATCH_MP_TAC HAS_REAL_DERIVATIVE_SUB THEN
4875   CONJ_TAC THENL [ALL_TAC; REAL_DIFF_TAC THEN REWRITE_TAC[REAL_MUL_RID]] THEN
4876   SUBGOAL_THEN
4877    `(f has_real_derivative f' x) (atreal x within real_interval(a,b))`
4878   MP_TAC THENL
4879    [MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN
4880     EXISTS_TAC `real_interval[a,b]` THEN
4881     ASM_SIMP_TAC[REAL_INTERVAL_OPEN_SUBSET_CLOSED];
4882     MATCH_MP_TAC EQ_IMP THEN
4883     MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_REAL_OPEN THEN
4884     REWRITE_TAC[REAL_OPEN_REAL_INTERVAL] THEN
4885     ASM_REWRITE_TAC[REAL_OPEN_CLOSED_INTERVAL] THEN ASM SET_TAC[]]);;
4886
4887 let REAL_DERIVATIVE_IVT_DECREASING = prove
4888  (`!f f' a b t.
4889    a <= b /\
4890    (!x. x IN real_interval[a,b]
4891         ==> (f has_real_derivative f'(x)) (atreal x within real_interval[a,b]))
4892    ==> !t. f'(b) <= t /\ t <= f'(a)
4893            ==> ?x. x IN real_interval[a,b] /\ f' x = t`,
4894   REPEAT STRIP_TAC THEN MP_TAC(SPECL
4895    [`\x. --((f:real->real) x)`; `\x. --((f':real->real) x)`;
4896     `a:real`; `b:real`] REAL_DERIVATIVE_IVT_INCREASING) THEN
4897   ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_NEG] THEN
4898   DISCH_THEN(MP_TAC o SPEC `--t:real`) THEN
4899   ASM_REWRITE_TAC[REAL_LE_NEG2; REAL_EQ_NEG2]);;
4900
4901 (* ------------------------------------------------------------------------- *)
4902 (* Continuity and differentiability of inverse functions.                    *)
4903 (* ------------------------------------------------------------------------- *)
4904
4905 let HAS_REAL_DERIVATIVE_INVERSE_BASIC = prove
4906  (`!f g f' t y.
4907         (f has_real_derivative f') (atreal (g y)) /\
4908         ~(f' = &0) /\
4909         g real_continuous atreal y /\
4910         real_open t /\
4911         y IN t /\
4912         (!z. z IN t ==> f (g z) = z)
4913         ==> (g has_real_derivative inv(f')) (atreal y)`,
4914   REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_AT; REAL_OPEN;
4915               REAL_CONTINUOUS_CONTINUOUS_ATREAL] THEN
4916   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_INVERSE_BASIC THEN
4917   MAP_EVERY EXISTS_TAC
4918    [`lift o f o drop`; `\x:real^1. f' % x`; `IMAGE lift t`] THEN
4919   ASM_REWRITE_TAC[o_THM; LIFT_DROP; LIFT_IN_IMAGE_LIFT] THEN
4920   ASM_SIMP_TAC[FORALL_IN_IMAGE; LIFT_DROP; LINEAR_COMPOSE_CMUL; LINEAR_ID] THEN
4921   REWRITE_TAC[FUN_EQ_THM; I_THM; o_THM; VECTOR_MUL_ASSOC] THEN
4922   ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID]);;
4923
4924 let HAS_REAL_DERIVATIVE_INVERSE_STRONG = prove
4925  (`!f g f' s x.
4926          real_open s /\
4927          x IN s /\
4928          f real_continuous_on s /\
4929          (!x. x IN s ==> g (f x) = x) /\
4930          (f has_real_derivative f') (atreal x) /\
4931          ~(f' = &0)
4932          ==> (g has_real_derivative inv(f')) (atreal (f x))`,
4933   REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_AT; REAL_OPEN;
4934               REAL_CONTINUOUS_ON] THEN
4935   REPEAT STRIP_TAC THEN
4936   MP_TAC(ISPEC `lift o f o drop` HAS_DERIVATIVE_INVERSE_STRONG) THEN
4937   REWRITE_TAC[FORALL_LIFT; o_THM; LIFT_DROP] THEN
4938   DISCH_THEN MATCH_MP_TAC THEN
4939   MAP_EVERY EXISTS_TAC [`\x:real^1. f' % x`; `IMAGE lift s`] THEN
4940   ASM_REWRITE_TAC[o_THM; LIFT_DROP; LIFT_IN_IMAGE_LIFT] THEN
4941   ASM_SIMP_TAC[FUN_EQ_THM; I_THM; o_THM; VECTOR_MUL_ASSOC] THEN
4942   ASM_SIMP_TAC[REAL_MUL_RINV; VECTOR_MUL_LID]);;
4943
4944 let HAS_REAL_DERIVATIVE_INVERSE_STRONG_X = prove
4945  (`!f g f' s y.
4946         real_open s /\ (g y) IN s /\ f real_continuous_on s /\
4947         (!x. x IN s ==> (g(f(x)) = x)) /\
4948         (f has_real_derivative f') (atreal (g y)) /\ ~(f' = &0) /\
4949         f(g y) = y
4950         ==> (g has_real_derivative inv(f')) (atreal y)`,
4951   REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_AT; REAL_OPEN;
4952               REAL_CONTINUOUS_ON] THEN
4953   REPEAT STRIP_TAC THEN
4954   MP_TAC(ISPEC `lift o f o drop` HAS_DERIVATIVE_INVERSE_STRONG_X) THEN
4955   REWRITE_TAC[FORALL_LIFT; o_THM; LIFT_DROP] THEN
4956   DISCH_THEN MATCH_MP_TAC THEN
4957   MAP_EVERY EXISTS_TAC [`\x:real^1. f' % x`; `IMAGE lift s`] THEN
4958   ASM_REWRITE_TAC[o_THM; LIFT_DROP; LIFT_IN_IMAGE_LIFT] THEN
4959   ASM_SIMP_TAC[FUN_EQ_THM; I_THM; o_THM; VECTOR_MUL_ASSOC] THEN
4960   ASM_SIMP_TAC[REAL_MUL_RINV; VECTOR_MUL_LID]);;
4961
4962 (* ------------------------------------------------------------------------- *)
4963 (* Real differentiation of sequences and series.                             *)
4964 (* ------------------------------------------------------------------------- *)
4965
4966 let HAS_REAL_DERIVATIVE_SEQUENCE = prove
4967  (`!s f f' g'.
4968          is_realinterval s /\
4969          (!n x. x IN s
4970                 ==> (f n has_real_derivative f' n x) (atreal x within s)) /\
4971          (!e. &0 < e
4972               ==> ?N. !n x. n >= N /\ x IN s ==> abs(f' n x - g' x) <= e) /\
4973          (?x l. x IN s /\ ((\n. f n x) ---> l) sequentially)
4974          ==> ?g. !x. x IN s
4975                      ==> ((\n. f n x) ---> g x) sequentially /\
4976                          (g has_real_derivative g' x) (atreal x within s)`,
4977   REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN; IS_REALINTERVAL_CONVEX;
4978               TENDSTO_REAL] THEN REPEAT STRIP_TAC THEN
4979   MP_TAC(ISPECL [`IMAGE lift s`;
4980                  `\n:num. lift o f n o drop`;
4981                  `\n:num x:real^1 h:real^1. f' n (drop x) % h`;
4982                  `\x:real^1 h:real^1. g' (drop x) % h`]
4983          HAS_DERIVATIVE_SEQUENCE) THEN
4984   ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP] THEN ANTS_TAC THENL
4985    [REWRITE_TAC[IMP_CONJ; RIGHT_EXISTS_AND_THM; RIGHT_FORALL_IMP_THM;
4986                 EXISTS_IN_IMAGE; FORALL_IN_IMAGE] THEN
4987     REWRITE_TAC[EXISTS_LIFT; o_THM; LIFT_DROP] THEN
4988     RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN
4989     CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
4990     REWRITE_TAC[GSYM VECTOR_SUB_RDISTRIB; NORM_MUL] THEN
4991     ASM_MESON_TAC[REAL_LE_RMUL; NORM_POS_LE];
4992     REWRITE_TAC[o_DEF; LIFT_DROP] THEN
4993     DISCH_THEN(X_CHOOSE_TAC `g:real^1->real^1`) THEN
4994     EXISTS_TAC `drop o g o lift` THEN
4995     RULE_ASSUM_TAC(REWRITE_RULE[ETA_AX]) THEN
4996     ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]]);;
4997
4998 let HAS_REAL_DERIVATIVE_SERIES = prove
4999  (`!s f f' g' k.
5000          is_realinterval s /\
5001          (!n x. x IN s
5002                 ==> (f n has_real_derivative f' n x) (atreal x within s)) /\
5003          (!e. &0 < e
5004               ==> ?N. !n x. n >= N /\ x IN s
5005                             ==> abs(sum (k INTER (0..n)) (\i. f' i x) - g' x)
5006                                     <= e) /\
5007          (?x l. x IN s /\ ((\n. f n x) real_sums l) k)
5008          ==> ?g. !x. x IN s
5009                      ==> ((\n. f n x) real_sums g x) k /\
5010                          (g has_real_derivative g' x) (atreal x within s)`,
5011   REPEAT GEN_TAC THEN REWRITE_TAC[real_sums] THEN
5012   DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
5013   MATCH_MP_TAC HAS_REAL_DERIVATIVE_SEQUENCE THEN EXISTS_TAC
5014    `\n:num x:real. sum(k INTER (0..n)) (\n. f' n x):real` THEN
5015   ASM_SIMP_TAC[ETA_AX; FINITE_INTER_NUMSEG; HAS_REAL_DERIVATIVE_SUM]);;
5016
5017 let REAL_DIFFERENTIABLE_BOUND = prove
5018  (`!f f' s B.
5019         is_realinterval s /\
5020         (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s) /\
5021                         abs(f' x) <= B)
5022         ==> !x y. x IN s /\ y IN s ==> abs(f x - f y) <= B * abs(x - y)`,
5023   REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN; IS_REALINTERVAL_CONVEX;
5024               o_DEF] THEN REPEAT STRIP_TAC THEN
5025   MP_TAC(ISPECL
5026    [`lift o f o drop`; `\x h:real^1. f' (drop x) % h`;
5027     `IMAGE lift s`; `B:real`]
5028         DIFFERENTIABLE_BOUND) THEN
5029   ASM_SIMP_TAC[o_DEF; FORALL_IN_IMAGE; LIFT_DROP] THEN ANTS_TAC THENL
5030    [X_GEN_TAC `v:real` THEN DISCH_TAC THEN
5031     MP_TAC(ISPEC `\h:real^1. f' (v:real) % h` ONORM) THEN
5032     SIMP_TAC[LINEAR_COMPOSE_CMUL; LINEAR_ID] THEN
5033     DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN
5034     ASM_SIMP_TAC[NORM_MUL; REAL_LE_RMUL; NORM_POS_LE];
5035     SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; LIFT_DROP] THEN
5036     ASM_SIMP_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM LIFT_SUB; NORM_LIFT]]);;
5037
5038 let REAL_TAYLOR_MVT_POS = prove
5039  (`!f a x n.
5040     a < x /\
5041     (!i t. t IN real_interval[a,x] /\ i <= n
5042            ==> ((f i) has_real_derivative f (i + 1) t)
5043                (atreal t within real_interval[a,x]))
5044     ==> ?t. t IN real_interval(a,x) /\
5045             f 0 x =
5046               sum (0..n) (\i. f i a * (x - a) pow i / &(FACT i)) +
5047               f (n + 1) t * (x - a) pow (n + 1) / &(FACT(n + 1))`,
5048   REPEAT STRIP_TAC THEN
5049   SUBGOAL_THEN
5050    `?B. sum (0..n) (\i. f i a * (x - a) pow i / &(FACT i)) +
5051         B * (x - a) pow (n + 1) = f 0 x`
5052   STRIP_ASSUME_TAC THENL
5053    [MATCH_MP_TAC(MESON[]
5054      `a + (y - a) / x * x:real = y ==> ?b. a + b * x = y`) THEN
5055     MATCH_MP_TAC(REAL_FIELD `~(x = &0) ==> a + (y - a) / x * x = y`) THEN
5056     ASM_REWRITE_TAC[REAL_POW_EQ_0; REAL_SUB_0] THEN ASM_REAL_ARITH_TAC;
5057     ALL_TAC] THEN
5058   MP_TAC(SPECL [`\t. sum(0..n) (\i. f i t * (x - t) pow i / &(FACT i)) +
5059                      B * (x - t) pow (n + 1)`;
5060                 `\t. (f (n + 1) t * (x - t) pow n / &(FACT n)) -
5061                      B * &(n + 1) * (x - t) pow n`;
5062                 `a:real`; `x:real`]
5063         REAL_ROLLE_SIMPLE) THEN
5064   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
5065    [CONJ_TAC THENL
5066      [SIMP_TAC[SUM_CLAUSES_LEFT; LE_0] THEN
5067       REWRITE_TAC[GSYM ADD1; real_pow; REAL_SUB_REFL; REAL_POW_ZERO;
5068                   REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ADD_RID] THEN
5069       CONV_TAC NUM_REDUCE_CONV THEN
5070       REWRITE_TAC[NOT_SUC; REAL_MUL_RZERO; REAL_DIV_1; REAL_MUL_RID] THEN
5071       REWRITE_TAC[REAL_ARITH `x = (x + y) + &0 <=> y = &0`] THEN
5072       MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN
5073       SIMP_TAC[ARITH; ARITH_RULE `1 <= i ==> ~(i = 0)`] THEN
5074       REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_MUL_RZERO];
5075       ALL_TAC] THEN
5076     X_GEN_TAC `t:real` THEN DISCH_TAC THEN REWRITE_TAC[real_sub] THEN
5077     MATCH_MP_TAC HAS_REAL_DERIVATIVE_ADD THEN CONJ_TAC THENL
5078      [ALL_TAC;
5079       REAL_DIFF_TAC THEN REWRITE_TAC[ADD_SUB] THEN CONV_TAC REAL_RING] THEN
5080     REWRITE_TAC[GSYM real_sub] THEN
5081     MATCH_MP_TAC(MESON[]
5082      `!g'. f' = g' /\ (f has_real_derivative g') net
5083            ==> (f has_real_derivative f') net`) THEN
5084     EXISTS_TAC
5085      `sum (0..n) (\i. f i t * --(&i * (x - t) pow (i - 1)) / &(FACT i) +
5086                                 f (i + 1) t * (x - t) pow i / &(FACT i))` THEN
5087     REWRITE_TAC[] THEN CONJ_TAC THENL
5088      [ALL_TAC;
5089       MATCH_MP_TAC HAS_REAL_DERIVATIVE_SUM THEN
5090       REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
5091       X_GEN_TAC `m:num` THEN STRIP_TAC THEN
5092       MATCH_MP_TAC HAS_REAL_DERIVATIVE_MUL_WITHIN THEN
5093       ASM_SIMP_TAC[ETA_AX] THEN REAL_DIFF_TAC THEN REAL_ARITH_TAC] THEN
5094     SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; ARITH; FACT; REAL_DIV_1;
5095              real_pow; REAL_MUL_LZERO; REAL_NEG_0; REAL_MUL_RZERO;
5096              REAL_MUL_RID; REAL_ADD_LID] THEN
5097     ASM_CASES_TAC `n = 0` THENL
5098      [ASM_REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH; FACT] THEN REAL_ARITH_TAC;
5099       ALL_TAC] THEN
5100     ASM_SIMP_TAC[SPECL [`f:num->real`; `1`] SUM_OFFSET_0; LE_1] THEN
5101     REWRITE_TAC[ADD_SUB] THEN
5102     REWRITE_TAC[GSYM ADD1; FACT; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD;
5103                 GSYM REAL_OF_NUM_SUC] THEN
5104     REWRITE_TAC[real_div; REAL_INV_MUL] THEN
5105     REWRITE_TAC[REAL_ARITH `--(n * x) * (inv n * inv y):real =
5106                             --(n / n) * x / y`] THEN
5107     REWRITE_TAC[REAL_FIELD `--((&n + &1) / (&n + &1)) * x = --x`] THEN
5108     REWRITE_TAC[GSYM REAL_INV_MUL; REAL_OF_NUM_MUL; REAL_OF_NUM_SUC] THEN
5109     REWRITE_TAC[GSYM(CONJUNCT2 FACT)] THEN
5110     REWRITE_TAC[REAL_ARITH `a * --b + c:real = c - a * b`] THEN
5111     REWRITE_TAC[ADD1; GSYM real_div; SUM_DIFFS_ALT; LE_0] THEN
5112     ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> n - 1 + 1 = n`; FACT] THEN
5113     REWRITE_TAC[ADD_CLAUSES] THEN REAL_ARITH_TAC;
5114     ALL_TAC] THEN
5115   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real` THEN STRIP_TAC THEN
5116   ASM_REWRITE_TAC[] THEN
5117   FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN
5118   REWRITE_TAC[REAL_EQ_ADD_LCANCEL] THEN
5119   REWRITE_TAC[REAL_ARITH `a * b / c:real = a / c * b`] THEN
5120   AP_THM_TAC THEN AP_TERM_TAC THEN
5121   FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH
5122    `a * x / f - B * k * x = &0 ==> (B * k - a / f) * x = &0`)) THEN
5123   REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0; REAL_SUB_0] THEN
5124   ASM_CASES_TAC `x:real = t` THENL
5125    [ASM_MESON_TAC[IN_REAL_INTERVAL; REAL_LT_REFL]; ALL_TAC] THEN
5126   ASM_REWRITE_TAC[GSYM ADD1; FACT] THEN
5127   REWRITE_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD; ADD1] THEN
5128   SUBGOAL_THEN `~(&(FACT n) = &0)` MP_TAC THENL
5129    [REWRITE_TAC[REAL_OF_NUM_EQ; FACT_NZ]; CONV_TAC REAL_FIELD]);;
5130
5131 let REAL_TAYLOR_MVT_NEG = prove
5132  (`!f a x n.
5133     x < a /\
5134     (!i t. t IN real_interval[x,a] /\ i <= n
5135            ==> ((f i) has_real_derivative f (i + 1) t)
5136                (atreal t within real_interval[x,a]))
5137     ==> ?t. t IN real_interval(x,a) /\
5138             f 0 x =
5139               sum (0..n) (\i. f i a * (x - a) pow i / &(FACT i)) +
5140               f (n + 1) t * (x - a) pow (n + 1) / &(FACT(n + 1))`,
5141   REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN
5142   ONCE_REWRITE_TAC[MESON[REAL_NEG_NEG] `(?x:real. P x) <=> (?x. P(--x))`] THEN
5143   MP_TAC(SPECL [`\n x. (-- &1) pow n * (f:num->real->real) n (--x)`;
5144                 `--a:real`; `  --x:real`; `n:num`]
5145         REAL_TAYLOR_MVT_POS) THEN
5146   REWRITE_TAC[REAL_NEG_NEG] THEN
5147   ONCE_REWRITE_TAC[REAL_ARITH `(x * y) * z / w:real = y * (x * z) / w`] THEN
5148   REWRITE_TAC[GSYM REAL_POW_MUL] THEN
5149   REWRITE_TAC[REAL_ARITH `-- &1 * (--x - --a) = x - a`] THEN
5150   REWRITE_TAC[IN_REAL_INTERVAL; real_pow; REAL_MUL_LID] THEN
5151   REWRITE_TAC[REAL_ARITH `--a < t /\ t < --x <=> x < --t /\ --t < a`] THEN
5152   DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[REAL_LT_NEG2] THEN
5153   MAP_EVERY X_GEN_TAC [`m:num`; `t:real`] THEN STRIP_TAC THEN
5154   REWRITE_TAC[REAL_POW_ADD; GSYM REAL_MUL_ASSOC] THEN
5155   MATCH_MP_TAC HAS_REAL_DERIVATIVE_LMUL_WITHIN THEN
5156   ONCE_REWRITE_TAC[REAL_ARITH `y pow 1 * x:real = x * y`] THEN
5157   ONCE_REWRITE_TAC[GSYM o_DEF] THEN
5158   MATCH_MP_TAC REAL_DIFF_CHAIN_WITHIN THEN CONJ_TAC THENL
5159    [GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN
5160     REAL_DIFF_TAC THEN REFL_TAC;
5161     ALL_TAC] THEN
5162   SUBGOAL_THEN `IMAGE (--) (real_interval[--a,--x]) = real_interval[x,a]`
5163   SUBST1_TAC THENL
5164    [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_REAL_INTERVAL] THEN
5165     REWRITE_TAC[REAL_ARITH `x:real = --y <=> --x = y`; UNWIND_THM1] THEN
5166     REAL_ARITH_TAC;
5167     FIRST_X_ASSUM MATCH_MP_TAC THEN
5168     ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]);;
5169
5170 let REAL_TAYLOR = prove
5171  (`!f n s B.
5172     is_realinterval s /\
5173     (!i x. x IN s /\ i <= n
5174            ==> ((f i) has_real_derivative f (i + 1) x) (atreal x within s)) /\
5175     (!x. x IN s ==> abs(f (n + 1) x) <= B)
5176     ==> !w z. w IN s /\ z IN s
5177               ==> abs(f 0 z -
5178                       sum (0..n) (\i. f i w * (z - w) pow i / &(FACT i)))
5179                   <= B * abs(z - w) pow (n + 1) / &(FACT(n + 1))`,
5180   REPEAT STRIP_TAC THEN
5181   REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
5182    (REAL_ARITH `w = z \/ w < z \/ z < w`)
5183   THENL
5184    [ASM_SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; REAL_SUB_REFL; REAL_POW_ZERO;
5185                  REAL_ABS_0; ARITH; ADD_EQ_0; real_div] THEN
5186     REWRITE_TAC[REAL_MUL_LZERO; FACT; REAL_INV_1; REAL_MUL_RZERO] THEN
5187     MATCH_MP_TAC(REAL_ARITH `y = &0 ==> abs(x - (x * &1 * &1 + y)) <= &0`) THEN
5188     MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN
5189     SIMP_TAC[ARITH; LE_1; REAL_MUL_RZERO; REAL_MUL_LZERO];
5190     MP_TAC(ISPECL [`f:num->real->real`; `w:real`; `z:real`; `n:num`]
5191                   REAL_TAYLOR_MVT_POS) THEN
5192     ASM_REWRITE_TAC[] THEN
5193     SUBGOAL_THEN `real_interval[w,z] SUBSET s` ASSUME_TAC THENL
5194      [SIMP_TAC[SUBSET; IN_REAL_INTERVAL] THEN ASM_MESON_TAC[is_realinterval];
5195       ALL_TAC];
5196     MP_TAC(ISPECL [`f:num->real->real`; `w:real`; `z:real`; `n:num`]
5197                   REAL_TAYLOR_MVT_NEG) THEN
5198     ASM_REWRITE_TAC[] THEN
5199     SUBGOAL_THEN `real_interval[z,w] SUBSET s` ASSUME_TAC THENL
5200      [SIMP_TAC[SUBSET; IN_REAL_INTERVAL] THEN ASM_MESON_TAC[is_realinterval];
5201       ALL_TAC]] THEN
5202  (ANTS_TAC THENL
5203    [MAP_EVERY X_GEN_TAC [`m:num`; `t:real`] THEN STRIP_TAC THEN
5204     MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN
5205     EXISTS_TAC `s:real->bool` THEN ASM_REWRITE_TAC[] THEN
5206     FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[SUBSET];
5207     ALL_TAC] THEN
5208   DISCH_THEN(X_CHOOSE_THEN `t:real`
5209    (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN
5210   REWRITE_TAC[REAL_ADD_SUB; REAL_ABS_MUL; REAL_ABS_DIV] THEN
5211   REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NUM] THEN
5212   MATCH_MP_TAC REAL_LE_RMUL THEN
5213   SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_POW_LE; REAL_ABS_POS] THEN
5214   ASM_MESON_TAC[REAL_INTERVAL_OPEN_SUBSET_CLOSED; SUBSET]));;
5215
5216 (* ------------------------------------------------------------------------- *)
5217 (* Comparing sums and "integrals" via real antiderivatives.                  *)
5218 (* ------------------------------------------------------------------------- *)
5219
5220 let REAL_SUM_INTEGRAL_UBOUND_INCREASING = prove
5221  (`!f g m n.
5222       m <= n /\
5223       (!x. x IN real_interval[&m,&n + &1]
5224            ==> (g has_real_derivative f(x))
5225                (atreal x within real_interval[&m,&n + &1])) /\
5226       (!x y. &m <= x /\ x <= y /\ y <= &n + &1 ==> f x <= f y)
5227       ==> sum(m..n) (\k. f(&k)) <= g(&n + &1) - g(&m)`,
5228   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
5229   EXISTS_TAC `sum(m..n) (\k. g(&(k + 1)) - g(&k))` THEN CONJ_TAC THENL
5230    [ALL_TAC; ASM_SIMP_TAC[SUM_DIFFS_ALT; REAL_OF_NUM_ADD; REAL_LE_REFL]] THEN
5231   MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN
5232   MP_TAC(ISPECL [`g:real->real`; `f:real->real`; `&k`; `&(k + 1)`]
5233                 REAL_MVT_SIMPLE) THEN
5234   ASM_REWRITE_TAC[REAL_OF_NUM_LT; ARITH_RULE `k < k + 1`] THEN
5235   ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ADD_SUB] THEN ANTS_TAC THENL
5236    [REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN
5237     EXISTS_TAC `real_interval[&m,&n + &1]` THEN CONJ_TAC THENL
5238      [FIRST_X_ASSUM MATCH_MP_TAC THEN
5239       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_REAL_INTERVAL]);
5240       REWRITE_TAC[SUBSET] THEN GEN_TAC] THEN
5241     REWRITE_TAC[IN_REAL_INTERVAL] THEN
5242     RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC;
5243     DISCH_THEN(X_CHOOSE_THEN `t:real`
5244      (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN
5245     REWRITE_TAC[REAL_MUL_RID] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
5246     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_REAL_INTERVAL]) THEN
5247     RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN
5248     ASM_REAL_ARITH_TAC]);;
5249
5250 let REAL_SUM_INTEGRAL_UBOUND_DECREASING = prove
5251  (`!f g m n.
5252       m <= n /\
5253       (!x. x IN real_interval[&m - &1,&n]
5254            ==> (g has_real_derivative f(x))
5255                (atreal x within real_interval[&m - &1,&n])) /\
5256       (!x y. &m - &1 <= x /\ x <= y /\ y <= &n ==> f y <= f x)
5257       ==> sum(m..n) (\k. f(&k)) <= g(&n) - g(&m - &1)`,
5258   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
5259   EXISTS_TAC `sum(m..n) (\k. g(&(k + 1) - &1) - g(&k - &1))` THEN
5260   CONJ_TAC THENL
5261    [ALL_TAC;
5262     ASM_REWRITE_TAC[SUM_DIFFS_ALT] THEN
5263     ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ARITH `(x + &1) - &1 = x`] THEN
5264     REWRITE_TAC[REAL_LE_REFL]] THEN
5265   MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN
5266   MP_TAC(ISPECL [`g:real->real`; `f:real->real`; `&k - &1`; `&k`]
5267                 REAL_MVT_SIMPLE) THEN
5268   ASM_REWRITE_TAC[REAL_ARITH `k - &1 < k`] THEN ANTS_TAC THENL
5269    [REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN
5270     EXISTS_TAC `real_interval[&m - &1,&n]` THEN CONJ_TAC THENL
5271      [FIRST_X_ASSUM MATCH_MP_TAC THEN
5272       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_REAL_INTERVAL]);
5273       REWRITE_TAC[SUBSET] THEN GEN_TAC] THEN
5274     REWRITE_TAC[IN_REAL_INTERVAL] THEN
5275     RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC;
5276     REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ARITH `(a + &1) - &1 = a`] THEN
5277     DISCH_THEN(X_CHOOSE_THEN `t:real`
5278      (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN
5279     REWRITE_TAC[REAL_ARITH `a * (x - (x - &1)) = a`] THEN
5280     FIRST_X_ASSUM MATCH_MP_TAC THEN
5281     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_REAL_INTERVAL]) THEN
5282     RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN
5283     ASM_REAL_ARITH_TAC]);;
5284
5285 let REAL_SUM_INTEGRAL_LBOUND_INCREASING = prove
5286  (`!f g m n.
5287       m <= n /\
5288       (!x. x IN real_interval[&m - &1,&n]
5289            ==> (g has_real_derivative f(x))
5290                (atreal x within real_interval[&m - &1,&n])) /\
5291       (!x y. &m - &1 <= x /\ x <= y /\ y <= &n ==> f x <= f y)
5292       ==> g(&n) - g(&m - &1) <= sum(m..n) (\k. f(&k))`,
5293   REPEAT STRIP_TAC THEN
5294   MP_TAC(ISPECL [`\z. --((f:real->real) z)`;
5295                  `\z. --((g:real->real) z)`;
5296                  `m:num`; `n:num`] REAL_SUM_INTEGRAL_UBOUND_DECREASING) THEN
5297   REWRITE_TAC[RE_NEG; RE_SUB; SUM_NEG; REAL_LE_NEG2;
5298               REAL_ARITH `--x - --y:real = --(x - y)`] THEN
5299   ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_NEG]);;
5300
5301 let REAL_SUM_INTEGRAL_LBOUND_DECREASING = prove
5302  (`!f g m n.
5303       m <= n /\
5304       (!x. x IN real_interval[&m,&n + &1]
5305            ==> (g has_real_derivative f(x))
5306                (atreal x within  real_interval[&m,&n + &1])) /\
5307       (!x y. &m <= x /\ x <= y /\ y <= &n + &1 ==> f y <= f x)
5308       ==> g(&n + &1) - g(&m) <= sum(m..n) (\k. f(&k))`,
5309   REPEAT STRIP_TAC THEN
5310   MP_TAC(ISPECL [`\z. --((f:real->real) z)`;
5311                  `\z. --((g:real->real) z)`;
5312                  `m:num`; `n:num`] REAL_SUM_INTEGRAL_UBOUND_INCREASING) THEN
5313   REWRITE_TAC[RE_NEG; RE_SUB; SUM_NEG; REAL_LE_NEG2;
5314               REAL_ARITH `--x - --y:real = --(x - y)`] THEN
5315   ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_NEG]);;
5316
5317 let REAL_SUM_INTEGRAL_BOUNDS_INCREASING = prove
5318  (`!f g m n.
5319          m <= n /\
5320          (!x. x IN real_interval[&m - &1,&n + &1]
5321               ==> (g has_real_derivative f x)
5322                   (atreal x within real_interval[&m - &1,&n + &1])) /\
5323          (!x y. &m - &1 <= x /\ x <= y /\ y <= &n + &1 ==> f x <= f y)
5324          ==> g(&n) - g(&m - &1) <= sum(m..n) (\k. f(&k)) /\
5325              sum (m..n) (\k. f(&k)) <= g(&n + &1) - g(&m)`,
5326   REPEAT STRIP_TAC THENL
5327    [MATCH_MP_TAC REAL_SUM_INTEGRAL_LBOUND_INCREASING;
5328     MATCH_MP_TAC REAL_SUM_INTEGRAL_UBOUND_INCREASING] THEN
5329   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5330   TRY(MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN
5331       EXISTS_TAC `real_interval[&m - &1,&n + &1]` THEN CONJ_TAC) THEN
5332   TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN
5333   TRY(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_REAL_INTERVAL])) THEN
5334   REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN
5335   RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC);;
5336
5337 let REAL_SUM_INTEGRAL_BOUNDS_DECREASING = prove
5338  (`!f g m n.
5339       m <= n /\
5340       (!x. x IN real_interval[&m - &1,&n + &1]
5341            ==> (g has_real_derivative f(x))
5342                (atreal x within real_interval[&m - &1,&n + &1])) /\
5343       (!x y. &m - &1 <= x /\ x <= y /\ y <= &n + &1 ==> f y <= f x)
5344       ==> g(&n + &1) - g(&m) <= sum(m..n) (\k. f(&k)) /\
5345           sum(m..n) (\k. f(&k)) <= g(&n) - g(&m - &1)`,
5346   REPEAT STRIP_TAC THENL
5347    [MATCH_MP_TAC REAL_SUM_INTEGRAL_LBOUND_DECREASING;
5348     MATCH_MP_TAC REAL_SUM_INTEGRAL_UBOUND_DECREASING] THEN
5349   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5350   TRY(MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN
5351       EXISTS_TAC `real_interval[&m - &1,&n + &1]` THEN CONJ_TAC) THEN
5352   TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN
5353   TRY(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_REAL_INTERVAL])) THEN
5354   REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN
5355   RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC);;
5356
5357 (* ------------------------------------------------------------------------- *)
5358 (* Relating different kinds of real limits.                                  *)
5359 (* ------------------------------------------------------------------------- *)
5360
5361 let LIM_POSINFINITY_SEQUENTIALLY = prove
5362  (`!f l. (f --> l) at_posinfinity ==> ((\n. f(&n)) --> l) sequentially`,
5363   REPEAT GEN_TAC THEN
5364   REWRITE_TAC[LIM_AT_POSINFINITY; LIM_SEQUENTIALLY] THEN
5365   DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5366   FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
5367   DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN
5368   MP_TAC(ISPEC `B:real` REAL_ARCH_SIMPLE) THEN
5369   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN
5370   REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
5371   RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC);;
5372
5373 let REALLIM_POSINFINITY_SEQUENTIALLY = prove
5374  (`!f l. (f ---> l) at_posinfinity ==> ((\n. f(&n)) ---> l) sequentially`,
5375   REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN
5376   DISCH_THEN(MP_TAC o MATCH_MP LIM_POSINFINITY_SEQUENTIALLY) THEN
5377   REWRITE_TAC[o_DEF]);;
5378
5379 let LIM_ZERO_POSINFINITY = prove
5380  (`!f l. ((\x. f(&1 / x)) --> l) (atreal (&0)) ==> (f --> l) at_posinfinity`,
5381   REPEAT GEN_TAC THEN REWRITE_TAC[LIM_ATREAL; LIM_AT_POSINFINITY] THEN
5382   DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5383   FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
5384   REWRITE_TAC[dist; REAL_SUB_RZERO; real_ge] THEN
5385   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
5386   EXISTS_TAC `&2 / d` THEN X_GEN_TAC `z:real` THEN DISCH_TAC THEN
5387   FIRST_X_ASSUM(MP_TAC o SPEC `inv(z):real`) THEN
5388   REWRITE_TAC[real_div; REAL_MUL_LINV; REAL_INV_INV] THEN
5389   REWRITE_TAC[REAL_MUL_LID] THEN DISCH_THEN MATCH_MP_TAC THEN
5390   ASM_REWRITE_TAC[REAL_ABS_INV; REAL_LT_INV_EQ] THEN CONJ_TAC THENL
5391    [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
5392      `a <= z ==> &0 < a ==> &0 < abs z`));
5393     GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN
5394     MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN
5395     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
5396      `&2 / d <= z ==> &0 < &2 / d ==> inv d < abs z`))] THEN
5397   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH]);;
5398
5399 let LIM_ZERO_NEGINFINITY = prove
5400  (`!f l. ((\x. f(&1 / x)) --> l) (atreal (&0)) ==> (f --> l) at_neginfinity`,
5401   REPEAT GEN_TAC THEN REWRITE_TAC[LIM_ATREAL; LIM_AT_NEGINFINITY] THEN
5402   DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5403   FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
5404   REWRITE_TAC[dist; REAL_SUB_RZERO; real_ge] THEN
5405   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
5406   EXISTS_TAC `--(&2 / d)` THEN X_GEN_TAC `z:real` THEN DISCH_TAC THEN
5407   FIRST_X_ASSUM(MP_TAC o SPEC `inv(z):real`) THEN
5408   REWRITE_TAC[real_div; REAL_MUL_LINV; REAL_INV_INV] THEN
5409   REWRITE_TAC[REAL_MUL_LID] THEN DISCH_THEN MATCH_MP_TAC THEN
5410   ASM_REWRITE_TAC[REAL_ABS_INV; REAL_LT_INV_EQ] THEN CONJ_TAC THENL
5411    [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
5412      `z <= --a ==> &0 < a ==> &0 < abs z`));
5413     GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN
5414     MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN
5415     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
5416      `z <= --(&2 / d) ==> &0 < &2 / d ==> inv d < abs z`))] THEN
5417   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH]);;
5418
5419 let REALLIM_ZERO_POSINFINITY = prove
5420  (`!f l. ((\x. f(&1 / x)) ---> l) (atreal (&0)) ==> (f ---> l) at_posinfinity`,
5421   REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN
5422   REWRITE_TAC[o_DEF; LIM_ZERO_POSINFINITY]);;
5423
5424 let REALLIM_ZERO_NEGINFINITY = prove
5425  (`!f l. ((\x. f(&1 / x)) ---> l) (atreal (&0)) ==> (f ---> l) at_neginfinity`,
5426   REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN
5427   REWRITE_TAC[o_DEF; LIM_ZERO_NEGINFINITY]);;
5428
5429 (* ------------------------------------------------------------------------- *)
5430 (* Real segments (bidirectional intervals).                                  *)
5431 (* ------------------------------------------------------------------------- *)
5432
5433 let closed_real_segment = define
5434  `closed_real_segment[a,b] = {(&1 - u) * a + u * b | &0 <= u /\ u <= &1}`;;
5435
5436 let open_real_segment = new_definition
5437  `open_real_segment(a,b) = closed_real_segment[a,b] DIFF {a,b}`;;
5438
5439 make_overloadable "real_segment" `:A`;;
5440
5441 overload_interface("real_segment",`open_real_segment`);;
5442 overload_interface("real_segment",`closed_real_segment`);;
5443
5444 let real_segment = prove
5445  (`real_segment[a,b] = {(&1 - u) * a + u * b | &0 <= u /\ u <= &1} /\
5446    real_segment(a,b) = real_segment[a,b] DIFF {a,b}`,
5447   REWRITE_TAC[open_real_segment; closed_real_segment]);;
5448
5449 let REAL_SEGMENT_SEGMENT = prove
5450  (`(!a b. real_segment[a,b] = IMAGE drop (segment[lift a,lift b])) /\
5451    (!a b. real_segment(a,b) = IMAGE drop (segment(lift a,lift b)))`,
5452   REWRITE_TAC[segment; real_segment] THEN
5453   SIMP_TAC[IMAGE_DIFF_INJ; DROP_EQ; IMAGE_CLAUSES; LIFT_DROP] THEN
5454   ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
5455   REWRITE_TAC[GSYM IMAGE_o; o_DEF; DROP_ADD; DROP_CMUL; LIFT_DROP]);;
5456
5457 let SEGMENT_REAL_SEGMENT = prove
5458  (`(!a b. segment[a,b] = IMAGE lift (real_segment[drop a,drop b])) /\
5459    (!a b. segment(a,b) = IMAGE lift (real_segment(drop a,drop b)))`,
5460   REWRITE_TAC[REAL_SEGMENT_SEGMENT; GSYM IMAGE_o] THEN
5461   REWRITE_TAC[o_DEF; IMAGE_ID; LIFT_DROP]);;
5462
5463 let IMAGE_LIFT_REAL_SEGMENT = prove
5464  (`(!a b. IMAGE lift (real_segment[a,b]) = segment[lift a,lift b]) /\
5465    (!a b. IMAGE lift (real_segment(a,b)) = segment(lift a,lift b))`,
5466   REWRITE_TAC[SEGMENT_REAL_SEGMENT; LIFT_DROP]);;
5467
5468 let REAL_SEGMENT_INTERVAL = prove
5469  (`(!a b. real_segment[a,b] =
5470           if a <= b then real_interval[a,b] else real_interval[b,a]) /\
5471    (!a b. real_segment(a,b) =
5472           if a <= b then real_interval(a,b) else real_interval(b,a))`,
5473   REWRITE_TAC[REAL_SEGMENT_SEGMENT; SEGMENT_1; LIFT_DROP] THEN
5474   REWRITE_TAC[REAL_INTERVAL_INTERVAL] THEN
5475   CONJ_TAC THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[]);;
5476
5477 let REAL_CONTINUOUS_INJECTIVE_IFF_MONOTONIC = prove
5478  (`!f s.
5479         f real_continuous_on s /\ is_realinterval s
5480         ==> ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=>
5481              (!x y. x IN s /\ y IN s /\ x < y ==> f x < f y) \/
5482              (!x y. x IN s /\ y IN s /\ x < y ==> f y < f x))`,
5483   REPEAT GEN_TAC THEN
5484   REWRITE_TAC[REAL_CONTINUOUS_ON; IS_REALINTERVAL_IS_INTERVAL] THEN
5485   DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_INJECTIVE_IFF_MONOTONIC) THEN
5486   REWRITE_TAC[FORALL_LIFT; LIFT_IN_IMAGE_LIFT; o_THM; LIFT_DROP; LIFT_EQ]);;
5487
5488 (* ------------------------------------------------------------------------- *)
5489 (* Convex real->real functions.                                              *)
5490 (* ------------------------------------------------------------------------- *)
5491
5492 parse_as_infix ("real_convex_on",(12,"right"));;
5493
5494 let real_convex_on = new_definition
5495   `(f:real->real) real_convex_on s <=>
5496         !x y u v. x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ (u + v = &1)
5497                   ==> f(u * x + v * y) <= u * f(x) + v * f(y)`;;
5498
5499 let REAL_CONVEX_ON = prove
5500  (`!f s. f real_convex_on s <=> (f o drop) convex_on (IMAGE lift s)`,
5501   REWRITE_TAC[real_convex_on; convex_on] THEN
5502   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
5503   REWRITE_TAC[o_THM; LIFT_DROP; DROP_ADD; DROP_CMUL]);;
5504
5505 let REAL_CONVEX_ON_SUBSET = prove
5506  (`!f s t. f real_convex_on t /\ s SUBSET t ==> f real_convex_on s`,
5507   REWRITE_TAC[REAL_CONVEX_ON] THEN
5508   MESON_TAC[CONVEX_ON_SUBSET; IMAGE_SUBSET]);;
5509
5510 let REAL_CONVEX_ADD = prove
5511  (`!s f g. f real_convex_on s /\ g real_convex_on s
5512            ==> (\x. f(x) + g(x)) real_convex_on s`,
5513   REWRITE_TAC[REAL_CONVEX_ON; o_DEF; CONVEX_ADD]);;
5514
5515 let REAL_CONVEX_LMUL = prove
5516  (`!s c f. &0 <= c /\ f real_convex_on s ==> (\x. c * f(x)) real_convex_on s`,
5517   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_CONVEX_ON; o_DEF] THEN
5518   DISCH_THEN(MP_TAC o MATCH_MP CONVEX_CMUL) THEN REWRITE_TAC[]);;
5519
5520 let REAL_CONVEX_RMUL = prove
5521  (`!s c f. &0 <= c /\ f real_convex_on s ==> (\x. f(x) * c) real_convex_on s`,
5522   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_CONVEX_LMUL]);;
5523
5524 let REAL_CONVEX_LOWER = prove
5525  (`!f s x y. f real_convex_on s /\
5526              x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ u + v = &1
5527              ==> f(u * x + v * y) <= max (f(x)) (f(y))`,
5528   REWRITE_TAC[REAL_CONVEX_ON] THEN
5529   REWRITE_TAC[FORALL_DROP; GSYM IN_IMAGE_LIFT_DROP] THEN
5530   REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONVEX_LOWER) THEN
5531   REWRITE_TAC[o_THM; DROP_ADD; DROP_CMUL]);;
5532
5533 let REAL_CONVEX_LOCAL_GLOBAL_MINIMUM = prove
5534  (`!f s t x.
5535        f real_convex_on s /\ x IN t /\ real_open t /\ t SUBSET s /\
5536        (!y. y IN t ==> f(x) <= f(y))
5537        ==> !y. y IN s ==> f(x) <= f(y)`,
5538   REWRITE_TAC[REAL_CONVEX_ON; REAL_OPEN] THEN
5539   REWRITE_TAC[FORALL_DROP; GSYM IN_IMAGE_LIFT_DROP] THEN
5540   REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP] THEN
5541   REPEAT GEN_TAC THEN STRIP_TAC THEN
5542   MP_TAC(ISPECL [`(f:real->real) o drop`; `IMAGE lift s`;
5543                  `IMAGE lift t`; `x:real^1`] CONVEX_LOCAL_GLOBAL_MINIMUM) THEN
5544   ASM_SIMP_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_THM; IMAGE_SUBSET]);;
5545
5546 let REAL_CONVEX_DISTANCE = prove
5547  (`!s a. (\x. abs(a - x)) real_convex_on s`,
5548   REWRITE_TAC[REAL_CONVEX_ON; o_DEF; FORALL_DROP; GSYM DROP_SUB] THEN
5549   REWRITE_TAC[drop; GSYM NORM_REAL; GSYM dist; CONVEX_DISTANCE]);;
5550
5551 let REAL_CONVEX_ON_JENSEN = prove
5552  (`!f s. is_realinterval s
5553          ==> (f real_convex_on s <=>
5554                 !k u x.
5555                    (!i:num. 1 <= i /\ i <= k ==> &0 <= u(i) /\ x(i) IN s) /\
5556                    (sum (1..k) u = &1)
5557                    ==> f(sum (1..k) (\i. u(i) * x(i)))
5558                            <= sum (1..k) (\i. u(i) * f(x(i))))`,
5559   REWRITE_TAC[IS_REALINTERVAL_CONVEX; REAL_CONVEX_ON] THEN
5560   SIMP_TAC[CONVEX_ON_JENSEN] THEN REPEAT STRIP_TAC THEN
5561   SIMP_TAC[o_DEF; DROP_VSUM; FINITE_NUMSEG] THEN
5562   AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN
5563   X_GEN_TAC `k:num` THEN REWRITE_TAC[] THEN
5564   AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN
5565   X_GEN_TAC `u:num->real` THEN REWRITE_TAC[] THEN EQ_TAC THEN DISCH_TAC THENL
5566    [X_GEN_TAC `x:num->real` THEN STRIP_TAC THEN
5567     FIRST_X_ASSUM(MP_TAC o SPEC `lift o (x:num->real)`) THEN
5568     ASM_REWRITE_TAC[o_DEF; LIFT_DROP; IN_IMAGE_LIFT_DROP] THEN
5569     REWRITE_TAC[DROP_CMUL; LIFT_DROP];
5570     X_GEN_TAC `x:num->real^1` THEN STRIP_TAC THEN
5571     FIRST_X_ASSUM(MP_TAC o SPEC `drop o (x:num->real^1)`) THEN
5572     ASM_REWRITE_TAC[o_DEF; LIFT_DROP; IN_IMAGE_LIFT_DROP] THEN
5573     ASM_REWRITE_TAC[DROP_CMUL; LIFT_DROP; GSYM IN_IMAGE_LIFT_DROP]]);;
5574
5575 let REAL_CONVEX_ON_CONTINUOUS = prove
5576  (`!f s. real_open s /\ f real_convex_on s ==> f real_continuous_on s`,
5577   REWRITE_TAC[REAL_CONVEX_ON; REAL_OPEN; REAL_CONTINUOUS_ON] THEN
5578   REWRITE_TAC[CONVEX_ON_CONTINUOUS]);;
5579
5580 let REAL_CONVEX_ON_LEFT_SECANT_MUL = prove
5581  (`!f s. f real_convex_on s <=>
5582           !a b x. a IN s /\ b IN s /\ x IN real_segment[a,b]
5583                   ==> (f x - f a) * abs(b - a) <= (f b - f a) * abs(x - a)`,
5584   REWRITE_TAC[REAL_CONVEX_ON; CONVEX_ON_LEFT_SECANT_MUL] THEN
5585   REWRITE_TAC[REAL_SEGMENT_SEGMENT] THEN
5586   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
5587   REWRITE_TAC[o_DEF; LIFT_DROP] THEN
5588   REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP]);;
5589
5590 let REAL_CONVEX_ON_RIGHT_SEQUENT_MUL = prove
5591  (`!f s. f real_convex_on s <=>
5592           !a b x. a IN s /\ b IN s /\ x IN real_segment[a,b]
5593                   ==> (f b - f a) * abs(b - x) <= (f b - f x) * abs(b - a)`,
5594   REWRITE_TAC[REAL_CONVEX_ON; CONVEX_ON_RIGHT_SECANT_MUL] THEN
5595   REWRITE_TAC[REAL_SEGMENT_SEGMENT] THEN
5596   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
5597   REWRITE_TAC[o_DEF; LIFT_DROP] THEN
5598   REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP]);;
5599
5600 let REAL_CONVEX_ON_LEFT_SECANT = prove
5601  (`!f s.
5602       f real_convex_on s <=>
5603         !a b x. a IN s /\ b IN s /\ x IN real_segment(a,b)
5604                 ==> (f x - f a) / abs(x - a) <= (f b - f a) / abs(b - a)`,
5605   REWRITE_TAC[REAL_CONVEX_ON; CONVEX_ON_LEFT_SECANT] THEN
5606   REWRITE_TAC[REAL_SEGMENT_SEGMENT] THEN
5607   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
5608   REWRITE_TAC[o_DEF; LIFT_DROP] THEN
5609   REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP]);;
5610
5611 let REAL_CONVEX_ON_RIGHT_SEQUENT = prove
5612  (`!f s.
5613       f real_convex_on s <=>
5614         !a b x. a IN s /\ b IN s /\ x IN real_segment(a,b)
5615                 ==> (f b - f a) / abs(b - a) <= (f b - f x) / abs(b - x)`,
5616   REWRITE_TAC[REAL_CONVEX_ON; CONVEX_ON_RIGHT_SECANT] THEN
5617   REWRITE_TAC[REAL_SEGMENT_SEGMENT] THEN
5618   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
5619   REWRITE_TAC[o_DEF; LIFT_DROP] THEN
5620   REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP]);;
5621
5622 let REAL_CONVEX_ON_DERIVATIVE_SECANT_IMP = prove
5623  (`!f f' s x y.
5624         f real_convex_on s /\ real_segment[x,y] SUBSET s /\
5625         (f has_real_derivative f') (atreal x within s)
5626         ==> f' * (y - x) <= f y - f x`,
5627   REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN;
5628               REAL_CONVEX_ON; REAL_SEGMENT_SEGMENT] THEN
5629   REWRITE_TAC[SUBSET; IN_IMAGE_LIFT_DROP] THEN
5630   REPEAT GEN_TAC THEN REWRITE_TAC[FORALL_DROP] THEN
5631   REWRITE_TAC[LIFT_DROP] THEN
5632   REWRITE_TAC[GSYM IN_IMAGE_LIFT_DROP; GSYM SUBSET] THEN
5633   ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[LIFT_DROP]
5634         `\x. lift(drop(f % x))`)] THEN
5635   REWRITE_TAC[GSYM o_DEF] THEN
5636   DISCH_THEN(MP_TAC o MATCH_MP CONVEX_ON_DERIVATIVE_SECANT_IMP) THEN
5637   REWRITE_TAC[o_THM; DROP_CMUL; DROP_SUB; LIFT_DROP]);;
5638
5639 let REAL_CONVEX_ON_SECANT_DERIVATIVE_IMP = prove
5640  (`!f f' s x y.
5641         f real_convex_on s /\ real_segment[x,y] SUBSET s /\
5642         (f has_real_derivative f') (atreal y within s)
5643         ==> f y - f x <= f' * (y - x)`,
5644   REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN;
5645               REAL_CONVEX_ON; REAL_SEGMENT_SEGMENT] THEN
5646   REWRITE_TAC[SUBSET; IN_IMAGE_LIFT_DROP] THEN
5647   REPEAT GEN_TAC THEN REWRITE_TAC[FORALL_DROP] THEN
5648   REWRITE_TAC[LIFT_DROP] THEN
5649   REWRITE_TAC[GSYM IN_IMAGE_LIFT_DROP; GSYM SUBSET] THEN
5650   ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[LIFT_DROP]
5651         `\x. lift(drop(f % x))`)] THEN
5652   REWRITE_TAC[GSYM o_DEF] THEN
5653   DISCH_THEN(MP_TAC o MATCH_MP CONVEX_ON_SECANT_DERIVATIVE_IMP) THEN
5654   REWRITE_TAC[o_THM; DROP_CMUL; DROP_SUB; LIFT_DROP]);;
5655
5656 let REAL_CONVEX_ON_DERIVATIVES_IMP = prove
5657  (`!f f'x f'y s x y.
5658         f real_convex_on s /\ real_segment[x,y] SUBSET s /\
5659         (f has_real_derivative f'x) (atreal x within s) /\
5660         (f has_real_derivative f'y) (atreal y within s)
5661         ==> f'x * (y - x) <= f'y * (y - x)`,
5662   REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN;
5663               REAL_CONVEX_ON; REAL_SEGMENT_SEGMENT] THEN
5664   REWRITE_TAC[SUBSET; IN_IMAGE_LIFT_DROP] THEN
5665   REPEAT GEN_TAC THEN REWRITE_TAC[FORALL_DROP] THEN
5666   REWRITE_TAC[LIFT_DROP] THEN
5667   REWRITE_TAC[GSYM IN_IMAGE_LIFT_DROP; GSYM SUBSET] THEN
5668   ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[LIFT_DROP]
5669         `\x. lift(drop(f % x))`)] THEN
5670   REWRITE_TAC[GSYM o_DEF] THEN
5671   DISCH_THEN(MP_TAC o MATCH_MP CONVEX_ON_DERIVATIVES_IMP) THEN
5672   REWRITE_TAC[o_THM; DROP_CMUL; DROP_SUB; LIFT_DROP]);;
5673
5674 let REAL_CONVEX_ON_DERIVATIVE_INCREASING_IMP = prove
5675  (`!f f'x f'y s x y.
5676         f real_convex_on s /\ real_interval[x,y] SUBSET s /\
5677         (f has_real_derivative f'x) (atreal x within s) /\
5678         (f has_real_derivative f'y) (atreal y within s) /\
5679         x < y
5680         ==> f'x <= f'y`,
5681   REPEAT STRIP_TAC THEN
5682   MP_TAC(ISPECL [`f:real->real`; `f'x:real`; `f'y:real`; `s:real->bool`;
5683                  `x:real`; `y:real`] REAL_CONVEX_ON_DERIVATIVES_IMP) THEN
5684   ASM_REWRITE_TAC[REAL_SEGMENT_INTERVAL] THEN
5685   ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_RMUL_EQ; REAL_SUB_LT]);;
5686
5687 let REAL_CONVEX_ON_DERIVATIVE_SECANT = prove
5688  (`!f f' s.
5689         is_realinterval s /\
5690         (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s))
5691         ==> (f real_convex_on s <=>
5692              !x y. x IN s /\ y IN s ==> f'(x) * (y - x) <= f y - f x)`,
5693   REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN;
5694               REAL_CONVEX_ON; IS_REALINTERVAL_CONVEX] THEN
5695   REPEAT GEN_TAC THEN
5696   REWRITE_TAC[FORALL_DROP; GSYM IN_IMAGE_LIFT_DROP; LIFT_DROP] THEN
5697   ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[LIFT_DROP; o_DEF]
5698         `lift o (\x. drop(f % x))`)] THEN
5699   DISCH_THEN(SUBST1_TAC o MATCH_MP CONVEX_ON_DERIVATIVE_SECANT) THEN
5700   REWRITE_TAC[DROP_CMUL; DROP_SUB; o_THM]);;
5701
5702 let REAL_CONVEX_ON_SECANT_DERIVATIVE = prove
5703  (`!f f' s.
5704         is_realinterval s /\
5705         (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s))
5706         ==> (f real_convex_on s <=>
5707              !x y. x IN s /\ y IN s ==> f y - f x <= f'(y) * (y - x))`,
5708   REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN;
5709               REAL_CONVEX_ON; IS_REALINTERVAL_CONVEX] THEN
5710   REPEAT GEN_TAC THEN
5711   REWRITE_TAC[FORALL_DROP; GSYM IN_IMAGE_LIFT_DROP; LIFT_DROP] THEN
5712   ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[LIFT_DROP; o_DEF]
5713         `lift o (\x. drop(f % x))`)] THEN
5714   DISCH_THEN(SUBST1_TAC o MATCH_MP CONVEX_ON_SECANT_DERIVATIVE) THEN
5715   REWRITE_TAC[DROP_CMUL; DROP_SUB; o_THM]);;
5716
5717 let REAL_CONVEX_ON_DERIVATIVES = prove
5718  (`!f f' s.
5719         is_realinterval s /\
5720         (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s))
5721         ==> (f real_convex_on s <=>
5722              !x y. x IN s /\ y IN s ==> f'(x) * (y - x) <= f'(y) * (y - x))`,
5723   REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN;
5724               REAL_CONVEX_ON; IS_REALINTERVAL_CONVEX] THEN
5725   REPEAT GEN_TAC THEN
5726   REWRITE_TAC[FORALL_DROP; GSYM IN_IMAGE_LIFT_DROP; LIFT_DROP] THEN
5727   ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[LIFT_DROP; o_DEF]
5728         `lift o (\x. drop(f % x))`)] THEN
5729   DISCH_THEN(SUBST1_TAC o MATCH_MP CONVEX_ON_DERIVATIVES) THEN
5730   REWRITE_TAC[DROP_CMUL; DROP_SUB; o_THM]);;
5731
5732 let REAL_CONVEX_ON_DERIVATIVE_INCREASING = prove
5733  (`!f f' s.
5734         is_realinterval s /\
5735         (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s))
5736         ==> (f real_convex_on s <=>
5737              !x y. x IN s /\ y IN s /\ x <= y ==> f'(x) <= f'(y))`,
5738   REPEAT GEN_TAC THEN DISCH_TAC THEN
5739   FIRST_ASSUM(SUBST1_TAC o MATCH_MP REAL_CONVEX_ON_DERIVATIVES) THEN
5740   EQ_TAC THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN
5741   STRIP_TAC THENL
5742    [FIRST_X_ASSUM(MP_TAC o SPECL [`x:real`; `y:real`]) THEN
5743     ASM_CASES_TAC `x:real = y` THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN
5744     ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_SUB_LT; REAL_LT_LE];
5745     DISJ_CASES_TAC(REAL_ARITH `x <= y \/ y <= x`) THENL
5746      [FIRST_X_ASSUM(MP_TAC o SPECL [`x:real`; `y:real`]);
5747       FIRST_X_ASSUM(MP_TAC o SPECL [`y:real`; `x:real`])] THEN
5748     ASM_CASES_TAC `x:real = y` THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN
5749     ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_SUB_LT; REAL_LT_LE] THEN
5750     ONCE_REWRITE_TAC[REAL_ARITH
5751      `a * (y - x) <= b * (y - x) <=> b * (x - y) <= a * (x - y)`] THEN
5752     ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_SUB_LT; REAL_LT_LE]]);;
5753
5754 let HAS_REAL_DERIVATIVE_INCREASING_IMP = prove
5755  (`!f f' s a b.
5756         is_realinterval s /\
5757         (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s)) /\
5758         (!x. x IN s ==> &0 <= f'(x)) /\
5759         a IN s /\ b IN s /\ a <= b
5760         ==> f(a) <= f(b)`,
5761   REPEAT STRIP_TAC THEN
5762   SUBGOAL_THEN `real_interval[a,b] SUBSET s` ASSUME_TAC THENL
5763    [REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN
5764     FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [is_realinterval]) THEN
5765     MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_REWRITE_TAC[];
5766     ALL_TAC] THEN
5767   MP_TAC(ISPECL [`f:real->real`; `f':real->real`; `a:real`; `b:real`]
5768     REAL_MVT_VERY_SIMPLE) THEN
5769   ANTS_TAC THENL
5770    [ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:real` THEN DISCH_TAC THEN
5771     MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN
5772     EXISTS_TAC `s:real->bool` THEN ASM SET_TAC[];
5773     DISCH_THEN(X_CHOOSE_THEN `z:real` MP_TAC) THEN STRIP_TAC THEN
5774     GEN_REWRITE_TAC I [GSYM REAL_SUB_LE] THEN
5775     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN
5776     CONJ_TAC THENL [ASM SET_TAC[]; ASM_REAL_ARITH_TAC]]);;
5777
5778 let HAS_REAL_DERIVATIVE_INCREASING = prove
5779  (`!f f' s. is_realinterval s /\ ~(?a. s = {a}) /\
5780            (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s))
5781            ==> ((!x. x IN s ==> &0 <= f'(x)) <=>
5782                 (!x y. x IN s /\ y IN s /\ x <= y ==> f(x) <= f(y)))`,
5783   REWRITE_TAC[NOT_EXISTS_THM] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL
5784    [ASM_MESON_TAC[HAS_REAL_DERIVATIVE_INCREASING_IMP]; ALL_TAC] THEN
5785   DISCH_TAC THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN
5786   MATCH_MP_TAC(ISPEC `atreal x within s` REALLIM_LBOUND) THEN
5787   EXISTS_TAC `\y:real. (f y - f x) / (y - x)` THEN
5788   ASM_SIMP_TAC[GSYM HAS_REAL_DERIVATIVE_WITHINREAL] THEN
5789   ASM_SIMP_TAC[TRIVIAL_LIMIT_WITHIN_REALINTERVAL] THEN
5790   REWRITE_TAC[EVENTUALLY_WITHINREAL] THEN
5791   EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN
5792   X_GEN_TAC `y:real` THEN
5793   REWRITE_TAC[REAL_ARITH `&0 < abs(y - x) <=> ~(y = x)`] THEN STRIP_TAC THEN
5794   FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH
5795    `~(y:real = x) ==> x < y \/ y < x`))
5796   THENL
5797    [ALL_TAC;
5798     ONCE_REWRITE_TAC[GSYM REAL_NEG_SUB] THEN
5799     REWRITE_TAC[real_div; REAL_INV_NEG; REAL_MUL_LNEG; REAL_MUL_RNEG] THEN
5800     REWRITE_TAC[REAL_NEG_NEG; GSYM real_div]] THEN
5801   MATCH_MP_TAC REAL_LE_DIV THEN
5802   ASM_SIMP_TAC[REAL_SUB_LE; REAL_LT_IMP_LE]);;
5803
5804 let REAL_CONVEX_ON_SECOND_DERIVATIVE = prove
5805  (`!f f' f'' s.
5806         is_realinterval s /\ ~(?a. s = {a}) /\
5807         (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s)) /\
5808         (!x. x IN s ==> (f' has_real_derivative f''(x)) (atreal x within s))
5809         ==> (f real_convex_on s <=> !x. x IN s ==> &0 <= f''(x))`,
5810   REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
5811    `!x y. x IN s /\ y IN s /\ x <= y ==> (f':real->real)(x) <= f'(y)` THEN
5812   CONJ_TAC THENL
5813    [MATCH_MP_TAC REAL_CONVEX_ON_DERIVATIVE_INCREASING;
5814     CONV_TAC SYM_CONV THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_INCREASING] THEN
5815   ASM_REWRITE_TAC[]);;
5816
5817 let REAL_CONVEX_ON_ASYM = prove
5818  (`!s f. f real_convex_on s <=>
5819          !x y u v.
5820                 x IN s /\ y IN s /\ x < y /\ &0 <= u /\ &0 <= v /\ u + v = &1
5821                 ==> f (u * x + v * y) <= u * f x + v * f y`,
5822   REPEAT GEN_TAC THEN REWRITE_TAC[real_convex_on] THEN
5823   EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN
5824   MATCH_MP_TAC REAL_WLOG_LT THEN
5825   SIMP_TAC[GSYM REAL_ADD_RDISTRIB; REAL_MUL_LID; REAL_LE_REFL] THEN
5826   ASM_MESON_TAC[REAL_ADD_SYM]);;
5827
5828 let REAL_CONVEX_ON_EXP = prove
5829  (`!s. exp real_convex_on s`,
5830   GEN_TAC THEN MATCH_MP_TAC REAL_CONVEX_ON_SUBSET THEN
5831   EXISTS_TAC `(:real)` THEN REWRITE_TAC[SUBSET_UNIV] THEN
5832   MP_TAC(ISPECL [`exp`; `exp`; `exp`; `(:real)`]
5833      REAL_CONVEX_ON_SECOND_DERIVATIVE) THEN
5834   SIMP_TAC[HAS_REAL_DERIVATIVE_EXP; REAL_EXP_POS_LE;
5835            HAS_REAL_DERIVATIVE_ATREAL_WITHIN; IS_REALINTERVAL_UNIV] THEN
5836   DISCH_THEN MATCH_MP_TAC THEN
5837   MATCH_MP_TAC(SET_RULE
5838    `&0 IN s /\ &1 IN s /\ ~(&1 = &0) ==> ~(?a. s = {a})`) THEN
5839   REWRITE_TAC[IN_UNIV] THEN REAL_ARITH_TAC);;
5840
5841 let REAL_CONVEX_ON_RPOW = prove
5842  (`!s t. s SUBSET {x | &0 <= x} /\ &1 <= t
5843          ==> (\x. x rpow t) real_convex_on s`,
5844   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONVEX_ON_SUBSET THEN
5845   EXISTS_TAC `{x | &0 <= x}` THEN ASM_REWRITE_TAC[] THEN
5846   SUBGOAL_THEN `(\x. x rpow t) real_convex_on {x | &0 < x}` MP_TAC THENL
5847    [MP_TAC(ISPECL
5848      [`\x. x rpow t`; `\x. t * x rpow (t - &1)`;
5849       `\x. t * (t - &1) * x rpow (t - &2)`; `{x | &0 < x}`]
5850         REAL_CONVEX_ON_SECOND_DERIVATIVE) THEN
5851     ASM_REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL
5852      [REPEAT CONJ_TAC THENL
5853        [REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC;
5854         MATCH_MP_TAC(SET_RULE
5855          `&1 IN s /\ &2 IN s /\ ~(&1 = &2) ==> ~(?a. s = {a})`) THEN
5856         REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC;
5857         REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN ASM_REAL_ARITH_TAC;
5858         REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN
5859         ASM_REWRITE_TAC[REAL_ARITH `t - &1 - &1 = t - &2`] THEN
5860         ASM_REAL_ARITH_TAC];
5861       DISCH_THEN SUBST1_TAC THEN REPEAT STRIP_TAC THEN
5862       REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL
5863        [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN
5864       MATCH_MP_TAC RPOW_POS_LE THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]];
5865     REWRITE_TAC[REAL_CONVEX_ON_ASYM] THEN
5866     MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real` THEN
5867     REWRITE_TAC[IN_ELIM_THM] THEN ASM_CASES_TAC `x = &0` THENL
5868      [DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN
5869       REPEAT STRIP_TAC THEN
5870       ASM_SIMP_TAC[RPOW_ZERO; REAL_ARITH `&1 <= t ==> ~(t = &0)`] THEN
5871       REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_LID] THEN
5872       ASM_CASES_TAC `v = &0` THEN
5873       ASM_SIMP_TAC[RPOW_ZERO; REAL_ARITH `&1 <= t ==> ~(t = &0)`;
5874                    REAL_MUL_LZERO; REAL_LE_REFL] THEN
5875       ASM_SIMP_TAC[RPOW_MUL; REAL_LT_LE] THEN
5876       MATCH_MP_TAC REAL_LE_RMUL THEN
5877       ASM_SIMP_TAC[RPOW_POS_LE; REAL_LT_IMP_LE] THEN
5878        MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `exp(&1 * log v)` THEN
5879       CONJ_TAC THENL
5880        [ASM_SIMP_TAC[rpow; REAL_LT_LE; REAL_EXP_MONO_LE] THEN
5881         ONCE_REWRITE_TAC[REAL_ARITH
5882          `a * l <= b * l <=> --l * b <= --l * a`] THEN
5883         MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN
5884         ASM_SIMP_TAC[GSYM LOG_INV; REAL_LT_LE] THEN MATCH_MP_TAC LOG_POS THEN
5885         MATCH_MP_TAC REAL_INV_1_LE THEN ASM_REAL_ARITH_TAC;
5886         ASM_SIMP_TAC[REAL_MUL_LID; EXP_LOG; REAL_LT_LE; REAL_LE_REFL]];
5887       ASM_MESON_TAC[REAL_LT_LE; REAL_LET_TRANS]]]);;
5888
5889 (* ------------------------------------------------------------------------- *)
5890 (* A couple of simple bounds that it's convenient to get this way.           *)
5891 (* ------------------------------------------------------------------------- *)
5892
5893 let REAL_LE_X_SINH = prove
5894  (`!x. &0 <= x ==> x <= (exp x - inv(exp x)) / &2`,
5895   SUBGOAL_THEN
5896    `!a b. a <= b
5897           ==> exp a - inv(exp a) - &2 * a <= exp b - inv(exp b) - &2 * b`
5898    (MP_TAC o SPEC `&0`)
5899   THENL
5900    [MP_TAC(ISPECL
5901      [`\x. exp x - exp(--x) - &2 * x`; `\x. exp x + exp(--x) - &2`; `(:real)`]
5902      HAS_REAL_DERIVATIVE_INCREASING) THEN
5903     REWRITE_TAC[IN_ELIM_THM; IS_REALINTERVAL_UNIV; IN_UNIV] THEN ANTS_TAC THENL
5904      [CONJ_TAC THENL [SET_TAC[REAL_ARITH `~(&1 = &0)`]; ALL_TAC] THEN
5905       GEN_TAC THEN REAL_DIFF_TAC THEN REAL_ARITH_TAC;
5906       SIMP_TAC[REAL_EXP_NEG] THEN DISCH_THEN(fun th -> SIMP_TAC[GSYM th]) THEN
5907       X_GEN_TAC `x:real` THEN
5908       SIMP_TAC[REAL_EXP_NZ; REAL_FIELD
5909        `~(e = &0) ==> e + inv e - &2 = (e - &1) pow 2 / e`] THEN
5910       SIMP_TAC[REAL_EXP_POS_LE; REAL_LE_DIV; REAL_LE_POW_2]];
5911     MATCH_MP_TAC MONO_FORALL THEN REWRITE_TAC[REAL_EXP_0] THEN
5912     REAL_ARITH_TAC]);;
5913
5914 let REAL_LE_ABS_SINH = prove
5915  (`!x. abs x <= abs((exp x - inv(exp x)) / &2)`,
5916   GEN_TAC THEN ASM_CASES_TAC `&0 <= x` THENL
5917    [MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= abs y`) THEN
5918     ASM_SIMP_TAC[REAL_LE_X_SINH];
5919     MATCH_MP_TAC(REAL_ARITH `~(&0 <= x) /\ --x <= --y ==> abs x <= abs y`) THEN
5920     ASM_REWRITE_TAC[REAL_ARITH `--((a - b) / &2) = (b - a) / &2`] THEN
5921     MATCH_MP_TAC REAL_LE_TRANS THEN
5922     EXISTS_TAC `(exp(--x) - inv(exp(--x))) / &2` THEN
5923     ASM_SIMP_TAC[REAL_LE_X_SINH; REAL_ARITH `~(&0 <= x) ==> &0 <= --x`] THEN
5924     REWRITE_TAC[REAL_EXP_NEG; REAL_INV_INV] THEN REAL_ARITH_TAC]);;
5925
5926 (* ------------------------------------------------------------------------- *)
5927 (* Integrals of real->real functions; measures of real sets.                 *)
5928 (* ------------------------------------------------------------------------- *)
5929
5930 parse_as_infix("has_real_integral",(12,"right"));;
5931 parse_as_infix("real_integrable_on",(12,"right"));;
5932 parse_as_infix("absolutely_real_integrable_on",(12,"right"));;
5933 parse_as_infix("has_real_measure",(12,"right"));;
5934
5935 let has_real_integral = new_definition
5936  `(f has_real_integral y) s <=>
5937         ((lift o f o drop) has_integral (lift y)) (IMAGE lift s)`;;
5938
5939 let real_integrable_on = new_definition
5940  `f real_integrable_on i <=> ?y. (f has_real_integral y) i`;;
5941
5942 let real_integral = new_definition
5943  `real_integral i f = @y. (f has_real_integral y) i`;;
5944
5945 let real_negligible = new_definition
5946  `real_negligible s <=> negligible (IMAGE lift s)`;;
5947
5948 let absolutely_real_integrable_on = new_definition
5949  `f absolutely_real_integrable_on s <=>
5950         f real_integrable_on s /\ (\x. abs(f x)) real_integrable_on s`;;
5951
5952 let has_real_measure = new_definition
5953  `s has_real_measure m <=> ((\x. &1) has_real_integral m) s`;;
5954
5955 let real_measurable = new_definition
5956  `real_measurable s <=> ?m. s has_real_measure m`;;
5957
5958 let real_measure = new_definition
5959  `real_measure s = @m. s has_real_measure m`;;
5960
5961 let HAS_REAL_INTEGRAL = prove
5962  (`(f has_real_integral y) (real_interval[a,b]) <=>
5963    ((lift o f o drop) has_integral (lift y)) (interval[lift a,lift b])`,
5964   REWRITE_TAC[has_real_integral; IMAGE_LIFT_REAL_INTERVAL]);;
5965
5966 let REAL_INTEGRABLE_INTEGRAL = prove
5967  (`!f i. f real_integrable_on i
5968          ==> (f has_real_integral (real_integral i f)) i`,
5969   REPEAT GEN_TAC THEN REWRITE_TAC[real_integrable_on; real_integral] THEN
5970   CONV_TAC(RAND_CONV SELECT_CONV) THEN REWRITE_TAC[]);;
5971
5972 let HAS_REAL_INTEGRAL_INTEGRABLE = prove
5973  (`!f i s. (f has_real_integral i) s ==> f real_integrable_on s`,
5974   REWRITE_TAC[real_integrable_on] THEN MESON_TAC[]);;
5975
5976 let HAS_REAL_INTEGRAL_INTEGRAL = prove
5977  (`!f s. f real_integrable_on s <=>
5978          (f has_real_integral (real_integral s f)) s`,
5979   MESON_TAC[REAL_INTEGRABLE_INTEGRAL; HAS_REAL_INTEGRAL_INTEGRABLE]);;
5980
5981 let HAS_REAL_INTEGRAL_UNIQUE = prove
5982  (`!f i k1 k2.
5983         (f has_real_integral k1) i /\ (f has_real_integral k2) i ==> k1 = k2`,
5984   REPEAT GEN_TAC THEN REWRITE_TAC[has_real_integral] THEN
5985   DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_UNIQUE) THEN
5986   REWRITE_TAC[LIFT_EQ]);;
5987
5988 let REAL_INTEGRAL_UNIQUE = prove
5989  (`!f y k.
5990       (f has_real_integral y) k ==> real_integral k f = y`,
5991   REPEAT STRIP_TAC THEN REWRITE_TAC[real_integral] THEN
5992   MATCH_MP_TAC SELECT_UNIQUE THEN ASM_MESON_TAC[HAS_REAL_INTEGRAL_UNIQUE]);;
5993
5994 let HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL = prove
5995  (`!f i s.
5996         (f has_real_integral i) s <=>
5997         f real_integrable_on s /\ real_integral s f = i`,
5998   MESON_TAC[REAL_INTEGRABLE_INTEGRAL; REAL_INTEGRAL_UNIQUE;
5999             real_integrable_on]);;
6000
6001 let REAL_INTEGRAL_EQ_HAS_INTEGRAL = prove
6002  (`!s f y. f real_integrable_on s
6003            ==> (real_integral s f = y <=> (f has_real_integral y) s)`,
6004   MESON_TAC[REAL_INTEGRABLE_INTEGRAL; REAL_INTEGRAL_UNIQUE]);;
6005
6006 let REAL_INTEGRABLE_ON = prove
6007  (`f real_integrable_on s <=>
6008         (lift o f o drop) integrable_on (IMAGE lift s)`,
6009   REWRITE_TAC[real_integrable_on; has_real_integral; EXISTS_DROP;
6010               integrable_on; LIFT_DROP]);;
6011
6012 let ABSOLUTELY_REAL_INTEGRABLE_ON = prove
6013  (`f absolutely_real_integrable_on s <=>
6014         (lift o f o drop) absolutely_integrable_on (IMAGE lift s)`,
6015   REWRITE_TAC[absolutely_real_integrable_on; REAL_INTEGRABLE_ON;
6016               absolutely_integrable_on] THEN
6017   REWRITE_TAC[o_DEF; LIFT_DROP; NORM_LIFT]);;
6018
6019 let REAL_INTEGRAL = prove
6020  (`f real_integrable_on s
6021    ==> real_integral s f = drop(integral (IMAGE lift s) (lift o f o drop))`,
6022   REWRITE_TAC[REAL_INTEGRABLE_ON] THEN REPEAT STRIP_TAC THEN
6023   MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN
6024   REWRITE_TAC[has_real_integral; LIFT_DROP] THEN
6025   ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL]);;
6026
6027 let HAS_REAL_INTEGRAL_IS_0 = prove
6028  (`!f s. (!x. x IN s ==> f(x) = &0) ==> (f has_real_integral &0) s`,
6029   REPEAT STRIP_TAC THEN REWRITE_TAC[has_real_integral; LIFT_NUM] THEN
6030   MATCH_MP_TAC HAS_INTEGRAL_IS_0 THEN
6031   ASM_REWRITE_TAC[LIFT_EQ; FORALL_IN_IMAGE; o_THM; LIFT_DROP; GSYM LIFT_NUM]);;
6032
6033 let HAS_REAL_INTEGRAL_0 = prove
6034  (`!s. ((\x. &0) has_real_integral &0) s`,
6035   SIMP_TAC[HAS_REAL_INTEGRAL_IS_0]);;
6036
6037 let HAS_REAL_INTEGRAL_0_EQ = prove
6038  (`!i s. ((\x. &0) has_real_integral i) s <=> i = &0`,
6039   MESON_TAC[HAS_REAL_INTEGRAL_UNIQUE; HAS_REAL_INTEGRAL_0]);;
6040
6041 let HAS_REAL_INTEGRAL_LINEAR = prove
6042  (`!f:real->real y s h:real->real.
6043         (f has_real_integral y) s /\ linear(lift o h o drop)
6044         ==> ((h o f) has_real_integral h(y)) s`,
6045   REPEAT GEN_TAC THEN REWRITE_TAC[has_real_integral] THEN
6046   DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_LINEAR) THEN
6047   REWRITE_TAC[o_DEF; LIFT_DROP]);;
6048
6049 let HAS_REAL_INTEGRAL_LMUL = prove
6050  (`!(f:real->real) k s c.
6051         (f has_real_integral k) s
6052         ==> ((\x. c * f(x)) has_real_integral (c * k)) s`,
6053   REPEAT GEN_TAC THEN REWRITE_TAC[has_real_integral] THEN
6054   DISCH_THEN(MP_TAC o SPEC `c:real` o MATCH_MP HAS_INTEGRAL_CMUL) THEN
6055   REWRITE_TAC[GSYM LIFT_CMUL; o_DEF]);;
6056
6057 let HAS_REAL_INTEGRAL_RMUL = prove
6058  (`!(f:real->real) k s c.
6059         (f has_real_integral k) s
6060         ==> ((\x. f(x) * c) has_real_integral (k * c)) s`,
6061   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
6062   REWRITE_TAC[HAS_REAL_INTEGRAL_LMUL]);;
6063
6064 let HAS_REAL_INTEGRAL_NEG = prove
6065  (`!f k s. (f has_real_integral k) s
6066            ==> ((\x. --(f x)) has_real_integral (--k)) s`,
6067   REPEAT GEN_TAC THEN REWRITE_TAC[has_real_integral] THEN
6068   DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_NEG) THEN
6069   REWRITE_TAC[o_DEF; LIFT_NEG]);;
6070
6071 let HAS_REAL_INTEGRAL_ADD = prove
6072  (`!f:real->real g k l s.
6073         (f has_real_integral k) s /\ (g has_real_integral l) s
6074         ==> ((\x. f(x) + g(x)) has_real_integral (k + l)) s`,
6075   REPEAT GEN_TAC THEN REWRITE_TAC[has_real_integral] THEN
6076   DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_ADD) THEN
6077   REWRITE_TAC[o_DEF; LIFT_ADD]);;
6078
6079 let HAS_REAL_INTEGRAL_SUB = prove
6080  (`!f:real->real g k l s.
6081         (f has_real_integral k) s /\ (g has_real_integral l) s
6082         ==> ((\x. f(x) - g(x)) has_real_integral (k - l)) s`,
6083   REPEAT GEN_TAC THEN REWRITE_TAC[has_real_integral] THEN
6084   DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_SUB) THEN
6085   REWRITE_TAC[o_DEF; LIFT_SUB]);;
6086
6087 let REAL_INTEGRAL_0 = prove
6088  (`!s. real_integral s (\x. &0) = &0`,
6089   MESON_TAC[REAL_INTEGRAL_UNIQUE; HAS_REAL_INTEGRAL_0]);;
6090
6091 let REAL_INTEGRAL_ADD = prove
6092  (`!f:real->real g s.
6093         f real_integrable_on s /\ g real_integrable_on s
6094         ==> real_integral s (\x. f x + g x) =
6095             real_integral s f + real_integral s g`,
6096   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN
6097   MATCH_MP_TAC HAS_REAL_INTEGRAL_ADD THEN
6098   ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL]);;
6099
6100 let REAL_INTEGRAL_LMUL = prove
6101  (`!f:real->real c s.
6102         f real_integrable_on s
6103         ==> real_integral s (\x. c * f(x)) = c * real_integral s f`,
6104   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN
6105   MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN
6106   ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL]);;
6107
6108 let REAL_INTEGRAL_RMUL = prove
6109  (`!f:real->real c s.
6110         f real_integrable_on s
6111         ==> real_integral s (\x. f(x) * c) = real_integral s f * c`,
6112   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN
6113   MATCH_MP_TAC HAS_REAL_INTEGRAL_RMUL THEN
6114   ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL]);;
6115
6116 let REAL_INTEGRAL_NEG = prove
6117  (`!f:real->real s.
6118         f real_integrable_on s
6119         ==> real_integral s (\x. --f(x)) = --real_integral s f`,
6120   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN
6121   MATCH_MP_TAC HAS_REAL_INTEGRAL_NEG THEN
6122   ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL]);;
6123
6124 let REAL_INTEGRAL_SUB = prove
6125  (`!f:real->real g s.
6126         f real_integrable_on s /\ g real_integrable_on s
6127         ==> real_integral s (\x. f x - g x) =
6128             real_integral s f - real_integral s g`,
6129   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN
6130   MATCH_MP_TAC HAS_REAL_INTEGRAL_SUB THEN
6131   ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL]);;
6132
6133 let REAL_INTEGRABLE_0 = prove
6134  (`!s. (\x. &0) real_integrable_on s`,
6135   REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_0]);;
6136
6137 let REAL_INTEGRABLE_ADD = prove
6138  (`!f:real->real g s.
6139         f real_integrable_on s /\ g real_integrable_on s
6140         ==> (\x. f x + g x) real_integrable_on s`,
6141   REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_ADD]);;
6142
6143 let REAL_INTEGRABLE_LMUL = prove
6144  (`!f:real->real c s.
6145         f real_integrable_on s
6146         ==> (\x. c * f(x)) real_integrable_on s`,
6147   REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_LMUL]);;
6148
6149 let REAL_INTEGRABLE_RMUL = prove
6150  (`!f:real->real c s.
6151         f real_integrable_on s
6152         ==> (\x. f(x) * c) real_integrable_on s`,
6153   REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_RMUL]);;
6154
6155 let REAL_INTEGRABLE_NEG = prove
6156  (`!f:real->real s.
6157         f real_integrable_on s ==> (\x. --f(x)) real_integrable_on s`,
6158   REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_NEG]);;
6159
6160 let REAL_INTEGRABLE_SUB = prove
6161  (`!f:real->real g s.
6162         f real_integrable_on s /\ g real_integrable_on s
6163         ==> (\x. f x - g x) real_integrable_on s`,
6164   REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_SUB]);;
6165
6166 let REAL_INTEGRABLE_LINEAR = prove
6167  (`!f h s. f real_integrable_on s /\
6168            linear(lift o h o drop) ==> (h o f) real_integrable_on s`,
6169   REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_LINEAR]);;
6170
6171 let REAL_INTEGRAL_LINEAR = prove
6172  (`!f:real->real s h:real->real.
6173         f real_integrable_on s /\ linear(lift o h o drop)
6174         ==> real_integral s (h o f) = h(real_integral s f)`,
6175   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_UNIQUE THEN
6176   MAP_EVERY EXISTS_TAC
6177    [`(h:real->real) o (f:real->real)`; `s:real->bool`] THEN
6178   CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HAS_REAL_INTEGRAL_LINEAR] THEN
6179   ASM_SIMP_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL; REAL_INTEGRABLE_LINEAR]);;
6180
6181 let HAS_REAL_INTEGRAL_SUM = prove
6182  (`!f:A->real->real s t.
6183         FINITE t /\
6184         (!a. a IN t ==> ((f a) has_real_integral (i a)) s)
6185         ==> ((\x. sum t (\a. f a x)) has_real_integral (sum t i)) s`,
6186   GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
6187   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
6188   SIMP_TAC[SUM_CLAUSES; HAS_REAL_INTEGRAL_0; IN_INSERT] THEN
6189   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_ADD THEN
6190   ASM_REWRITE_TAC[ETA_AX] THEN CONJ_TAC THEN
6191   FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[]);;
6192
6193 let REAL_INTEGRAL_SUM = prove
6194  (`!f:A->real->real s t.
6195         FINITE t /\
6196         (!a. a IN t ==> (f a) real_integrable_on s)
6197         ==> real_integral s (\x. sum t (\a. f a x)) =
6198                 sum t (\a. real_integral s (f a))`,
6199   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN
6200   MATCH_MP_TAC HAS_REAL_INTEGRAL_SUM THEN
6201   ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL]);;
6202
6203 let REAL_INTEGRABLE_SUM = prove
6204  (`!f:A->real->real s t.
6205         FINITE t /\
6206         (!a. a IN t ==> (f a) real_integrable_on s)
6207         ==>  (\x. sum t (\a. f a x)) real_integrable_on s`,
6208   REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_SUM]);;
6209
6210 let HAS_REAL_INTEGRAL_EQ = prove
6211  (`!f:real->real g k s.
6212         (!x. x IN s ==> (f(x) = g(x))) /\
6213         (f has_real_integral k) s
6214         ==> (g has_real_integral k) s`,
6215   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN
6216   DISCH_THEN(CONJUNCTS_THEN2
6217    (MP_TAC o MATCH_MP HAS_REAL_INTEGRAL_IS_0) MP_TAC) THEN
6218   REWRITE_TAC[IMP_IMP] THEN DISCH_THEN
6219    (MP_TAC o MATCH_MP HAS_REAL_INTEGRAL_SUB) THEN
6220   SIMP_TAC[REAL_ARITH `x - (x - y:real) = y`; ETA_AX; REAL_SUB_RZERO]);;
6221
6222 let REAL_INTEGRABLE_EQ = prove
6223  (`!f:real->real g s.
6224         (!x. x IN s ==> (f(x) = g(x))) /\
6225         f real_integrable_on s
6226         ==> g real_integrable_on s`,
6227   REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_EQ]);;
6228
6229 let HAS_REAL_INTEGRAL_EQ_EQ = prove
6230  (`!f:real->real g k s.
6231         (!x. x IN s ==> (f(x) = g(x)))
6232         ==> ((f has_real_integral k) s <=> (g has_real_integral k) s)`,
6233   MESON_TAC[HAS_REAL_INTEGRAL_EQ]);;
6234
6235 let HAS_REAL_INTEGRAL_NULL = prove
6236  (`!f:real->real a b.
6237     b <= a ==> (f has_real_integral &0) (real_interval[a,b])`,
6238   REPEAT STRIP_TAC THEN
6239   REWRITE_TAC[has_real_integral; REAL_INTERVAL_INTERVAL] THEN
6240   REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; LIFT_NUM] THEN
6241   REWRITE_TAC[SET_RULE `IMAGE (\x. x) s = s`] THEN
6242   MATCH_MP_TAC HAS_INTEGRAL_NULL THEN
6243   ASM_REWRITE_TAC[CONTENT_EQ_0_1; LIFT_DROP]);;
6244
6245 let HAS_REAL_INTEGRAL_NULL_EQ = prove
6246  (`!f a b i. b <= a
6247              ==> ((f has_real_integral i) (real_interval[a,b]) <=> i = &0)`,
6248   ASM_MESON_TAC[REAL_INTEGRAL_UNIQUE; HAS_REAL_INTEGRAL_NULL]);;
6249
6250 let REAL_INTEGRAL_NULL = prove
6251  (`!f a b. b <= a
6252            ==> real_integral(real_interval[a,b]) f = &0`,
6253   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN
6254   ASM_MESON_TAC[HAS_REAL_INTEGRAL_NULL]);;
6255
6256 let REAL_INTEGRABLE_ON_NULL = prove
6257  (`!f a b. b <= a
6258            ==> f real_integrable_on real_interval[a,b]`,
6259   REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_NULL]);;
6260
6261 let HAS_REAL_INTEGRAL_EMPTY = prove
6262  (`!f. (f has_real_integral &0) {}`,
6263   GEN_TAC THEN REWRITE_TAC[EMPTY_AS_REAL_INTERVAL] THEN
6264   MATCH_MP_TAC HAS_REAL_INTEGRAL_NULL THEN REWRITE_TAC[REAL_POS]);;
6265
6266 let HAS_REAL_INTEGRAL_EMPTY_EQ = prove
6267  (`!f i. (f has_real_integral i) {} <=> i = &0`,
6268   MESON_TAC[HAS_REAL_INTEGRAL_UNIQUE; HAS_REAL_INTEGRAL_EMPTY]);;
6269
6270 let REAL_INTEGRABLE_ON_EMPTY = prove
6271  (`!f. f real_integrable_on {}`,
6272   REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_EMPTY]);;
6273
6274 let REAL_INTEGRAL_EMPTY = prove
6275  (`!f. real_integral {} f = &0`,
6276   MESON_TAC[EMPTY_AS_REAL_INTERVAL; REAL_INTEGRAL_UNIQUE;
6277             HAS_REAL_INTEGRAL_EMPTY]);;
6278
6279 let HAS_REAL_INTEGRAL_REFL = prove
6280  (`!f a. (f has_real_integral &0) (real_interval[a,a])`,
6281   REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_NULL THEN
6282   REWRITE_TAC[REAL_LE_REFL]);;
6283
6284 let REAL_INTEGRABLE_ON_REFL = prove
6285  (`!f a. f real_integrable_on real_interval[a,a]`,
6286   REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_REFL]);;
6287
6288 let REAL_INTEGRAL_REFL = prove
6289  (`!f a. real_integral (real_interval[a,a]) f = &0`,
6290   MESON_TAC[REAL_INTEGRAL_UNIQUE; HAS_REAL_INTEGRAL_REFL]);;
6291
6292 let HAS_REAL_INTEGRAL_CONST = prove
6293  (`!a b c.
6294         a <= b
6295         ==> ((\x. c) has_real_integral (c * (b - a))) (real_interval[a,b])`,
6296   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
6297   REWRITE_TAC[has_real_integral; IMAGE_LIFT_REAL_INTERVAL] THEN
6298   MP_TAC(ISPECL [`lift a`; `lift b`; `lift c`] HAS_INTEGRAL_CONST) THEN
6299   ASM_SIMP_TAC[o_DEF; CONTENT_1; LIFT_DROP; LIFT_CMUL]);;
6300
6301 let REAL_INTEGRABLE_CONST = prove
6302  (`!a b c. (\x. c) real_integrable_on real_interval[a,b]`,
6303   REWRITE_TAC[REAL_INTEGRABLE_ON; IMAGE_LIFT_REAL_INTERVAL;
6304               o_DEF; INTEGRABLE_CONST]);;
6305
6306 let REAL_INTEGRAL_CONST = prove
6307  (`!a b c.
6308         a <= b
6309         ==> real_integral (real_interval [a,b]) (\x. c) = c * (b - a)`,
6310   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN
6311   ASM_SIMP_TAC[HAS_REAL_INTEGRAL_CONST]);;
6312
6313 let HAS_REAL_INTEGRAL_BOUND = prove
6314  (`!f:real->real a b i B.
6315         &0 <= B /\ a <= b /\
6316         (f has_real_integral i) (real_interval[a,b]) /\
6317         (!x. x IN real_interval[a,b] ==> abs(f x) <= B)
6318         ==> abs i <= B * (b - a)`,
6319   REWRITE_TAC[HAS_REAL_INTEGRAL; REAL_INTERVAL_INTERVAL; GSYM NORM_LIFT] THEN
6320   REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP] THEN REPEAT STRIP_TAC THEN
6321   GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o BINOP_CONV) [GSYM LIFT_DROP] THEN
6322   ASM_SIMP_TAC[GSYM CONTENT_1; LIFT_DROP] THEN
6323   MATCH_MP_TAC HAS_INTEGRAL_BOUND THEN
6324   EXISTS_TAC `lift o f o drop` THEN ASM_REWRITE_TAC[o_THM]);;
6325
6326 let HAS_REAL_INTEGRAL_LE = prove
6327  (`!f g s i j.
6328         (f has_real_integral i) s /\ (g has_real_integral j) s /\
6329         (!x. x IN s ==> f x <= g x)
6330         ==> i <= j`,
6331   REWRITE_TAC[has_real_integral] THEN REPEAT STRIP_TAC THEN
6332   GEN_REWRITE_TAC BINOP_CONV [GSYM LIFT_DROP] THEN
6333   REWRITE_TAC[drop] THEN MATCH_MP_TAC
6334    (ISPECL [`lift o f o drop`; `lift o g o drop`; `IMAGE lift s`]
6335            HAS_INTEGRAL_COMPONENT_LE) THEN
6336   ASM_REWRITE_TAC[FORALL_IN_IMAGE; DIMINDEX_1; LE_REFL; o_THM; LIFT_DROP;
6337                   GSYM drop]);;
6338
6339 let REAL_INTEGRAL_LE = prove
6340  (`!f:real->real g:real->real s.
6341         f real_integrable_on s /\ g real_integrable_on s /\
6342         (!x. x IN s ==> f x <= g x)
6343         ==> real_integral s f <= real_integral s g`,
6344   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_LE THEN
6345   ASM_MESON_TAC[REAL_INTEGRABLE_INTEGRAL]);;
6346
6347 let HAS_REAL_INTEGRAL_POS = prove
6348  (`!f:real->real s i.
6349         (f has_real_integral i) s /\
6350         (!x. x IN s ==> &0 <= f x)
6351         ==> &0 <= i`,
6352   REPEAT STRIP_TAC THEN
6353   MP_TAC(ISPECL [`(\x. &0):real->real`; `f:real->real`;
6354                  `s:real->bool`; `&0:real`;
6355                  `i:real`] HAS_REAL_INTEGRAL_LE) THEN
6356   ASM_SIMP_TAC[HAS_REAL_INTEGRAL_0]);;
6357
6358 let REAL_INTEGRAL_POS = prove
6359  (`!f:real->real s.
6360         f real_integrable_on s /\
6361         (!x. x IN s ==> &0 <= f x)
6362         ==> &0 <= real_integral s f`,
6363   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_POS THEN
6364   ASM_MESON_TAC[REAL_INTEGRABLE_INTEGRAL]);;
6365
6366 let HAS_REAL_INTEGRAL_ISNEG = prove
6367  (`!f:real->real s i.
6368         (f has_real_integral i) s /\
6369         (!x. x IN s ==> f x <= &0)
6370         ==> i <= &0`,
6371   REPEAT STRIP_TAC THEN
6372   MP_TAC(ISPECL [`f:real->real`; `(\x. &0):real->real`;
6373                  `s:real->bool`; `i:real`; `&0:real`;
6374                 ] HAS_REAL_INTEGRAL_LE) THEN
6375   ASM_SIMP_TAC[HAS_REAL_INTEGRAL_0]);;
6376
6377 let HAS_REAL_INTEGRAL_LBOUND = prove
6378  (`!f:real->real a b i.
6379         a <= b /\
6380         (f has_real_integral i) (real_interval[a,b]) /\
6381         (!x. x IN real_interval[a,b] ==> B <= f(x))
6382         ==> B * (b - a) <= i`,
6383   REPEAT STRIP_TAC THEN
6384   MP_TAC(ISPECL [`(\x. B):real->real`; `f:real->real`;
6385                  `real_interval[a,b]`;
6386                   `B * (b - a):real`;
6387                  `i:real`]
6388                 HAS_REAL_INTEGRAL_LE) THEN
6389   ASM_SIMP_TAC[HAS_REAL_INTEGRAL_CONST]);;
6390
6391 let HAS_REAL_INTEGRAL_UBOUND = prove
6392  (`!f:real->real a b i.
6393         a <= b /\
6394         (f has_real_integral i) (real_interval[a,b]) /\
6395         (!x. x IN real_interval[a,b] ==> f(x) <= B)
6396         ==> i <= B * (b - a)`,
6397   REPEAT STRIP_TAC THEN
6398   MP_TAC(ISPECL [`f:real->real`; `(\x. B):real->real`;
6399                  `real_interval[a,b]`; `i:real`;
6400                  `B * (b - a):real`]
6401                 HAS_REAL_INTEGRAL_LE) THEN
6402   ASM_SIMP_TAC[HAS_REAL_INTEGRAL_CONST]);;
6403
6404 let REAL_INTEGRAL_LBOUND = prove
6405  (`!f:real->real a b.
6406         a <= b /\
6407         f real_integrable_on real_interval[a,b] /\
6408         (!x. x IN real_interval[a,b] ==> B <= f(x))
6409         ==> B * (b - a) <= real_integral(real_interval[a,b]) f`,
6410   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_LBOUND THEN
6411   EXISTS_TAC `f:real->real` THEN
6412   ASM_REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL]);;
6413
6414 let REAL_INTEGRAL_UBOUND = prove
6415  (`!f:real->real a b.
6416         a <= b /\
6417         f real_integrable_on real_interval[a,b] /\
6418         (!x. x IN real_interval[a,b] ==> f(x) <= B)
6419         ==> real_integral(real_interval[a,b]) f <= B * (b - a)`,
6420   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_UBOUND THEN
6421   EXISTS_TAC `f:real->real` THEN
6422   ASM_REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL]);;
6423
6424 let REAL_INTEGRABLE_UNIFORM_LIMIT = prove
6425  (`!f a b. (!e. &0 < e
6426                 ==> ?g. (!x. x IN real_interval[a,b] ==> abs(f x - g x) <= e) /\
6427                         g real_integrable_on real_interval[a,b] )
6428            ==> f real_integrable_on real_interval[a,b]`,
6429   REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL; GSYM EXISTS_LIFT] THEN
6430   REWRITE_TAC[GSYM integrable_on] THEN REPEAT STRIP_TAC THEN
6431   MATCH_MP_TAC INTEGRABLE_UNIFORM_LIMIT THEN
6432   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
6433   FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
6434   DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN
6435   EXISTS_TAC `lift o g o drop` THEN ASM_REWRITE_TAC[] THEN
6436   REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; FORALL_IN_IMAGE] THEN
6437   ASM_SIMP_TAC[o_THM; LIFT_DROP; GSYM LIFT_SUB; NORM_LIFT]);;
6438
6439 let HAS_REAL_INTEGRAL_NEGLIGIBLE = prove
6440  (`!f s t.
6441         real_negligible s /\ (!x. x IN (t DIFF s) ==> f x = &0)
6442         ==> (f has_real_integral (&0)) t`,
6443   REWRITE_TAC[has_real_integral; real_negligible; LIFT_NUM] THEN
6444   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_NEGLIGIBLE THEN
6445   EXISTS_TAC `IMAGE lift s` THEN ASM_REWRITE_TAC[] THEN
6446   REWRITE_TAC[o_THM; IN_DIFF; IMP_CONJ; FORALL_IN_IMAGE] THEN
6447   REWRITE_TAC[LIFT_IN_IMAGE_LIFT; LIFT_DROP] THEN ASM SET_TAC[LIFT_NUM]);;
6448
6449 let HAS_REAL_INTEGRAL_SPIKE = prove
6450  (`!f g s t y.
6451         real_negligible s /\ (!x. x IN (t DIFF s) ==> g x = f x) /\
6452         (f has_real_integral y) t
6453         ==> (g has_real_integral y) t`,
6454   REWRITE_TAC[has_real_integral; real_negligible] THEN
6455   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN
6456   MAP_EVERY EXISTS_TAC [`lift o f o drop`; `IMAGE lift s`] THEN
6457   ASM_REWRITE_TAC[] THEN
6458   REWRITE_TAC[o_THM; IN_DIFF; IMP_CONJ; FORALL_IN_IMAGE] THEN
6459   REWRITE_TAC[LIFT_IN_IMAGE_LIFT; LIFT_DROP] THEN ASM SET_TAC[LIFT_NUM]);;
6460
6461 let HAS_REAL_INTEGRAL_SPIKE_EQ = prove
6462  (`!f g s t y.
6463         real_negligible s /\ (!x. x IN (t DIFF s) ==> g x = f x)
6464         ==> ((f has_real_integral y) t <=> (g has_real_integral y) t)`,
6465   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
6466   MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE THENL
6467    [EXISTS_TAC `f:real->real`; EXISTS_TAC `g:real->real`] THEN
6468   EXISTS_TAC `s:real->bool` THEN ASM_REWRITE_TAC[] THEN
6469   ASM_MESON_TAC[REAL_ABS_SUB]);;
6470
6471 let REAL_INTEGRABLE_SPIKE = prove
6472  (`!f g s t.
6473         real_negligible s /\ (!x. x IN (t DIFF s) ==> g x = f x)
6474         ==> f real_integrable_on t ==> g real_integrable_on  t`,
6475   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[real_integrable_on] THEN
6476   MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
6477   MP_TAC(SPEC_ALL HAS_REAL_INTEGRAL_SPIKE) THEN ASM_REWRITE_TAC[]);;
6478
6479 let REAL_INTEGRAL_SPIKE = prove
6480  (`!f:real->real g s t.
6481         real_negligible s /\ (!x. x IN (t DIFF s) ==> g x = f x)
6482         ==> real_integral t f = real_integral t g`,
6483   REPEAT STRIP_TAC THEN REWRITE_TAC[real_integral] THEN
6484   AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE_EQ THEN
6485   ASM_MESON_TAC[]);;
6486
6487 let REAL_NEGLIGIBLE_SUBSET = prove
6488  (`!s:real->bool t:real->bool.
6489         real_negligible s /\ t SUBSET s ==> real_negligible t`,
6490   REWRITE_TAC[real_negligible] THEN REPEAT STRIP_TAC THEN
6491   MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
6492   EXISTS_TAC `IMAGE lift s` THEN ASM_SIMP_TAC[IMAGE_SUBSET]);;
6493
6494 let REAL_NEGLIGIBLE_DIFF = prove
6495  (`!s t:real->bool. real_negligible s ==> real_negligible(s DIFF t)`,
6496   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN
6497   EXISTS_TAC `s:real->bool` THEN ASM_REWRITE_TAC[SUBSET_DIFF]);;
6498
6499 let REAL_NEGLIGIBLE_INTER = prove
6500  (`!s t. real_negligible s \/ real_negligible t ==> real_negligible(s INTER t)`,
6501   MESON_TAC[REAL_NEGLIGIBLE_SUBSET; INTER_SUBSET]);;
6502
6503 let REAL_NEGLIGIBLE_UNION = prove
6504  (`!s t:real->bool.
6505        real_negligible s /\ real_negligible t ==> real_negligible (s UNION t)`,
6506   SIMP_TAC[NEGLIGIBLE_UNION; IMAGE_UNION; real_negligible]);;
6507
6508 let REAL_NEGLIGIBLE_UNION_EQ = prove
6509  (`!s t:real->bool.
6510         real_negligible (s UNION t) <=> real_negligible s /\ real_negligible t`,
6511   MESON_TAC[REAL_NEGLIGIBLE_UNION; SUBSET_UNION; REAL_NEGLIGIBLE_SUBSET]);;
6512
6513 let REAL_NEGLIGIBLE_SING = prove
6514  (`!a:real. real_negligible {a}`,
6515   REWRITE_TAC[real_negligible; NEGLIGIBLE_SING; IMAGE_CLAUSES]);;
6516
6517 let REAL_NEGLIGIBLE_INSERT = prove
6518  (`!a:real s. real_negligible(a INSERT s) <=> real_negligible s`,
6519   REWRITE_TAC[real_negligible; NEGLIGIBLE_INSERT; IMAGE_CLAUSES]);;
6520
6521 let REAL_NEGLIGIBLE_EMPTY = prove
6522  (`real_negligible {}`,
6523   REWRITE_TAC[real_negligible; NEGLIGIBLE_EMPTY; IMAGE_CLAUSES]);;
6524
6525 let REAL_NEGLIGIBLE_FINITE = prove
6526  (`!s. FINITE s ==> real_negligible s`,
6527   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
6528   SIMP_TAC[REAL_NEGLIGIBLE_EMPTY; REAL_NEGLIGIBLE_INSERT]);;
6529
6530 let REAL_NEGLIGIBLE_UNIONS = prove
6531  (`!s. FINITE s /\ (!t. t IN s ==> real_negligible t)
6532        ==> real_negligible(UNIONS s)`,
6533   REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
6534   REWRITE_TAC[UNIONS_0; UNIONS_INSERT; REAL_NEGLIGIBLE_EMPTY; IN_INSERT] THEN
6535   SIMP_TAC[REAL_NEGLIGIBLE_UNION]);;
6536
6537 let HAS_REAL_INTEGRAL_SPIKE_FINITE = prove
6538  (`!f:real->real g s t y.
6539         FINITE s /\ (!x. x IN (t DIFF s) ==> g x = f x) /\
6540         (f has_real_integral y) t
6541         ==> (g has_real_integral y) t`,
6542   MESON_TAC[HAS_REAL_INTEGRAL_SPIKE; REAL_NEGLIGIBLE_FINITE]);;
6543
6544 let HAS_REAL_INTEGRAL_SPIKE_FINITE_EQ = prove
6545  (`!f:real->real g s y.
6546         FINITE s /\ (!x. x IN (t DIFF s) ==> g x = f x)
6547         ==> ((f has_real_integral y) t <=> (g has_real_integral y) t)`,
6548   MESON_TAC[HAS_REAL_INTEGRAL_SPIKE_FINITE]);;
6549
6550 let REAL_INTEGRABLE_SPIKE_FINITE = prove
6551  (`!f:real->real g s.
6552         FINITE s /\ (!x. x IN (t DIFF s) ==> g x = f x)
6553         ==> f real_integrable_on t
6554             ==> g real_integrable_on  t`,
6555   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[real_integrable_on] THEN
6556   MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
6557   MP_TAC(SPEC_ALL HAS_REAL_INTEGRAL_SPIKE_FINITE) THEN ASM_REWRITE_TAC[]);;
6558
6559 let REAL_NEGLIGIBLE_FRONTIER_INTERVAL = prove
6560  (`!a b:real. real_negligible(real_interval[a,b] DIFF real_interval(a,b))`,
6561   REPEAT GEN_TAC THEN REWRITE_TAC[real_interval; DIFF; IN_ELIM_THM] THEN
6562   MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{(a:real),b}` THEN
6563   ASM_SIMP_TAC[REAL_NEGLIGIBLE_FINITE; FINITE_RULES] THEN
6564   REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN
6565   REAL_ARITH_TAC);;
6566
6567 let HAS_REAL_INTEGRAL_SPIKE_INTERIOR = prove
6568  (`!f:real->real g a b y.
6569         (!x. x IN real_interval(a,b) ==> g x = f x) /\
6570         (f has_real_integral y) (real_interval[a,b])
6571         ==> (g has_real_integral y) (real_interval[a,b])`,
6572   REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN DISCH_TAC THEN
6573   MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`]
6574                            HAS_REAL_INTEGRAL_SPIKE) THEN
6575   EXISTS_TAC `real_interval[a:real,b] DIFF real_interval(a,b)` THEN
6576   REWRITE_TAC[REAL_NEGLIGIBLE_FRONTIER_INTERVAL] THEN ASM SET_TAC[]);;
6577
6578 let HAS_REAL_INTEGRAL_SPIKE_INTERIOR_EQ = prove
6579  (`!f:real->real g a b y.
6580         (!x. x IN real_interval(a,b) ==> g x = f x)
6581         ==> ((f has_real_integral y) (real_interval[a,b]) <=>
6582              (g has_real_integral y) (real_interval[a,b]))`,
6583   MESON_TAC[HAS_REAL_INTEGRAL_SPIKE_INTERIOR]);;
6584
6585 let REAL_INTEGRABLE_SPIKE_INTERIOR = prove
6586  (`!f:real->real g a b.
6587         (!x. x IN real_interval(a,b) ==> g x = f x)
6588         ==> f real_integrable_on (real_interval[a,b])
6589             ==> g real_integrable_on  (real_interval[a,b])`,
6590   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[real_integrable_on] THEN
6591   MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
6592   MP_TAC(SPEC_ALL HAS_REAL_INTEGRAL_SPIKE_INTERIOR) THEN ASM_REWRITE_TAC[]);;
6593
6594 let REAL_INTEGRAL_EQ = prove
6595  (`!f g s.
6596         (!x. x IN s ==> f x = g x) ==> real_integral s f = real_integral s g`,
6597   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN
6598   EXISTS_TAC `{}:real->bool` THEN
6599   ASM_SIMP_TAC[REAL_NEGLIGIBLE_EMPTY; IN_DIFF]);;
6600
6601 let REAL_INTEGRAL_EQ_0 = prove
6602  (`!f s. (!x. x IN s ==> f x = &0) ==> real_integral s f = &0`,
6603   REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
6604   EXISTS_TAC `real_integral s (\x. &0)` THEN
6605   CONJ_TAC THENL
6606    [MATCH_MP_TAC REAL_INTEGRAL_EQ THEN ASM_REWRITE_TAC[];
6607     REWRITE_TAC[REAL_INTEGRAL_0]]);;
6608
6609 let REAL_INTEGRABLE_CONTINUOUS = prove
6610  (`!f a b.
6611         f real_continuous_on real_interval[a,b]
6612         ==> f real_integrable_on real_interval[a,b]`,
6613   REWRITE_TAC[REAL_CONTINUOUS_ON; real_integrable_on; has_real_integral;
6614               GSYM integrable_on; GSYM EXISTS_LIFT] THEN
6615   REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; INTEGRABLE_CONTINUOUS]);;
6616
6617 let REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS = prove
6618  (`!f f' a b.
6619         a <= b /\
6620         (!x. x IN real_interval[a,b]
6621              ==> (f has_real_derivative f'(x))
6622                  (atreal x within real_interval[a,b]))
6623         ==> (f' has_real_integral (f(b) - f(a))) (real_interval[a,b])`,
6624   REWRITE_TAC[has_real_integral; HAS_REAL_VECTOR_DERIVATIVE_WITHIN] THEN
6625   REPEAT GEN_TAC THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; LIFT_SUB] THEN
6626   REWRITE_TAC[REAL_INTERVAL_INTERVAL; FORALL_IN_IMAGE; LIFT_DROP] THEN
6627   GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o BINOP_CONV) [GSYM LIFT_DROP] THEN
6628   DISCH_THEN(MP_TAC o MATCH_MP FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN
6629   REWRITE_TAC[o_DEF; LIFT_DROP]);;
6630
6631 let REAL_INTEGRABLE_SUBINTERVAL = prove
6632  (`!f:real->real a b c d.
6633         f real_integrable_on real_interval[a,b] /\
6634         real_interval[c,d] SUBSET real_interval[a,b]
6635         ==> f real_integrable_on real_interval[c,d]`,
6636   REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL] THEN
6637   REWRITE_TAC[EXISTS_DROP; GSYM integrable_on; LIFT_DROP] THEN
6638   REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN
6639   MAP_EVERY EXISTS_TAC [`lift a`; `lift b`] THEN
6640   ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL] THEN
6641   ASM_SIMP_TAC[IMAGE_SUBSET]);;
6642
6643 let HAS_REAL_INTEGRAL_COMBINE = prove
6644  (`!f i j a b c.
6645         a <= c /\ c <= b /\
6646         (f has_real_integral i) (real_interval[a,c]) /\
6647         (f has_real_integral j) (real_interval[c,b])
6648         ==> (f has_real_integral (i + j)) (real_interval[a,b])`,
6649   REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_INTEGRAL; LIFT_ADD] THEN
6650   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMBINE THEN
6651   EXISTS_TAC `lift c` THEN ASM_REWRITE_TAC[LIFT_DROP]);;
6652
6653 let REAL_INTEGRAL_COMBINE = prove
6654  (`!f a b c.
6655         a <= c /\ c <= b /\ f real_integrable_on (real_interval[a,b])
6656         ==> real_integral(real_interval[a,c]) f +
6657             real_integral(real_interval[c,b]) f =
6658             real_integral(real_interval[a,b]) f`,
6659   REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
6660   MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN
6661   MATCH_MP_TAC HAS_REAL_INTEGRAL_COMBINE THEN
6662   EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN
6663   MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN
6664   MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN
6665   MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN
6666   ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL; REAL_LE_REFL]);;
6667
6668 let REAL_INTEGRABLE_COMBINE = prove
6669  (`!f a b c.
6670         a <= c /\ c <= b /\
6671         f real_integrable_on real_interval[a,c] /\
6672         f real_integrable_on real_interval[c,b]
6673         ==> f real_integrable_on real_interval[a,b]`,
6674   REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_COMBINE]);;
6675
6676 let REAL_INTEGRABLE_ON_LITTLE_SUBINTERVALS = prove
6677  (`!f:real->real a b.
6678         (!x. x IN real_interval[a,b]
6679              ==> ?d. &0 < d /\
6680                      !u v. x IN real_interval[u,v] /\
6681                            (!y. y IN real_interval[u,v]
6682                                 ==> abs(y - x) < d /\ y IN real_interval[a,b])
6683                            ==> f real_integrable_on real_interval[u,v])
6684         ==> f real_integrable_on real_interval[a,b]`,
6685   REPEAT GEN_TAC THEN
6686   REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL; EXISTS_DROP;
6687               GSYM integrable_on; LIFT_DROP] THEN
6688   DISCH_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_LITTLE_SUBINTERVALS THEN
6689   REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; FORALL_IN_IMAGE] THEN
6690   X_GEN_TAC `x:real` THEN DISCH_TAC THEN
6691   FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[] THEN
6692   REWRITE_TAC[GSYM EXISTS_DROP; FORALL_LIFT] THEN
6693   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN
6694   REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN
6695   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
6696   CONJ_TAC THENL
6697    [ASM_MESON_TAC[IMAGE_LIFT_REAL_INTERVAL; LIFT_IN_IMAGE_LIFT];
6698     REWRITE_TAC[REAL_INTERVAL_INTERVAL; FORALL_IN_IMAGE] THEN
6699     X_GEN_TAC `y:real^1` THEN DISCH_TAC THEN
6700     REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `y:real^1` o REWRITE_RULE[SUBSET])) THEN
6701     ASM_SIMP_TAC[IN_BALL; FUN_IN_IMAGE; dist; NORM_REAL] THEN
6702     REWRITE_TAC[GSYM drop; DROP_SUB; LIFT_DROP] THEN SIMP_TAC[REAL_ABS_SUB]]);;
6703
6704 let REAL_INTEGRAL_HAS_REAL_DERIVATIVE = prove
6705  (`!f:real->real a b.
6706      (f real_continuous_on real_interval[a,b])
6707      ==> !x. x IN real_interval[a,b]
6708              ==> ((\u. real_integral(real_interval[a,u]) f)
6709                   has_real_derivative f(x))
6710                  (atreal x within real_interval[a,b])`,
6711   REPEAT GEN_TAC THEN
6712   REWRITE_TAC[REAL_CONTINUOUS_ON; IMAGE_LIFT_REAL_INTERVAL] THEN
6713   DISCH_TAC THEN
6714   FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRAL_HAS_VECTOR_DERIVATIVE) THEN
6715   REWRITE_TAC[HAS_REAL_VECTOR_DERIVATIVE_WITHIN] THEN
6716   REWRITE_TAC[REAL_INTERVAL_INTERVAL; FORALL_IN_IMAGE] THEN
6717   REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP] THEN
6718   DISCH_TAC THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN
6719   FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN
6720   ASM_REWRITE_TAC[SET_RULE `IMAGE (\x. x) s = s`] THEN
6721   MATCH_MP_TAC(REWRITE_RULE[TAUT
6722     `a /\ b /\ c /\ d ==> e <=> a /\ b /\ c ==> d ==> e`]
6723      HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN) THEN
6724   EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_LT_01] THEN
6725   X_GEN_TAC `y:real^1` THEN STRIP_TAC THEN
6726   ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN
6727   REWRITE_TAC[LIFT_DROP] THEN CONV_TAC SYM_CONV THEN
6728   REWRITE_TAC[INTERVAL_REAL_INTERVAL; GSYM IMAGE_o; LIFT_DROP; o_DEF] THEN
6729   REWRITE_TAC[GSYM o_DEF; SET_RULE `IMAGE (\x. x) s = s`] THEN
6730   MATCH_MP_TAC REAL_INTEGRAL THEN
6731   MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN
6732   MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN CONJ_TAC THENL
6733    [REWRITE_TAC[REAL_INTEGRABLE_ON; IMAGE_LIFT_REAL_INTERVAL] THEN
6734     MATCH_MP_TAC INTEGRABLE_CONTINUOUS THEN ASM_REWRITE_TAC[];
6735     ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN
6736     REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN
6737     REWRITE_TAC[LIFT_DROP] THEN REAL_ARITH_TAC]);;
6738
6739 let REAL_ANTIDERIVATIVE_CONTINUOUS = prove
6740  (`!f a b.
6741      (f real_continuous_on real_interval[a,b])
6742      ==> ?g. !x. x IN real_interval[a,b]
6743                  ==> (g has_real_derivative f(x))
6744                      (atreal x within real_interval[a,b])`,
6745   MESON_TAC[REAL_INTEGRAL_HAS_REAL_DERIVATIVE]);;
6746
6747 let REAL_ANTIDERIVATIVE_INTEGRAL_CONTINUOUS = prove
6748  (`!f a b.
6749      (f real_continuous_on real_interval[a,b])
6750      ==> ?g. !u v. u IN real_interval[a,b] /\
6751                    v IN real_interval[a,b] /\ u <= v
6752                    ==> (f has_real_integral (g(v) - g(u)))
6753                        (real_interval[u,v])`,
6754   REPEAT STRIP_TAC THEN
6755   FIRST_ASSUM(MP_TAC o MATCH_MP REAL_ANTIDERIVATIVE_CONTINUOUS) THEN
6756   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real->real` THEN
6757   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS THEN
6758   ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real` THEN
6759   STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN
6760   EXISTS_TAC `real_interval[a:real,b]` THEN CONJ_TAC THENL
6761    [FIRST_X_ASSUM MATCH_MP_TAC; ALL_TAC] THEN
6762   REPEAT(POP_ASSUM MP_TAC) THEN
6763   REWRITE_TAC[SUBSET_REAL_INTERVAL; IN_REAL_INTERVAL] THEN REAL_ARITH_TAC);;
6764
6765 let HAS_REAL_INTEGRAL_AFFINITY = prove
6766  (`!f:real->real i a b m c.
6767         (f has_real_integral i) (real_interval[a,b]) /\ ~(m = &0)
6768         ==> ((\x. f(m * x + c)) has_real_integral (inv(abs(m)) * i))
6769             (IMAGE (\x. inv m * (x - c)) (real_interval[a,b]))`,
6770   REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_INTEGRAL] THEN
6771   DISCH_THEN(MP_TAC o SPEC `lift c` o MATCH_MP HAS_INTEGRAL_AFFINITY) THEN
6772   REWRITE_TAC[DIMINDEX_1; REAL_POW_1; has_real_integral] THEN
6773   REWRITE_TAC[o_DEF; DROP_ADD; DROP_CMUL; LIFT_DROP; LIFT_CMUL] THEN
6774   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
6775   REWRITE_TAC[INTERVAL_REAL_INTERVAL; GSYM IMAGE_o; LIFT_DROP] THEN
6776   AP_THM_TAC THEN AP_TERM_TAC THEN
6777   REWRITE_TAC[FUN_EQ_THM; o_DEF; LIFT_CMUL; LIFT_SUB] THEN VECTOR_ARITH_TAC);;
6778
6779 let REAL_INTEGRABLE_AFFINITY = prove
6780  (`!f a b m c.
6781         f real_integrable_on real_interval[a,b] /\ ~(m = &0)
6782         ==> (\x. f(m * x + c)) real_integrable_on
6783             (IMAGE (\x. inv m * (x - c)) (real_interval[a,b]))`,
6784   REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_AFFINITY]);;
6785
6786 let HAS_REAL_INTEGRAL_STRETCH = prove
6787  (`!f:real->real i a b m.
6788         (f has_real_integral i) (real_interval[a,b]) /\ ~(m = &0)
6789         ==> ((\x. f(m * x)) has_real_integral (inv(abs(m)) * i))
6790             (IMAGE (\x. inv m * x) (real_interval[a,b]))`,
6791   MP_TAC HAS_REAL_INTEGRAL_AFFINITY THEN
6792   REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
6793   DISCH_THEN(MP_TAC o SPEC `&0`) THEN
6794   REWRITE_TAC[REAL_ADD_RID; REAL_SUB_RZERO]);;
6795
6796 let REAL_INTEGRABLE_STRETCH = prove
6797  (`!f a b m.
6798         f real_integrable_on real_interval[a,b] /\ ~(m = &0)
6799         ==> (\x. f(m * x)) real_integrable_on
6800             (IMAGE (\x. inv m * x) (real_interval[a,b]))`,
6801   REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_STRETCH]);;
6802
6803 let HAS_REAL_INTEGRAL_REFLECT_LEMMA = prove
6804  (`!f:real->real i a b.
6805      (f has_real_integral i) (real_interval[a,b])
6806      ==> ((\x. f(--x)) has_real_integral i) (real_interval[--b,--a])`,
6807   REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_INTEGRAL] THEN
6808   DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_REFLECT_LEMMA) THEN
6809   REWRITE_TAC[LIFT_NEG; o_DEF; DROP_NEG]);;
6810
6811 let HAS_REAL_INTEGRAL_REFLECT = prove
6812  (`!f:real->real i a b.
6813      ((\x. f(--x)) has_real_integral i) (real_interval[--b,--a]) <=>
6814      (f has_real_integral i) (real_interval[a,b])`,
6815   REPEAT GEN_TAC THEN EQ_TAC THEN
6816   DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_INTEGRAL_REFLECT_LEMMA) THEN
6817   REWRITE_TAC[REAL_NEG_NEG; ETA_AX]);;
6818
6819 let REAL_INTEGRABLE_REFLECT = prove
6820  (`!f:real->real a b.
6821      (\x. f(--x)) real_integrable_on (real_interval[--b,--a]) <=>
6822      f real_integrable_on (real_interval[a,b])`,
6823   REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL_REFLECT]);;
6824
6825 let REAL_INTEGRAL_REFLECT = prove
6826  (`!f:real->real a b.
6827      real_integral (real_interval[--b,--a]) (\x. f(--x)) =
6828      real_integral (real_interval[a,b]) f`,
6829   REWRITE_TAC[real_integral; HAS_REAL_INTEGRAL_REFLECT]);;
6830
6831 let REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR = prove
6832  (`!f:real->real f' a b.
6833         a <= b /\ f real_continuous_on real_interval[a,b] /\
6834         (!x. x IN real_interval(a,b)
6835              ==> (f has_real_derivative f'(x)) (atreal x))
6836         ==> (f' has_real_integral (f(b) - f(a))) (real_interval[a,b])`,
6837   REWRITE_TAC[has_real_integral; HAS_REAL_VECTOR_DERIVATIVE_AT] THEN
6838   REPEAT GEN_TAC THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; LIFT_SUB] THEN
6839   REWRITE_TAC[REAL_INTERVAL_INTERVAL; FORALL_IN_IMAGE; LIFT_DROP] THEN
6840   GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o BINOP_CONV) [GSYM LIFT_DROP] THEN
6841   REWRITE_TAC[REAL_CONTINUOUS_ON; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN
6842   DISCH_THEN(MP_TAC o MATCH_MP FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR) THEN
6843   REWRITE_TAC[o_DEF; LIFT_DROP]);;
6844
6845 let REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG = prove
6846  (`!f f' s a b.
6847         COUNTABLE s /\
6848         a <= b /\ f real_continuous_on real_interval[a,b] /\
6849         (!x. x IN real_interval(a,b) DIFF s
6850              ==> (f has_real_derivative f'(x)) (atreal x))
6851         ==> (f' has_real_integral (f(b) - f(a))) (real_interval[a,b])`,
6852   REWRITE_TAC[has_real_integral; HAS_REAL_VECTOR_DERIVATIVE_AT] THEN
6853   REPEAT GEN_TAC THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; LIFT_SUB] THEN
6854   REWRITE_TAC[REAL_INTERVAL_INTERVAL; FORALL_IN_IMAGE; IMP_CONJ; IN_DIFF] THEN
6855   SUBGOAL_THEN `!x. drop x IN s <=> x IN IMAGE lift s`
6856     (fun th -> REWRITE_TAC[th]) THENL [SET_TAC[LIFT_DROP]; ALL_TAC] THEN
6857   SUBGOAL_THEN `COUNTABLE s <=> COUNTABLE(IMAGE lift s)` SUBST1_TAC THENL
6858    [EQ_TAC THEN SIMP_TAC[COUNTABLE_IMAGE] THEN
6859     DISCH_THEN(MP_TAC o ISPEC `drop` o MATCH_MP COUNTABLE_IMAGE) THEN
6860     REWRITE_TAC[GSYM IMAGE_o; IMAGE_LIFT_DROP];
6861     ALL_TAC] THEN
6862   REWRITE_TAC[IMP_IMP; GSYM IN_DIFF; GSYM CONJ_ASSOC] THEN
6863   REWRITE_TAC[REAL_CONTINUOUS_ON; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN
6864   REWRITE_TAC[LIFT_DROP] THEN
6865   GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV o BINOP_CONV)
6866    [GSYM LIFT_DROP] THEN
6867   DISCH_THEN(MP_TAC o
6868     MATCH_MP FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG) THEN
6869   REWRITE_TAC[o_DEF; LIFT_DROP]);;
6870
6871 let REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG = prove
6872  (`!f f' s a b.
6873         COUNTABLE s /\
6874         a <= b /\ f real_continuous_on real_interval[a,b] /\
6875         (!x. x IN real_interval[a,b] DIFF s
6876              ==> (f has_real_derivative f'(x)) (atreal x))
6877         ==> (f' has_real_integral (f(b) - f(a))) (real_interval[a,b])`,
6878   REPEAT STRIP_TAC THEN
6879   MATCH_MP_TAC REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG THEN
6880   EXISTS_TAC `s:real->bool` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN
6881   DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN
6882   SIMP_TAC[IN_REAL_INTERVAL; IN_DIFF] THEN REAL_ARITH_TAC);;
6883
6884 let REAL_INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT = prove
6885  (`!f:real->real a b.
6886         f real_integrable_on real_interval[a,b]
6887         ==> (\x. real_integral (real_interval[a,x]) f)
6888             real_continuous_on real_interval[a,b]`,
6889   REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_ON] THEN
6890   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_INTEGRABLE_ON]) THEN
6891   REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN
6892   DISCH_THEN(MP_TAC o MATCH_MP INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT) THEN
6893   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_EQ) THEN
6894   GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[o_DEF] THEN
6895   GEN_REWRITE_TAC I [GSYM DROP_EQ] THEN
6896   REWRITE_TAC[INTERVAL_REAL_INTERVAL; LIFT_DROP; GSYM o_DEF] THEN
6897   CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL THEN
6898   MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN
6899   MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN
6900   ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN
6901   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
6902   REWRITE_TAC[LIFT_DROP] THEN REAL_ARITH_TAC);;
6903
6904 let REAL_INDEFINITE_INTEGRAL_CONTINUOUS_LEFT = prove
6905  (`!f:real->real a b.
6906         f real_integrable_on real_interval[a,b]
6907         ==> (\x. real_integral (real_interval[x,b]) f)
6908             real_continuous_on real_interval[a,b]`,
6909   REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_ON] THEN
6910   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_INTEGRABLE_ON]) THEN
6911   REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN
6912   DISCH_THEN(MP_TAC o MATCH_MP INDEFINITE_INTEGRAL_CONTINUOUS_LEFT) THEN
6913   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_EQ) THEN
6914   GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[o_DEF] THEN
6915   GEN_REWRITE_TAC I [GSYM DROP_EQ] THEN
6916   REWRITE_TAC[INTERVAL_REAL_INTERVAL; LIFT_DROP; GSYM o_DEF] THEN
6917   CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL THEN
6918   MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN
6919   MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN
6920   ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN
6921   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN
6922   REWRITE_TAC[LIFT_DROP] THEN REAL_ARITH_TAC);;
6923
6924 let HAS_REAL_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL = prove
6925  (`!f:real->real a b k y.
6926         COUNTABLE k /\ f real_continuous_on real_interval[a,b] /\ f a = y /\
6927         (!x. x IN (real_interval[a,b] DIFF k)
6928              ==> (f has_real_derivative &0)
6929                  (atreal x within real_interval[a,b]))
6930         ==> !x. x IN real_interval[a,b] ==> f x = y`,
6931   REWRITE_TAC[has_real_integral; HAS_REAL_VECTOR_DERIVATIVE_WITHIN] THEN
6932   REPEAT GEN_TAC THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; LIFT_SUB] THEN
6933   REWRITE_TAC[REAL_INTERVAL_INTERVAL; FORALL_IN_IMAGE; IMP_CONJ; IN_DIFF] THEN
6934   REWRITE_TAC[REAL_CONTINUOUS_ON; IMP_IMP; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN
6935   REWRITE_TAC[GSYM IMP_CONJ; LIFT_DROP; has_vector_derivative] THEN
6936   REWRITE_TAC[LIFT_NUM; VECTOR_MUL_RZERO] THEN STRIP_TAC THEN
6937   MP_TAC(ISPECL
6938    [`lift o f o drop`; `lift a`; `lift b`; `IMAGE lift k`; `lift y`]
6939    HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL) THEN
6940   ASM_SIMP_TAC[COUNTABLE_IMAGE; o_THM; LIFT_DROP; LIFT_EQ; IN_DIFF] THEN
6941   DISCH_THEN MATCH_MP_TAC THEN REPEAT STRIP_TAC THEN
6942   FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[LIFT_DROP]);;
6943
6944 let HAS_REAL_DERIVATIVE_ZERO_UNIQUE_STRONG_CONVEX = prove
6945  (`!f:real->real s k c y.
6946       is_realinterval s /\ COUNTABLE k /\ f real_continuous_on s /\
6947       c IN s /\ f c = y /\
6948       (!x. x IN (s DIFF k) ==> (f has_real_derivative &0) (atreal x within s))
6949       ==> !x. x IN s ==> f x = y`,
6950   REWRITE_TAC[has_real_integral; HAS_REAL_VECTOR_DERIVATIVE_WITHIN] THEN
6951   REWRITE_TAC[IS_REALINTERVAL_CONVEX; REAL_CONTINUOUS_ON] THEN
6952   REPEAT GEN_TAC THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; LIFT_SUB] THEN
6953   REWRITE_TAC[REAL_INTERVAL_INTERVAL; FORALL_IN_IMAGE; IMP_CONJ; IN_DIFF] THEN
6954   REWRITE_TAC[REAL_CONTINUOUS_ON; IMP_IMP; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN
6955   REWRITE_TAC[GSYM IMP_CONJ; LIFT_DROP; has_vector_derivative] THEN
6956   REWRITE_TAC[LIFT_NUM; VECTOR_MUL_RZERO] THEN STRIP_TAC THEN
6957   MP_TAC(ISPECL
6958    [`lift o f o drop`; `IMAGE lift s`; `IMAGE lift k`; `lift c`; `lift y`]
6959    HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONVEX) THEN
6960   ASM_SIMP_TAC[COUNTABLE_IMAGE; o_THM; LIFT_DROP; LIFT_EQ; IN_DIFF] THEN
6961   ASM_REWRITE_TAC[LIFT_IN_IMAGE_LIFT; FORALL_IN_IMAGE; LIFT_DROP] THEN
6962   ASM_SIMP_TAC[IMP_CONJ; FORALL_IN_IMAGE; LIFT_IN_IMAGE_LIFT]);;
6963
6964 let HAS_REAL_DERIVATIVE_INDEFINITE_INTEGRAL = prove
6965  (`!f a b.
6966         f real_integrable_on real_interval[a,b]
6967         ==> ?k. real_negligible k /\
6968                 !x. x IN real_interval[a,b] DIFF k
6969                     ==> ((\x. real_integral(real_interval[a,x]) f)
6970                          has_real_derivative
6971                          f(x)) (atreal x within real_interval[a,b])`,
6972   REPEAT STRIP_TAC THEN
6973   MP_TAC(ISPECL [`lift o f o drop`; `lift a`; `lift b`]
6974         HAS_VECTOR_DERIVATIVE_INDEFINITE_INTEGRAL) THEN
6975   ASM_REWRITE_TAC[GSYM REAL_INTEGRABLE_ON; GSYM IMAGE_LIFT_REAL_INTERVAL] THEN
6976   REWRITE_TAC[IN_DIFF; FORALL_IN_IMAGE; IMP_CONJ] THEN
6977   DISCH_THEN(X_CHOOSE_THEN `k:real^1->bool` STRIP_ASSUME_TAC) THEN
6978   EXISTS_TAC `IMAGE drop k` THEN
6979   ASM_REWRITE_TAC[real_negligible; HAS_REAL_VECTOR_DERIVATIVE_WITHIN] THEN
6980   ASM_REWRITE_TAC[GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN
6981   REWRITE_TAC[IN_IMAGE; GSYM LIFT_EQ; LIFT_DROP; UNWIND_THM1] THEN
6982   X_GEN_TAC `x:real` THEN REPEAT DISCH_TAC THEN
6983   FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[] THEN
6984   REWRITE_TAC[o_THM; LIFT_DROP] THEN MATCH_MP_TAC(REWRITE_RULE
6985    [TAUT `a /\ b /\ c /\ d ==> e <=> a /\ b /\ c ==> d ==> e`]
6986         HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN) THEN
6987   EXISTS_TAC `&1` THEN ASM_SIMP_TAC[FUN_IN_IMAGE; REAL_LT_01] THEN
6988   REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE] THEN
6989   X_GEN_TAC `y:real` THEN REPEAT DISCH_TAC THEN
6990   REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP; o_THM] THEN
6991   REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL] THEN CONV_TAC SYM_CONV THEN
6992   MATCH_MP_TAC REAL_INTEGRAL THEN
6993   MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN
6994   MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN
6995   ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN
6996   RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN
6997   ASM_REAL_ARITH_TAC);;
6998
6999 let HAS_REAL_INTEGRAL_RESTRICT = prove
7000  (`!f:real->real s t.
7001         s SUBSET t
7002         ==> (((\x. if x IN s then f x else &0) has_real_integral i) t <=>
7003              (f has_real_integral i) s)`,
7004   REPEAT STRIP_TAC THEN REWRITE_TAC[has_real_integral; o_DEF] THEN
7005   MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`; `IMAGE lift t`; `lift i`]
7006         HAS_INTEGRAL_RESTRICT) THEN
7007   ASM_SIMP_TAC[IMAGE_SUBSET; IN_IMAGE_LIFT_DROP; o_DEF] THEN
7008   DISCH_THEN(SUBST1_TAC o SYM) THEN
7009   ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[LIFT_NUM]);;
7010
7011 let HAS_REAL_INTEGRAL_RESTRICT_UNIV = prove
7012  (`!f:real->real s i.
7013         ((\x. if x IN s then f x else &0) has_real_integral i) (:real) <=>
7014          (f has_real_integral i) s`,
7015   SIMP_TAC[HAS_REAL_INTEGRAL_RESTRICT; SUBSET_UNIV]);;
7016
7017 let HAS_REAL_INTEGRAL_SPIKE_SET_EQ = prove
7018  (`!f s t y.
7019         real_negligible(s DIFF t UNION t DIFF s)
7020         ==> ((f has_real_integral y) s <=> (f has_real_integral y) t)`,
7021   REPEAT STRIP_TAC THEN
7022   ONCE_REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN
7023   MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE_EQ THEN
7024   EXISTS_TAC `s DIFF t UNION t DIFF s:real->bool` THEN
7025   ASM_REWRITE_TAC[] THEN SET_TAC[]);;
7026
7027 let HAS_REAL_INTEGRAL_SPIKE_SET = prove
7028  (`!f s t y.
7029         real_negligible(s DIFF t UNION t DIFF s) /\
7030         (f has_real_integral y) s
7031         ==> (f has_real_integral y) t`,
7032   MESON_TAC[HAS_REAL_INTEGRAL_SPIKE_SET_EQ]);;
7033
7034 let REAL_INTEGRABLE_SPIKE_SET = prove
7035  (`!f s t.
7036         real_negligible(s DIFF t UNION t DIFF s)
7037         ==> f real_integrable_on s ==> f real_integrable_on t`,
7038   REWRITE_TAC[real_integrable_on] THEN
7039   MESON_TAC[HAS_REAL_INTEGRAL_SPIKE_SET_EQ]);;
7040
7041 let REAL_INTEGRABLE_SPIKE_SET_EQ = prove
7042  (`!f s t.
7043         real_negligible(s DIFF t UNION t DIFF s)
7044         ==> (f real_integrable_on s <=> f real_integrable_on t)`,
7045   MESON_TAC[REAL_INTEGRABLE_SPIKE_SET; UNION_COMM]);;
7046
7047 let REAL_INTEGRAL_SPIKE_SET = prove
7048  (`!f s t.
7049         real_negligible(s DIFF t UNION t DIFF s)
7050         ==> real_integral s f = real_integral t f`,
7051   REPEAT STRIP_TAC THEN REWRITE_TAC[real_integral] THEN
7052   AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE_SET_EQ THEN
7053   ASM_MESON_TAC[]);;
7054
7055 let HAS_REAL_INTEGRAL_OPEN_INTERVAL = prove
7056  (`!f a b y. (f has_real_integral y) (real_interval(a,b)) <=>
7057              (f has_real_integral y) (real_interval[a,b])`,
7058   REWRITE_TAC[has_real_integral; IMAGE_LIFT_REAL_INTERVAL] THEN
7059   REWRITE_TAC[HAS_INTEGRAL_OPEN_INTERVAL]);;
7060
7061 let REAL_INTEGRABLE_ON_OPEN_INTERVAL = prove
7062  (`!f a b. f real_integrable_on real_interval(a,b) <=>
7063            f real_integrable_on real_interval[a,b]`,
7064   REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL_OPEN_INTERVAL]);;
7065
7066 let REAL_INTEGRAL_OPEN_INTERVAL = prove
7067  (`!f a b. real_integral(real_interval(a,b)) f =
7068            real_integral(real_interval[a,b]) f`,
7069   REWRITE_TAC[real_integral; HAS_REAL_INTEGRAL_OPEN_INTERVAL]);;
7070
7071 let HAS_REAL_INTEGRAL_ON_SUPERSET = prove
7072  (`!f s t.
7073         (!x. ~(x IN s) ==> f x = &0) /\ s SUBSET t /\ (f has_real_integral i) s
7074         ==> (f has_real_integral i) t`,
7075   REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET] THEN
7076   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
7077   ONCE_REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN
7078   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN
7079   AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[]);;
7080
7081 let REAL_INTEGRABLE_ON_SUPERSET = prove
7082  (`!f s t.
7083         (!x. ~(x IN s) ==> f x = &0) /\ s SUBSET t /\ f real_integrable_on s
7084         ==> f real_integrable_on t`,
7085   REWRITE_TAC[real_integrable_on] THEN
7086   MESON_TAC[HAS_REAL_INTEGRAL_ON_SUPERSET]);;
7087
7088 let REAL_INTEGRABLE_RESTRICT_UNIV = prove
7089  (`!f s. (\x. if x IN s then f x else &0) real_integrable_on (:real) <=>
7090          f real_integrable_on s`,
7091   REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL_RESTRICT_UNIV]);;
7092
7093 let REAL_INTEGRAL_RESTRICT_UNIV = prove
7094  (`!f s.
7095      real_integral (:real) (\x. if x IN s then f x else &0) =
7096      real_integral s f`,
7097   REWRITE_TAC[real_integral; HAS_REAL_INTEGRAL_RESTRICT_UNIV]);;
7098
7099 let REAL_INTEGRAL_RESTRICT = prove
7100  (`!f s t.
7101         s SUBSET t
7102         ==> real_integral t (\x. if x IN s then f x else &0) =
7103             real_integral s f`,
7104   SIMP_TAC[real_integral; HAS_REAL_INTEGRAL_RESTRICT]);;
7105
7106 let HAS_REAL_INTEGRAL_RESTRICT_INTER = prove
7107  (`!f s t.
7108         ((\x. if x IN s then f x else &0) has_real_integral i) t <=>
7109         (f has_real_integral i) (s INTER t)`,
7110   REPEAT GEN_TAC THEN
7111   ONCE_REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN
7112   REWRITE_TAC[IN_INTER] THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
7113   REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[]);;
7114
7115 let REAL_INTEGRAL_RESTRICT_INTER = prove
7116  (`!f s t.
7117         real_integral t (\x. if x IN s then f x else &0) =
7118         real_integral (s INTER t) f`,
7119   REWRITE_TAC[real_integral; HAS_REAL_INTEGRAL_RESTRICT_INTER]);;
7120
7121 let REAL_INTEGRABLE_RESTRICT_INTER = prove
7122  (`!f s t.
7123         (\x. if x IN s then f x else &0) real_integrable_on t <=>
7124         f real_integrable_on (s INTER t)`,
7125   REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL_RESTRICT_INTER]);;
7126
7127 let REAL_NEGLIGIBLE_ON_INTERVALS = prove
7128  (`!s. real_negligible s <=>
7129          !a b:real. real_negligible(s INTER real_interval[a,b])`,
7130   GEN_TAC THEN REWRITE_TAC[real_negligible] THEN
7131   GEN_REWRITE_TAC LAND_CONV [NEGLIGIBLE_ON_INTERVALS] THEN
7132   REWRITE_TAC[FORALL_LIFT; GSYM IMAGE_LIFT_REAL_INTERVAL] THEN
7133   REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN AP_TERM_TAC THEN SET_TAC[LIFT_DROP]);;
7134
7135 let HAS_REAL_INTEGRAL_SUBSET_LE = prove
7136  (`!f:real->real s t i j.
7137         s SUBSET t /\ (f has_real_integral i) s /\ (f has_real_integral j) t /\
7138         (!x. x IN t ==> &0 <= f x)
7139         ==> i <= j`,
7140   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_LE THEN
7141   MAP_EVERY EXISTS_TAC
7142    [`\x:real. if x IN s then f(x) else &0`;
7143     `\x:real. if x IN t then f(x) else &0`; `(:real)`] THEN
7144   ASM_REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV; IN_UNIV] THEN
7145   X_GEN_TAC `x:real` THEN
7146   REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_REFL]) THEN
7147   ASM SET_TAC[]);;
7148
7149 let REAL_INTEGRAL_SUBSET_LE = prove
7150  (`!f:real->real s t.
7151         s SUBSET t /\ f real_integrable_on s /\ f real_integrable_on t /\
7152         (!x. x IN t ==> &0 <= f(x))
7153         ==> real_integral s f <= real_integral t f`,
7154   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_SUBSET_LE THEN
7155   ASM_MESON_TAC[REAL_INTEGRABLE_INTEGRAL]);;
7156
7157 let REAL_INTEGRABLE_ON_SUBINTERVAL = prove
7158  (`!f:real->real s a b.
7159         f real_integrable_on s /\ real_interval[a,b] SUBSET s
7160         ==> f real_integrable_on real_interval[a,b]`,
7161   REWRITE_TAC[REAL_INTEGRABLE_ON; IMAGE_LIFT_REAL_INTERVAL] THEN
7162   REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN
7163   EXISTS_TAC `IMAGE lift s` THEN ASM_REWRITE_TAC[] THEN
7164   REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL] THEN
7165   ASM_SIMP_TAC[IMAGE_SUBSET]);;
7166
7167 let REAL_INTEGRABLE_STRADDLE = prove
7168  (`!f s.
7169         (!e. &0 < e
7170              ==> ?g h i j. (g has_real_integral i) s /\
7171                            (h has_real_integral j) s /\
7172                            abs(i - j) < e /\
7173                            !x. x IN s ==> g x <= f x /\ f x <= h x)
7174         ==> f real_integrable_on s`,
7175   REWRITE_TAC[REAL_INTEGRABLE_ON; has_real_integral] THEN
7176   REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_STRADDLE THEN
7177   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
7178   FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
7179   REWRITE_TAC[EXISTS_DROP; FORALL_IN_IMAGE] THEN
7180   SIMP_TAC[LEFT_IMP_EXISTS_THM; GSYM DROP_SUB; LIFT_DROP; GSYM ABS_DROP] THEN
7181   MAP_EVERY X_GEN_TAC
7182    [`g:real->real`; `h:real->real`; `i:real^1`; `j:real^1`] THEN
7183   STRIP_TAC THEN MAP_EVERY EXISTS_TAC
7184    [`lift o g o drop`; `lift o h o drop`; `i:real^1`; `j:real^1`] THEN
7185   ASM_REWRITE_TAC[o_THM; LIFT_DROP]);;
7186
7187 let HAS_REAL_INTEGRAL_STRADDLE_NULL = prove
7188  (`!f g s. (!x. x IN s ==> &0 <= f x /\ f x <= g x) /\
7189            (g has_real_integral &0) s
7190            ==> (f has_real_integral &0) s`,
7191   REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN
7192   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
7193    [MATCH_MP_TAC REAL_INTEGRABLE_STRADDLE THEN
7194     GEN_TAC THEN DISCH_TAC THEN
7195     MAP_EVERY EXISTS_TAC
7196      [`(\x. &0):real->real`; `g:real->real`;
7197       `&0:real`; `&0:real`] THEN
7198     ASM_REWRITE_TAC[HAS_REAL_INTEGRAL_0; REAL_SUB_REFL; REAL_ABS_NUM];
7199     DISCH_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL
7200      [MATCH_MP_TAC(ISPECL [`f:real->real`; `g:real->real`]
7201         HAS_REAL_INTEGRAL_LE);
7202       MATCH_MP_TAC(ISPECL [`(\x. &0):real->real`; `f:real->real`]
7203         HAS_REAL_INTEGRAL_LE)] THEN
7204     EXISTS_TAC `s:real->bool` THEN
7205     ASM_SIMP_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL; HAS_REAL_INTEGRAL_0]]);;
7206
7207 let HAS_REAL_INTEGRAL_UNION = prove
7208  (`!f i j s t.
7209         (f has_real_integral i) s /\ (f has_real_integral j) t /\
7210         real_negligible(s INTER t)
7211         ==> (f has_real_integral (i + j)) (s UNION t)`,
7212   REPEAT GEN_TAC THEN
7213   REWRITE_TAC[has_real_integral; real_negligible; LIFT_ADD; IMAGE_UNION] THEN
7214   DISCH_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_UNION THEN POP_ASSUM MP_TAC THEN
7215   REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN REWRITE_TAC[] THEN
7216   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[LIFT_DROP]);;
7217
7218 let HAS_REAL_INTEGRAL_UNIONS = prove
7219  (`!f:real->real i t.
7220         FINITE t /\
7221         (!s. s IN t ==> (f has_real_integral (i s)) s) /\
7222         (!s s'. s IN t /\ s' IN t /\ ~(s = s') ==> real_negligible(s INTER s'))
7223         ==> (f has_real_integral (sum t i)) (UNIONS t)`,
7224   REPEAT GEN_TAC THEN
7225   REWRITE_TAC[has_real_integral; real_negligible; LIFT_ADD; IMAGE_UNIONS] THEN
7226   SIMP_TAC[LIFT_SUM] THEN DISCH_TAC THEN
7227   MP_TAC(ISPECL [`lift o f o drop`; `\s. lift(i(IMAGE drop s))`;
7228                  `IMAGE (IMAGE lift) t`]
7229     HAS_INTEGRAL_UNIONS) THEN
7230   ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM;
7231                IMAGE_LIFT_DROP; GSYM IMAGE_o] THEN
7232   ASM_SIMP_TAC[LIFT_EQ; SET_RULE
7233    `(!x y. f x = f y <=> x = y)
7234     ==> (IMAGE f s = IMAGE f t <=> s = t) /\
7235         (IMAGE f s INTER IMAGE f t = IMAGE f (s INTER t))`] THEN
7236   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
7237   W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhand o snd) THEN
7238   ANTS_TAC THENL [ASM SET_TAC[LIFT_DROP]; ALL_TAC] THEN
7239   DISCH_THEN SUBST1_TAC THEN
7240   REWRITE_TAC[o_DEF; GSYM IMAGE_o; IMAGE_LIFT_DROP]);;
7241
7242 let REAL_MONOTONE_CONVERGENCE_INCREASING = prove
7243  (`!f:num->real->real g s.
7244         (!k. (f k) real_integrable_on s) /\
7245         (!k x. x IN s ==> f k x <= f (SUC k) x) /\
7246         (!x. x IN s ==> ((\k. f k x) ---> g x) sequentially) /\
7247         real_bounded {real_integral s (f k) | k IN (:num)}
7248         ==> g real_integrable_on s /\
7249             ((\k. real_integral s (f k)) ---> real_integral s g) sequentially`,
7250   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_ON; TENDSTO_REAL] THEN
7251   REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN
7252   MP_TAC(ISPECL [`\n x. lift(f (n:num) (drop x))`;
7253                  `lift o g o drop`;  `IMAGE lift s`]
7254                 MONOTONE_CONVERGENCE_INCREASING) THEN
7255   ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_DEF] THEN
7256   SUBGOAL_THEN
7257    `!k:num. real_integral s (f k) =
7258             drop(integral (IMAGE lift s) (lift o f k o drop))`
7259    (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN REWRITE_TAC[th])
7260   THENL
7261    [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL THEN
7262     ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF];
7263     ALL_TAC] THEN
7264   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_bounded]) THEN
7265   REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; GSYM ABS_DROP] THEN
7266   DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN ANTS_TAC THENL
7267    [REWRITE_TAC[bounded] THEN EXISTS_TAC `B:real` THEN
7268     RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN
7269     ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV];
7270     ALL_TAC] THEN
7271   REWRITE_TAC[o_DEF; LIFT_DROP] THEN
7272   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN
7273   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
7274   ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN REWRITE_TAC[LIFT_DROP] THEN
7275   CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM o_DEF] THEN
7276   MATCH_MP_TAC REAL_INTEGRAL THEN ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]);;
7277
7278 let REAL_MONOTONE_CONVERGENCE_DECREASING = prove
7279  (`!f:num->real->real g s.
7280         (!k. (f k) real_integrable_on s) /\
7281         (!k x. x IN s ==> f (SUC k) x <= f k x) /\
7282         (!x. x IN s ==> ((\k. f k x) ---> g x) sequentially) /\
7283         real_bounded {real_integral s (f k) | k IN (:num)}
7284         ==> g real_integrable_on s /\
7285             ((\k. real_integral s (f k)) ---> real_integral s g) sequentially`,
7286   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_ON; TENDSTO_REAL] THEN
7287   REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN
7288   MP_TAC(ISPECL [`\n x. lift(f (n:num) (drop x))`;
7289                  `lift o g o drop`;  `IMAGE lift s`]
7290                 MONOTONE_CONVERGENCE_DECREASING) THEN
7291   ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_DEF] THEN
7292   SUBGOAL_THEN
7293    `!k:num. real_integral s (f k) =
7294             drop(integral (IMAGE lift s) (lift o f k o drop))`
7295    (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN REWRITE_TAC[th])
7296   THENL
7297    [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL THEN
7298     ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF];
7299     ALL_TAC] THEN
7300   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_bounded]) THEN
7301   REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; GSYM ABS_DROP] THEN
7302   DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN ANTS_TAC THENL
7303    [REWRITE_TAC[bounded] THEN EXISTS_TAC `B:real` THEN
7304     RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN
7305     ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV];
7306     ALL_TAC] THEN
7307   REWRITE_TAC[o_DEF; LIFT_DROP] THEN
7308   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN
7309   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
7310   ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN REWRITE_TAC[LIFT_DROP] THEN
7311   CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM o_DEF] THEN
7312   MATCH_MP_TAC REAL_INTEGRAL THEN ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]);;
7313
7314 let REAL_BEPPO_LEVI_INCREASING = prove
7315  (`!f s. (!k. (f k) real_integrable_on s) /\
7316          (!k x. x IN s ==> f k x <= f (SUC k) x) /\
7317          real_bounded {real_integral s (f k) | k IN (:num)}
7318          ==> ?g k. real_negligible k /\
7319                    !x. x IN (s DIFF k) ==> ((\k. f k x) ---> g x) sequentially`,
7320   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_ON; TENDSTO_REAL] THEN
7321   REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN
7322   MP_TAC(ISPECL [`\n x. lift(f (n:num) (drop x))`;
7323                  `IMAGE lift s`]
7324                 BEPPO_LEVI_INCREASING) THEN
7325   ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_DEF] THEN
7326   SUBGOAL_THEN
7327    `!k:num. real_integral s (f k) =
7328             drop(integral (IMAGE lift s) (lift o f k o drop))`
7329    (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN REWRITE_TAC[th])
7330   THENL
7331    [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL THEN
7332     ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF];
7333     ALL_TAC] THEN
7334   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_bounded]) THEN
7335   REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; GSYM ABS_DROP] THEN
7336   DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN ANTS_TAC THENL
7337    [REWRITE_TAC[bounded] THEN EXISTS_TAC `B:real` THEN
7338     RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN
7339     ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV];
7340     ALL_TAC] THEN
7341   REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_DIFF; IMP_CONJ; FORALL_IN_IMAGE] THEN
7342   MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `k:real^1->bool`] THEN
7343   REWRITE_TAC[IMP_IMP; LIFT_DROP] THEN STRIP_TAC THEN
7344   MAP_EVERY EXISTS_TAC [`drop o g o lift`; `IMAGE drop k`] THEN
7345   ASM_REWRITE_TAC[real_negligible; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN
7346   ASM_REWRITE_TAC[IN_IMAGE_LIFT_DROP; o_THM; LIFT_DROP]);;
7347
7348 let REAL_BEPPO_LEVI_DECREASING = prove
7349  (`!f s. (!k. (f k) real_integrable_on s) /\
7350          (!k x. x IN s ==> f (SUC k) x <= f k x) /\
7351          real_bounded {real_integral s (f k) | k IN (:num)}
7352          ==> ?g k. real_negligible k /\
7353                    !x. x IN (s DIFF k) ==> ((\k. f k x) ---> g x) sequentially`,
7354   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_ON; TENDSTO_REAL] THEN
7355   REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN
7356   MP_TAC(ISPECL [`\n x. lift(f (n:num) (drop x))`;
7357                  `IMAGE lift s`]
7358                 BEPPO_LEVI_DECREASING) THEN
7359   ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_DEF] THEN
7360   SUBGOAL_THEN
7361    `!k:num. real_integral s (f k) =
7362             drop(integral (IMAGE lift s) (lift o f k o drop))`
7363    (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN REWRITE_TAC[th])
7364   THENL
7365    [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL THEN
7366     ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF];
7367     ALL_TAC] THEN
7368   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_bounded]) THEN
7369   REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; GSYM ABS_DROP] THEN
7370   DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN ANTS_TAC THENL
7371    [REWRITE_TAC[bounded] THEN EXISTS_TAC `B:real` THEN
7372     RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN
7373     ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV];
7374     ALL_TAC] THEN
7375   REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_DIFF; IMP_CONJ; FORALL_IN_IMAGE] THEN
7376   MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `k:real^1->bool`] THEN
7377   REWRITE_TAC[IMP_IMP; LIFT_DROP] THEN STRIP_TAC THEN
7378   MAP_EVERY EXISTS_TAC [`drop o g o lift`; `IMAGE drop k`] THEN
7379   ASM_REWRITE_TAC[real_negligible; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN
7380   ASM_REWRITE_TAC[IN_IMAGE_LIFT_DROP; o_THM; LIFT_DROP]);;
7381
7382 let REAL_BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING = prove
7383  (`!f s.
7384      (!k. (f k) real_integrable_on s) /\
7385      (!k x. x IN s ==> f k x <= f (SUC k) x) /\
7386      real_bounded {real_integral s (f k) | k IN (:num)}
7387      ==> ?g k. real_negligible k /\
7388                (!x. x IN (s DIFF k) ==> ((\k. f k x) ---> g x) sequentially) /\
7389                g real_integrable_on s /\
7390                ((\k. real_integral s (f k)) ---> real_integral s g)
7391                sequentially`,
7392   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_ON; TENDSTO_REAL] THEN
7393   REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN
7394   MP_TAC(ISPECL [`\n x. lift(f (n:num) (drop x))`;
7395                  `IMAGE lift s`]
7396                 BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING) THEN
7397   ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_DEF] THEN
7398   SUBGOAL_THEN
7399    `!k:num. real_integral s (f k) =
7400             drop(integral (IMAGE lift s) (lift o f k o drop))`
7401    (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN REWRITE_TAC[th])
7402   THENL
7403    [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL THEN
7404     ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF];
7405     ALL_TAC] THEN
7406   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_bounded]) THEN
7407   REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; GSYM ABS_DROP] THEN
7408   DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN ANTS_TAC THENL
7409    [REWRITE_TAC[bounded] THEN EXISTS_TAC `B:real` THEN
7410     RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN
7411     ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV];
7412     ALL_TAC] THEN
7413   REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_DIFF; IMP_CONJ; FORALL_IN_IMAGE] THEN
7414   MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `k:real^1->bool`] THEN
7415   REWRITE_TAC[IMP_IMP; LIFT_DROP] THEN STRIP_TAC THEN
7416   MAP_EVERY EXISTS_TAC [`drop o g o lift`; `IMAGE drop k`] THEN
7417   ASM_REWRITE_TAC[real_negligible; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN
7418   ASM_REWRITE_TAC[IN_IMAGE_LIFT_DROP; o_THM; LIFT_DROP; ETA_AX] THEN
7419   SUBGOAL_THEN
7420    `real_integral s (drop o g o lift) =
7421             drop(integral (IMAGE lift s) (lift o (drop o g o lift) o drop))`
7422   SUBST1_TAC THENL
7423    [MATCH_MP_TAC REAL_INTEGRAL THEN
7424     ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF; LIFT_DROP; ETA_AX];
7425     ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]]);;
7426
7427 let REAL_BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING = prove
7428  (`!f s.
7429      (!k. (f k) real_integrable_on s) /\
7430      (!k x. x IN s ==> f (SUC k) x <= f k x) /\
7431      real_bounded {real_integral s (f k) | k IN (:num)}
7432      ==> ?g k. real_negligible k /\
7433                (!x. x IN (s DIFF k) ==> ((\k. f k x) ---> g x) sequentially) /\
7434                g real_integrable_on s /\
7435                ((\k. real_integral s (f k)) ---> real_integral s g)
7436                sequentially`,
7437   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_ON; TENDSTO_REAL] THEN
7438   REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN
7439   MP_TAC(ISPECL [`\n x. lift(f (n:num) (drop x))`;
7440                  `IMAGE lift s`]
7441                 BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING) THEN
7442   ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_DEF] THEN
7443   SUBGOAL_THEN
7444    `!k:num. real_integral s (f k) =
7445             drop(integral (IMAGE lift s) (lift o f k o drop))`
7446    (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN REWRITE_TAC[th])
7447   THENL
7448    [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL THEN
7449     ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF];
7450     ALL_TAC] THEN
7451   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_bounded]) THEN
7452   REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; GSYM ABS_DROP] THEN
7453   DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN ANTS_TAC THENL
7454    [REWRITE_TAC[bounded] THEN EXISTS_TAC `B:real` THEN
7455     RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN
7456     ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV];
7457     ALL_TAC] THEN
7458   REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_DIFF; IMP_CONJ; FORALL_IN_IMAGE] THEN
7459   MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `k:real^1->bool`] THEN
7460   REWRITE_TAC[IMP_IMP; LIFT_DROP] THEN STRIP_TAC THEN
7461   MAP_EVERY EXISTS_TAC [`drop o g o lift`; `IMAGE drop k`] THEN
7462   ASM_REWRITE_TAC[real_negligible; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN
7463   ASM_REWRITE_TAC[IN_IMAGE_LIFT_DROP; o_THM; LIFT_DROP; ETA_AX] THEN
7464   SUBGOAL_THEN
7465    `real_integral s (drop o g o lift) =
7466             drop(integral (IMAGE lift s) (lift o (drop o g o lift) o drop))`
7467   SUBST1_TAC THENL
7468    [MATCH_MP_TAC REAL_INTEGRAL THEN
7469     ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF; LIFT_DROP; ETA_AX];
7470     ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]]);;
7471
7472 let REAL_INTEGRAL_ABS_BOUND_INTEGRAL = prove
7473  (`!f:real->real g s.
7474         f real_integrable_on s /\ g real_integrable_on s /\
7475         (!x. x IN s ==> abs(f x) <= g x)
7476         ==> abs(real_integral s f) <= real_integral s g`,
7477   SIMP_TAC[REAL_INTEGRAL; GSYM ABS_DROP] THEN
7478   SIMP_TAC[REAL_INTEGRABLE_ON; INTEGRAL_NORM_BOUND_INTEGRAL] THEN
7479   REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN
7480   ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; NORM_LIFT]);;
7481
7482 let ABSOLUTELY_REAL_INTEGRABLE_LE = prove
7483  (`!f:real->real s.
7484         f absolutely_real_integrable_on s
7485         ==> abs(real_integral s f) <= real_integral s (\x. abs(f x))`,
7486   SIMP_TAC[absolutely_real_integrable_on] THEN
7487   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN
7488   ASM_REWRITE_TAC[REAL_LE_REFL]);;
7489
7490 let ABSOLUTELY_REAL_INTEGRABLE_0 = prove
7491  (`!s. (\x. &0) absolutely_real_integrable_on s`,
7492   REWRITE_TAC[absolutely_real_integrable_on; REAL_ABS_NUM;
7493               REAL_INTEGRABLE_0]);;
7494
7495 let ABSOLUTELY_REAL_INTEGRABLE_CONST = prove
7496  (`!a b c. (\x. c) absolutely_real_integrable_on real_interval[a,b]`,
7497   REWRITE_TAC[absolutely_real_integrable_on; REAL_INTEGRABLE_CONST]);;
7498
7499 let ABSOLUTELY_REAL_INTEGRABLE_LMUL = prove
7500  (`!f s c. f absolutely_real_integrable_on s
7501            ==> (\x. c * f(x)) absolutely_real_integrable_on s`,
7502   SIMP_TAC[absolutely_real_integrable_on;
7503            REAL_INTEGRABLE_LMUL; REAL_ABS_MUL]);;
7504
7505 let ABSOLUTELY_REAL_INTEGRABLE_RMUL = prove
7506  (`!f s c. f absolutely_real_integrable_on s
7507            ==> (\x. f(x) * c) absolutely_real_integrable_on s`,
7508   SIMP_TAC[absolutely_real_integrable_on;
7509            REAL_INTEGRABLE_RMUL; REAL_ABS_MUL]);;
7510
7511 let ABSOLUTELY_REAL_INTEGRABLE_NEG = prove
7512  (`!f s. f absolutely_real_integrable_on s
7513          ==> (\x. --f(x)) absolutely_real_integrable_on s`,
7514   SIMP_TAC[absolutely_real_integrable_on; REAL_INTEGRABLE_NEG; REAL_ABS_NEG]);;
7515
7516 let ABSOLUTELY_REAL_INTEGRABLE_ABS = prove
7517  (`!f s. f absolutely_real_integrable_on s
7518          ==> (\x. abs(f x)) absolutely_real_integrable_on s`,
7519   SIMP_TAC[absolutely_real_integrable_on; REAL_ABS_ABS]);;
7520
7521 let ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL = prove
7522  (`!f:real->real s a b.
7523         f absolutely_real_integrable_on s /\ real_interval[a,b] SUBSET s
7524         ==> f absolutely_real_integrable_on real_interval[a,b]`,
7525   REWRITE_TAC[absolutely_real_integrable_on] THEN
7526   MESON_TAC[REAL_INTEGRABLE_ON_SUBINTERVAL]);;
7527
7528 let ABSOLUTELY_REAL_INTEGRABLE_RESTRICT_UNIV = prove
7529  (`!f s. (\x. if x IN s then f x else &0)
7530               absolutely_real_integrable_on (:real) <=>
7531          f absolutely_real_integrable_on s`,
7532   REWRITE_TAC[absolutely_real_integrable_on; REAL_INTEGRABLE_RESTRICT_UNIV;
7533               COND_RAND; REAL_ABS_NUM]);;
7534
7535 let ABSOLUTELY_REAL_INTEGRABLE_ADD = prove
7536  (`!f:real->real g s.
7537         f absolutely_real_integrable_on s /\
7538         g absolutely_real_integrable_on s
7539         ==> (\x. f(x) + g(x)) absolutely_real_integrable_on s`,
7540   REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON] THEN
7541   SIMP_TAC[o_DEF; LIFT_ADD; ABSOLUTELY_INTEGRABLE_ADD]);;
7542
7543 let ABSOLUTELY_REAL_INTEGRABLE_SUB = prove
7544  (`!f:real->real g s.
7545         f absolutely_real_integrable_on s /\
7546         g absolutely_real_integrable_on s
7547         ==> (\x. f(x) - g(x)) absolutely_real_integrable_on s`,
7548   REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON] THEN
7549   SIMP_TAC[o_DEF; LIFT_SUB; ABSOLUTELY_INTEGRABLE_SUB]);;
7550
7551 let ABSOLUTELY_REAL_INTEGRABLE_LINEAR = prove
7552  (`!f h s.
7553         f absolutely_real_integrable_on s /\ linear(lift o h o drop)
7554         ==> (h o f) absolutely_real_integrable_on s`,
7555   REPEAT GEN_TAC THEN REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON] THEN
7556   DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_LINEAR) THEN
7557   REWRITE_TAC[o_DEF; LIFT_DROP]);;
7558
7559 let ABSOLUTELY_REAL_INTEGRABLE_SUM = prove
7560  (`!f:A->real->real s t.
7561         FINITE t /\
7562         (!a. a IN t ==> (f a) absolutely_real_integrable_on s)
7563         ==>  (\x. sum t (\a. f a x)) absolutely_real_integrable_on s`,
7564   GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
7565   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
7566   SIMP_TAC[SUM_CLAUSES; ABSOLUTELY_REAL_INTEGRABLE_0; IN_INSERT;
7567            ABSOLUTELY_REAL_INTEGRABLE_ADD; ETA_AX]);;
7568
7569 let ABSOLUTELY_REAL_INTEGRABLE_MAX = prove
7570  (`!f:real->real g:real->real s.
7571         f absolutely_real_integrable_on s /\ g absolutely_real_integrable_on s
7572         ==> (\x. max (f x) (g x))
7573             absolutely_real_integrable_on s`,
7574   REPEAT STRIP_TAC THEN
7575   REWRITE_TAC[REAL_ARITH `max a b = &1 / &2 * ((a + b) + abs(a - b))`] THEN
7576   MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_LMUL THEN
7577   ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_SUB; ABSOLUTELY_REAL_INTEGRABLE_ADD;
7578                ABSOLUTELY_REAL_INTEGRABLE_ABS]);;
7579
7580 let ABSOLUTELY_REAL_INTEGRABLE_MIN = prove
7581  (`!f:real->real g:real->real s.
7582         f absolutely_real_integrable_on s /\ g absolutely_real_integrable_on s
7583         ==> (\x. min (f x) (g x))
7584             absolutely_real_integrable_on s`,
7585   REPEAT STRIP_TAC THEN
7586   REWRITE_TAC[REAL_ARITH `min a b = &1 / &2 * ((a + b) - abs(a - b))`] THEN
7587   MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_LMUL THEN
7588   ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_SUB; ABSOLUTELY_REAL_INTEGRABLE_ADD;
7589                ABSOLUTELY_REAL_INTEGRABLE_ABS]);;
7590
7591 let ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE = prove
7592  (`!f s. f absolutely_real_integrable_on s ==> f real_integrable_on s`,
7593   SIMP_TAC[absolutely_real_integrable_on]);;
7594
7595 let ABSOLUTELY_REAL_INTEGRABLE_CONTINUOUS = prove
7596  (`!f a b.
7597         f real_continuous_on real_interval[a,b]
7598         ==> f absolutely_real_integrable_on real_interval[a,b]`,
7599   REWRITE_TAC[REAL_CONTINUOUS_ON; ABSOLUTELY_REAL_INTEGRABLE_ON;
7600               has_real_integral;
7601               GSYM integrable_on; GSYM EXISTS_LIFT] THEN
7602   REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; ABSOLUTELY_INTEGRABLE_CONTINUOUS]);;
7603
7604 let NONNEGATIVE_ABSOLUTELY_REAL_INTEGRABLE = prove
7605  (`!f s.
7606         (!x. x IN s ==> &0 <= f(x)) /\
7607         f real_integrable_on s
7608         ==> f absolutely_real_integrable_on s`,
7609   SIMP_TAC[absolutely_real_integrable_on] THEN
7610   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRABLE_EQ THEN
7611   EXISTS_TAC `f:real->real` THEN ASM_SIMP_TAC[real_abs]);;
7612
7613 let ABSOLUTELY_REAL_INTEGRABLE_INTEGRABLE_BOUND = prove
7614  (`!f:real->real g s.
7615         (!x. x IN s ==> abs(f x) <= g x) /\
7616         f real_integrable_on s /\ g real_integrable_on s
7617         ==> f absolutely_real_integrable_on s`,
7618   REWRITE_TAC[REAL_INTEGRABLE_ON; ABSOLUTELY_REAL_INTEGRABLE_ON] THEN
7619   REPEAT STRIP_TAC THEN
7620   MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN
7621   EXISTS_TAC `lift o g o drop` THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN
7622   ASM_REWRITE_TAC[o_DEF; LIFT_DROP; NORM_LIFT]);;
7623
7624 let ABSOLUTELY_REAL_INTEGRABLE_ABSOLUTELY_REAL_INTEGRABLE_BOUND = prove
7625  (`!f:real->real g:real->real s.
7626         (!x. x IN s ==> abs(f x) <= abs(g x)) /\
7627         f real_integrable_on s /\ g absolutely_real_integrable_on s
7628         ==> f absolutely_real_integrable_on s`,
7629   REPEAT STRIP_TAC THEN
7630   MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_INTEGRABLE_BOUND THEN
7631   EXISTS_TAC `\x:real. abs(g x)` THEN ASM_REWRITE_TAC[] THEN
7632   RULE_ASSUM_TAC(REWRITE_RULE[absolutely_real_integrable_on]) THEN
7633   ASM_REWRITE_TAC[]);;
7634
7635 let ABSOLUTELY_REAL_INTEGRABLE_ABSOLUTELY_REAL_INTEGRABLE_UBOUND = prove
7636  (`!f:real->real g:real->real s.
7637         (!x. x IN s ==> f x <= g x) /\
7638         f real_integrable_on s /\ g absolutely_real_integrable_on s
7639         ==> f absolutely_real_integrable_on s`,
7640   REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON; REAL_INTEGRABLE_ON] THEN
7641   REPEAT STRIP_TAC THEN MATCH_MP_TAC
7642    ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_UBOUND THEN
7643   EXISTS_TAC `lift o g o drop` THEN ASM_REWRITE_TAC[] THEN
7644   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
7645   ASM_REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; o_THM; LIFT_DROP;
7646                   GSYM drop]);;
7647
7648 let ABSOLUTELY_REAL_INTEGRABLE_ABSOLUTELY_REAL_INTEGRABLE_LBOUND = prove
7649  (`!f:real->real g:real->real s.
7650         (!x. x IN s ==> f x <= g x) /\
7651         f absolutely_real_integrable_on s /\ g real_integrable_on s
7652         ==> f absolutely_real_integrable_on s`,
7653   REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON; REAL_INTEGRABLE_ON] THEN
7654   REPEAT STRIP_TAC THEN MATCH_MP_TAC
7655    ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_LBOUND THEN
7656   EXISTS_TAC `lift o f o drop` THEN ASM_REWRITE_TAC[] THEN
7657   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
7658   ASM_REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; o_THM; LIFT_DROP;
7659                   GSYM drop]);;
7660
7661 let ABSOLUTELY_REAL_INTEGRABLE_INF = prove
7662  (`!fs s:real->bool k:A->bool.
7663         FINITE k /\ ~(k = {}) /\
7664         (!i. i IN k ==> (\x. fs x i) absolutely_real_integrable_on s)
7665         ==> (\x. inf (IMAGE (fs x) k)) absolutely_real_integrable_on s`,
7666   GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
7667   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[IMAGE_CLAUSES] THEN
7668   SIMP_TAC[INF_INSERT_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN
7669   MAP_EVERY X_GEN_TAC [`a:A`; `k:A->bool`] THEN
7670   ASM_CASES_TAC `k:A->bool = {}` THEN ASM_REWRITE_TAC[] THEN
7671   SIMP_TAC[IN_SING; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN
7672   REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN
7673   REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MIN THEN
7674   CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INSERT] THEN
7675   REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
7676   ASM_REWRITE_TAC[IN_INSERT]);;
7677
7678 let ABSOLUTELY_REAL_INTEGRABLE_SUP = prove
7679  (`!fs s:real->bool k:A->bool.
7680         FINITE k /\ ~(k = {}) /\
7681         (!i. i IN k ==> (\x. fs x i) absolutely_real_integrable_on s)
7682         ==> (\x. sup (IMAGE (fs x) k)) absolutely_real_integrable_on s`,
7683   GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
7684   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[IMAGE_CLAUSES] THEN
7685   SIMP_TAC[SUP_INSERT_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN
7686   MAP_EVERY X_GEN_TAC [`a:A`; `k:A->bool`] THEN
7687   ASM_CASES_TAC `k:A->bool = {}` THEN ASM_REWRITE_TAC[] THEN
7688   SIMP_TAC[IN_SING; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN
7689   REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN
7690   REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MAX THEN
7691   CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INSERT] THEN
7692   REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
7693   ASM_REWRITE_TAC[IN_INSERT]);;
7694
7695 let REAL_DOMINATED_CONVERGENCE = prove
7696  (`!f:num->real->real g h s.
7697         (!k. (f k) real_integrable_on s) /\ h real_integrable_on s /\
7698         (!k x. x IN s ==> abs(f k x) <= h x) /\
7699         (!x. x IN s ==> ((\k. f k x) ---> g x) sequentially)
7700         ==> g real_integrable_on s /\
7701             ((\k. real_integral s (f k)) ---> real_integral s g) sequentially`,
7702   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_ON; TENDSTO_REAL] THEN
7703   REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN
7704   MP_TAC(ISPECL [`\n x. lift(f (n:num) (drop x))`;
7705                  `lift o g o drop`;  `lift o h o drop`; `IMAGE lift s`]
7706                 DOMINATED_CONVERGENCE) THEN
7707   ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_DEF; NORM_LIFT] THEN
7708   SUBGOAL_THEN
7709    `!k:num. real_integral s (f k) =
7710             drop(integral (IMAGE lift s) (lift o f k o drop))`
7711    (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN REWRITE_TAC[th])
7712   THENL
7713    [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL THEN
7714     ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF];
7715     ALL_TAC] THEN
7716   REWRITE_TAC[o_DEF; LIFT_DROP] THEN
7717   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN
7718   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
7719   ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN REWRITE_TAC[LIFT_DROP] THEN
7720   CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM o_DEF] THEN
7721   MATCH_MP_TAC REAL_INTEGRAL THEN ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]);;
7722
7723 let HAS_REAL_MEASURE_HAS_MEASURE = prove
7724  (`!s m. s has_real_measure m <=> (IMAGE lift s) has_measure m`,
7725   REWRITE_TAC[has_real_measure; has_measure; has_real_integral] THEN
7726   REWRITE_TAC[o_DEF; LIFT_NUM]);;
7727
7728 let REAL_MEASURABLE_MEASURABLE = prove
7729  (`!s. real_measurable s <=> measurable(IMAGE lift s)`,
7730   REWRITE_TAC[real_measurable; measurable; HAS_REAL_MEASURE_HAS_MEASURE]);;
7731
7732 let REAL_MEASURE_MEASURE = prove
7733  (`!s. real_measure s = measure (IMAGE lift s)`,
7734   REWRITE_TAC[real_measure; measure; HAS_REAL_MEASURE_HAS_MEASURE]);;
7735
7736 let HAS_REAL_MEASURE_MEASURE = prove
7737  (`!s. real_measurable s <=> s has_real_measure (real_measure s)`,
7738   REWRITE_TAC[real_measure; real_measurable] THEN MESON_TAC[]);;
7739
7740 let HAS_REAL_MEASURE_UNIQUE = prove
7741  (`!s m1 m2. s has_real_measure m1 /\ s has_real_measure m2 ==> m1 = m2`,
7742   REWRITE_TAC[has_real_measure] THEN MESON_TAC[HAS_REAL_INTEGRAL_UNIQUE]);;
7743
7744 let REAL_MEASURE_UNIQUE = prove
7745  (`!s m. s has_real_measure m ==> real_measure s = m`,
7746   MESON_TAC[HAS_REAL_MEASURE_UNIQUE; HAS_REAL_MEASURE_MEASURE;
7747             real_measurable]);;
7748
7749 let HAS_REAL_MEASURE_REAL_MEASURABLE_REAL_MEASURE = prove
7750  (`!s m. s has_real_measure m <=> real_measurable s /\ real_measure s = m`,
7751   REWRITE_TAC[HAS_REAL_MEASURE_MEASURE] THEN MESON_TAC[REAL_MEASURE_UNIQUE]);;
7752
7753 let HAS_REAL_MEASURE_IMP_REAL_MEASURABLE = prove
7754  (`!s m. s has_real_measure m ==> real_measurable s`,
7755   REWRITE_TAC[real_measurable] THEN MESON_TAC[]);;
7756
7757 let HAS_REAL_MEASURE = prove
7758  (`!s m. s has_real_measure m <=>
7759               ((\x. if x IN s then &1 else &0) has_real_integral m) (:real)`,
7760   SIMP_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV; has_real_measure]);;
7761
7762 let REAL_MEASURABLE = prove
7763  (`!s. real_measurable s <=> (\x. &1) real_integrable_on s`,
7764   REWRITE_TAC[real_measurable; real_integrable_on;
7765               has_real_measure; EXISTS_DROP; LIFT_DROP]);;
7766
7767 let REAL_MEASURABLE_REAL_INTEGRABLE = prove
7768  (`real_measurable s <=>
7769     (\x. if x IN s then &1 else &0) real_integrable_on UNIV`,
7770   REWRITE_TAC[real_measurable; real_integrable_on; HAS_REAL_MEASURE]);;
7771
7772 let REAL_MEASURE_REAL_INTEGRAL = prove
7773  (`!s. real_measurable s ==> real_measure s = real_integral s (\x. &1)`,
7774   REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
7775   MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN
7776   ASM_REWRITE_TAC[GSYM has_real_measure; GSYM HAS_REAL_MEASURE_MEASURE]);;
7777
7778 let REAL_MEASURE_REAL_INTEGRAL_UNIV = prove
7779  (`!s. real_measurable s
7780        ==> real_measure s =
7781            real_integral UNIV (\x. if x IN s then &1 else &0)`,
7782   REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN
7783   MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN
7784   ASM_REWRITE_TAC[GSYM HAS_REAL_MEASURE; GSYM HAS_REAL_MEASURE_MEASURE]);;
7785
7786 let REAL_INTEGRAL_REAL_MEASURE = prove
7787  (`!s. real_measurable s ==> real_integral s (\x. &1) = real_measure s`,
7788   SIMP_TAC[GSYM DROP_EQ; LIFT_DROP; REAL_MEASURE_REAL_INTEGRAL]);;
7789
7790 let REAL_INTEGRAL_REAL_MEASURE_UNIV = prove
7791  (`!s. real_measurable s
7792        ==> real_integral UNIV (\x. if x IN s then &1 else &0) =
7793            real_measure s`,
7794   SIMP_TAC[REAL_MEASURE_REAL_INTEGRAL_UNIV]);;
7795
7796 let HAS_REAL_MEASURE_REAL_INTERVAL = prove
7797  (`(!a b. real_interval[a,b] has_real_measure (max (b - a) (&0))) /\
7798    (!a b. real_interval(a,b) has_real_measure (max (b - a) (&0)))`,
7799   REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; IMAGE_LIFT_REAL_INTERVAL] THEN
7800   REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_INTERVAL;
7801               MEASURE_INTERVAL] THEN
7802   REWRITE_TAC[CONTENT_CLOSED_INTERVAL_CASES; DIMINDEX_1; FORALL_1] THEN
7803   REWRITE_TAC[PRODUCT_1; GSYM drop; LIFT_DROP] THEN REAL_ARITH_TAC);;
7804
7805 let REAL_MEASURABLE_REAL_INTERVAL = prove
7806  (`(!a b. real_measurable (real_interval[a,b])) /\
7807    (!a b. real_measurable (real_interval(a,b)))`,
7808   REWRITE_TAC[real_measurable] THEN
7809   MESON_TAC[HAS_REAL_MEASURE_REAL_INTERVAL]);;
7810
7811 let REAL_MEASURE_REAL_INTERVAL = prove
7812  (`(!a b. real_measure(real_interval[a,b]) = max (b - a) (&0)) /\
7813    (!a b. real_measure(real_interval(a,b)) = max (b - a) (&0))`,
7814   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN
7815   REWRITE_TAC[HAS_REAL_MEASURE_REAL_INTERVAL]);;
7816
7817 let REAL_MEASURABLE_INTER = prove
7818  (`!s t. real_measurable s /\ real_measurable t
7819          ==> real_measurable (s INTER t)`,
7820   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_MEASURABLE_MEASURABLE] THEN
7821   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_INTER) THEN
7822   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[LIFT_DROP]);;
7823
7824 let REAL_MEASURABLE_UNION = prove
7825  (`!s t. real_measurable s /\ real_measurable t
7826          ==> real_measurable (s UNION t)`,
7827   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_MEASURABLE_MEASURABLE] THEN
7828   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_UNION) THEN
7829   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[LIFT_DROP]);;
7830
7831 let HAS_REAL_MEASURE_DISJOINT_UNION = prove
7832  (`!s1 s2 m1 m2. s1 has_real_measure m1 /\ s2 has_real_measure m2 /\
7833                  DISJOINT s1 s2
7834                  ==> (s1 UNION s2) has_real_measure (m1 + m2)`,
7835   REPEAT GEN_TAC THEN
7836   REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; IMAGE_UNION] THEN
7837   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_DISJOINT_UNION THEN
7838   ASM SET_TAC[LIFT_DROP]);;
7839
7840 let REAL_MEASURE_DISJOINT_UNION = prove
7841  (`!s t. real_measurable s /\ real_measurable t /\ DISJOINT s t
7842          ==> real_measure(s UNION t) = real_measure s + real_measure t`,
7843   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN
7844   ASM_SIMP_TAC[HAS_REAL_MEASURE_DISJOINT_UNION;
7845                GSYM HAS_REAL_MEASURE_MEASURE]);;
7846
7847 let HAS_REAL_MEASURE_POS_LE = prove
7848  (`!m s. s has_real_measure m ==> &0 <= m`,
7849   REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; HAS_MEASURE_POS_LE]);;
7850
7851 let REAL_MEASURE_POS_LE = prove
7852  (`!s. real_measurable s ==> &0 <= real_measure s`,
7853   REWRITE_TAC[HAS_REAL_MEASURE_MEASURE; HAS_REAL_MEASURE_POS_LE]);;
7854
7855 let HAS_REAL_MEASURE_SUBSET = prove
7856  (`!s1 s2 m1 m2.
7857         s1 has_real_measure m1 /\ s2 has_real_measure m2 /\ s1 SUBSET s2
7858         ==> m1 <= m2`,
7859   REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE] THEN REPEAT STRIP_TAC THEN
7860   MATCH_MP_TAC(ISPECL [`IMAGE lift s1`; `IMAGE lift s2`]
7861     HAS_MEASURE_SUBSET) THEN
7862   ASM SET_TAC[HAS_MEASURE_SUBSET]);;
7863
7864 let REAL_MEASURE_SUBSET = prove
7865  (`!s t. real_measurable s /\ real_measurable t /\ s SUBSET t
7866          ==> real_measure s <= real_measure t`,
7867   REWRITE_TAC[HAS_REAL_MEASURE_MEASURE] THEN
7868   MESON_TAC[HAS_REAL_MEASURE_SUBSET]);;
7869
7870 let HAS_REAL_MEASURE_0 = prove
7871  (`!s. s has_real_measure &0 <=> real_negligible s`,
7872   REWRITE_TAC[real_negligible; HAS_REAL_MEASURE_HAS_MEASURE] THEN
7873   REWRITE_TAC[HAS_MEASURE_0]);;
7874
7875 let REAL_MEASURE_EQ_0 = prove
7876  (`!s. real_negligible s ==> real_measure s = &0`,
7877   MESON_TAC[REAL_MEASURE_UNIQUE; HAS_REAL_MEASURE_0]);;
7878
7879 let HAS_REAL_MEASURE_EMPTY = prove
7880  (`{} has_real_measure &0`,
7881   REWRITE_TAC[HAS_REAL_MEASURE_0; REAL_NEGLIGIBLE_EMPTY]);;
7882
7883 let REAL_MEASURE_EMPTY = prove
7884  (`real_measure {} = &0`,
7885   SIMP_TAC[REAL_MEASURE_EQ_0; REAL_NEGLIGIBLE_EMPTY]);;
7886
7887 let REAL_MEASURABLE_EMPTY = prove
7888  (`real_measurable {}`,
7889   REWRITE_TAC[real_measurable] THEN MESON_TAC[HAS_REAL_MEASURE_EMPTY]);;
7890
7891 let REAL_MEASURABLE_REAL_MEASURE_EQ_0 = prove
7892  (`!s. real_measurable s ==> (real_measure s = &0 <=> real_negligible s)`,
7893   REWRITE_TAC[HAS_REAL_MEASURE_MEASURE; GSYM HAS_REAL_MEASURE_0] THEN
7894   MESON_TAC[REAL_MEASURE_UNIQUE]);;
7895
7896 let REAL_MEASURABLE_REAL_MEASURE_POS_LT = prove
7897  (`!s. real_measurable s ==> (&0 < real_measure s <=> ~real_negligible s)`,
7898   SIMP_TAC[REAL_LT_LE; REAL_MEASURE_POS_LE;
7899            GSYM REAL_MEASURABLE_REAL_MEASURE_EQ_0] THEN
7900   REWRITE_TAC[EQ_SYM_EQ]);;
7901
7902 let REAL_NEGLIGIBLE_REAL_INTERVAL = prove
7903  (`(!a b. real_negligible(real_interval[a,b]) <=> real_interval(a,b) = {}) /\
7904    (!a b. real_negligible(real_interval(a,b)) <=> real_interval(a,b) = {})`,
7905   REWRITE_TAC[real_negligible; IMAGE_LIFT_REAL_INTERVAL] THEN
7906   REWRITE_TAC[NEGLIGIBLE_INTERVAL] THEN
7907   REWRITE_TAC[REAL_INTERVAL_EQ_EMPTY; INTERVAL_EQ_EMPTY_1; LIFT_DROP]);;
7908
7909 let REAL_MEASURABLE_UNIONS = prove
7910  (`!f. FINITE f /\ (!s. s IN f ==> real_measurable s)
7911        ==> real_measurable (UNIONS f)`,
7912   REWRITE_TAC[REAL_MEASURABLE_MEASURABLE; IMAGE_UNIONS] THEN
7913   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN
7914   ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE]);;
7915
7916 let HAS_REAL_MEASURE_DIFF_SUBSET = prove
7917  (`!s1 s2 m1 m2.
7918         s1 has_real_measure m1 /\ s2 has_real_measure m2 /\ s2 SUBSET s1
7919         ==> (s1 DIFF s2) has_real_measure (m1 - m2)`,
7920   REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE] THEN REPEAT STRIP_TAC THEN
7921   SIMP_TAC[IMAGE_DIFF_INJ; LIFT_EQ] THEN
7922   MATCH_MP_TAC HAS_MEASURE_DIFF_SUBSET THEN
7923   ASM_SIMP_TAC[IMAGE_SUBSET]);;
7924
7925 let REAL_MEASURABLE_DIFF = prove
7926  (`!s t. real_measurable s /\ real_measurable t
7927          ==> real_measurable (s DIFF t)`,
7928   SIMP_TAC[REAL_MEASURABLE_MEASURABLE; IMAGE_DIFF_INJ; LIFT_EQ] THEN
7929   REWRITE_TAC[MEASURABLE_DIFF]);;
7930
7931 let REAL_MEASURE_DIFF_SUBSET = prove
7932  (`!s t. real_measurable s /\ real_measurable t /\ t SUBSET s
7933          ==> real_measure(s DIFF t) = real_measure s - real_measure t`,
7934   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN
7935   ASM_SIMP_TAC[HAS_REAL_MEASURE_DIFF_SUBSET; GSYM HAS_REAL_MEASURE_MEASURE]);;
7936
7937 let HAS_REAL_MEASURE_UNION_REAL_NEGLIGIBLE = prove
7938  (`!s t m.
7939         s has_real_measure m /\ real_negligible t
7940         ==> (s UNION t) has_real_measure m`,
7941   REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; real_negligible; IMAGE_UNION] THEN
7942   REWRITE_TAC[HAS_MEASURE_UNION_NEGLIGIBLE]);;
7943
7944 let HAS_REAL_MEASURE_DIFF_REAL_NEGLIGIBLE = prove
7945  (`!s t m.
7946         s has_real_measure m /\ real_negligible t
7947         ==> (s DIFF t) has_real_measure m`,
7948   REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; real_negligible] THEN
7949   SIMP_TAC[IMAGE_DIFF_INJ; LIFT_EQ] THEN
7950   REWRITE_TAC[HAS_MEASURE_DIFF_NEGLIGIBLE]);;
7951
7952 let HAS_REAL_MEASURE_UNION_REAL_NEGLIGIBLE_EQ = prove
7953  (`!s t m.
7954      real_negligible t
7955      ==> ((s UNION t) has_real_measure m <=> s has_real_measure m)`,
7956   REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; real_negligible; IMAGE_UNION] THEN
7957   REWRITE_TAC[HAS_MEASURE_UNION_NEGLIGIBLE_EQ]);;
7958
7959 let HAS_REAL_MEASURE_DIFF_REAL_NEGLIGIBLE_EQ = prove
7960  (`!s t m.
7961      real_negligible t
7962      ==> ((s DIFF t) has_real_measure m <=> s has_real_measure m)`,
7963   REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; real_negligible] THEN
7964   SIMP_TAC[IMAGE_DIFF_INJ; LIFT_EQ] THEN
7965   REWRITE_TAC[HAS_MEASURE_DIFF_NEGLIGIBLE_EQ]);;
7966
7967 let HAS_REAL_MEASURE_ALMOST = prove
7968  (`!s s' t m. s has_real_measure m /\ real_negligible t /\
7969               s UNION t = s' UNION t
7970               ==> s' has_real_measure m`,
7971   REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; real_negligible; IMAGE_UNION] THEN
7972   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_ALMOST THEN
7973   MAP_EVERY EXISTS_TAC [`IMAGE lift s`; `IMAGE lift t`] THEN ASM SET_TAC[]);;
7974
7975 let HAS_REAL_MEASURE_ALMOST_EQ = prove
7976  (`!s s' t. real_negligible t /\ s UNION t = s' UNION t
7977             ==> (s has_real_measure m <=> s' has_real_measure m)`,
7978   MESON_TAC[HAS_REAL_MEASURE_ALMOST]);;
7979
7980 let REAL_MEASURABLE_ALMOST = prove
7981  (`!s s' t. real_measurable s /\ real_negligible t /\ s UNION t = s' UNION t
7982             ==> real_measurable s'`,
7983   REWRITE_TAC[real_measurable] THEN MESON_TAC[HAS_REAL_MEASURE_ALMOST]);;
7984
7985 let HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNION = prove
7986  (`!s1 s2 m1 m2.
7987         s1 has_real_measure m1 /\ s2 has_real_measure m2 /\
7988         real_negligible(s1 INTER s2)
7989         ==> (s1 UNION s2) has_real_measure (m1 + m2)`,
7990   REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; real_negligible; IMAGE_UNION] THEN
7991   SIMP_TAC[IMAGE_INTER_INJ; LIFT_EQ] THEN
7992   REWRITE_TAC[HAS_MEASURE_NEGLIGIBLE_UNION]);;
7993
7994 let REAL_MEASURE_REAL_NEGLIGIBLE_UNION = prove
7995  (`!s t. real_measurable s /\ real_measurable t /\ real_negligible(s INTER t)
7996          ==> real_measure(s UNION t) = real_measure s + real_measure t`,
7997   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN
7998   ASM_SIMP_TAC[HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNION;
7999                GSYM HAS_REAL_MEASURE_MEASURE]);;
8000
8001 let HAS_REAL_MEASURE_REAL_NEGLIGIBLE_SYMDIFF = prove
8002  (`!s t m.
8003         s has_real_measure m /\
8004         real_negligible((s DIFF t) UNION (t DIFF s))
8005         ==> t has_real_measure m`,
8006   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_MEASURE_ALMOST THEN
8007   MAP_EVERY EXISTS_TAC
8008     [`s:real->bool`; `(s DIFF t) UNION (t DIFF s):real->bool`] THEN
8009   ASM_REWRITE_TAC[] THEN SET_TAC[]);;
8010
8011 let REAL_MEASURABLE_REAL_NEGLIGIBLE_SYMDIFF = prove
8012  (`!s t. real_measurable s /\ real_negligible((s DIFF t) UNION (t DIFF s))
8013          ==> real_measurable t`,
8014   REWRITE_TAC[real_measurable] THEN
8015   MESON_TAC[HAS_REAL_MEASURE_REAL_NEGLIGIBLE_SYMDIFF]);;
8016
8017 let REAL_MEASURE_REAL_NEGLIGIBLE_SYMDIFF = prove
8018  (`!s t. (real_measurable s \/ real_measurable t) /\
8019          real_negligible((s DIFF t) UNION (t DIFF s))
8020          ==> real_measure s = real_measure t`,
8021   MESON_TAC[HAS_REAL_MEASURE_REAL_NEGLIGIBLE_SYMDIFF; REAL_MEASURE_UNIQUE;
8022             UNION_COMM; HAS_REAL_MEASURE_MEASURE]);;
8023
8024 let HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS = prove
8025  (`!m f. FINITE f /\
8026          (!s. s IN f ==> s has_real_measure (m s)) /\
8027          (!s t. s IN f /\ t IN f /\ ~(s = t) ==> real_negligible(s INTER t))
8028          ==> (UNIONS f) has_real_measure (sum f m)`,
8029   GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
8030   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
8031   SIMP_TAC[SUM_CLAUSES; UNIONS_0; UNIONS_INSERT; HAS_REAL_MEASURE_EMPTY] THEN
8032   REWRITE_TAC[IN_INSERT] THEN
8033   MAP_EVERY X_GEN_TAC [`s:real->bool`; `f:(real->bool)->bool`] THEN
8034   STRIP_TAC THEN STRIP_TAC THEN
8035   MATCH_MP_TAC HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNION THEN
8036   REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN
8037   REWRITE_TAC[INTER_UNIONS] THEN MATCH_MP_TAC REAL_NEGLIGIBLE_UNIONS THEN
8038   ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
8039   ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN
8040   FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]);;
8041
8042 let REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS = prove
8043  (`!m f. FINITE f /\
8044          (!s. s IN f ==> s has_real_measure (m s)) /\
8045          (!s t. s IN f /\ t IN f /\ ~(s = t) ==> real_negligible(s INTER t))
8046          ==> real_measure(UNIONS f) = sum f m`,
8047   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN
8048   ASM_SIMP_TAC[HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS]);;
8049
8050 let HAS_REAL_MEASURE_DISJOINT_UNIONS = prove
8051  (`!m f. FINITE f /\
8052          (!s. s IN f ==> s has_real_measure (m s)) /\
8053          (!s t. s IN f /\ t IN f /\ ~(s = t) ==> DISJOINT s t)
8054          ==> (UNIONS f) has_real_measure (sum f m)`,
8055   REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN
8056   MATCH_MP_TAC HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS THEN
8057   ASM_SIMP_TAC[REAL_NEGLIGIBLE_EMPTY]);;
8058
8059 let REAL_MEASURE_DISJOINT_UNIONS = prove
8060  (`!m f:(real->bool)->bool.
8061         FINITE f /\
8062         (!s. s IN f ==> s has_real_measure (m s)) /\
8063         (!s t. s IN f /\ t IN f /\ ~(s = t) ==> DISJOINT s t)
8064         ==> real_measure(UNIONS f) = sum f m`,
8065   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN
8066   ASM_SIMP_TAC[HAS_REAL_MEASURE_DISJOINT_UNIONS]);;
8067
8068 let HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE = prove
8069  (`!f:A->(real->bool) s.
8070         FINITE s /\
8071         (!x. x IN s ==> real_measurable(f x)) /\
8072         (!x y. x IN s /\ y IN s /\ ~(x = y)
8073                ==> real_negligible((f x) INTER (f y)))
8074         ==> (UNIONS (IMAGE f s)) has_real_measure
8075             (sum s (\x. real_measure(f x)))`,
8076   REPEAT STRIP_TAC THEN
8077   SUBGOAL_THEN
8078    `sum s (\x. real_measure(f x)) =
8079     sum (IMAGE (f:A->real->bool) s) real_measure`
8080   SUBST1_TAC THENL
8081    [CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN
8082     MATCH_MP_TAC SUM_IMAGE_NONZERO THEN ASM_REWRITE_TAC[] THEN
8083     MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN STRIP_TAC THEN
8084     FIRST_X_ASSUM(MP_TAC o SPECL [`x:A`; `y:A`]) THEN
8085     ASM_SIMP_TAC[INTER_ACI; REAL_MEASURABLE_REAL_MEASURE_EQ_0];
8086     MATCH_MP_TAC HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS THEN
8087     ASM_SIMP_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_IMAGE] THEN
8088     ASM_MESON_TAC[FINITE_IMAGE; HAS_REAL_MEASURE_MEASURE]]);;
8089
8090 let REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE = prove
8091  (`!f:A->real->bool s.
8092         FINITE s /\
8093         (!x. x IN s ==> real_measurable(f x)) /\
8094         (!x y. x IN s /\ y IN s /\ ~(x = y)
8095                ==> real_negligible((f x) INTER (f y)))
8096         ==> real_measure(UNIONS (IMAGE f s)) = sum s (\x. real_measure(f x))`,
8097   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN
8098   ASM_SIMP_TAC[HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE]);;
8099
8100 let HAS_REAL_MEASURE_DISJOINT_UNIONS_IMAGE = prove
8101  (`!f:A->real->bool s.
8102         FINITE s /\
8103         (!x. x IN s ==> real_measurable(f x)) /\
8104         (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y))
8105         ==> (UNIONS (IMAGE f s)) has_real_measure
8106             (sum s (\x. real_measure(f x)))`,
8107   REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN
8108   MATCH_MP_TAC HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE THEN
8109   ASM_SIMP_TAC[REAL_NEGLIGIBLE_EMPTY]);;
8110
8111 let REAL_MEASURE_DISJOINT_UNIONS_IMAGE = prove
8112  (`!f:A->real->bool s.
8113         FINITE s /\
8114         (!x. x IN s ==> real_measurable(f x)) /\
8115         (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y))
8116         ==> real_measure(UNIONS (IMAGE f s)) = sum s (\x. real_measure(f x))`,
8117   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN
8118   ASM_SIMP_TAC[HAS_REAL_MEASURE_DISJOINT_UNIONS_IMAGE]);;
8119
8120 let HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE_STRONG = prove
8121  (`!f:A->real->bool s.
8122         FINITE {x | x IN s /\ ~(f x = {})} /\
8123         (!x. x IN s ==> real_measurable(f x)) /\
8124         (!x y. x IN s /\ y IN s /\ ~(x = y)
8125                ==> real_negligible((f x) INTER (f y)))
8126         ==> (UNIONS (IMAGE f s)) has_real_measure
8127             (sum s (\x. real_measure(f x)))`,
8128   REPEAT STRIP_TAC THEN
8129   MP_TAC(ISPECL [`f:A->real->bool`;
8130                  `{x | x IN s /\ ~((f:A->real->bool) x = {})}`]
8131         HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE) THEN
8132   ASM_SIMP_TAC[IN_ELIM_THM; FINITE_RESTRICT] THEN
8133   MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL
8134    [GEN_REWRITE_TAC I [EXTENSION] THEN
8135     REWRITE_TAC[IN_UNIONS; IN_IMAGE; IN_ELIM_THM] THEN
8136     MESON_TAC[NOT_IN_EMPTY];
8137     CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN
8138     SIMP_TAC[SUBSET; IN_ELIM_THM; TAUT `a /\ ~(a /\ b) <=> a /\ ~b`] THEN
8139     REWRITE_TAC[REAL_MEASURE_EMPTY]]);;
8140
8141 let REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE_STRONG = prove
8142  (`!f:A->real->bool s.
8143         FINITE {x | x IN s /\ ~(f x = {})} /\
8144         (!x. x IN s ==> real_measurable(f x)) /\
8145         (!x y. x IN s /\ y IN s /\ ~(x = y)
8146                ==> real_negligible((f x) INTER (f y)))
8147         ==> real_measure(UNIONS (IMAGE f s)) = sum s (\x. real_measure(f x))`,
8148   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN
8149   ASM_SIMP_TAC[HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE_STRONG]);;
8150
8151 let HAS_REAL_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG = prove
8152  (`!f:A->real->bool s.
8153         FINITE {x | x IN s /\ ~(f x = {})} /\
8154         (!x. x IN s ==> real_measurable(f x)) /\
8155         (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y))
8156         ==> (UNIONS (IMAGE f s)) has_real_measure
8157             (sum s (\x. real_measure(f x)))`,
8158   REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN
8159   MATCH_MP_TAC HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE_STRONG THEN
8160   ASM_SIMP_TAC[REAL_NEGLIGIBLE_EMPTY]);;
8161
8162 let REAL_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG = prove
8163  (`!f:A->real->bool s.
8164         FINITE {x | x IN s /\ ~(f x = {})} /\
8165         (!x. x IN s ==> real_measurable(f x)) /\
8166         (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y))
8167         ==> real_measure(UNIONS (IMAGE f s)) = sum s (\x. real_measure(f x))`,
8168   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN
8169   ASM_SIMP_TAC[HAS_REAL_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG]);;
8170
8171 let REAL_MEASURE_UNION = prove
8172  (`!s t. real_measurable s /\ real_measurable t
8173          ==> real_measure(s UNION t) =
8174              real_measure(s) + real_measure(t) - real_measure(s INTER t)`,
8175   REPEAT STRIP_TAC THEN
8176   ONCE_REWRITE_TAC[SET_RULE
8177    `s UNION t = (s INTER t) UNION (s DIFF t) UNION (t DIFF s)`] THEN
8178   ONCE_REWRITE_TAC[REAL_ARITH `a + b - c:real = c + (a - c) + (b - c)`] THEN
8179   MP_TAC(ISPECL [`s DIFF t:real->bool`; `t DIFF s:real->bool`]
8180         REAL_MEASURE_DISJOINT_UNION) THEN
8181   ASM_SIMP_TAC[REAL_MEASURABLE_DIFF] THEN
8182   ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN
8183   MP_TAC(ISPECL [`s INTER t:real->bool`;
8184                  `(s DIFF t) UNION (t DIFF s):real->bool`]
8185                 REAL_MEASURE_DISJOINT_UNION) THEN
8186   ASM_SIMP_TAC[REAL_MEASURABLE_DIFF;
8187                REAL_MEASURABLE_UNION; REAL_MEASURABLE_INTER] THEN
8188   ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN
8189   REPEAT(DISCH_THEN SUBST1_TAC) THEN AP_TERM_TAC THEN BINOP_TAC THEN
8190   REWRITE_TAC[REAL_EQ_SUB_LADD] THEN MATCH_MP_TAC EQ_TRANS THENL
8191    [EXISTS_TAC `real_measure((s DIFF t) UNION (s INTER t):real->bool)`;
8192     EXISTS_TAC `real_measure((t DIFF s) UNION (s INTER t):real->bool)`] THEN
8193   (CONJ_TAC THENL
8194     [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_MEASURE_DISJOINT_UNION THEN
8195      ASM_SIMP_TAC[REAL_MEASURABLE_DIFF; REAL_MEASURABLE_INTER];
8196      AP_TERM_TAC] THEN
8197    SET_TAC[]));;
8198
8199 let REAL_MEASURE_UNION_LE = prove
8200  (`!s t. real_measurable s /\ real_measurable t
8201          ==> real_measure(s UNION t) <= real_measure s + real_measure t`,
8202   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_MEASURE_UNION] THEN
8203   REWRITE_TAC[REAL_ARITH `a + b - c <= a + b <=> &0 <= c`] THEN
8204   MATCH_MP_TAC REAL_MEASURE_POS_LE THEN ASM_SIMP_TAC[REAL_MEASURABLE_INTER]);;
8205
8206 let REAL_MEASURE_UNIONS_LE = prove
8207  (`!f. FINITE f /\ (!s. s IN f ==> real_measurable s)
8208        ==> real_measure(UNIONS f) <= sum f (\s. real_measure s)`,
8209   REWRITE_TAC[IMP_CONJ] THEN
8210   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
8211   SIMP_TAC[UNIONS_0; UNIONS_INSERT; SUM_CLAUSES] THEN
8212   REWRITE_TAC[REAL_MEASURE_EMPTY; REAL_LE_REFL] THEN
8213   MAP_EVERY X_GEN_TAC [`s:real->bool`; `f:(real->bool)->bool`] THEN
8214   REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN
8215   MATCH_MP_TAC REAL_LE_TRANS THEN
8216   EXISTS_TAC `real_measure(s) + real_measure(UNIONS f)` THEN
8217   ASM_SIMP_TAC[REAL_MEASURE_UNION_LE; REAL_MEASURABLE_UNIONS] THEN
8218   REWRITE_TAC[REAL_LE_LADD] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
8219   ASM_SIMP_TAC[]);;
8220
8221 let REAL_MEASURE_UNIONS_LE_IMAGE = prove
8222  (`!f:A->bool s:A->(real->bool).
8223         FINITE f /\ (!a. a IN f ==> real_measurable(s a))
8224         ==> real_measure(UNIONS (IMAGE s f)) <= sum f (\a. real_measure(s a))`,
8225   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
8226   EXISTS_TAC `sum (IMAGE s (f:A->bool)) (\k:real->bool. real_measure k)` THEN
8227   ASM_SIMP_TAC[REAL_MEASURE_UNIONS_LE; FORALL_IN_IMAGE; FINITE_IMAGE] THEN
8228   GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM o_DEF] THEN
8229   REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC SUM_IMAGE_LE THEN
8230   ASM_SIMP_TAC[REAL_MEASURE_POS_LE]);;
8231
8232 let REAL_NEGLIGIBLE_OUTER = prove
8233  (`!s. real_negligible s <=>
8234        !e. &0 < e
8235            ==> ?t. s SUBSET t /\ real_measurable t /\ real_measure t < e`,
8236   REWRITE_TAC[real_negligible; REAL_MEASURABLE_MEASURABLE;
8237               REAL_MEASURE_MEASURE; SUBSET_LIFT_IMAGE;
8238               NEGLIGIBLE_OUTER; EXISTS_LIFT_IMAGE]);;
8239
8240 let REAL_NEGLIGIBLE_OUTER_LE = prove
8241  (`!s. real_negligible s <=>
8242        !e. &0 < e
8243            ==> ?t. s SUBSET t /\ real_measurable t /\ real_measure t <= e`,
8244   REWRITE_TAC[real_negligible; REAL_MEASURABLE_MEASURABLE;
8245               REAL_MEASURE_MEASURE; SUBSET_LIFT_IMAGE;
8246               NEGLIGIBLE_OUTER_LE; EXISTS_LIFT_IMAGE]);;
8247
8248 let REAL_MEASURABLE_INNER_OUTER = prove
8249  (`!s. real_measurable s <=>
8250                 !e. &0 < e
8251                     ==> ?t u. t SUBSET s /\ s SUBSET u /\
8252                               real_measurable t /\ real_measurable u /\
8253                               abs(real_measure t - real_measure u) < e`,
8254   GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL
8255    [GEN_TAC THEN DISCH_TAC THEN REPEAT(EXISTS_TAC `s:real->bool`) THEN
8256     ASM_REWRITE_TAC[SUBSET_REFL; REAL_SUB_REFL; REAL_ABS_NUM];
8257     ALL_TAC] THEN
8258   REWRITE_TAC[REAL_MEASURABLE_REAL_INTEGRABLE] THEN
8259   MATCH_MP_TAC REAL_INTEGRABLE_STRADDLE THEN
8260   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
8261   FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN
8262   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
8263   MAP_EVERY X_GEN_TAC [`t:real->bool`; `u:real->bool`] THEN STRIP_TAC THEN
8264   MAP_EVERY EXISTS_TAC
8265    [`(\x. if x IN t then &1 else &0):real->real`;
8266     `(\x. if x IN u then &1 else &0):real->real`;
8267     `real_measure(t:real->bool)`;
8268     `real_measure(u:real->bool)`] THEN
8269   ASM_REWRITE_TAC[GSYM HAS_REAL_MEASURE; GSYM HAS_REAL_MEASURE_MEASURE] THEN
8270   ASM_REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN REPEAT STRIP_TAC THEN
8271   REPEAT(COND_CASES_TAC THEN
8272          ASM_REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL]) THEN
8273   ASM SET_TAC[]);;
8274
8275 let HAS_REAL_MEASURE_INNER_OUTER = prove
8276  (`!s m. s has_real_measure m <=>
8277                 (!e. &0 < e ==> ?t. t SUBSET s /\ real_measurable t /\
8278                                     m - e < real_measure t) /\
8279                 (!e. &0 < e ==> ?u. s SUBSET u /\ real_measurable u /\
8280                                     real_measure u < m + e)`,
8281   REPEAT GEN_TAC THEN
8282   GEN_REWRITE_TAC LAND_CONV
8283       [HAS_REAL_MEASURE_REAL_MEASURABLE_REAL_MEASURE] THEN EQ_TAC THENL
8284    [REPEAT STRIP_TAC THEN EXISTS_TAC `s:real->bool` THEN
8285     ASM_REWRITE_TAC[SUBSET_REFL] THEN ASM_REAL_ARITH_TAC;
8286     ALL_TAC] THEN
8287   DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "t") (LABEL_TAC "u")) THEN
8288   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
8289    [GEN_REWRITE_TAC I [REAL_MEASURABLE_INNER_OUTER] THEN
8290     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
8291     REMOVE_THEN "u" (MP_TAC o SPEC `e / &2`) THEN
8292     REMOVE_THEN "t" (MP_TAC o SPEC `e / &2`) THEN
8293     ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
8294     REWRITE_TAC[IMP_IMP; LEFT_AND_EXISTS_THM] THEN
8295     REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
8296     REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
8297     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH
8298      `&0 < e /\ t <= u /\ m - e / &2 < t /\ u < m + e / &2
8299                           ==> abs(t - u) < e`) THEN
8300     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_MEASURE_SUBSET THEN
8301     ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
8302     DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH
8303      `~(&0 < x - y) /\ ~(&0 < y - x) ==> x = y`) THEN
8304     CONJ_TAC THEN DISCH_TAC THENL
8305      [REMOVE_THEN "u" (MP_TAC o SPEC `real_measure(s:real->bool) - m`) THEN
8306       ASM_REWRITE_TAC[REAL_SUB_ADD2; GSYM REAL_NOT_LE];
8307       REMOVE_THEN "t" (MP_TAC o SPEC `m - real_measure(s:real->bool)`) THEN
8308       ASM_REWRITE_TAC[REAL_SUB_SUB2; GSYM REAL_NOT_LE]] THEN
8309     ASM_MESON_TAC[REAL_MEASURE_SUBSET]]);;
8310
8311 let HAS_REAL_MEASURE_INNER_OUTER_LE = prove
8312  (`!s:real->bool m.
8313         s has_real_measure m <=>
8314                 (!e. &0 < e ==> ?t. t SUBSET s /\ real_measurable t /\
8315                                     m - e <= real_measure t) /\
8316                 (!e. &0 < e ==> ?u. s SUBSET u /\ real_measurable u /\
8317                                     real_measure u <= m + e)`,
8318   REWRITE_TAC[HAS_REAL_MEASURE_INNER_OUTER] THEN
8319   MESON_TAC[REAL_ARITH `&0 < e /\ m - e / &2 <= t ==> m - e < t`;
8320             REAL_ARITH `&0 < e /\ u <= m + e / &2 ==> u < m + e`;
8321             REAL_ARITH `&0 < e <=> &0 < e / &2`; REAL_LT_IMP_LE]);;
8322
8323 let HAS_REAL_MEASURE_AFFINITY = prove
8324  (`!s m c y. s has_real_measure y
8325              ==> (IMAGE (\x. m * x + c) s) has_real_measure abs(m) * y`,
8326   REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE] THEN
8327   DISCH_THEN(MP_TAC o SPECL [`m:real`; `lift c`] o MATCH_MP
8328     HAS_MEASURE_AFFINITY) THEN
8329   REWRITE_TAC[DIMINDEX_1; REAL_POW_1; GSYM IMAGE_o] THEN
8330   MATCH_MP_TAC EQ_IMP THEN REPEAT(AP_THM_TAC THEN AP_TERM_TAC) THEN
8331   SIMP_TAC[FUN_EQ_THM; FORALL_DROP; o_THM; LIFT_DROP; LIFT_ADD; LIFT_CMUL]);;
8332
8333 let HAS_REAL_MEASURE_SCALING = prove
8334  (`!s m y. s has_real_measure y
8335            ==> (IMAGE (\x. m * x) s) has_real_measure abs(m) * y`,
8336   ONCE_REWRITE_TAC[REAL_ARITH `m * x = m * x + &0`] THEN
8337   REWRITE_TAC[REAL_ARITH `abs m * x + &0 = abs m * x`] THEN
8338   REWRITE_TAC[HAS_REAL_MEASURE_AFFINITY]);;
8339
8340 let HAS_REAL_MEASURE_TRANSLATION = prove
8341  (`!s m a. s has_real_measure m ==> (IMAGE (\x. a + x) s) has_real_measure m`,
8342   REPEAT GEN_TAC THEN
8343   ONCE_REWRITE_TAC[REAL_ARITH `a + x = &1 * x + a`] THEN
8344   GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [REAL_ARITH `m = abs(&1) * m`] THEN
8345   REWRITE_TAC[HAS_REAL_MEASURE_AFFINITY]);;
8346
8347 let REAL_NEGLIGIBLE_TRANSLATION = prove
8348  (`!s a. real_negligible s ==> real_negligible (IMAGE (\x. a + x) s)`,
8349   SIMP_TAC[GSYM HAS_REAL_MEASURE_0; HAS_REAL_MEASURE_TRANSLATION]);;
8350
8351 let HAS_REAL_MEASURE_TRANSLATION_EQ = prove
8352  (`!s m. (IMAGE (\x. a + x) s) has_real_measure m <=> s has_real_measure m`,
8353   REPEAT GEN_TAC THEN EQ_TAC THEN
8354   REWRITE_TAC[HAS_REAL_MEASURE_TRANSLATION] THEN
8355   DISCH_THEN(MP_TAC o SPEC `--a:real` o
8356     MATCH_MP HAS_REAL_MEASURE_TRANSLATION) THEN
8357   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
8358   REWRITE_TAC[GSYM IMAGE_o; o_DEF; REAL_ARITH `--a + a + b:real = b`] THEN
8359   SET_TAC[]);;
8360
8361 let REAL_NEGLIGIBLE_TRANSLATION_REV = prove
8362  (`!s a. real_negligible (IMAGE (\x. a + x) s) ==> real_negligible s`,
8363   SIMP_TAC[GSYM HAS_REAL_MEASURE_0; HAS_REAL_MEASURE_TRANSLATION_EQ]);;
8364
8365 let REAL_NEGLIGIBLE_TRANSLATION_EQ = prove
8366  (`!s a. real_negligible (IMAGE (\x. a + x) s) <=> real_negligible s`,
8367   SIMP_TAC[GSYM HAS_REAL_MEASURE_0; HAS_REAL_MEASURE_TRANSLATION_EQ]);;
8368
8369 let REAL_MEASURABLE_TRANSLATION = prove
8370  (`!s. real_measurable (IMAGE (\x. a + x) s) <=> real_measurable s`,
8371   REWRITE_TAC[real_measurable; HAS_REAL_MEASURE_TRANSLATION_EQ]);;
8372
8373 let REAL_MEASURE_TRANSLATION = prove
8374  (`!s. real_measurable s
8375        ==> real_measure(IMAGE (\x. a + x) s) = real_measure s`,
8376   REWRITE_TAC[HAS_REAL_MEASURE_MEASURE] THEN REPEAT STRIP_TAC THEN
8377   MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN
8378   ASM_REWRITE_TAC[HAS_REAL_MEASURE_TRANSLATION_EQ]);;
8379
8380 let HAS_REAL_MEASURE_SCALING_EQ = prove
8381  (`!s m c. ~(c = &0)
8382            ==> ((IMAGE (\x. c * x) s) has_real_measure (abs(c) * m) <=>
8383                 s has_real_measure m)`,
8384   REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[HAS_REAL_MEASURE_SCALING] THEN
8385   DISCH_THEN(MP_TAC o SPEC `inv(c:real)` o
8386     MATCH_MP HAS_REAL_MEASURE_SCALING) THEN
8387   REWRITE_TAC[GSYM IMAGE_o; o_DEF; GSYM REAL_ABS_MUL] THEN
8388   REWRITE_TAC[GSYM REAL_POW_MUL; REAL_MUL_ASSOC] THEN
8389   ASM_SIMP_TAC[GSYM REAL_ABS_MUL; REAL_MUL_LINV] THEN
8390   REWRITE_TAC[REAL_POW_ONE; REAL_ABS_NUM; REAL_MUL_LID] THEN
8391   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SET_TAC[]);;
8392
8393 let REAL_MEASURABLE_SCALING = prove
8394  (`!s c. real_measurable s ==> real_measurable (IMAGE (\x. c * x) s)`,
8395   REWRITE_TAC[real_measurable] THEN MESON_TAC[HAS_REAL_MEASURE_SCALING]);;
8396
8397 let REAL_MEASURABLE_SCALING_EQ = prove
8398  (`!s c. ~(c = &0)
8399          ==> (real_measurable (IMAGE (\x. c * x) s) <=> real_measurable s)`,
8400   REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[REAL_MEASURABLE_SCALING] THEN
8401   DISCH_THEN(MP_TAC o SPEC `inv c:real` o MATCH_MP REAL_MEASURABLE_SCALING) THEN
8402   REWRITE_TAC[GSYM IMAGE_o; o_DEF; GSYM REAL_ABS_MUL] THEN
8403   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
8404   ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_LID] THEN
8405   SET_TAC[]);;
8406
8407 let REAL_MEASURE_SCALING = prove
8408  (`!s. real_measurable s
8409        ==> real_measure(IMAGE (\x. c * x) s) = abs(c) * real_measure s`,
8410   REWRITE_TAC[HAS_REAL_MEASURE_MEASURE] THEN REPEAT STRIP_TAC THEN
8411   MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN
8412   ASM_SIMP_TAC[HAS_REAL_MEASURE_SCALING]);;
8413
8414 let HAS_REAL_MEASURE_NESTED_UNIONS = prove
8415  (`!s B. (!n. real_measurable(s n)) /\
8416          (!n. real_measure(s n) <= B) /\
8417          (!n. s(n) SUBSET s(SUC n))
8418          ==> real_measurable(UNIONS { s(n) | n IN (:num) }) /\
8419              ((\n. real_measure(s n))
8420                    ---> real_measure(UNIONS { s(n) | n IN (:num) }))
8421              sequentially`,
8422   REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL; o_DEF] THEN
8423   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
8424   ASM_SIMP_TAC[REAL_MEASURE_MEASURE] THEN POP_ASSUM MP_TAC THEN
8425   REWRITE_TAC[REAL_MEASURABLE_MEASURABLE] THEN
8426   REPEAT(DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN
8427   MP_TAC(ISPECL [`IMAGE lift o (s:num->real->bool)`; `B:real`]
8428         HAS_MEASURE_NESTED_UNIONS) THEN
8429   ASM_SIMP_TAC[o_THM; IMAGE_SUBSET] THEN
8430   REWRITE_TAC[SET_RULE `{IMAGE f (s n) | P n} = IMAGE (IMAGE f) {s n | P n}`;
8431               GSYM IMAGE_UNIONS] THEN
8432   SIMP_TAC[REAL_MEASURE_MEASURE; REAL_MEASURABLE_MEASURABLE]);;
8433
8434 let REAL_MEASURABLE_NESTED_UNIONS = prove
8435  (`!s B. (!n. real_measurable(s n)) /\
8436          (!n. real_measure(s n) <= B) /\
8437          (!n. s(n) SUBSET s(SUC n))
8438          ==> real_measurable(UNIONS { s(n) | n IN (:num) })`,
8439   REPEAT GEN_TAC THEN
8440   DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_MEASURE_NESTED_UNIONS) THEN
8441   SIMP_TAC[]);;
8442
8443 let HAS_REAL_MEASURE_COUNTABLE_REAL_NEGLIGIBLE_UNIONS = prove
8444  (`!s:num->real->bool B.
8445         (!n. real_measurable(s n)) /\
8446         (!m n. ~(m = n) ==> real_negligible(s m INTER s n)) /\
8447         (!n. sum (0..n) (\k. real_measure(s k)) <= B)
8448         ==> real_measurable(UNIONS { s(n) | n IN (:num) }) /\
8449             ((\n. real_measure(s n)) real_sums
8450              real_measure(UNIONS { s(n) | n IN (:num) })) (from 0)`,
8451   REPEAT GEN_TAC THEN STRIP_TAC THEN
8452   MP_TAC(ISPECL [`\n. UNIONS (IMAGE s (0..n)):real->bool`; `B:real`]
8453                HAS_REAL_MEASURE_NESTED_UNIONS) THEN
8454   REWRITE_TAC[real_sums; FROM_0; INTER_UNIV] THEN
8455   SUBGOAL_THEN
8456    `!n. (UNIONS (IMAGE s (0..n)):real->bool) has_real_measure
8457         (sum(0..n) (\k. real_measure(s k)))`
8458   MP_TAC THENL
8459    [GEN_TAC THEN MATCH_MP_TAC HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE THEN
8460     ASM_SIMP_TAC[FINITE_NUMSEG];
8461     ALL_TAC] THEN
8462   DISCH_THEN(fun th -> ASSUME_TAC th THEN
8463     ASSUME_TAC(GEN `n:num` (MATCH_MP REAL_MEASURE_UNIQUE
8464      (SPEC `n:num` th)))) THEN
8465   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
8466    [CONJ_TAC THENL [ASM_MESON_TAC[real_measurable]; ALL_TAC] THEN
8467     GEN_TAC THEN MATCH_MP_TAC SUBSET_UNIONS THEN
8468     MATCH_MP_TAC IMAGE_SUBSET THEN
8469     REWRITE_TAC[SUBSET; IN_NUMSEG] THEN ARITH_TAC;
8470     ALL_TAC] THEN
8471   SIMP_TAC[LIFT_SUM; FINITE_NUMSEG; o_DEF] THEN
8472   SUBGOAL_THEN
8473    `UNIONS {UNIONS (IMAGE s (0..n)) | n IN (:num)}:real->bool =
8474     UNIONS (IMAGE s (:num))`
8475    (fun th -> REWRITE_TAC[th] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
8476               REWRITE_TAC[]) THEN
8477   GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real` THEN
8478   REWRITE_TAC[IN_UNIONS] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
8479   REWRITE_TAC[EXISTS_IN_IMAGE; EXISTS_IN_UNIONS; IN_UNIV] THEN
8480   REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE] THEN
8481   REWRITE_TAC[IN_NUMSEG; LE_0] THEN MESON_TAC[LE_REFL]);;
8482
8483 let REAL_NEGLIGIBLE_COUNTABLE_UNIONS = prove
8484  (`!s:num->real->bool.
8485         (!n. real_negligible(s n))
8486         ==> real_negligible(UNIONS {s(n) | n IN (:num)})`,
8487   REPEAT STRIP_TAC THEN
8488   MP_TAC(ISPECL [`s:num->real->bool`; `&0`]
8489     HAS_REAL_MEASURE_COUNTABLE_REAL_NEGLIGIBLE_UNIONS) THEN
8490   ASM_SIMP_TAC[REAL_MEASURE_EQ_0; SUM_0; REAL_LE_REFL; LIFT_NUM] THEN
8491   ANTS_TAC THENL
8492    [ASM_MESON_TAC[HAS_REAL_MEASURE_0; real_measurable; INTER_SUBSET;
8493                   REAL_NEGLIGIBLE_SUBSET];
8494     ALL_TAC] THEN
8495   SIMP_TAC[GSYM REAL_MEASURABLE_REAL_MEASURE_EQ_0] THEN
8496   STRIP_TAC THEN
8497   MATCH_MP_TAC REAL_SERIES_UNIQUE THEN REWRITE_TAC[LIFT_NUM] THEN
8498   MAP_EVERY EXISTS_TAC [`(\k. &0):num->real`; `from 0`] THEN
8499   ASM_REWRITE_TAC[REAL_SERIES_0]);;
8500
8501 let REAL_MEASURABLE_COUNTABLE_UNIONS_STRONG = prove
8502  (`!s:num->real->bool B.
8503         (!n. real_measurable(s n)) /\
8504         (!n. real_measure(UNIONS {s k | k <= n}) <= B)
8505         ==> real_measurable(UNIONS { s(n) | n IN (:num) })`,
8506   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN STRIP_TAC THEN
8507   MP_TAC(ISPECL [`\n. UNIONS (IMAGE s (0..n)):real->bool`; `B:real`]
8508                REAL_MEASURABLE_NESTED_UNIONS) THEN
8509   SUBGOAL_THEN
8510    `UNIONS {UNIONS (IMAGE s (0..n)) | n IN (:num)}:real->bool =
8511     UNIONS (IMAGE s (:num))`
8512    (fun th -> REWRITE_TAC[th])
8513   THENL
8514    [GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real` THEN
8515     REWRITE_TAC[IN_UNIONS] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
8516     REWRITE_TAC[EXISTS_IN_IMAGE; EXISTS_IN_UNIONS; IN_UNIV] THEN
8517     REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE] THEN
8518     REWRITE_TAC[IN_NUMSEG; LE_0] THEN MESON_TAC[LE_REFL];
8519     ALL_TAC] THEN
8520   DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
8521    [GEN_TAC THEN MATCH_MP_TAC REAL_MEASURABLE_UNIONS THEN
8522     ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE; FINITE_NUMSEG];
8523     ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN
8524     ASM_REWRITE_TAC[IN_NUMSEG; LE_0];
8525     GEN_TAC THEN MATCH_MP_TAC SUBSET_UNIONS THEN
8526     MATCH_MP_TAC IMAGE_SUBSET THEN
8527     REWRITE_TAC[SUBSET; IN_NUMSEG; LE_0] THEN ARITH_TAC]);;
8528
8529 let HAS_REAL_MEASURE_COUNTABLE_REAL_NEGLIGIBLE_UNIONS_BOUNDED = prove
8530  (`!s. (!n. real_measurable(s n)) /\
8531        (!m n. ~(m = n) ==> real_negligible(s m INTER s n)) /\
8532        real_bounded(UNIONS { s(n) | n IN (:num) })
8533        ==> real_measurable(UNIONS { s(n) | n IN (:num) }) /\
8534            ((\n. real_measure(s n)) real_sums
8535             real_measure(UNIONS { s(n) | n IN (:num) })) (from 0)`,
8536   REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL; o_DEF] THEN
8537   REWRITE_TAC[REAL_BOUNDED] THEN
8538   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
8539   ASM_SIMP_TAC[REAL_MEASURE_MEASURE] THEN POP_ASSUM MP_TAC THEN
8540   REWRITE_TAC[REAL_MEASURABLE_MEASURABLE; real_negligible] THEN
8541   REPEAT(DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN
8542   MP_TAC(ISPEC `IMAGE lift o (s:num->real->bool)`
8543         HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED) THEN
8544   ASM_SIMP_TAC[o_THM; IMAGE_SUBSET] THEN
8545   REWRITE_TAC[SET_RULE `{IMAGE f (s n) | P n} = IMAGE (IMAGE f) {s n | P n}`;
8546               GSYM IMAGE_UNIONS] THEN
8547   ASM_SIMP_TAC[GSYM IMAGE_INTER_INJ; LIFT_EQ] THEN
8548   SIMP_TAC[REAL_SUMS; o_DEF; REAL_MEASURE_MEASURE;
8549            REAL_MEASURABLE_MEASURABLE]);;
8550
8551 let REAL_MEASURABLE_COUNTABLE_UNIONS = prove
8552  (`!s B. (!n. real_measurable(s n)) /\
8553          (!n. sum (0..n) (\k. real_measure(s k)) <= B)
8554          ==> real_measurable(UNIONS { s(n) | n IN (:num) })`,
8555   REPEAT STRIP_TAC THEN
8556   MATCH_MP_TAC REAL_MEASURABLE_COUNTABLE_UNIONS_STRONG THEN
8557   EXISTS_TAC `B:real` THEN ASM_REWRITE_TAC[] THEN
8558   X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN
8559   EXISTS_TAC `sum(0..n) (\k. real_measure(s k:real->bool))` THEN
8560   ASM_REWRITE_TAC[] THEN
8561   W(MP_TAC o PART_MATCH (rand o rand) REAL_MEASURE_UNIONS_LE_IMAGE o
8562        rand o snd) THEN
8563   ASM_REWRITE_TAC[FINITE_NUMSEG] THEN
8564   ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN
8565   REWRITE_TAC[IN_NUMSEG; LE_0]);;
8566
8567 let REAL_MEASURABLE_COUNTABLE_UNIONS_BOUNDED = prove
8568  (`!s. (!n. real_measurable(s n)) /\
8569        real_bounded(UNIONS { s(n) | n IN (:num) })
8570        ==> real_measurable(UNIONS { s(n) | n IN (:num) })`,
8571   REWRITE_TAC[REAL_MEASURABLE_MEASURABLE; REAL_BOUNDED] THEN
8572   SIMP_TAC[IMAGE_INTER_INJ; LIFT_EQ; IMAGE_UNIONS] THEN
8573   REWRITE_TAC[SET_RULE `IMAGE f {g x | x IN s} = {f(g x) | x IN s}`] THEN
8574   REWRITE_TAC[MEASURABLE_COUNTABLE_UNIONS_BOUNDED]);;
8575
8576 let REAL_MEASURABLE_COUNTABLE_INTERS = prove
8577  (`!s. (!n. real_measurable(s n))
8578        ==> real_measurable(INTERS { s(n) | n IN (:num) })`,
8579   REPEAT STRIP_TAC THEN
8580   SUBGOAL_THEN `INTERS { s(n):real->bool | n IN (:num) } =
8581                 s 0 DIFF (UNIONS {s 0 DIFF s n | n IN (:num)})`
8582   SUBST1_TAC THENL
8583    [GEN_REWRITE_TAC I [EXTENSION] THEN
8584     REWRITE_TAC[IN_INTERS; IN_DIFF; IN_UNIONS] THEN
8585     REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN
8586     ASM SET_TAC[];
8587     ALL_TAC] THEN
8588   MATCH_MP_TAC REAL_MEASURABLE_DIFF THEN ASM_REWRITE_TAC[] THEN
8589   MATCH_MP_TAC REAL_MEASURABLE_COUNTABLE_UNIONS_STRONG THEN
8590   EXISTS_TAC `real_measure(s 0:real->bool)` THEN
8591   ASM_SIMP_TAC[REAL_MEASURABLE_DIFF; LE_0] THEN
8592   GEN_TAC THEN MATCH_MP_TAC REAL_MEASURE_SUBSET THEN
8593   ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
8594    [ALL_TAC;
8595     REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; IN_ELIM_THM; IN_DIFF] THEN
8596     MESON_TAC[IN_DIFF]] THEN
8597   ONCE_REWRITE_TAC[GSYM IN_NUMSEG_0] THEN
8598   ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
8599   ASM_SIMP_TAC[FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_NUMSEG;
8600                REAL_MEASURABLE_DIFF; REAL_MEASURABLE_UNIONS]);;
8601
8602 let REAL_NEGLIGIBLE_COUNTABLE = prove
8603  (`!s. COUNTABLE s ==> real_negligible s`,
8604   REPEAT STRIP_TAC THEN REWRITE_TAC[real_negligible] THEN
8605   MATCH_MP_TAC NEGLIGIBLE_COUNTABLE THEN ASM_SIMP_TAC[COUNTABLE_IMAGE]);;
8606
8607 let REAL_MEASURABLE_COMPACT = prove
8608  (`!s. real_compact s ==> real_measurable s`,
8609   REWRITE_TAC[REAL_MEASURABLE_MEASURABLE; real_compact; MEASURABLE_COMPACT]);;
8610
8611 let REAL_MEASURABLE_OPEN = prove
8612  (`!s. real_bounded s /\ real_open s ==> real_measurable s`,
8613   REWRITE_TAC[REAL_MEASURABLE_MEASURABLE; REAL_OPEN; REAL_BOUNDED;
8614               MEASURABLE_OPEN]);;
8615
8616 let HAS_REAL_INTEGRAL_NEGLIGIBLE_EQ = prove
8617  (`!f s. (!x. x IN s ==> &0 <= f(x))
8618          ==> ((f has_real_integral &0) s <=>
8619               real_negligible {x | x IN s /\ ~(f x = &0)})`,
8620   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL
8621    [ALL_TAC;
8622     MATCH_MP_TAC HAS_REAL_INTEGRAL_NEGLIGIBLE THEN
8623     EXISTS_TAC `{x | x IN s /\ ~((f:real->real) x = &0)}` THEN
8624     ASM_REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN MESON_TAC[]] THEN
8625   MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN EXISTS_TAC
8626    `UNIONS {{x:real | x IN s /\ abs(f x) >= &1 / (&n + &1)} |
8627             n IN (:num)}` THEN
8628   CONJ_TAC THENL
8629    [MATCH_MP_TAC REAL_NEGLIGIBLE_COUNTABLE_UNIONS THEN
8630     X_GEN_TAC `n:num` THEN REWRITE_TAC[GSYM HAS_REAL_MEASURE_0] THEN
8631     REWRITE_TAC[HAS_REAL_MEASURE] THEN
8632     MATCH_MP_TAC HAS_REAL_INTEGRAL_STRADDLE_NULL THEN
8633     EXISTS_TAC `\x:real. if x IN s then (&n + &1) * f(x) else &0` THEN
8634     CONJ_TAC THENL
8635      [REWRITE_TAC[IN_UNIV; IN_ELIM_THM; real_ge] THEN
8636       X_GEN_TAC `x:real` THEN COND_CASES_TAC THEN
8637       ASM_SIMP_TAC[REAL_POS] THENL
8638        [ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
8639         ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN
8640         MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ a <= abs x ==> a <= x`) THEN
8641         ASM_SIMP_TAC[];
8642         COND_CASES_TAC THEN REWRITE_TAC[REAL_POS] THEN
8643         ASM_SIMP_TAC[REAL_POS; REAL_LE_MUL; REAL_LE_ADD]];
8644       REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN
8645       SUBST1_TAC(REAL_ARITH `&0 = (&n + &1) * &0`) THEN
8646       MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN ASM_REWRITE_TAC[]];
8647     REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real` THEN
8648     REWRITE_TAC[REAL_ABS_NZ] THEN ONCE_REWRITE_TAC[REAL_ARCH_INV] THEN
8649     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `n:num`
8650       STRIP_ASSUME_TAC)) THEN
8651     REWRITE_TAC[IN_UNIONS; EXISTS_IN_GSPEC] THEN
8652     EXISTS_TAC `n - 1` THEN ASM_SIMP_TAC[IN_UNIV; IN_ELIM_THM; real_ge] THEN
8653     ASM_SIMP_TAC[REAL_OF_NUM_ADD; SUB_ADD; LE_1] THEN
8654     ASM_SIMP_TAC[real_div; REAL_MUL_LID; REAL_LT_IMP_LE]]);;
8655
8656 (* ------------------------------------------------------------------------- *)
8657 (* Drop the k'th coordinate, or insert t at the k'th coordinate.             *)
8658 (* ------------------------------------------------------------------------- *)
8659
8660 let dropout = new_definition
8661  `(dropout:num->real^N->real^M) k x =
8662         lambda i. if i < k then x$i else x$(i + 1)`;;
8663
8664 let pushin = new_definition
8665  `pushin k t x = lambda i. if i < k then x$i
8666                            else if i = k then t
8667                            else x$(i - 1)`;;
8668
8669 let DROPOUT_PUSHIN = prove
8670  (`!k t x.
8671         dimindex(:M) + 1 = dimindex(:N)
8672         ==> (dropout k:real^N->real^M) (pushin k t x) = x`,
8673   REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o SYM) THEN
8674   ASM_SIMP_TAC[CART_EQ; dropout; pushin; LAMBDA_BETA;
8675                ARITH_RULE `1 <= n + 1`; ADD_SUB;
8676                ARITH_RULE `m <= n ==> m <= n + 1 /\ m + 1 <= n + 1`] THEN
8677   ARITH_TAC);;
8678
8679 let PUSHIN_DROPOUT = prove
8680  (`!k x.
8681         dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N)
8682         ==> pushin k (x$k) ((dropout k:real^N->real^M) x) = x`,
8683   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN(ASSUME_TAC o GSYM)) THEN
8684   ASM_SIMP_TAC[CART_EQ; dropout; pushin; LAMBDA_BETA;
8685                ARITH_RULE `i <= n + 1 ==> i - 1 <= n`] THEN
8686   X_GEN_TAC `i:num` THEN STRIP_TAC THEN
8687   ASM_CASES_TAC `i:num = k` THEN ASM_REWRITE_TAC[LT_REFL] THEN
8688   FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE
8689    `~(i:num = k) ==> i < k \/ k < i`)) THEN
8690   ASM_SIMP_TAC[ARITH_RULE `i:num < k ==> ~(k < i)`] THEN
8691   W(MP_TAC o PART_MATCH (lhs o rand) LAMBDA_BETA o lhand o snd) THEN
8692   (ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN SUBST1_TAC]) THEN
8693   ASM_SIMP_TAC[ARITH_RULE `k < i ==> ~(i - 1 < k)`] THEN
8694   AP_TERM_TAC THEN ASM_ARITH_TAC);;
8695
8696 let DROPOUT_GALOIS = prove
8697  (`!k x:real^N y:real^M.
8698         dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N)
8699         ==> (y = dropout k x <=> (?t. x = pushin k t y))`,
8700   REPEAT STRIP_TAC THEN EQ_TAC THENL
8701    [DISCH_THEN SUBST1_TAC THEN
8702     EXISTS_TAC `(x:real^N)$k` THEN ASM_SIMP_TAC[PUSHIN_DROPOUT];
8703     DISCH_THEN(X_CHOOSE_THEN `t:real` SUBST1_TAC) THEN
8704     ASM_SIMP_TAC[DROPOUT_PUSHIN]]);;
8705
8706 let IN_IMAGE_DROPOUT = prove
8707  (`!x s.
8708         dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N)
8709         ==> (x IN IMAGE (dropout k:real^N->real^M) s <=>
8710              ?t. (pushin k t x) IN s)`,
8711   SIMP_TAC[IN_IMAGE; DROPOUT_GALOIS] THEN MESON_TAC[]);;
8712
8713 let CLOSED_INTERVAL_DROPOUT = prove
8714  (`!k a b. dimindex(:M) + 1 = dimindex(:N) /\
8715            1 <= k /\ k <= dimindex(:N) /\
8716            a$k <= b$k
8717            ==> interval[dropout k a,dropout k b] =
8718                IMAGE (dropout k:real^N->real^M) (interval[a,b])`,
8719   REPEAT STRIP_TAC THEN
8720   ASM_SIMP_TAC[EXTENSION; IN_IMAGE_DROPOUT; IN_INTERVAL] THEN
8721   X_GEN_TAC `x:real^M` THEN
8722   SIMP_TAC[pushin; dropout; LAMBDA_BETA] THEN EQ_TAC THENL
8723    [DISCH_TAC THEN EXISTS_TAC `(a:real^N)$k` THEN X_GEN_TAC `i:num` THEN
8724     STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
8725      [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN
8726       DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC;
8727       COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN
8728       FIRST_X_ASSUM(MP_TAC o SPEC `i - 1`) THEN
8729       COND_CASES_TAC THENL [ASM_ARITH_TAC; ASM_REWRITE_TAC[]] THEN
8730       ANTS_TAC THENL [ASM_ARITH_TAC; ASM_SIMP_TAC[SUB_ADD]]];
8731     DISCH_THEN(X_CHOOSE_TAC `t:real`) THEN X_GEN_TAC `i:num` THEN
8732     STRIP_TAC THEN COND_CASES_TAC THENL
8733      [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN
8734       DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC;
8735       FIRST_X_ASSUM(MP_TAC o SPEC `i + 1`) THEN
8736       ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
8737       COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_ARITH_TAC; ALL_TAC] THEN
8738       COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_ARITH_TAC; ALL_TAC] THEN
8739       ASM_REWRITE_TAC[ADD_SUB]]]);;
8740
8741 let IMAGE_DROPOUT_CLOSED_INTERVAL = prove
8742  (`!k a b. dimindex(:M) + 1 = dimindex(:N) /\
8743            1 <= k /\ k <= dimindex(:N)
8744            ==> IMAGE (dropout k:real^N->real^M) (interval[a,b]) =
8745                   if a$k <= b$k then interval[dropout k a,dropout k b]
8746                   else {}`,
8747   REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
8748   ASM_SIMP_TAC[CLOSED_INTERVAL_DROPOUT; IMAGE_EQ_EMPTY] THEN
8749   REWRITE_TAC[INTERVAL_EQ_EMPTY; GSYM REAL_NOT_LE] THEN ASM_MESON_TAC[]);;
8750
8751 let LINEAR_DROPOUT = prove
8752  (`!k. dimindex(:M) < dimindex(:N)
8753        ==> linear(dropout k :real^N->real^M)`,
8754   GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE
8755    `m < n ==> !i:num. i <= m ==> i <= n /\ i + 1 <= n`)) THEN
8756   SIMP_TAC[linear; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
8757            dropout; LAMBDA_BETA] THEN
8758   REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
8759   ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
8760                ARITH_RULE `1 <= i + 1`]);;
8761
8762 let DROPOUT_EQ = prove
8763  (`!x y k. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\
8764            x$k = y$k /\ (dropout k:real^N->real^M) x = dropout k y
8765            ==> x = y`,
8766   SIMP_TAC[CART_EQ; dropout; VEC_COMPONENT; LAMBDA_BETA; IN_ELIM_THM] THEN
8767   MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `k:num`] THEN
8768   STRIP_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
8769   ASM_CASES_TAC `i:num = k` THEN ASM_REWRITE_TAC[] THEN
8770   FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE
8771    `~(i:num = k) ==> i < k \/ k < i`))
8772   THENL
8773    [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_SIMP_TAC[];
8774     FIRST_X_ASSUM(MP_TAC o SPEC `i - 1`) THEN
8775     ASM_SIMP_TAC[SUB_ADD; ARITH_RULE `k < i ==> ~(i - 1 < k)`]] THEN
8776   DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC);;
8777
8778 let DROPOUT_0 = prove
8779  (`dropout k (vec 0:real^N) = vec 0`,
8780   SIMP_TAC[dropout; VEC_COMPONENT; CART_EQ; COND_ID; LAMBDA_BETA]);;
8781
8782 let DOT_DROPOUT = prove
8783  (`!k x y:real^N.
8784         dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N)
8785         ==> (dropout k x:real^M) dot (dropout k y) = x dot y - x$k * y$k`,
8786   REPEAT STRIP_TAC THEN SIMP_TAC[dot; dropout; LAMBDA_BETA] THEN
8787   REWRITE_TAC[TAUT `(if p then x else y:real) * (if p then a else b) =
8788                     (if p then x * a else y * b)`] THEN
8789   SIMP_TAC[SUM_CASES; FINITE_NUMSEG] THEN
8790   SUBGOAL_THEN
8791    `(!i. i IN 1..dimindex(:M) /\ i < k <=> i IN 1..k-1) /\
8792     (!i.  i IN 1..dimindex(:M) /\ ~(i < k) <=> i IN k..dimindex(:M))`
8793   (fun th -> REWRITE_TAC[th])
8794   THENL [REWRITE_TAC[IN_NUMSEG] THEN ASM_ARITH_TAC; ALL_TAC] THEN
8795   REWRITE_TAC[SIMPLE_IMAGE; IMAGE_ID] THEN
8796   REWRITE_TAC[GSYM(SPEC `1` SUM_OFFSET)] THEN
8797   W(MP_TAC o PART_MATCH (rhs o rand) SUM_UNION o lhs o snd) THEN
8798   ANTS_TAC THENL
8799    [REWRITE_TAC[FINITE_NUMSEG; DISJOINT_NUMSEG] THEN ARITH_TAC;
8800     DISCH_THEN(SUBST1_TAC o SYM)] THEN
8801   MP_TAC(ISPECL [`\i. (x:real^N)$i * (y:real^N)$i`;
8802                  `1..dimindex(:N)`;
8803                  `k:num`] SUM_DELETE) THEN
8804   ASM_REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG] THEN
8805   DISCH_THEN(SUBST1_TAC o SYM) THEN
8806   AP_THM_TAC THEN AP_TERM_TAC THEN
8807   REWRITE_TAC[EXTENSION; IN_NUMSEG; IN_UNION; IN_DELETE] THEN ASM_ARITH_TAC);;
8808
8809 let DOT_PUSHIN = prove
8810  (`!k a b x y:real^M.
8811         dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N)
8812         ==> (pushin k a x:real^N) dot (pushin k b y) = x dot y + a * b`,
8813   REPEAT STRIP_TAC THEN
8814   MATCH_MP_TAC EQ_TRANS THEN
8815   EXISTS_TAC `(dropout k (pushin k a (x:real^M):real^N):real^M) dot
8816               (dropout k (pushin k b (y:real^M):real^N):real^M) +
8817               a * b` THEN
8818   CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[DROPOUT_PUSHIN]] THEN
8819   ASM_SIMP_TAC[DOT_DROPOUT] THEN
8820   MATCH_MP_TAC(REAL_RING
8821    `a':real = a /\ b' = b ==> x = x - a' * b' + a * b`) THEN
8822   ASM_SIMP_TAC[pushin; LAMBDA_BETA; LT_REFL]);;
8823
8824 let DROPOUT_ADD = prove
8825  (`!k x y:real^N. dropout k (x + y) = dropout k x + dropout k y`,
8826   SIMP_TAC[dropout; VECTOR_ADD_COMPONENT; CART_EQ; LAMBDA_BETA] THEN
8827   MESON_TAC[]);;
8828
8829 let DROPOUT_SUB = prove
8830  (`!k x y:real^N. dropout k (x - y) = dropout k x - dropout k y`,
8831   SIMP_TAC[dropout; VECTOR_SUB_COMPONENT; CART_EQ; LAMBDA_BETA] THEN
8832   MESON_TAC[]);;
8833
8834 let DROPOUT_MUL = prove
8835  (`!k c x:real^N. dropout k (c % x) = c % dropout k x`,
8836   SIMP_TAC[dropout; VECTOR_MUL_COMPONENT; CART_EQ; LAMBDA_BETA] THEN
8837   MESON_TAC[]);;
8838
8839 (* ------------------------------------------------------------------------- *)
8840 (* Take slice of set s at x$k = t and drop the k'th coordinate.              *)
8841 (* ------------------------------------------------------------------------- *)
8842
8843 let slice = new_definition
8844  `slice k t s = IMAGE (dropout k) (s INTER {x | x$k = t})`;;
8845
8846 let IN_SLICE = prove
8847  (`!s:real^N->bool y:real^M.
8848         dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N)
8849         ==> (y IN slice k t s <=> pushin k t y IN s)`,
8850   SIMP_TAC[slice; IN_IMAGE_DROPOUT; IN_INTER; IN_ELIM_THM] THEN
8851   REPEAT STRIP_TAC THEN REWRITE_TAC[pushin] THEN
8852   ASM_SIMP_TAC[LAMBDA_BETA; LT_REFL] THEN MESON_TAC[]);;
8853
8854 let INTERVAL_INTER_HYPERPLANE = prove
8855  (`!k t a b:real^N.
8856         1 <= k /\ k <= dimindex(:N)
8857         ==> interval[a,b] INTER {x | x$k = t} =
8858                 if a$k <= t /\ t <= b$k
8859                 then interval[(lambda i. if i = k then t else a$i),
8860                               (lambda i. if i = k then t else b$i)]
8861                 else {}`,
8862   REPEAT STRIP_TAC THEN
8863   REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL; IN_ELIM_THM] THEN
8864   X_GEN_TAC `x:real^N` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
8865    [ALL_TAC; ASM_MESON_TAC[NOT_IN_EMPTY]] THEN
8866   SIMP_TAC[IN_INTERVAL; LAMBDA_BETA] THEN
8867   EQ_TAC THEN STRIP_TAC THENL [ASM_MESON_TAC[REAL_LE_ANTISYM]; ALL_TAC] THEN
8868   CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_ANTISYM]] THEN
8869   X_GEN_TAC `i:num` THEN STRIP_TAC THEN
8870   FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN
8871   COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);;
8872
8873 let SLICE_INTERVAL = prove
8874  (`!k a b t. dimindex(:M) + 1 = dimindex(:N) /\
8875              1 <= k /\ k <= dimindex(:N)
8876              ==> slice k t (interval[a,b]) =
8877                  if a$k <= t /\ t <= b$k
8878                  then interval[(dropout k:real^N->real^M) a,dropout k b]
8879                  else {}`,
8880   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[slice; INTERVAL_INTER_HYPERPLANE] THEN
8881   COND_CASES_TAC THEN ASM_REWRITE_TAC[IMAGE_CLAUSES] THEN
8882   ASM_SIMP_TAC[IMAGE_DROPOUT_CLOSED_INTERVAL; LAMBDA_BETA; REAL_LE_REFL] THEN
8883   MATCH_MP_TAC(MESON[]
8884    `a = a' /\ b = b' ==> interval[a,b] = interval[a',b']`) THEN
8885   SIMP_TAC[CART_EQ; LAMBDA_BETA; dropout] THEN
8886   SUBGOAL_THEN
8887    `!i. i <= dimindex(:M) ==> i <= dimindex(:N) /\ i + 1 <= dimindex(:N)`
8888   MP_TAC THENL
8889    [ASM_ARITH_TAC;
8890     ASM_SIMP_TAC[LAMBDA_BETA; ARITH_RULE `1 <= i + 1`] THEN ARITH_TAC]);;
8891
8892 let SLICE_DIFF = prove
8893  (`!k a s t.
8894         dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N)
8895         ==> (slice k a:(real^N->bool)->(real^M->bool)) (s DIFF t) =
8896              (slice k a s) DIFF (slice k a t)`,
8897   REPEAT STRIP_TAC THEN REWRITE_TAC[slice] THEN
8898   SIMP_TAC[SET_RULE `(s DIFF t) INTER u = (s INTER u) DIFF (t INTER u)`] THEN
8899   MATCH_MP_TAC(SET_RULE
8900    `(!x y. x IN a /\ y IN a /\ f x = f y ==> x = y)
8901     ==> IMAGE f ((s INTER a) DIFF (t INTER a)) =
8902         IMAGE f (s INTER a) DIFF IMAGE f (t INTER a)`) THEN
8903   REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[DROPOUT_EQ]);;
8904
8905 let SLICE_UNIV = prove
8906  (`!k a. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N)
8907         ==> slice k a (:real^N) = (:real^M)`,
8908   REPEAT STRIP_TAC THEN
8909   SIMP_TAC[EXTENSION; IN_UNIV; IN_IMAGE; slice; INTER_UNIV; IN_ELIM_THM] THEN
8910   X_GEN_TAC `y:real^M` THEN EXISTS_TAC `(pushin k a:real^M->real^N) y` THEN
8911   ASM_SIMP_TAC[DROPOUT_PUSHIN] THEN
8912   ASM_SIMP_TAC[pushin; LAMBDA_BETA; LT_REFL]);;
8913
8914 let SLICE_EMPTY = prove
8915  (`!k a. slice k a {} = {}`,
8916   REWRITE_TAC[slice; INTER_EMPTY; IMAGE_CLAUSES]);;
8917
8918 let SLICE_SUBSET = prove
8919  (`!s t k a. s SUBSET t ==> slice k a s SUBSET slice k a t`,
8920   REWRITE_TAC[slice] THEN SET_TAC[]);;
8921
8922 let SLICE_UNIONS = prove
8923  (`!s k a. slice k a (UNIONS s) = UNIONS (IMAGE (slice k a) s)`,
8924   REPEAT GEN_TAC THEN REWRITE_TAC[slice; INTER_UNIONS; IMAGE_UNIONS] THEN
8925   ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[GSYM IMAGE_o] THEN
8926   AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
8927   REWRITE_TAC[FUN_EQ_THM; o_THM; slice]);;
8928
8929 let SLICE_UNION = prove
8930  (`!k a s t.
8931         dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N)
8932         ==> (slice k a:(real^N->bool)->(real^M->bool)) (s UNION t) =
8933              (slice k a s) UNION (slice k a t)`,
8934   REPEAT GEN_TAC THEN REWRITE_TAC[slice; IMAGE_UNION;
8935         SET_RULE `(s UNION t) INTER u = (s INTER u) UNION (t INTER u)`] THEN
8936   ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[GSYM IMAGE_o] THEN
8937   AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
8938   REWRITE_TAC[FUN_EQ_THM; o_THM; slice]);;
8939
8940 let SLICE_INTER = prove
8941  (`!k a s t.
8942         dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N)
8943         ==> (slice k a:(real^N->bool)->(real^M->bool)) (s INTER t) =
8944              (slice k a s) INTER (slice k a t)`,
8945   REPEAT STRIP_TAC THEN REWRITE_TAC[slice] THEN
8946   MATCH_MP_TAC(SET_RULE
8947     `(!x y. x IN u /\ y IN u /\ f x = f y ==> x = y)
8948      ==> IMAGE f ((s INTER t) INTER u) =
8949          IMAGE f (s INTER u) INTER IMAGE f (t INTER u)`) THEN
8950   REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[DROPOUT_EQ]);;
8951
8952 let CONVEX_SLICE = prove
8953  (`!k t s. dimindex(:M) < dimindex(:N) /\ convex s
8954            ==> convex((slice k t:(real^N->bool)->(real^M->bool)) s)`,
8955   REPEAT STRIP_TAC THEN REWRITE_TAC[slice] THEN
8956   MATCH_MP_TAC CONVEX_LINEAR_IMAGE THEN ASM_SIMP_TAC[LINEAR_DROPOUT] THEN
8957   MATCH_MP_TAC CONVEX_INTER THEN ASM_REWRITE_TAC[CONVEX_STANDARD_HYPERPLANE]);;
8958
8959 let COMPACT_SLICE = prove
8960  (`!k t s. dimindex(:M) < dimindex(:N) /\ compact s
8961            ==> compact((slice k t:(real^N->bool)->(real^M->bool)) s)`,
8962   REPEAT STRIP_TAC THEN REWRITE_TAC[slice] THEN
8963   MATCH_MP_TAC COMPACT_LINEAR_IMAGE THEN ASM_SIMP_TAC[LINEAR_DROPOUT] THEN
8964   REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL
8965    [MATCH_MP_TAC BOUNDED_INTER THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED];
8966     MATCH_MP_TAC CLOSED_INTER THEN
8967     ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_STANDARD_HYPERPLANE]]);;
8968
8969 let CLOSED_SLICE = prove
8970  (`!k t s. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\
8971            closed s
8972            ==> closed((slice k t:(real^N->bool)->(real^M->bool)) s)`,
8973   REPEAT STRIP_TAC THEN REWRITE_TAC[slice] THEN
8974   SUBGOAL_THEN
8975    `closed(IMAGE (dropout k:real^N->real^M)
8976                  (IMAGE (\x. x - t % basis k)
8977                         (s INTER {x | x$k = t})))`
8978   MP_TAC THENL
8979    [ALL_TAC;
8980     REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC EQ_IMP THEN
8981     AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN
8982     REWRITE_TAC[FUN_EQ_THM; o_THM; dropout] THEN
8983     SUBGOAL_THEN
8984      `!i. i <= dimindex(:M) ==> i <= dimindex(:N) /\ i + 1 <= dimindex(:N)`
8985     MP_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
8986     SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; CART_EQ;
8987              LAMBDA_BETA; BASIS_COMPONENT; ARITH_RULE `1 <= i + 1`] THEN
8988     SIMP_TAC[ARITH_RULE `i:num < k ==> ~(i = k)`;
8989              ARITH_RULE `~(i < k) ==> ~(i + 1 = k)`] THEN
8990     REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO]] THEN
8991   MATCH_MP_TAC CLOSED_INJECTIVE_IMAGE_SUBSET_SUBSPACE THEN
8992   EXISTS_TAC `{x:real^N | x$k = &0}` THEN
8993   ASM_SIMP_TAC[SUBSPACE_SPECIAL_HYPERPLANE; LINEAR_DROPOUT;
8994                ARITH_RULE `m + 1 = n ==> m < n`] THEN
8995   REPEAT CONJ_TAC THENL
8996    [ONCE_REWRITE_TAC[VECTOR_ARITH `x - t % b:real^N = --(t % b) + x`] THEN
8997     ASM_SIMP_TAC[CLOSED_TRANSLATION_EQ; CLOSED_INTER;
8998                  CLOSED_STANDARD_HYPERPLANE];
8999     MATCH_MP_TAC(SET_RULE
9000      `IMAGE f t SUBSET u ==> IMAGE f (s INTER t) SUBSET u`) THEN
9001     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
9002     ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT;
9003                  REAL_MUL_RID; REAL_SUB_REFL];
9004     REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN
9005     MATCH_MP_TAC DROPOUT_EQ THEN EXISTS_TAC `k:num` THEN
9006     ASM_REWRITE_TAC[DROPOUT_0; VEC_COMPONENT]]);;
9007
9008 let OPEN_SLICE = prove
9009  (`!k t s. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\
9010            open s
9011            ==> open((slice k t:(real^N->bool)->(real^M->bool)) s)`,
9012   REWRITE_TAC[OPEN_CLOSED] THEN REPEAT STRIP_TAC THEN
9013   SUBGOAL_THEN `closed(slice k t ((:real^N) DIFF s):real^M->bool)`
9014   MP_TAC THENL
9015    [ASM_SIMP_TAC[CLOSED_SLICE];
9016    ASM_SIMP_TAC[SLICE_DIFF; SLICE_UNIV]]);;
9017
9018 let BOUNDED_SLICE = prove
9019  (`!k t s. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\
9020            bounded s
9021            ==> bounded((slice k t:(real^N->bool)->(real^M->bool)) s)`,
9022   REPEAT STRIP_TAC THEN
9023   FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
9024   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9025   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
9026   MATCH_MP_TAC BOUNDED_SUBSET THEN
9027   EXISTS_TAC `(slice k t:(real^N->bool)->(real^M->bool)) (interval[a,b])` THEN
9028   ASM_SIMP_TAC[SLICE_SUBSET] THEN ASM_SIMP_TAC[SLICE_INTERVAL] THEN
9029   MESON_TAC[BOUNDED_EMPTY; BOUNDED_INTERVAL]);;
9030
9031 let SLICE_CBALL = prove
9032  (`!k t x r.
9033         dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N)
9034         ==> (slice k t:(real^N->bool)->(real^M->bool)) (cball(x,r)) =
9035                 if abs(t - x$k) <= r
9036                 then cball(dropout k x,sqrt(r pow 2 - (t - x$k) pow 2))
9037                 else {}`,
9038   REPEAT STRIP_TAC THEN REWRITE_TAC[slice] THEN COND_CASES_TAC THENL
9039    [ALL_TAC;
9040     REWRITE_TAC[IMAGE_EQ_EMPTY] THEN
9041     REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; NOT_IN_EMPTY; IN_CBALL] THEN
9042     X_GEN_TAC `y:real^N` THEN REWRITE_TAC[dist] THEN
9043     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
9044     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
9045      `~(a <= r) ==> a <= b ==> b <= r ==> F`)) THEN
9046     ASM_MESON_TAC[VECTOR_SUB_COMPONENT; COMPONENT_LE_NORM; NORM_SUB]] THEN
9047   FIRST_ASSUM(ASSUME_TAC o MATCH_MP(REAL_ARITH `abs(x) <= r ==> &0 <= r`)) THEN
9048   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_CBALL] THEN X_GEN_TAC `y:real^M` THEN
9049   ASM_SIMP_TAC[DROPOUT_GALOIS; LEFT_AND_EXISTS_THM] THEN
9050   ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN
9051   REWRITE_TAC[IN_CBALL; IN_INTER; IN_ELIM_THM] THEN
9052   ASM_SIMP_TAC[pushin; LAMBDA_BETA; LT_REFL] THEN
9053   ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM2] THEN
9054   ASM_REWRITE_TAC[dist; NORM_LE_SQUARE; GSYM pushin] THEN
9055   ASM_SIMP_TAC[SQRT_POW_2; SQRT_POS_LE; REAL_SUB_LE; GSYM REAL_LE_SQUARE_ABS;
9056                REAL_ARITH `abs(x) <= r ==> abs(x) <= abs(r)`] THEN
9057   REWRITE_TAC[VECTOR_ARITH
9058    `(x - y:real^N) dot (x - y) = x dot x + y dot y - &2 * x dot y`] THEN
9059   ASM_SIMP_TAC[DOT_DROPOUT; DOT_PUSHIN] THEN MATCH_MP_TAC(REAL_FIELD
9060      `a = t * k + b
9061       ==> (xx + (yy + t * t) - &2 * a <= r pow 2 <=>
9062            xx - k * k + yy - &2 * b <= r pow 2 - (t - k) pow 2)`) THEN
9063   SUBGOAL_THEN
9064    `y:real^M = dropout k (pushin k t y:real^N)`
9065    (fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th])
9066   THENL
9067    [CONV_TAC SYM_CONV THEN MATCH_MP_TAC DROPOUT_PUSHIN THEN ASM_ARITH_TAC;
9068     ASM_SIMP_TAC[DOT_DROPOUT] THEN
9069     ASM_SIMP_TAC[pushin; LAMBDA_BETA; LT_REFL] THEN REAL_ARITH_TAC]);;
9070
9071 let SLICE_BALL = prove
9072  (`!k t x r.
9073         dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N)
9074         ==> (slice k t:(real^N->bool)->(real^M->bool)) (ball(x,r)) =
9075                 if abs(t - x$k) < r
9076                 then ball(dropout k x,sqrt(r pow 2 - (t - x$k) pow 2))
9077                 else {}`,
9078   REPEAT STRIP_TAC THEN REWRITE_TAC[slice] THEN COND_CASES_TAC THENL
9079    [ALL_TAC;
9080     REWRITE_TAC[IMAGE_EQ_EMPTY] THEN
9081     REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; NOT_IN_EMPTY; IN_BALL] THEN
9082     X_GEN_TAC `y:real^N` THEN REWRITE_TAC[dist] THEN
9083     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
9084     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
9085      `~(a < r) ==> a <= b ==> b < r ==> F`)) THEN
9086     ASM_MESON_TAC[VECTOR_SUB_COMPONENT; COMPONENT_LE_NORM; NORM_SUB]] THEN
9087   FIRST_ASSUM(ASSUME_TAC o MATCH_MP(REAL_ARITH `abs(x) < r ==> &0 < r`)) THEN
9088   REWRITE_TAC[EXTENSION; IN_IMAGE; IN_BALL] THEN X_GEN_TAC `y:real^M` THEN
9089   ASM_SIMP_TAC[DROPOUT_GALOIS; LEFT_AND_EXISTS_THM] THEN
9090   ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN
9091   REWRITE_TAC[IN_BALL; IN_INTER; IN_ELIM_THM] THEN
9092   ASM_SIMP_TAC[pushin; LAMBDA_BETA; LT_REFL] THEN
9093   ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM2] THEN
9094   ASM_REWRITE_TAC[dist; NORM_LT_SQUARE; GSYM pushin] THEN
9095   ASM_SIMP_TAC[SQRT_POW_2; SQRT_POS_LT; REAL_SUB_LT; GSYM REAL_LT_SQUARE_ABS;
9096    REAL_LT_IMP_LE; REAL_ARITH `abs(x) < r ==> abs(x) < abs(r)`] THEN
9097   REWRITE_TAC[VECTOR_ARITH
9098    `(x - y:real^N) dot (x - y) = x dot x + y dot y - &2 * x dot y`] THEN
9099   ASM_SIMP_TAC[DOT_DROPOUT; DOT_PUSHIN] THEN MATCH_MP_TAC(REAL_FIELD
9100      `a = t * k + b
9101       ==> (xx + (yy + t * t) - &2 * a < r pow 2 <=>
9102            xx - k * k + yy - &2 * b < r pow 2 - (t - k) pow 2)`) THEN
9103   SUBGOAL_THEN
9104    `y:real^M = dropout k (pushin k t y:real^N)`
9105    (fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th])
9106   THENL
9107    [CONV_TAC SYM_CONV THEN MATCH_MP_TAC DROPOUT_PUSHIN THEN ASM_ARITH_TAC;
9108     ASM_SIMP_TAC[DOT_DROPOUT] THEN
9109     ASM_SIMP_TAC[pushin; LAMBDA_BETA; LT_REFL] THEN REAL_ARITH_TAC]);;
9110
9111 (* ------------------------------------------------------------------------- *)
9112 (* Weak but useful versions of Fubini's theorem.                             *)
9113 (* ------------------------------------------------------------------------- *)
9114
9115 let FUBINI_CLOSED_INTERVAL = prove
9116  (`!k a b:real^N.
9117         dimindex(:M) + 1 = dimindex(:N) /\
9118         1 <= k /\ k <= dimindex(:N) /\
9119         a$k <= b$k
9120         ==> ((\t. measure (slice k t (interval[a,b]) :real^M->bool))
9121              has_real_integral
9122              (measure(interval[a,b]))) (:real)`,
9123   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SLICE_INTERVAL] THEN
9124   ONCE_REWRITE_TAC[COND_RAND] THEN
9125   REWRITE_TAC[MEASURE_EMPTY; MEASURE_INTERVAL] THEN
9126   REWRITE_TAC[GSYM IN_REAL_INTERVAL] THEN
9127   SIMP_TAC[HAS_REAL_INTEGRAL_RESTRICT; SUBSET_UNIV] THEN
9128   SUBGOAL_THEN
9129    `content(interval[a:real^N,b]) =
9130     content(interval[dropout k a:real^M,dropout k b]) * (b$k - a$k)`
9131   SUBST1_TAC THEN ASM_SIMP_TAC[HAS_REAL_INTEGRAL_CONST] THEN
9132   REWRITE_TAC[CONTENT_CLOSED_INTERVAL_CASES] THEN
9133   GEN_REWRITE_TAC (RAND_CONV o RATOR_CONV) [COND_RAND] THEN
9134   GEN_REWRITE_TAC RAND_CONV [COND_RATOR] THEN
9135   REWRITE_TAC[REAL_MUL_LZERO] THEN MATCH_MP_TAC(TAUT
9136    `(p <=> p') /\ x = x'
9137     ==> (if p then x else y) = (if p' then x' else y)`) THEN
9138   CONJ_TAC THENL
9139    [SIMP_TAC[dropout; LAMBDA_BETA] THEN EQ_TAC THEN DISCH_TAC THEN
9140     X_GEN_TAC `i:num` THEN STRIP_TAC THENL
9141      [COND_CASES_TAC THEN REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
9142       ASM_ARITH_TAC;
9143       ASM_CASES_TAC `i:num = k` THEN ASM_REWRITE_TAC[] THEN
9144       ASM_CASES_TAC `i:num < k` THENL
9145        [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[];
9146         FIRST_X_ASSUM(MP_TAC o SPEC `i - 1`) THEN
9147         COND_CASES_TAC THENL [ASM_ARITH_TAC; ASM_SIMP_TAC[SUB_ADD]]] THEN
9148       DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC];
9149     ALL_TAC] THEN
9150   SUBGOAL_THEN `1..dimindex(:N) =
9151                 (1..(k-1)) UNION
9152                 (k INSERT (IMAGE (\x. x + 1) (k..dimindex(:M))))`
9153   SUBST1_TAC THENL
9154    [REWRITE_TAC[EXTENSION; IN_NUMSEG; IN_UNION; IN_INSERT; IN_IMAGE] THEN
9155     ASM_SIMP_TAC[ARITH_RULE
9156      `1 <= k
9157       ==> (x = y + 1 /\ k <= y /\ y <= n <=>
9158            y = x - 1 /\ k + 1 <= x /\ x <= n + 1)`] THEN
9159     REWRITE_TAC[CONJ_ASSOC; LEFT_EXISTS_AND_THM; EXISTS_REFL] THEN
9160     ASM_ARITH_TAC;
9161     ALL_TAC] THEN
9162   REWRITE_TAC[SET_RULE `s UNION (x INSERT t) = x INSERT (s UNION t)`] THEN
9163   SIMP_TAC[PRODUCT_CLAUSES; FINITE_NUMSEG; FINITE_UNION; FINITE_IMAGE] THEN
9164   ASM_SIMP_TAC[IN_NUMSEG; IN_UNION; IN_IMAGE; ARITH_RULE
9165    `1 <= k ==> ~(k <= k - 1)`] THEN
9166   COND_CASES_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
9167   GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN AP_TERM_TAC THEN
9168   MP_TAC(ISPECL [`1`; `k - 1`; `dimindex(:M)`] NUMSEG_COMBINE_R) THEN
9169   ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN
9170   W(MP_TAC o PART_MATCH (lhs o rand) PRODUCT_UNION o lhand o snd) THEN
9171   SIMP_TAC[FINITE_NUMSEG; FINITE_IMAGE; IN_NUMSEG; SET_RULE
9172             `DISJOINT s (IMAGE f t) <=> !x. x IN t ==> ~(f x IN s)`] THEN
9173   ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN
9174   W(MP_TAC o PART_MATCH (lhs o rand) PRODUCT_UNION o rand o snd) THEN
9175   SIMP_TAC[FINITE_NUMSEG; FINITE_IMAGE; IN_NUMSEG; SET_RULE
9176             `DISJOINT s t <=> !x. ~(x IN s /\ x IN t)`] THEN
9177   ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN
9178   ASM_SIMP_TAC[PRODUCT_IMAGE; EQ_ADD_RCANCEL; SUB_ADD] THEN
9179   BINOP_TAC THEN MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN
9180   SIMP_TAC[dropout; LAMBDA_BETA; o_THM] THEN
9181   REPEAT STRIP_TAC THEN BINOP_TAC THEN
9182   (W(MP_TAC o PART_MATCH (lhs o rand) LAMBDA_BETA o rand o snd) THEN
9183    ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN
9184    REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
9185    ASM_ARITH_TAC));;
9186
9187 let MEASURABLE_OUTER_INTERVALS_BOUNDED_EXPLICIT_SPECIAL = prove
9188  (`!s a b e.
9189         2 <= dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\
9190         measurable s /\ s SUBSET interval[a,b] /\ &0 < e
9191         ==> ?f:num->real^N->bool.
9192               (!i. (f i) SUBSET interval[a,b] /\
9193                    ?c d. c$k <= d$k /\ f i = interval[c,d]) /\
9194               (!i j. ~(i = j) ==> negligible(f i INTER f j)) /\
9195               s SUBSET UNIONS {f n | n IN (:num)} /\
9196               measurable(UNIONS {f n | n IN (:num)}) /\
9197               measure(UNIONS {f n | n IN (:num)}) <= measure s + e`,
9198   let lemma = prove
9199    (`UNIONS {if n IN s then f n else {} | n IN (:num)} =
9200      UNIONS (IMAGE f s)`,
9201    SIMP_TAC[EXTENSION; IN_UNIONS; IN_ELIM_THM; IN_UNIV; EXISTS_IN_IMAGE] THEN
9202    MESON_TAC[NOT_IN_EMPTY]) in
9203   REPEAT GEN_TAC THEN
9204   REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
9205   DISCH_TAC THEN
9206   FIRST_ASSUM(MP_TAC o MATCH_MP MEASURABLE_OUTER_INTERVALS_BOUNDED) THEN
9207   DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
9208   ASM_CASES_TAC `FINITE(d:(real^N->bool)->bool)` THENL
9209    [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN
9210     DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool`
9211      (fun th -> SUBST_ALL_TAC(CONJUNCT2 th) THEN ASSUME_TAC(CONJUNCT1 th))) THEN
9212      RULE_ASSUM_TAC(REWRITE_RULE[IMP_CONJ; FORALL_IN_IMAGE;
9213        RIGHT_FORALL_IMP_THM; IN_UNIV]) THEN
9214     EXISTS_TAC `\k. if k IN 1..CARD(d:(real^N->bool)->bool) then f k
9215                     else ({}:real^N->bool)` THEN
9216     REWRITE_TAC[] THEN CONJ_TAC THENL
9217      [X_GEN_TAC `i:num` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL
9218        [ASM_MESON_TAC[REAL_NOT_LT; IN_NUMSEG; REAL_NOT_LE; INTERVAL_EQ_EMPTY];
9219         REWRITE_TAC[EMPTY_SUBSET] THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN
9220         EXISTS_TAC `(lambda i. if i = k then &0 else &1):real^N` THEN
9221         EXISTS_TAC `(lambda i. if i = k then &1 else &0):real^N` THEN
9222         REWRITE_TAC[INTERVAL_EQ_EMPTY] THEN CONJ_TAC THENL
9223          [SIMP_TAC[LAMBDA_BETA; ASSUME `1 <= k`; ASSUME `k <= dimindex(:N)`;
9224                    REAL_POS];
9225           ALL_TAC] THEN
9226         SUBGOAL_THEN `?j. 1 <= j /\ j <= dimindex(:N) /\ ~(j = k)` MP_TAC THENL
9227          [MATCH_MP_TAC(MESON[] `P(k - 1) \/ P(k + 1) ==> ?i. P i`) THEN
9228           ASM_ARITH_TAC;
9229           MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[LAMBDA_BETA] THEN
9230           REAL_ARITH_TAC]];
9231       ALL_TAC] THEN
9232     CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[lemma]] THEN
9233     REPEAT GEN_TAC THEN
9234       REPEAT(COND_CASES_TAC THEN
9235              ASM_REWRITE_TAC[INTER_EMPTY; NEGLIGIBLE_EMPTY]);
9236     MP_TAC(ISPEC `d:(real^N->bool)->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN
9237     ASM_REWRITE_TAC[INFINITE] THEN MATCH_MP_TAC MONO_EXISTS THEN
9238     X_GEN_TAC `f:num->real^N->bool` THEN
9239     DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN
9240     RULE_ASSUM_TAC(REWRITE_RULE[IMP_CONJ; FORALL_IN_IMAGE;
9241        RIGHT_FORALL_IMP_THM; IN_UNIV]) THEN
9242     RULE_ASSUM_TAC(REWRITE_RULE[GSYM SIMPLE_IMAGE]) THEN
9243     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
9244      [ASM_MESON_TAC[REAL_NOT_LT; IN_NUMSEG; REAL_NOT_LE; INTERVAL_EQ_EMPTY];
9245         ALL_TAC] THEN
9246     MAP_EVERY X_GEN_TAC [`i:num`; `j:num`]] THEN
9247   (DISCH_TAC THEN
9248    SUBGOAL_THEN `negligible(interior((f:num->real^N->bool) i) INTER
9249                             interior(f j))`
9250    MP_TAC THENL [ASM_MESON_TAC[NEGLIGIBLE_EMPTY]; ALL_TAC] THEN
9251    REWRITE_TAC[GSYM INTERIOR_INTER] THEN
9252    REWRITE_TAC[GSYM HAS_MEASURE_0] THEN
9253    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT]
9254      HAS_MEASURE_NEGLIGIBLE_SYMDIFF) THEN
9255    SIMP_TAC[INTERIOR_SUBSET; SET_RULE
9256       `interior(s) SUBSET s
9257        ==> (interior s DIFF s) UNION (s DIFF interior s) =
9258            s DIFF interior s`] THEN
9259    SUBGOAL_THEN `(?c d. (f:num->real^N->bool) i = interval[c,d]) /\
9260                  (?c d. (f:num->real^N->bool) j = interval[c,d])`
9261    STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
9262    ASM_REWRITE_TAC[INTER_INTERVAL; NEGLIGIBLE_FRONTIER_INTERVAL;
9263                    INTERIOR_CLOSED_INTERVAL]));;
9264
9265 let REAL_MONOTONE_CONVERGENCE_INCREASING_AE = prove
9266  (`!f:num->real->real g s.
9267         (!k. (f k) real_integrable_on s) /\
9268         (!k x. x IN s ==> f k x <= f (SUC k) x) /\
9269         (?t. real_negligible t /\
9270              !x. x IN (s DIFF t) ==> ((\k. f k x) ---> g x) sequentially) /\
9271         real_bounded {real_integral s (f k) | k IN (:num)}
9272         ==> g real_integrable_on s /\
9273             ((\k. real_integral s (f k)) ---> real_integral s g) sequentially`,
9274   REPEAT GEN_TAC THEN STRIP_TAC THEN
9275   SUBGOAL_THEN
9276    `g real_integrable_on (s DIFF t) /\
9277     ((\k. real_integral (s DIFF t) (f k)) ---> real_integral (s DIFF t) g)
9278     sequentially`
9279   MP_TAC THENL
9280    [MATCH_MP_TAC REAL_MONOTONE_CONVERGENCE_INCREASING THEN
9281     REPEAT CONJ_TAC THENL
9282      [UNDISCH_TAC `!k:num. f k real_integrable_on s` THEN
9283       MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
9284       MATCH_MP_TAC REAL_INTEGRABLE_SPIKE_SET;
9285       ASM_SIMP_TAC[IN_DIFF];
9286       ASM_REWRITE_TAC[];
9287       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_bounded]) THEN
9288       REWRITE_TAC[real_bounded; FORALL_IN_GSPEC; IN_UNIV] THEN
9289       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN
9290       MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC EQ_IMP THEN
9291       AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
9292       MATCH_MP_TAC REAL_INTEGRAL_SPIKE_SET];
9293     MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL
9294      [MATCH_MP_TAC REAL_INTEGRABLE_SPIKE_SET_EQ THEN
9295       MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN
9296       EXISTS_TAC `t:real->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[];
9297       AP_THM_TAC THEN BINOP_TAC THENL
9298        [ABS_TAC; ALL_TAC] THEN
9299       MATCH_MP_TAC REAL_INTEGRAL_SPIKE_SET]] THEN
9300   MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN
9301   EXISTS_TAC `t:real->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]);;
9302
9303 let FUBINI_SIMPLE_LEMMA = prove
9304  (`!k s:real^N->bool e.
9305         &0 < e /\
9306         dimindex(:M) + 1 = dimindex(:N) /\
9307         1 <= k /\ k <= dimindex(:N) /\
9308         bounded s /\ measurable s /\
9309         (!t. measurable(slice k t s:real^M->bool)) /\
9310         (\t. measure (slice k t s:real^M->bool)) real_integrable_on (:real)
9311         ==> real_integral(:real) (\t. measure (slice k t s :real^M->bool))
9312                 <= measure s + e`,
9313   REPEAT STRIP_TAC THEN
9314   FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
9315   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9316   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
9317   MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `b:real^N`; `e:real`]
9318         MEASURABLE_OUTER_INTERVALS_BOUNDED_EXPLICIT_SPECIAL) THEN
9319   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
9320    [SUBGOAL_THEN `1 <= dimindex(:M)` MP_TAC THENL
9321      [REWRITE_TAC[DIMINDEX_GE_1]; ASM_ARITH_TAC];
9322     ALL_TAC] THEN
9323   DISCH_THEN(X_CHOOSE_THEN `d:num->(real^N->bool)` STRIP_ASSUME_TAC) THEN
9324   SUBGOAL_THEN `!t n:num. measurable((slice k t:(real^N->bool)->real^M->bool)
9325                                      (d n))`
9326   ASSUME_TAC THENL
9327    [MAP_EVERY X_GEN_TAC [`t:real`; `n:num`] THEN
9328     FIRST_X_ASSUM(STRIP_ASSUME_TAC o CONJUNCT2 o SPEC `n:num`) THEN
9329     ASM_SIMP_TAC[SLICE_INTERVAL] THEN
9330     MESON_TAC[MEASURABLE_EMPTY; MEASURABLE_INTERVAL];
9331     ALL_TAC] THEN
9332   MATCH_MP_TAC REAL_LE_TRANS THEN
9333   EXISTS_TAC `measure(UNIONS {d n | n IN (:num)}:real^N->bool)` THEN
9334   ASM_REWRITE_TAC[] THEN
9335   MP_TAC(ISPECL
9336        [`\n t. sum(0..n)
9337            (\m. measure((slice k t:(real^N->bool)->real^M->bool)
9338                        (d m)))`;
9339         `\t. measure((slice k t:(real^N->bool)->real^M->bool)
9340                    (UNIONS {d n | n IN (:num)}))`; `(:real)`]
9341          REAL_MONOTONE_CONVERGENCE_INCREASING_AE) THEN
9342   REWRITE_TAC[] THEN ANTS_TAC THENL
9343    [CONJ_TAC THENL
9344      [X_GEN_TAC `i:num` THEN MATCH_MP_TAC REAL_INTEGRABLE_SUM THEN
9345       ASM_REWRITE_TAC[FINITE_NUMSEG] THEN X_GEN_TAC `j:num` THEN
9346       DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o SPEC `j:num`) THEN
9347       REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9348       MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN STRIP_TAC THEN
9349       MP_TAC(ISPECL [`k:num`; `u:real^N`; `v:real^N`]
9350         FUBINI_CLOSED_INTERVAL) THEN
9351       ASM_REWRITE_TAC[] THEN MESON_TAC[real_integrable_on];
9352       ALL_TAC] THEN
9353     CONJ_TAC THENL
9354      [REPEAT STRIP_TAC THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0] THEN
9355       REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC MEASURE_POS_LE THEN
9356       ASM_REWRITE_TAC[];
9357       ALL_TAC] THEN
9358     CONJ_TAC THENL
9359      [ALL_TAC;
9360       REWRITE_TAC[real_bounded; FORALL_IN_GSPEC; IN_UNIV] THEN
9361       EXISTS_TAC `measure(interval[a:real^N,b])` THEN X_GEN_TAC `i:num` THEN
9362       W(MP_TAC o PART_MATCH (lhand o rand) REAL_INTEGRAL_SUM o
9363         rand o lhand o snd) THEN
9364       ANTS_TAC THENL
9365        [REWRITE_TAC[FINITE_NUMSEG] THEN X_GEN_TAC `j:num` THEN DISCH_TAC THEN
9366         SUBGOAL_THEN `?u v. u$k <= v$k /\
9367                             (d:num->real^N->bool) j = interval[u,v]`
9368         STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
9369         ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_integrable_on] THEN
9370         EXISTS_TAC `measure(interval[u:real^N,v])` THEN
9371         MATCH_MP_TAC FUBINI_CLOSED_INTERVAL THEN ASM_REWRITE_TAC[];
9372         ALL_TAC] THEN
9373       DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
9374       EXISTS_TAC `abs(sum(0..i) (\m. measure(d m:real^N->bool)))` THEN
9375       CONJ_TAC THENL
9376        [MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN
9377         MATCH_MP_TAC SUM_EQ_NUMSEG THEN
9378         X_GEN_TAC `j:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN
9379         MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN
9380         SUBGOAL_THEN `?u v. u$k <= v$k /\
9381                             (d:num->real^N->bool) j = interval[u,v]`
9382         STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
9383         ASM_REWRITE_TAC[] THEN
9384         MATCH_MP_TAC FUBINI_CLOSED_INTERVAL THEN ASM_REWRITE_TAC[];
9385         ALL_TAC] THEN
9386       MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= a ==> abs x <= a`) THEN
9387       CONJ_TAC THENL
9388        [MATCH_MP_TAC SUM_POS_LE THEN REWRITE_TAC[FINITE_NUMSEG] THEN
9389         ASM_MESON_TAC[MEASURE_POS_LE; MEASURABLE_INTERVAL];
9390         ALL_TAC] THEN
9391       W(MP_TAC o PART_MATCH (rhs o rand) MEASURE_NEGLIGIBLE_UNIONS_IMAGE o
9392         lhand o snd) THEN
9393       ANTS_TAC THENL
9394        [ASM_SIMP_TAC[FINITE_NUMSEG] THEN ASM_MESON_TAC[MEASURABLE_INTERVAL];
9395         ALL_TAC] THEN
9396       DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC MEASURE_SUBSET THEN
9397       REWRITE_TAC[MEASURABLE_INTERVAL] THEN CONJ_TAC THENL
9398        [MATCH_MP_TAC MEASURABLE_UNIONS THEN
9399         ASM_SIMP_TAC[FINITE_NUMSEG; FINITE_IMAGE; FORALL_IN_IMAGE] THEN
9400         ASM_MESON_TAC[MEASURABLE_INTERVAL];
9401         REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[]]] THEN
9402     EXISTS_TAC
9403      `(IMAGE (\i. (interval_lowerbound(d i):real^N)$k) (:num)) UNION
9404       (IMAGE (\i. (interval_upperbound(d i):real^N)$k) (:num))` THEN
9405     CONJ_TAC THENL
9406      [MATCH_MP_TAC REAL_NEGLIGIBLE_COUNTABLE THEN
9407       SIMP_TAC[COUNTABLE_UNION; COUNTABLE_IMAGE; NUM_COUNTABLE];
9408       ALL_TAC] THEN
9409     X_GEN_TAC `t:real` THEN
9410     REWRITE_TAC[IN_DIFF; IN_UNION; IN_IMAGE] THEN
9411     GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [IN_UNIV] THEN
9412     REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM] THEN DISCH_TAC THEN
9413     MP_TAC(ISPEC `\n:num. (slice k t:(real^N->bool)->real^M->bool)
9414                           (d n)`
9415        HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED) THEN
9416     ASM_REWRITE_TAC[SLICE_UNIONS] THEN ANTS_TAC THENL
9417      [ALL_TAC;
9418       DISCH_THEN(MP_TAC o CONJUNCT2) THEN
9419       GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN
9420       REWRITE_TAC[GSYM REAL_SUMS; real_sums; FROM_INTER_NUMSEG] THEN
9421       REWRITE_TAC[SIMPLE_IMAGE; GSYM IMAGE_o; o_DEF]] THEN
9422     CONJ_TAC THENL
9423      [ALL_TAC;
9424       MATCH_MP_TAC BOUNDED_SUBSET THEN
9425       EXISTS_TAC `(slice k t:(real^N->bool)->real^M->bool) (interval[a,b])` THEN
9426       CONJ_TAC THENL
9427        [ASM_SIMP_TAC[SLICE_INTERVAL] THEN
9428         MESON_TAC[BOUNDED_INTERVAL; BOUNDED_EMPTY];
9429         REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN
9430         ASM_MESON_TAC[SLICE_SUBSET]]] THEN
9431     MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN DISCH_TAC THEN
9432     FIRST_X_ASSUM(MP_TAC o SPECL [`i:num`; `j:num`]) THEN
9433     ASM_REWRITE_TAC[] THEN
9434     ASM_CASES_TAC `(d:num->real^N->bool) i = {}` THENL
9435      [ASM_REWRITE_TAC[INTER_EMPTY; NEGLIGIBLE_EMPTY; SLICE_EMPTY];
9436       UNDISCH_TAC `~((d:num->real^N->bool) i = {})`] THEN
9437     ASM_CASES_TAC `(d:num->real^N->bool) j = {}` THENL
9438      [ASM_REWRITE_TAC[INTER_EMPTY; NEGLIGIBLE_EMPTY; SLICE_EMPTY];
9439       UNDISCH_TAC `~((d:num->real^N->bool) j = {})`] THEN
9440     FIRST_ASSUM(fun th ->
9441       MAP_EVERY (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)
9442        [SPEC `i:num` th; SPEC `j:num` th]) THEN
9443     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9444     MAP_EVERY X_GEN_TAC [`w:real^N`; `x:real^N`] THEN STRIP_TAC THEN
9445     MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN STRIP_TAC THEN
9446     ASM_SIMP_TAC[SLICE_INTERVAL; INTERVAL_NE_EMPTY] THEN
9447     DISCH_TAC THEN DISCH_TAC THEN
9448     REPEAT(COND_CASES_TAC THEN
9449            ASM_REWRITE_TAC[INTER_EMPTY; NEGLIGIBLE_EMPTY]) THEN
9450     REWRITE_TAC[INTER_INTERVAL; NEGLIGIBLE_INTERVAL; INTERVAL_EQ_EMPTY] THEN
9451     ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a /\ b ==> ~c)`] THEN
9452     SIMP_TAC[LAMBDA_BETA] THEN REWRITE_TAC[NOT_IMP] THEN
9453     DISCH_THEN(X_CHOOSE_THEN `l:num` STRIP_ASSUME_TAC) THEN
9454     SUBGOAL_THEN `~(l:num = k)` ASSUME_TAC THENL
9455      [FIRST_X_ASSUM(CONJUNCTS_THEN
9456        (fun th -> MP_TAC(SPEC `i:num` th) THEN MP_TAC(SPEC `j:num` th))) THEN
9457       ASM_SIMP_TAC[INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND] THEN
9458       REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
9459       REWRITE_TAC[] THEN DISCH_THEN SUBST_ALL_TAC THEN ASM_REAL_ARITH_TAC;
9460       ALL_TAC] THEN
9461     FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE
9462      `~(l:num = k) ==> l < k \/ k < l`))
9463     THENL
9464      [EXISTS_TAC `l:num` THEN
9465       MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN
9466       CONJ_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[dropout; LAMBDA_BETA]] THEN
9467       ASM_REWRITE_TAC[];
9468       ALL_TAC] THEN
9469     EXISTS_TAC `l - 1` THEN
9470     MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN
9471     CONJ_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[dropout; LAMBDA_BETA]] THEN
9472     ASM_SIMP_TAC[ARITH_RULE `k < l ==> ~(l - 1 < k)`] THEN
9473     ASM_SIMP_TAC[SUB_ADD];
9474     ALL_TAC] THEN
9475   STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
9476    `real_integral (:real)
9477         (\t. measure ((slice k t :(real^N->bool)->real^M->bool)
9478                       (UNIONS {d n | n IN (:num)})))` THEN
9479   CONJ_TAC THENL
9480    [MATCH_MP_TAC REAL_INTEGRAL_LE THEN ASM_REWRITE_TAC[] THEN
9481     X_GEN_TAC `t:real` THEN DISCH_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
9482     ASM_SIMP_TAC[SLICE_SUBSET; SLICE_UNIONS] THEN
9483     ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[GSYM IMAGE_o] THEN
9484     ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN
9485     MATCH_MP_TAC MEASURABLE_COUNTABLE_UNIONS_BOUNDED THEN
9486     ASM_REWRITE_TAC[o_THM] THEN
9487     MATCH_MP_TAC BOUNDED_SUBSET THEN
9488     EXISTS_TAC `(slice k t:(real^N->bool)->real^M->bool) (interval[a,b])` THEN
9489     CONJ_TAC THENL
9490      [ASM_SIMP_TAC[SLICE_INTERVAL] THEN
9491       MESON_TAC[BOUNDED_INTERVAL; BOUNDED_EMPTY];
9492       REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN
9493       ASM_MESON_TAC[SLICE_SUBSET]];
9494     MATCH_MP_TAC REAL_EQ_IMP_LE THEN
9495     MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UNIQUE) THEN
9496     EXISTS_TAC `\n. real_integral (:real)
9497        (\t. sum (0..n) (\m. measure((slice k t:(real^N->bool)->real^M->bool)
9498
9499                          (d m))))` THEN
9500     ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN
9501     MP_TAC(ISPEC `d:num->(real^N->bool)`
9502      HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED) THEN
9503     ANTS_TAC THENL
9504      [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
9505        [ASM_MESON_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN
9506       MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `interval[a:real^N,b]` THEN
9507       REWRITE_TAC[BOUNDED_INTERVAL; UNIONS_SUBSET; IN_ELIM_THM] THEN
9508       ASM_MESON_TAC[];
9509       ALL_TAC] THEN
9510     ASM_REWRITE_TAC[] THEN
9511     GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN
9512     REWRITE_TAC[GSYM REAL_SUMS] THEN
9513     REWRITE_TAC[real_sums; FROM_INTER_NUMSEG] THEN
9514     MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN
9515     AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN
9516     X_GEN_TAC `i:num` THEN REWRITE_TAC[] THEN
9517     W(MP_TAC o PART_MATCH (lhand o rand) REAL_INTEGRAL_SUM o rand o snd) THEN
9518     ANTS_TAC THENL
9519      [REWRITE_TAC[FINITE_NUMSEG] THEN X_GEN_TAC `j:num` THEN DISCH_TAC THEN
9520       SUBGOAL_THEN `?u v. u$k <= v$k /\
9521                           (d:num->real^N->bool) j = interval[u,v]`
9522       STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
9523       ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_integrable_on] THEN
9524       EXISTS_TAC `measure(interval[u:real^N,v])` THEN
9525       MATCH_MP_TAC FUBINI_CLOSED_INTERVAL THEN ASM_REWRITE_TAC[];
9526       ALL_TAC] THEN
9527     DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN
9528     X_GEN_TAC `j:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN
9529     CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN
9530     SUBGOAL_THEN `?u v. u$k <= v$k /\
9531                           (d:num->real^N->bool) j = interval[u,v]`
9532     STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
9533     ASM_REWRITE_TAC[] THEN
9534     MATCH_MP_TAC FUBINI_CLOSED_INTERVAL THEN ASM_REWRITE_TAC[]]);;
9535
9536 let FUBINI_SIMPLE = prove
9537  (`!k s:real^N->bool.
9538         dimindex(:M) + 1 = dimindex(:N) /\
9539         1 <= k /\ k <= dimindex(:N) /\
9540         bounded s /\
9541         measurable s /\
9542         (!t. measurable(slice k t s :real^M->bool)) /\
9543         (\t. measure (slice k t s :real^M->bool)) real_integrable_on (:real)
9544         ==> measure s =
9545               real_integral(:real)(\t. measure (slice k t s :real^M->bool))`,
9546   REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL
9547    [ASM_REWRITE_TAC[SLICE_EMPTY; MEASURE_EMPTY; REAL_INTEGRAL_0];
9548     ALL_TAC] THEN
9549   FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
9550   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
9551   MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
9552   SUBGOAL_THEN `~(interval[a:real^N,b] = {})` MP_TAC THENL
9553    [ASM SET_TAC[]; REWRITE_TAC[INTERVAL_NE_EMPTY] THEN DISCH_TAC] THEN
9554   MATCH_MP_TAC(REAL_ARITH `~(&0 < b - a) /\ ~(&0 < a - b) ==> a:real = b`) THEN
9555   CONJ_TAC THEN MATCH_MP_TAC(MESON[]
9556      `(!e. x - y = e ==> ~(&0 < e)) ==> ~(&0 < x - y)`) THEN
9557   X_GEN_TAC `e:real` THEN REPEAT STRIP_TAC THENL
9558    [MP_TAC(ISPECL [`k:num`; `s:real^N->bool`; `e / &2`]
9559       FUBINI_SIMPLE_LEMMA) THEN
9560     ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
9561     ALL_TAC] THEN
9562   MP_TAC(ISPECL [`k:num`; `interval[a:real^N,b] DIFF s`; `e / &2`]
9563     FUBINI_SIMPLE_LEMMA) THEN
9564   ASM_REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN
9565   CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
9566   CONJ_TAC THENL [SIMP_TAC[BOUNDED_DIFF; BOUNDED_INTERVAL]; ALL_TAC] THEN
9567   CONJ_TAC THENL
9568    [ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTERVAL]; ALL_TAC] THEN
9569   ASM_SIMP_TAC[SLICE_DIFF] THEN
9570   MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL
9571    [X_GEN_TAC `t:real` THEN MATCH_MP_TAC MEASURABLE_DIFF THEN
9572     ASM_SIMP_TAC[SLICE_INTERVAL] THEN
9573     MESON_TAC[MEASURABLE_EMPTY; MEASURABLE_INTERVAL];
9574     DISCH_TAC] THEN
9575   SUBGOAL_THEN
9576    `!t. measure(slice k t (interval[a:real^N,b]) DIFF
9577                 slice k t (s:real^N->bool) :real^M->bool) =
9578         measure(slice k t (interval[a:real^N,b]):real^M->bool) -
9579         measure(slice k t s :real^M->bool)`
9580    (fun th -> REWRITE_TAC[th])
9581   THENL
9582    [X_GEN_TAC `t:real` THEN MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN
9583     ASM_SIMP_TAC[SLICE_SUBSET] THEN
9584     ASM_SIMP_TAC[SLICE_INTERVAL] THEN
9585     MESON_TAC[MEASURABLE_EMPTY; MEASURABLE_INTERVAL];
9586     ALL_TAC] THEN
9587   MP_TAC(ISPECL [`k:num`; `a:real^N`; `b:real^N`] FUBINI_CLOSED_INTERVAL) THEN
9588   ASM_SIMP_TAC[] THEN DISCH_TAC THEN CONJ_TAC THENL
9589    [MATCH_MP_TAC REAL_INTEGRABLE_SUB THEN ASM_MESON_TAC[real_integrable_on];
9590     ALL_TAC] THEN
9591   REWRITE_TAC[REAL_NOT_LE] THEN
9592   ASM_SIMP_TAC[MEASURE_DIFF_SUBSET; MEASURABLE_INTERVAL] THEN
9593   W(MP_TAC o PART_MATCH (lhs o rand) REAL_INTEGRAL_SUB o rand o snd) THEN
9594   ANTS_TAC THENL
9595    [ASM_MESON_TAC[real_integrable_on]; DISCH_THEN SUBST1_TAC] THEN
9596   FIRST_ASSUM(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN
9597   ASM_REAL_ARITH_TAC);;
9598
9599 let FUBINI_SIMPLE_ALT = prove
9600  (`!k s:real^N->bool.
9601         dimindex(:M) + 1 = dimindex(:N) /\
9602         1 <= k /\ k <= dimindex(:N) /\
9603         bounded s /\
9604         measurable s /\
9605         (!t. measurable(slice k t s :real^M->bool)) /\
9606         ((\t. measure (slice k t s :real^M->bool)) has_real_integral B) (:real)
9607         ==> measure s = B`,
9608   REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
9609    `real_integral (:real)
9610                  (\t. measure (slice k t (s:real^N->bool) :real^M->bool))` THEN
9611   CONJ_TAC THENL
9612    [MATCH_MP_TAC FUBINI_SIMPLE THEN ASM_REWRITE_TAC[] THEN
9613     ASM_MESON_TAC[real_integrable_on];
9614     MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN ASM_REWRITE_TAC[]]);;
9615
9616 let FUBINI_SIMPLE_COMPACT_STRONG = prove
9617  (`!k s:real^N->bool.
9618         dimindex(:M) + 1 = dimindex(:N) /\
9619         1 <= k /\ k <= dimindex(:N) /\
9620         compact s /\
9621         ((\t. measure (slice k t s :real^M->bool)) has_real_integral B) (:real)
9622         ==> measurable s /\ measure s = B`,
9623   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MEASURABLE_COMPACT] THEN
9624   MATCH_MP_TAC FUBINI_SIMPLE_ALT THEN
9625   EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[] THEN
9626   ASM_SIMP_TAC[COMPACT_IMP_BOUNDED; MEASURABLE_COMPACT] THEN
9627   GEN_TAC THEN MATCH_MP_TAC MEASURABLE_COMPACT THEN
9628   MATCH_MP_TAC COMPACT_SLICE THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);;
9629
9630 let FUBINI_SIMPLE_COMPACT = prove
9631  (`!k s:real^N->bool.
9632         dimindex(:M) + 1 = dimindex(:N) /\
9633         1 <= k /\ k <= dimindex(:N) /\
9634         compact s /\
9635         ((\t. measure (slice k t s :real^M->bool)) has_real_integral B) (:real)
9636         ==> measure s = B`,
9637   REPEAT GEN_TAC THEN
9638   DISCH_THEN(MP_TAC o MATCH_MP FUBINI_SIMPLE_COMPACT_STRONG) THEN SIMP_TAC[]);;
9639
9640 let FUBINI_SIMPLE_CONVEX_STRONG = prove
9641  (`!k s:real^N->bool.
9642         dimindex(:M) + 1 = dimindex(:N) /\
9643         1 <= k /\ k <= dimindex(:N) /\
9644         bounded s /\ convex s /\
9645         ((\t. measure (slice k t s :real^M->bool)) has_real_integral B) (:real)
9646         ==> measurable s /\ measure s = B`,
9647   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MEASURABLE_CONVEX] THEN
9648   MATCH_MP_TAC FUBINI_SIMPLE_ALT THEN
9649   EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[] THEN
9650   ASM_SIMP_TAC[MEASURABLE_CONVEX] THEN
9651   GEN_TAC THEN MATCH_MP_TAC MEASURABLE_CONVEX THEN CONJ_TAC THENL
9652    [MATCH_MP_TAC CONVEX_SLICE; MATCH_MP_TAC BOUNDED_SLICE] THEN
9653   ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);;
9654
9655 let FUBINI_SIMPLE_CONVEX = prove
9656  (`!k s:real^N->bool.
9657         dimindex(:M) + 1 = dimindex(:N) /\
9658         1 <= k /\ k <= dimindex(:N) /\
9659         bounded s /\ convex s /\
9660         ((\t. measure (slice k t s :real^M->bool)) has_real_integral B) (:real)
9661         ==> measure s = B`,
9662   REPEAT GEN_TAC THEN
9663   DISCH_THEN(MP_TAC o MATCH_MP FUBINI_SIMPLE_CONVEX_STRONG) THEN SIMP_TAC[]);;
9664
9665 let FUBINI_SIMPLE_OPEN_STRONG = prove
9666  (`!k s:real^N->bool.
9667         dimindex(:M) + 1 = dimindex(:N) /\
9668         1 <= k /\ k <= dimindex(:N) /\
9669         bounded s /\ open s /\
9670         ((\t. measure (slice k t s :real^M->bool)) has_real_integral B) (:real)
9671         ==> measurable s /\ measure s = B`,
9672   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MEASURABLE_OPEN] THEN
9673   MATCH_MP_TAC FUBINI_SIMPLE_ALT THEN
9674   EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[] THEN
9675   ASM_SIMP_TAC[MEASURABLE_OPEN] THEN
9676   GEN_TAC THEN MATCH_MP_TAC MEASURABLE_OPEN THEN CONJ_TAC THENL
9677    [MATCH_MP_TAC BOUNDED_SLICE; MATCH_MP_TAC OPEN_SLICE] THEN
9678   ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);;
9679
9680 let FUBINI_SIMPLE_OPEN = prove
9681  (`!k s:real^N->bool.
9682         dimindex(:M) + 1 = dimindex(:N) /\
9683         1 <= k /\ k <= dimindex(:N) /\
9684         bounded s /\ open s /\
9685         ((\t. measure (slice k t s :real^M->bool)) has_real_integral B) (:real)
9686         ==> measure s = B`,
9687   REPEAT GEN_TAC THEN
9688   DISCH_THEN(MP_TAC o MATCH_MP FUBINI_SIMPLE_OPEN_STRONG) THEN SIMP_TAC[]);;
9689
9690 (* ------------------------------------------------------------------------- *)
9691 (* Scaled integer, and hence rational, values are dense in the reals.        *)
9692 (* ------------------------------------------------------------------------- *)
9693
9694 let REAL_OPEN_SET_RATIONAL = prove
9695  (`!s. real_open s /\ ~(s = {}) ==> ?x. rational x /\ x IN s`,
9696   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
9697   MP_TAC(ISPEC `IMAGE lift s` OPEN_SET_RATIONAL_COORDINATES) THEN
9698   ASM_REWRITE_TAC[GSYM REAL_OPEN; IMAGE_EQ_EMPTY; EXISTS_IN_IMAGE] THEN
9699   SIMP_TAC[DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP]);;
9700
9701 let REAL_OPEN_RATIONAL = prove
9702  (`!P. real_open {x | P x} /\ (?x. P x) ==> ?x. rational x /\ P x`,
9703   REPEAT STRIP_TAC THEN
9704   MP_TAC(SPEC `{x:real | P x}` REAL_OPEN_SET_RATIONAL) THEN
9705   ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN ASM_MESON_TAC[]);;
9706
9707 let REAL_OPEN_SET_EXISTS_RATIONAL = prove
9708  (`!s. real_open s ==> ((?x. rational x /\ x IN s) <=> (?x. x IN s))`,
9709   REPEAT STRIP_TAC THEN EQ_TAC THEN
9710   ASM_MESON_TAC[REAL_OPEN_SET_RATIONAL; GSYM MEMBER_NOT_EMPTY]);;
9711
9712 let REAL_OPEN_EXISTS_RATIONAL = prove
9713  (`!P. real_open {x | P x} ==> ((?x. rational x /\ P x) <=> (?x. P x))`,
9714   GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_OPEN_SET_EXISTS_RATIONAL) THEN
9715   REWRITE_TAC[IN_ELIM_THM]);;
9716
9717 (* ------------------------------------------------------------------------- *)
9718 (* Hence a criterion for two functions to agree.                             *)
9719 (* ------------------------------------------------------------------------- *)
9720
9721 let CONTINUOUS_ON_CONST_DYADIC_RATIONALS = prove
9722  (`!f:real^M->real^N a.
9723      f continuous_on (:real^M) /\
9724      (!x. (!i. 1 <= i /\ i <= dimindex(:M) ==> integer(x$i)) ==> f(x) = a) /\
9725      (!x. f(x) = a ==> f(inv(&2) % x) = a)
9726      ==> !x. f(x) = a`,
9727   REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL
9728    [`f:real^M->real^N`;
9729     `{ inv(&2 pow n) % x:real^M |n,x|
9730        !i. 1 <= i /\ i <= dimindex(:M) ==> integer(x$i) }`;
9731     `a:real^N`] CONTINUOUS_CONSTANT_ON_CLOSURE) THEN
9732   ASM_REWRITE_TAC[FORALL_IN_GSPEC; CLOSURE_DYADIC_RATIONALS; IN_UNIV] THEN
9733   DISCH_THEN MATCH_MP_TAC THEN
9734   INDUCT_TAC THEN ASM_REWRITE_TAC[real_pow; REAL_INV_1; VECTOR_MUL_LID] THEN
9735   ASM_SIMP_TAC[REAL_INV_MUL; GSYM VECTOR_MUL_ASSOC]);;
9736
9737 let REAL_CONTINUOUS_ON_CONST_DYADIC_RATIONALS = prove
9738  (`!f a.
9739      f real_continuous_on (:real) /\
9740      (!x. integer(x) ==> f(x) = a) /\
9741      (!x. f(x) = a ==> f(x / &2) = a)
9742      ==> !x. f(x) = a`,
9743   REPEAT STRIP_TAC THEN
9744   MP_TAC(ISPECL [`lift o f o drop`; `lift a`]
9745     CONTINUOUS_ON_CONST_DYADIC_RATIONALS) THEN
9746   ASM_REWRITE_TAC[GSYM REAL_CONTINUOUS_ON; GSYM IMAGE_LIFT_UNIV] THEN
9747   ASM_SIMP_TAC[o_THM; DIMINDEX_1; FORALL_1; GSYM drop; LIFT_EQ; DROP_CMUL;
9748                REAL_ARITH `inv(&2) * x = x / &2`] THEN
9749   ASM_MESON_TAC[LIFT_DROP]);;
9750
9751 (* ------------------------------------------------------------------------- *)
9752 (* Various sufficient conditions for additivity to imply linearity.          *)
9753 (* ------------------------------------------------------------------------- *)
9754
9755 let CONTINUOUS_ADDITIVE_IMP_LINEAR = prove
9756  (`!f:real^M->real^N.
9757         f continuous_on (:real^M) /\
9758         (!x y. f(x + y) = f(x) + f(y))
9759         ==> linear f`,
9760   GEN_TAC THEN STRIP_TAC THEN
9761   SUBGOAL_THEN `(f:real^M->real^N) (vec 0) = vec 0` ASSUME_TAC THENL
9762    [FIRST_ASSUM(MP_TAC o repeat (SPEC `vec 0:real^M`)) THEN
9763     REWRITE_TAC[VECTOR_ADD_LID] THEN VECTOR_ARITH_TAC;
9764     ALL_TAC] THEN
9765   ASM_REWRITE_TAC[linear] THEN
9766   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN X_GEN_TAC `x:real^M` THEN
9767   MP_TAC(ISPECL [`\c. norm((f:real^M->real^N)(c % x) - c % f(x))`; `&0`]
9768         REAL_CONTINUOUS_ON_CONST_DYADIC_RATIONALS) THEN
9769   REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN DISCH_THEN MATCH_MP_TAC THEN
9770   REPEAT CONJ_TAC THENL
9771    [RULE_ASSUM_TAC(REWRITE_RULE[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN
9772     RULE_ASSUM_TAC(REWRITE_RULE[IN_UNIV; WITHIN_UNIV]) THEN
9773     REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; IN_UNIV] THEN
9774     GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
9775     MATCH_MP_TAC REAL_CONTINUOUS_CONTINUOUS_WITHINREAL_COMPOSE THEN
9776     SIMP_TAC[REAL_CONTINUOUS_NORM_WITHIN] THEN MATCH_MP_TAC CONTINUOUS_SUB THEN
9777     ASM_SIMP_TAC[REWRITE_RULE[GSYM REAL_CONTINUOUS_CONTINUOUS1]CONTINUOUS_VMUL;
9778                  REAL_CONTINUOUS_WITHIN_ID; CONTINUOUS_AT_WITHIN;
9779                  REWRITE_RULE[o_DEF] CONTINUOUS_WITHINREAL_COMPOSE];
9780     MATCH_MP_TAC FORALL_INTEGER THEN CONJ_TAC THENL
9781      [INDUCT_TAC THEN ASM_SIMP_TAC[VECTOR_MUL_LZERO; GSYM REAL_OF_NUM_SUC] THEN
9782       ASM_REWRITE_TAC[VECTOR_ADD_RDISTRIB; VECTOR_MUL_LID];
9783       X_GEN_TAC `c:real` THEN
9784       FIRST_X_ASSUM(MP_TAC o SPECL [`c % x:real^M`; `--(c % x):real^M`]) THEN
9785       ASM_REWRITE_TAC[VECTOR_ADD_RINV; VECTOR_MUL_LNEG; IMP_IMP] THEN
9786       VECTOR_ARITH_TAC];
9787     X_GEN_TAC `c:real` THEN
9788     FIRST_X_ASSUM(MP_TAC o funpow 2 (SPEC `c / &2 % x:real^M`)) THEN
9789     REWRITE_TAC[VECTOR_ARITH `c / &2 % x + c / &2 % x:real^N = c % x`] THEN
9790     REWRITE_TAC[IMP_IMP] THEN VECTOR_ARITH_TAC]);;
9791
9792 let OSTROWSKI_THEOREM = prove
9793  (`!f:real^M->real^N B s.
9794         (!x y. f(x + y) = f(x) + f(y)) /\
9795         (!x. x IN s ==> norm(f x) <= B) /\
9796         measurable s /\ &0 < measure s
9797         ==> linear f`,
9798   REPEAT GEN_TAC THEN
9799   REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
9800   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC o
9801     MATCH_MP STEINHAUS) THEN
9802   SUBGOAL_THEN `!x y. (f:real^M->real^N)(x - y) = f x - f y` ASSUME_TAC THENL
9803    [ASM_MESON_TAC[VECTOR_ARITH `x - y:real^M = z <=> x = y + z`];
9804     ALL_TAC] THEN
9805   SUBGOAL_THEN `!n x. &n % (f:real^M->real^N) x = f(&n % x)` ASSUME_TAC THENL
9806    [INDUCT_TAC THENL
9807      [ASM_MESON_TAC[VECTOR_SUB_REFL; VECTOR_MUL_LZERO];
9808       ASM_REWRITE_TAC[GSYM REAL_OF_NUM_SUC; VECTOR_ADD_RDISTRIB] THEN
9809       REWRITE_TAC[VECTOR_MUL_LID]];
9810     ALL_TAC] THEN
9811   MATCH_MP_TAC CONTINUOUS_ADDITIVE_IMP_LINEAR THEN ASM_REWRITE_TAC[] THEN
9812   SUBGOAL_THEN `!x. norm(x) < d ==> norm((f:real^M->real^N) x) <= &2 * B`
9813   ASSUME_TAC THENL
9814    [X_GEN_TAC `z:real^M` THEN DISCH_TAC THEN
9815     FIRST_X_ASSUM(MP_TAC o SPEC `z:real^M` o GEN_REWRITE_RULE I [SUBSET]) THEN
9816     ASM_REWRITE_TAC[IN_BALL_0] THEN SPEC_TAC(`z:real^M`,`z:real^M`) THEN
9817     ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM] THEN
9818     REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN(ANTE_RES_THEN MP_TAC)) THEN
9819     CONV_TAC NORM_ARITH;
9820     ALL_TAC] THEN
9821   REWRITE_TAC[continuous_on; IN_UNIV; dist] THEN
9822   MAP_EVERY X_GEN_TAC [`x:real^M`; `e:real`] THEN DISCH_TAC THEN
9823   MP_TAC(SPEC `e:real` REAL_ARCH) THEN ASM_REWRITE_TAC[] THEN
9824   DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC o SPEC `max (&1) (&2 * B)`) THEN
9825   ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THENL
9826    [REAL_ARITH_TAC; DISCH_TAC] THEN
9827   EXISTS_TAC `d / &n` THEN
9828   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1] THEN
9829   X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN
9830   SUBGOAL_THEN `norm(&n % (f:real^M->real^N)(y - x)) <= &2 * B` MP_TAC THENL
9831    [ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
9832     SIMP_TAC[NORM_MUL; REAL_ABS_NUM] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
9833     ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; LE_1];
9834     SIMP_TAC[NORM_MUL; REAL_ABS_NUM] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
9835     ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN
9836     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN
9837     ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN
9838     ASM_REAL_ARITH_TAC]);;
9839
9840 let MEASURABLE_ADDITIVE_IMP_LINEAR = prove
9841  (`!f:real^M->real^N.
9842         f measurable_on (:real^M) /\ (!x y. f(x + y) = f(x) + f(y))
9843         ==> linear f`,
9844   REPEAT STRIP_TAC THEN MATCH_MP_TAC OSTROWSKI_THEOREM THEN
9845   FIRST_X_ASSUM(MP_TAC o MATCH_MP MEASURABLE_ON_NORM) THEN
9846   REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_COMPONENT_LE] THEN
9847   REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP] THEN
9848   DISCH_TAC THEN
9849   ASM_CASES_TAC `!b. negligible {x | norm((f:real^M->real^N) x) <= b}` THENL
9850    [FIRST_X_ASSUM(MP_TAC o MATCH_MP NEGLIGIBLE_COUNTABLE_UNIONS o
9851         GEN `n:num` o SPEC `&n:real`) THEN
9852     REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV; REAL_ARCH_SIMPLE] THEN
9853     SIMP_TAC[SET_RULE `{x | T} = (:real^M)`; OPEN_NOT_NEGLIGIBLE;
9854              OPEN_UNIV; UNIV_NOT_EMPTY];
9855     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN
9856     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN
9857     ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN
9858     REWRITE_TAC[NOT_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN
9859     MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_TAC THEN
9860     EXISTS_TAC `{x:real^M | norm(f x:real^N) <= B} INTER interval[a,b]` THEN
9861     ASM_SIMP_TAC[IN_ELIM_THM; IN_INTER] THEN
9862     MATCH_MP_TAC(MESON[MEASURABLE_MEASURE_POS_LT]
9863      `measurable s /\ ~negligible s ==> measurable s /\ &0 < measure s`) THEN
9864     ASM_REWRITE_TAC[] THEN
9865     MATCH_MP_TAC MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE THEN
9866     ASM_REWRITE_TAC[MEASURABLE_INTERVAL]]);;
9867
9868 let REAL_CONTINUOUS_ADDITIVE_IMP_LINEAR = prove
9869  (`!f. f real_continuous_on (:real) /\
9870        (!x y. f(x + y) = f(x) + f(y))
9871        ==> !a x. f(a * x) = a * f(x)`,
9872   GEN_TAC THEN STRIP_TAC THEN
9873   MP_TAC(ISPEC `lift o f o drop` CONTINUOUS_ADDITIVE_IMP_LINEAR) THEN
9874   ASM_REWRITE_TAC[GSYM REAL_CONTINUOUS_ON; GSYM IMAGE_LIFT_UNIV] THEN
9875   ASM_REWRITE_TAC[linear; GSYM FORALL_DROP; o_THM; DROP_ADD; LIFT_DROP;
9876                   DROP_CMUL; GSYM LIFT_ADD; GSYM LIFT_CMUL; LIFT_EQ]);;
9877
9878 (* ------------------------------------------------------------------------- *)
9879 (* Extending a continuous function in a periodic way.                        *)
9880 (* ------------------------------------------------------------------------- *)
9881
9882 let REAL_CONTINUOUS_FLOOR = prove
9883  (`!x. ~(integer x) ==> floor real_continuous (atreal x)`,
9884   REPEAT STRIP_TAC THEN REWRITE_TAC[real_continuous_atreal] THEN
9885   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
9886   EXISTS_TAC `min (x - floor x) ((floor x + &1) - x)` THEN
9887   ASM_REWRITE_TAC[REAL_LT_MIN; REAL_SUB_LT; REAL_FLOOR_LT; FLOOR] THEN
9888   REPEAT STRIP_TAC THEN
9889   MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x = y ==> abs(x - y) < e`) THEN
9890   ASM_REWRITE_TAC[GSYM FLOOR_UNIQUE; FLOOR] THEN
9891   MP_TAC(ISPEC `x:real` FLOOR) THEN ASM_REAL_ARITH_TAC);;
9892
9893 let REAL_CONTINUOUS_FRAC = prove
9894  (`!x. ~(integer x) ==> frac real_continuous (atreal x)`,
9895   REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN
9896   REWRITE_TAC[FRAC_FLOOR] THEN MATCH_MP_TAC REAL_CONTINUOUS_SUB THEN
9897   ASM_SIMP_TAC[REAL_CONTINUOUS_FLOOR; REAL_CONTINUOUS_AT_ID]);;
9898
9899 let REAL_CONTINUOUS_ON_COMPOSE_FRAC = prove
9900  (`!f. f real_continuous_on real_interval[&0,&1] /\ f(&1) = f(&0)
9901        ==> (f o frac) real_continuous_on (:real)`,
9902   REPEAT STRIP_TAC THEN
9903   UNDISCH_TAC `f real_continuous_on real_interval[&0,&1]` THEN
9904   REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; WITHINREAL_UNIV] THEN
9905   DISCH_TAC THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN
9906   ASM_CASES_TAC `integer x` THENL
9907    [ALL_TAC;
9908     MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_COMPOSE THEN
9909     ASM_SIMP_TAC[REAL_CONTINUOUS_FRAC] THEN
9910     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [IN_REAL_INTERVAL] o
9911                   SPEC `frac x`) THEN
9912     ASM_SIMP_TAC[FLOOR_FRAC; REAL_LT_IMP_LE] THEN
9913     REWRITE_TAC[real_continuous_atreal; real_continuous_withinreal] THEN
9914     MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
9915     ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN
9916     DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
9917     EXISTS_TAC `min d (min (frac x) (&1 - frac x))` THEN
9918     ASM_SIMP_TAC[REAL_LT_MIN; REAL_SUB_LT; FLOOR_FRAC; REAL_FRAC_POS_LT] THEN
9919     REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
9920     ASM_REAL_ARITH_TAC] THEN
9921   ASM_SIMP_TAC[real_continuous_atreal; REAL_FRAC_ZERO; REAL_FLOOR_REFL] THEN
9922   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
9923   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (BINDER_CONV o LAND_CONV)
9924      [IN_REAL_INTERVAL]) THEN
9925   DISCH_THEN(fun th -> MP_TAC(SPEC `&1` th) THEN MP_TAC(SPEC `&0` th)) THEN
9926   REWRITE_TAC[REAL_LE_REFL; REAL_POS] THEN
9927   REWRITE_TAC[IMP_IMP; real_continuous_withinreal; AND_FORALL_THM] THEN
9928   DISCH_THEN(MP_TAC o SPEC `e:real`) THEN
9929   ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN
9930   DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC)
9931                (X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC)) THEN
9932   EXISTS_TAC `min (&1) (min d1 d2)` THEN
9933   ASM_REWRITE_TAC[REAL_LT_01; REAL_LT_MIN; o_DEF] THEN
9934   X_GEN_TAC `y:real` THEN STRIP_TAC THEN
9935   DISJ_CASES_TAC(REAL_ARITH `x <= y \/ y < x`) THENL
9936    [SUBGOAL_THEN `floor y = floor x` ASSUME_TAC THENL
9937      [REWRITE_TAC[GSYM FLOOR_UNIQUE; FLOOR] THEN
9938       ASM_SIMP_TAC[REAL_FLOOR_REFL] THEN ASM_REAL_ARITH_TAC;
9939       ASM_SIMP_TAC[FRAC_FLOOR; REAL_FLOOR_REFL; REAL_SUB_REFL] THEN
9940       FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN ASM_REAL_ARITH_TAC)];
9941     SUBGOAL_THEN `floor y = floor x - &1` ASSUME_TAC THENL
9942      [REWRITE_TAC[GSYM FLOOR_UNIQUE; FLOOR] THEN
9943       ASM_SIMP_TAC[REAL_FLOOR_REFL; INTEGER_CLOSED] THEN ASM_REAL_ARITH_TAC;
9944       ASM_SIMP_TAC[FRAC_FLOOR; REAL_FLOOR_REFL; REAL_SUB_REFL] THEN
9945       FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN ASM_REAL_ARITH_TAC)]]);;
9946
9947 let REAL_TIETZE_PERIODIC_INTERVAL = prove
9948  (`!f a b.
9949         f real_continuous_on real_interval[a,b] /\ f(a) = f(b)
9950         ==> ?g. g real_continuous_on (:real) /\
9951                 (!x. x IN real_interval[a,b] ==> g(x) = f(x)) /\
9952                 (!x. g(x + (b - a)) = g x)`,
9953   REPEAT STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH `b:real <= a \/ a < b`) THENL
9954    [EXISTS_TAC `\x:real. (f:real->real) a` THEN
9955     REWRITE_TAC[IN_REAL_INTERVAL; REAL_CONTINUOUS_ON_CONST] THEN
9956     ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_ANTISYM];
9957     EXISTS_TAC `(f:real->real) o (\y. a + (b - a) * y) o frac o
9958                 (\x. (x - a) / (b - a))` THEN
9959     REWRITE_TAC[o_THM] THEN REPEAT CONJ_TAC THENL
9960      [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN
9961       SIMP_TAC[real_div; REAL_CONTINUOUS_ON_RMUL; REAL_CONTINUOUS_ON_SUB;
9962                REAL_CONTINUOUS_ON_CONST; REAL_CONTINUOUS_ON_ID] THEN
9963       MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real)` THEN
9964       REWRITE_TAC[SUBSET_UNIV] THEN
9965       MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE_FRAC THEN
9966       ASM_SIMP_TAC[o_THM; REAL_MUL_RZERO; REAL_MUL_RID; REAL_SUB_ADD2;
9967                    REAL_ADD_RID] THEN
9968       MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN
9969       SIMP_TAC[REAL_CONTINUOUS_ON_LMUL; REAL_CONTINUOUS_ON_ADD;
9970                REAL_CONTINUOUS_ON_CONST; REAL_CONTINUOUS_ON_ID] THEN
9971       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
9972         REAL_CONTINUOUS_ON_SUBSET)) THEN
9973       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_REAL_INTERVAL] THEN
9974       ASM_SIMP_TAC[REAL_LE_ADDR; REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LT] THEN
9975       REWRITE_TAC[REAL_ARITH
9976        `a + (b - a) * x <= b <=> &0 <= (b - a) * (&1 - x)`] THEN
9977        ASM_SIMP_TAC[REAL_LE_ADDR; REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LE];
9978       X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN
9979       STRIP_TAC THEN ASM_CASES_TAC `x:real = b` THENL
9980        [ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; REAL_SUB_LT] THEN
9981         ASM_REWRITE_TAC[FRAC_NUM; REAL_MUL_RZERO; REAL_ADD_RID];
9982         SUBGOAL_THEN `frac((x - a) / (b - a)) = (x - a) / (b - a)`
9983         SUBST1_TAC THENL
9984          [REWRITE_TAC[REAL_FRAC_EQ] THEN
9985           ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_SUB_LT] THEN
9986           ASM_REAL_ARITH_TAC;
9987           AP_TERM_TAC THEN UNDISCH_TAC `a:real < b` THEN CONV_TAC REAL_FIELD]];
9988       ASM_SIMP_TAC[REAL_FIELD
9989         `a < b ==> ((x + b - a) - a) / (b - a) = &1 + (x - a) / (b - a)`] THEN
9990       REWRITE_TAC[REAL_FRAC_ADD; FRAC_NUM; FLOOR_FRAC; REAL_ADD_LID]]]);;
9991
9992 (* ------------------------------------------------------------------------- *)
9993 (* A variant of REAL_CONTINUOUS_ADDITIVE_IMP_LINEAR for intervals.           *)
9994 (* ------------------------------------------------------------------------- *)
9995
9996 let REAL_CONTINUOUS_ADDITIVE_EXTEND = prove
9997  (`!f. f real_continuous_on real_interval[&0,&1] /\
9998        (!x y. &0 <= x /\ &0 <= y /\ x + y <= &1
9999               ==> f(x + y) = f(x) + f(y))
10000        ==> ?g.  g real_continuous_on (:real) /\
10001                 (!x y. g(x + y) = g(x) + g(y)) /\
10002                 (!x. x IN real_interval[&0,&1] ==> g x = f x)`,
10003   REPEAT STRIP_TAC THEN SUBGOAL_THEN `f(&0) = &0` ASSUME_TAC THENL
10004    [FIRST_ASSUM(MP_TAC o ISPECL [`&0`; `&0`]) THEN
10005     REWRITE_TAC[REAL_ADD_LID] THEN REAL_ARITH_TAC;
10006     ALL_TAC] THEN
10007   EXISTS_TAC `\x. f(&1) * floor(x) + f(frac x)` THEN
10008   REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
10009    [UNDISCH_TAC `f real_continuous_on real_interval[&0,&1]` THEN
10010     REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; WITHINREAL_UNIV] THEN
10011     DISCH_TAC THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN
10012     ASM_CASES_TAC `integer x` THENL
10013      [ALL_TAC;
10014       MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN CONJ_TAC THEN
10015       ASM_SIMP_TAC[REAL_CONTINUOUS_LMUL; REAL_CONTINUOUS_FLOOR; ETA_AX] THEN
10016       MATCH_MP_TAC(REWRITE_RULE[o_DEF] REAL_CONTINUOUS_ATREAL_COMPOSE) THEN
10017       ASM_SIMP_TAC[REAL_CONTINUOUS_FRAC] THEN
10018       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [IN_REAL_INTERVAL] o
10019                     SPEC `frac x`) THEN
10020       ASM_SIMP_TAC[FLOOR_FRAC; REAL_LT_IMP_LE] THEN
10021       REWRITE_TAC[real_continuous_atreal; real_continuous_withinreal] THEN
10022       MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN
10023       ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN
10024       DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
10025       EXISTS_TAC `min d (min (frac x) (&1 - frac x))` THEN
10026       ASM_SIMP_TAC[REAL_LT_MIN; REAL_SUB_LT; FLOOR_FRAC; REAL_FRAC_POS_LT] THEN
10027       REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
10028       ASM_REAL_ARITH_TAC] THEN
10029     ASM_SIMP_TAC[real_continuous_atreal; REAL_FRAC_ZERO; REAL_FLOOR_REFL] THEN
10030     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
10031     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (BINDER_CONV o LAND_CONV)
10032        [IN_REAL_INTERVAL]) THEN
10033     DISCH_THEN(fun th -> MP_TAC(SPEC `&1` th) THEN MP_TAC(SPEC `&0` th)) THEN
10034     REWRITE_TAC[REAL_LE_REFL; REAL_POS] THEN
10035     REWRITE_TAC[IMP_IMP; real_continuous_withinreal; AND_FORALL_THM] THEN
10036     DISCH_THEN(MP_TAC o SPEC `e:real`) THEN
10037     ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN
10038     DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC)
10039                  (X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC)) THEN
10040     EXISTS_TAC `min (&1) (min d1 d2)` THEN
10041     ASM_REWRITE_TAC[REAL_LT_01; REAL_LT_MIN] THEN
10042     X_GEN_TAC `y:real` THEN STRIP_TAC THEN
10043     DISJ_CASES_TAC(REAL_ARITH `x <= y \/ y < x`) THENL
10044      [SUBGOAL_THEN `floor y = floor x` ASSUME_TAC THENL
10045        [REWRITE_TAC[GSYM FLOOR_UNIQUE; FLOOR] THEN
10046         ASM_SIMP_TAC[REAL_FLOOR_REFL] THEN ASM_REAL_ARITH_TAC;
10047         ASM_SIMP_TAC[FRAC_FLOOR; REAL_FLOOR_REFL] THEN
10048         REWRITE_TAC[REAL_ARITH `(a + x) - (a + &0) = x - &0`] THEN
10049         FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC];
10050       SUBGOAL_THEN `floor y = floor x - &1` ASSUME_TAC THENL
10051        [REWRITE_TAC[GSYM FLOOR_UNIQUE; FLOOR] THEN
10052         ASM_SIMP_TAC[REAL_FLOOR_REFL; INTEGER_CLOSED] THEN ASM_REAL_ARITH_TAC;
10053         ASM_SIMP_TAC[FRAC_FLOOR; REAL_FLOOR_REFL] THEN
10054         REWRITE_TAC[REAL_ARITH `(f1 * (x - &1) + f) - (f1 * x + &0) =
10055                                 f - f1`] THEN
10056         FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]];
10057     REPEAT GEN_TAC THEN REWRITE_TAC[REAL_FLOOR_ADD; REAL_FRAC_ADD] THEN
10058     COND_CASES_TAC THEN
10059     ASM_SIMP_TAC[REAL_LT_IMP_LE; FLOOR_FRAC; REAL_LE_ADD] THENL
10060      [REAL_ARITH_TAC; ALL_TAC] THEN
10061     REWRITE_TAC[REAL_ARITH
10062      `f1 * ((x + y) + &1) + g = (f1 * x + z) + f1 * y + h <=>
10063       f1 / &2 + g / &2 = z / &2 + h / &2`] THEN
10064     SUBGOAL_THEN
10065      `!t. &0 <= t /\ t <= &1 ==> f(t) / &2 = f(t / &2)`
10066     ASSUME_TAC THENL
10067      [GEN_TAC THEN FIRST_ASSUM(MP_TAC o ISPECL [`t / &2`; `t / &2`]) THEN
10068       REWRITE_TAC[REAL_HALF] THEN REAL_ARITH_TAC;
10069       ALL_TAC] THEN
10070     ASM_SIMP_TAC[REAL_POS; REAL_LE_REFL; FLOOR_FRAC; REAL_LT_IMP_LE;
10071                  REAL_ARITH `~(x + y < &1) ==> &0 <= (x + y) - &1`;
10072                  REAL_ARITH `x < &1 /\ y < &1 ==> (x + y) - &1 <= &1`] THEN
10073     MATCH_MP_TAC(MESON[]
10074      `f(a + b) = f a + f b /\ f(c + d) = f(c) + f(d) /\ a + b = c + d
10075       ==> (f:real->real)(a) + f(b) = f(c) + f(d)`) THEN
10076     REPEAT CONJ_TAC THEN TRY REAL_ARITH_TAC THEN
10077     FIRST_X_ASSUM MATCH_MP_TAC THEN
10078     MAP_EVERY (MP_TAC o C SPEC FLOOR_FRAC) [`x:real`; `y:real`] THEN
10079     ASM_REAL_ARITH_TAC;
10080     GEN_TAC THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_CASES_TAC `x = &1` THEN
10081     ASM_REWRITE_TAC[FLOOR_NUM; FRAC_NUM; REAL_MUL_RID; REAL_ADD_RID] THEN
10082     STRIP_TAC THEN SUBGOAL_THEN `floor x = &0` ASSUME_TAC THENL
10083      [ASM_REWRITE_TAC[GSYM FLOOR_UNIQUE; INTEGER_CLOSED];
10084       ASM_REWRITE_TAC[FRAC_FLOOR; REAL_SUB_RZERO]] THEN
10085     ASM_REAL_ARITH_TAC]);;
10086
10087 let REAL_CONTINUOUS_ADDITIVE_IMP_LINEAR_INTERVAL = prove
10088  (`!f b. (f ---> &0) (atreal (&0) within {x | &0 <= x}) /\
10089          (!x y. &0 <= x /\ &0 <= y /\ x + y <= b ==> f(x + y) = f(x) + f(y))
10090          ==> !a x. &0 <= x /\ x <= b /\
10091                    &0 <= a * x /\ a * x <= b
10092                    ==> f(a * x) = a * f(x)`,
10093   SUBGOAL_THEN
10094    `!f. (f ---> &0) (atreal (&0) within {x | &0 <= x}) /\
10095         (!x y. &0 <= x /\ &0 <= y /\ x + y <= &1 ==> f(x + y) = f(x) + f(y))
10096         ==> !a x. &0 <= x /\ x <= &1 /\ &0 <= a * x /\ a * x <= &1
10097                   ==> f(a * x) = a * f(x)`
10098   ASSUME_TAC THENL
10099    [SUBGOAL_THEN
10100      `!f. f real_continuous_on real_interval[&0,&1] /\
10101           (!x y. &0 <= x /\ &0 <= y /\ x + y <= &1 ==> f(x + y) = f(x) + f(y))
10102           ==> !a x. &0 <= x /\ x <= &1 /\ &0 <= a * x /\ a * x <= &1
10103                     ==> f(a * x) = a * f(x)`
10104     (fun th -> GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC th) THENL
10105      [REPEAT STRIP_TAC THEN
10106       MP_TAC(ISPEC `f:real->real` REAL_CONTINUOUS_ADDITIVE_EXTEND) THEN
10107       ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN
10108       DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN
10109       MP_TAC(ISPEC `g:real->real` REAL_CONTINUOUS_ADDITIVE_IMP_LINEAR) THEN
10110       ASM_MESON_TAC[];
10111       ASM_REWRITE_TAC[real_continuous_on; IN_REAL_INTERVAL] THEN
10112       X_GEN_TAC `x:real` THEN STRIP_TAC THEN
10113       X_GEN_TAC `e:real` THEN DISCH_TAC THEN
10114       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REALLIM_WITHINREAL]) THEN
10115       DISCH_THEN(MP_TAC o SPEC `e:real`) THEN
10116       ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN
10117       DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
10118       EXISTS_TAC `d:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN
10119       X_GEN_TAC `y:real` THEN STRIP_TAC THEN
10120       REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
10121        (REAL_ARITH `y = x \/ y < x \/ x < y`) THENL
10122        [ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM];
10123         SUBGOAL_THEN `(f:real->real)(y + (x - y)) = f(y) + f(x - y)`
10124         MP_TAC THENL
10125          [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC;
10126           REWRITE_TAC[REAL_SUB_ADD2] THEN DISCH_THEN SUBST1_TAC THEN
10127           REWRITE_TAC[REAL_ADD_SUB2; REAL_ABS_NEG] THEN
10128           FIRST_X_ASSUM MATCH_MP_TAC THEN
10129           REWRITE_TAC[IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC];
10130         SUBGOAL_THEN `(f:real->real)(x + (y - x)) = f(x) + f(y - x)`
10131         MP_TAC THENL
10132          [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC;
10133           REWRITE_TAC[REAL_SUB_ADD2] THEN DISCH_THEN SUBST1_TAC THEN
10134           REWRITE_TAC[REAL_ADD_SUB] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
10135           REWRITE_TAC[IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC]]];
10136     REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
10137      (REAL_ARITH `b < &0 \/ b = &0 \/ &0 < b`)
10138     THENL
10139      [ASM_REAL_ARITH_TAC;
10140       ASM_SIMP_TAC[REAL_ARITH
10141        `a <= x /\ x <= a /\ a <= y /\ y <= a <=> x = a /\ y = a`] THEN
10142       FIRST_X_ASSUM(MP_TAC o SPECL [`&0`; `&0`]) THEN
10143       ASM_REWRITE_TAC[REAL_ADD_LID; REAL_LE_REFL] THEN CONV_TAC REAL_RING;
10144       ALL_TAC] THEN
10145     FIRST_X_ASSUM(MP_TAC o ISPEC `(\x. f(b * x)):real->real`) THEN
10146     REWRITE_TAC[] THEN ANTS_TAC THENL
10147      [ALL_TAC;
10148       MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `a:real` THEN
10149       DISCH_THEN(fun th -> X_GEN_TAC `x:real` THEN STRIP_TAC THEN
10150                            MP_TAC(ISPEC `x / b:real` th)) THEN
10151       ASM_SIMP_TAC[REAL_FIELD `&0 < b ==> b * a * x / b = a * x`;
10152                    REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN
10153       DISCH_THEN MATCH_MP_TAC THEN
10154       REWRITE_TAC[REAL_ARITH `a * x / b:real = (a * x) / b`] THEN
10155       ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN
10156       ASM_REAL_ARITH_TAC] THEN
10157     CONJ_TAC THENL
10158      [ALL_TAC;
10159       REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ADD_LDISTRIB] THEN
10160       FIRST_X_ASSUM MATCH_MP_TAC THEN
10161       ASM_SIMP_TAC[REAL_ARITH `b * x + b * y <= b <=> &0 <= b * (&1 - (x + y))`;
10162                    REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LE]] THEN
10163     REWRITE_TAC[REALLIM_WITHINREAL] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
10164     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REALLIM_WITHINREAL]) THEN
10165     DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN
10166     REWRITE_TAC[REAL_SUB_RZERO; IN_ELIM_THM] THEN
10167     DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
10168     EXISTS_TAC `d / b:real` THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN
10169     REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
10170     ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; REAL_ABS_MUL] THEN
10171     ASM_SIMP_TAC[REAL_ARITH `&0 < b ==> abs b * x = x * b`] THEN
10172     ASM_SIMP_TAC[REAL_LT_MUL; GSYM REAL_LT_RDIV_EQ]]);;
10173
10174 (* ------------------------------------------------------------------------- *)
10175 (* More Steinhaus variants.                                                  *)
10176 (* ------------------------------------------------------------------------- *)
10177
10178 let STEINHAUS_TRIVIAL = prove
10179  (`!s e. ~(negligible s) /\ &0 < e
10180          ==> ?x y:real^N. x IN s /\ y IN s /\ ~(x = y) /\ norm(x - y) < e`,
10181   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
10182   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN DISCH_TAC THEN
10183   MATCH_MP_TAC NEGLIGIBLE_COUNTABLE THEN
10184   MATCH_MP_TAC DISCRETE_IMP_COUNTABLE THEN
10185   ASM_MESON_TAC[REAL_NOT_LT]);;
10186
10187 let REAL_STEINHAUS = prove
10188  (`!s. real_measurable s /\ &0 < real_measure s
10189        ==> ?d. &0 < d /\
10190                real_interval(--d,d) SUBSET {x - y | x IN s /\ y IN s}`,
10191   GEN_TAC THEN SIMP_TAC[IMP_CONJ; REAL_MEASURE_MEASURE] THEN
10192   REWRITE_TAC[IMP_IMP; REAL_MEASURABLE_MEASURABLE] THEN
10193   DISCH_THEN(MP_TAC o MATCH_MP STEINHAUS) THEN
10194   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN
10195   REWRITE_TAC[SUBSET; BALL_INTERVAL; IN_INTERVAL_1; IN_REAL_INTERVAL] THEN
10196   REWRITE_TAC[SET_RULE `{g x y | x IN IMAGE f s /\ y IN IMAGE f t} =
10197                         {g (f x) (f y) | x IN s /\ y IN t}`] THEN
10198   REWRITE_TAC[GSYM LIFT_SUB] THEN
10199   REWRITE_TAC[SET_RULE `{lift(f x y) | P x y} = IMAGE lift {f x y | P x y}`;
10200               IN_IMAGE_LIFT_DROP; GSYM FORALL_DROP] THEN
10201   REWRITE_TAC[DROP_SUB; DROP_VEC; LIFT_DROP; DROP_ADD] THEN
10202   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
10203   ASM_REAL_ARITH_TAC);;
10204
10205 (* ------------------------------------------------------------------------- *)
10206 (* Bernstein polynomials.                                                    *)
10207 (* ------------------------------------------------------------------------- *)
10208
10209 let bernstein = new_definition
10210  `bernstein n k x = &(binom(n,k)) * x pow k * (&1 - x) pow (n - k)`;;
10211
10212 let BERNSTEIN_CONV =
10213   GEN_REWRITE_CONV I [bernstein] THENC
10214   COMB2_CONV (RAND_CONV(RAND_CONV NUM_BINOM_CONV))
10215              (RAND_CONV(RAND_CONV NUM_SUB_CONV)) THENC
10216   REAL_POLY_CONV;;
10217
10218 (* ------------------------------------------------------------------------- *)
10219 (* Lemmas about Bernstein polynomials.                                       *)
10220 (* ------------------------------------------------------------------------- *)
10221
10222 let BERNSTEIN_POS = prove
10223  (`!n k x. &0 <= x /\ x <= &1 ==> &0 <= bernstein n k x`,
10224   REPEAT STRIP_TAC THEN REWRITE_TAC[bernstein] THEN
10225   MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN
10226   MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THEN
10227   MATCH_MP_TAC REAL_POW_LE THEN ASM_REAL_ARITH_TAC);;
10228
10229 let SUM_BERNSTEIN = prove
10230  (`!n. sum (0..n) (\k. bernstein n k x) = &1`,
10231   REWRITE_TAC[bernstein; GSYM REAL_BINOMIAL_THEOREM] THEN
10232   REWRITE_TAC[REAL_SUB_ADD2; REAL_POW_ONE]);;
10233
10234 let BERNSTEIN_LEMMA = prove
10235  (`!n x. sum(0..n) (\k. (&k - &n * x) pow 2 * bernstein n k x) =
10236          &n * x * (&1 - x)`,
10237   REPEAT STRIP_TAC THEN
10238   SUBGOAL_THEN
10239     `!x y. sum(0..n) (\k. &(binom(n,k)) * x pow k * y pow (n - k)) =
10240            (x + y) pow n`
10241   (LABEL_TAC "0") THENL [ASM_REWRITE_TAC[REAL_BINOMIAL_THEOREM]; ALL_TAC] THEN
10242   SUBGOAL_THEN
10243    `!x y. sum(0..n) (\k. &k * &(binom(n,k)) * x pow (k - 1) * y pow (n - k)) =
10244           &n * (x + y) pow (n - 1)`
10245   (LABEL_TAC "1") THENL
10246    [REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_DERIVATIVE_UNIQUE_ATREAL THEN
10247     MAP_EVERY EXISTS_TAC
10248      [`\x. sum(0..n) (\k. &(binom(n,k)) * x pow k * y pow (n - k))`;
10249       `x:real`] THEN
10250     CONJ_TAC THENL
10251      [MATCH_MP_TAC HAS_REAL_DERIVATIVE_SUM THEN REWRITE_TAC[FINITE_NUMSEG];
10252       ASM_REWRITE_TAC[]] THEN
10253     REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN CONV_TAC REAL_RING;
10254     ALL_TAC] THEN
10255   SUBGOAL_THEN
10256    `!x y. sum(0..n)
10257         (\k. &k * &(k - 1) * &(binom(n,k)) * x pow (k - 2) * y pow (n - k)) =
10258           &n * &(n - 1) * (x + y) pow (n - 2)`
10259   (LABEL_TAC "2") THENL
10260    [REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_DERIVATIVE_UNIQUE_ATREAL THEN
10261     MAP_EVERY EXISTS_TAC
10262      [`\x. sum(0..n) (\k. &k * &(binom(n,k)) * x pow (k - 1) * y pow (n - k))`;
10263       `x:real`] THEN
10264     CONJ_TAC THENL
10265      [MATCH_MP_TAC HAS_REAL_DERIVATIVE_SUM THEN REWRITE_TAC[FINITE_NUMSEG];
10266       ASM_REWRITE_TAC[]] THEN
10267     REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN
10268     REWRITE_TAC[ARITH_RULE `n - 1 - 1 = n - 2`] THEN CONV_TAC REAL_RING;
10269     ALL_TAC] THEN
10270   REWRITE_TAC[REAL_ARITH
10271    `(a - b) pow 2 * x =
10272     a * (a - &1) * x + (&1 - &2 * b) * a * x + b * b * x`] THEN
10273   REWRITE_TAC[SUM_ADD_NUMSEG; SUM_LMUL; SUM_BERNSTEIN] THEN
10274   SUBGOAL_THEN `sum(0..n) (\k. &k * bernstein n k x) = &n * x` SUBST1_TAC THENL
10275    [REMOVE_THEN "1" (MP_TAC o SPECL [`x:real`; `&1 - x`]) THEN
10276     REWRITE_TAC[REAL_SUB_ADD2; REAL_POW_ONE; bernstein; REAL_MUL_RID] THEN
10277     DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM SUM_RMUL] THEN
10278     MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN
10279     REWRITE_TAC[REAL_ARITH
10280      `(k * b * xk * y) * x:real = k * b * (x * xk) * y`] THEN
10281     REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN
10282     DISJ_CASES_TAC(ARITH_RULE `k = 0 \/ SUC(k - 1) = k`) THEN
10283     ASM_REWRITE_TAC[REAL_MUL_LZERO];
10284     ALL_TAC] THEN
10285   SUBGOAL_THEN
10286   `sum(0..n) (\k. &k * (&k - &1) * bernstein n k x) = &n * (&n - &1) * x pow 2`
10287   SUBST1_TAC THENL [ALL_TAC; CONV_TAC REAL_RING] THEN
10288   REMOVE_THEN "2" (MP_TAC o SPECL [`x:real`; `&1 - x`]) THEN
10289   REWRITE_TAC[REAL_SUB_ADD2; REAL_POW_ONE; bernstein; REAL_MUL_RID] THEN
10290   ASM_CASES_TAC `n = 0` THEN
10291   ASM_REWRITE_TAC[SUM_SING_NUMSEG; REAL_MUL_LZERO] THEN
10292   ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; LE_1; REAL_MUL_ASSOC] THEN
10293   DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM SUM_RMUL] THEN
10294   MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN
10295   REWRITE_TAC[REAL_ARITH `((((k * k1) * b) * xk) * y) * x2:real =
10296                             k * k1 * b * y * (x2 * xk)`] THEN
10297   REWRITE_TAC[GSYM REAL_POW_ADD; GSYM REAL_MUL_ASSOC] THEN
10298   REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
10299    (ARITH_RULE `k = 0 \/ k = 1 \/ 1 <= k /\ 2 + k - 2 = k`) THEN
10300   ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; SUB_REFL; REAL_SUB_REFL] THEN
10301   ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB] THEN REWRITE_TAC[REAL_MUL_AC]);;
10302
10303 (* ------------------------------------------------------------------------- *)
10304 (* Explicit Bernstein version of 1D Weierstrass approximation theorem        *)
10305 (* ------------------------------------------------------------------------- *)
10306
10307 let BERNSTEIN_WEIERSTRASS = prove
10308  (`!f e.
10309       f real_continuous_on real_interval[&0,&1] /\ &0 < e
10310       ==> ?N. !n x. N <= n /\ x IN real_interval[&0,&1]
10311                     ==> abs(f x -
10312                             sum(0..n) (\k. f(&k / &n) * bernstein n k x)) < e`,
10313   REPEAT STRIP_TAC THEN
10314   SUBGOAL_THEN `real_bounded(IMAGE f (real_interval[&0,&1]))` MP_TAC THENL
10315    [MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN
10316     MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN
10317     ASM_REWRITE_TAC[REAL_COMPACT_INTERVAL];
10318     REWRITE_TAC[REAL_BOUNDED_POS; LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE] THEN
10319     REWRITE_TAC[IN_REAL_INTERVAL] THEN X_GEN_TAC `M:real` THEN STRIP_TAC] THEN
10320   SUBGOAL_THEN `f real_uniformly_continuous_on real_interval[&0,&1]`
10321   MP_TAC THENL
10322    [ASM_SIMP_TAC[REAL_COMPACT_UNIFORMLY_CONTINUOUS; REAL_COMPACT_INTERVAL];
10323     REWRITE_TAC[real_uniformly_continuous_on] THEN
10324     DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN
10325     ASM_REWRITE_TAC[REAL_HALF; IN_REAL_INTERVAL] THEN
10326     DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC)] THEN
10327   SUBGOAL_THEN
10328    `!n x. 0 < n /\ &0 <= x /\ x <= &1
10329           ==> abs(f x - sum(0..n) (\k. f(&k / &n) * bernstein n k x))
10330                 <= e / &2 + (&2 * M) / (d pow 2 * &n)`
10331   ASSUME_TAC THENL
10332    [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
10333     EXISTS_TAC `abs(sum(0..n) (\k. (f x - f(&k / &n)) * bernstein n k x))` THEN
10334     CONJ_TAC THENL
10335      [REWRITE_TAC[REAL_SUB_RDISTRIB; SUM_SUB_NUMSEG; SUM_LMUL] THEN
10336       REWRITE_TAC[SUM_BERNSTEIN; REAL_MUL_RID; REAL_LE_REFL];
10337       ALL_TAC] THEN
10338     W(MP_TAC o PART_MATCH lhand SUM_ABS_NUMSEG o lhand o snd) THEN
10339     MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN
10340     REWRITE_TAC[REAL_ABS_MUL] THEN
10341     ASM_SIMP_TAC[BERNSTEIN_POS; REAL_ARITH `&0 <= x ==> abs x = x`] THEN
10342     MATCH_MP_TAC REAL_LE_TRANS THEN
10343     EXISTS_TAC
10344      `sum(0..n) (\k. (e / &2 + &2 * M / d pow 2 * (x - &k / &n) pow 2) *
10345                      bernstein n k x)` THEN
10346     CONJ_TAC THENL
10347      [MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN
10348       REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_RMUL THEN
10349       ASM_SIMP_TAC[BERNSTEIN_POS] THEN
10350       SUBGOAL_THEN `&0 <= &k / &n /\ &k / &n <= &1` STRIP_ASSUME_TAC THENL
10351        [ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT] THEN
10352         ASM_REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE; MULT_CLAUSES];
10353         ALL_TAC] THEN
10354       DISJ_CASES_TAC(REAL_ARITH
10355         `abs(x - &k / &n) < d \/ d <= abs(x - &k / &n)`)
10356       THENL
10357        [MATCH_MP_TAC(REAL_ARITH `x < e /\ &0 <= d ==> x <= e + d`) THEN
10358         ASM_SIMP_TAC[REAL_ARITH `&0 <= &2 * x <=> &0 <= x`] THEN
10359         ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_DIV; REAL_POW_2; REAL_LE_SQUARE;
10360                      REAL_LT_IMP_LE];
10361         MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= d ==> x <= e / &2 + d`) THEN
10362         ASM_REWRITE_TAC[] THEN
10363         MATCH_MP_TAC(REAL_ARITH
10364          `abs(x) <= M /\ abs(y) <= M /\ M * &1 <= M * b / d
10365           ==> abs(x - y) <= &2 * M / d * b`) THEN
10366         ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_POW_LT; REAL_LE_RDIV_EQ] THEN
10367         REWRITE_TAC[REAL_MUL_LID; GSYM REAL_LE_SQUARE_ABS] THEN
10368         ASM_REAL_ARITH_TAC];
10369       REWRITE_TAC[REAL_ADD_RDISTRIB; SUM_ADD_NUMSEG; SUM_LMUL] THEN
10370       REWRITE_TAC[SUM_BERNSTEIN; REAL_MUL_RID; REAL_LE_LADD] THEN
10371       REWRITE_TAC[GSYM REAL_MUL_ASSOC; SUM_LMUL] THEN
10372       REWRITE_TAC[real_div; REAL_INV_MUL; GSYM REAL_MUL_ASSOC] THEN
10373       ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_OF_NUM_LT; ARITH; REAL_POW_LT;
10374                    REAL_LT_INV_EQ] THEN
10375       MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `&n pow 2` THEN
10376       ASM_SIMP_TAC[GSYM SUM_LMUL; REAL_POW_LT; REAL_OF_NUM_LT; REAL_FIELD
10377         `&0 < n ==> n pow 2 * inv(n) = n`] THEN
10378       REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_POW_MUL] THEN
10379       ASM_SIMP_TAC[REAL_OF_NUM_LT; REAL_FIELD
10380         `&0 < n ==> n * (x - k * inv n) = n * x - k`] THEN
10381       ONCE_REWRITE_TAC[REAL_ARITH `(x - y:real) pow 2 = (y - x) pow 2`] THEN
10382       REWRITE_TAC[BERNSTEIN_LEMMA; REAL_ARITH
10383         `&n * x <= &n <=> &n * x <= &n * &1 * &1`] THEN
10384       MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN
10385       MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REAL_ARITH_TAC];
10386     MP_TAC(ISPEC `(e / &4 * d pow 2) / (&2 * M)` REAL_ARCH_INV) THEN
10387     ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH; REAL_LT_MUL] THEN
10388     ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_POW_LT; REAL_MUL_LZERO] THEN
10389     REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN
10390     REWRITE_TAC[REAL_ARITH `(x * &2 * m) * i = (&2 * m) * (i * x)`] THEN
10391     REWRITE_TAC[GSYM REAL_INV_MUL] THEN
10392     ASM_SIMP_TAC[GSYM real_div; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
10393     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN
10394     MAP_EVERY X_GEN_TAC [`n:num`; `x:real`] THEN STRIP_TAC THEN
10395     FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `x:real`]) THEN ASM_SIMP_TAC[] THEN
10396     ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
10397     MATCH_MP_TAC(REAL_ARITH
10398      `&0 < e /\ k < e / &4 ==> x <= e / &2 + k ==> x < e`) THEN
10399     ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
10400      `x < e ==> y <= x ==> y < e`)) THEN
10401     ASM_SIMP_TAC[real_div; REAL_LE_LMUL_EQ; REAL_LT_MUL;
10402                  REAL_OF_NUM_LT; ARITH] THEN
10403     MATCH_MP_TAC REAL_LE_INV2 THEN
10404     ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_MUL; REAL_POW_LT;
10405                  REAL_OF_NUM_LT; LE_1; REAL_OF_NUM_LE]]);;
10406
10407 (* ------------------------------------------------------------------------- *)
10408 (* General Stone-Weierstrass theorem.                                        *)
10409 (* ------------------------------------------------------------------------- *)
10410
10411 let STONE_WEIERSTRASS_ALT = prove
10412  (`!(P:(real^N->real)->bool) (s:real^N->bool).
10413         compact s /\
10414         (!c. P(\x. c)) /\
10415         (!f g. P(f) /\ P(g) ==> P(\x. f x + g x)) /\
10416         (!f g. P(f) /\ P(g) ==> P(\x. f x * g x)) /\
10417         (!x y. x IN s /\ y IN s /\ ~(x = y)
10418                ==> ?f. (!x. x IN s ==> f real_continuous (at x within s)) /\
10419                        P(f) /\ ~(f x = f y))
10420         ==> !f e. (!x. x IN s ==> f real_continuous (at x within s)) /\ &0 < e
10421                   ==> ?g. P(g) /\ !x. x IN s ==> abs(f x - g x) < e`,
10422   REPEAT GEN_TAC THEN STRIP_TAC THEN MAP_EVERY ABBREV_TAC
10423    [`C = \f. !x:real^N. x IN s ==> f real_continuous at x within s`;
10424     `A = \f. C f /\
10425              !e. &0 < e
10426                ==> ?g. P(g) /\ !x:real^N. x IN s ==> abs(f x - g x) < e`] THEN
10427   SUBGOAL_THEN `!f:real^N->real. C(f) ==> A(f)` MP_TAC THENL
10428    [ALL_TAC; MAP_EVERY EXPAND_TAC ["A"; "C"] THEN SIMP_TAC[]] THEN
10429   SUBGOAL_THEN `!c:real. A(\x:real^N. c)` (LABEL_TAC "const") THENL
10430    [MAP_EVERY EXPAND_TAC ["A"; "C"] THEN X_GEN_TAC `c:real` THEN
10431     ASM_REWRITE_TAC[REAL_CONTINUOUS_CONST] THEN X_GEN_TAC `e:real` THEN
10432     DISCH_TAC THEN EXISTS_TAC `(\x. c):real^N->real` THEN
10433     ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_0];
10434     ALL_TAC] THEN
10435   SUBGOAL_THEN `!f g:real^N->real. A(f) /\ A(g) ==> A(\x. f x + g x)`
10436   (LABEL_TAC "add") THENL
10437    [MAP_EVERY EXPAND_TAC ["A"; "C"] THEN SIMP_TAC[REAL_CONTINUOUS_ADD] THEN
10438     MAP_EVERY X_GEN_TAC [`f:real^N->real`; `g:real^N->real`] THEN
10439     DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN
10440     DISCH_THEN(CONJUNCTS_THEN (MP_TAC o SPEC `e / &2` o CONJUNCT2)) THEN
10441     ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN
10442     X_GEN_TAC `g':real^N->real` THEN STRIP_TAC THEN
10443     X_GEN_TAC `f':real^N->real` THEN STRIP_TAC THEN
10444     EXISTS_TAC `(\x. f' x + g' x):real^N->real` THEN
10445     ASM_SIMP_TAC[REAL_ARITH
10446      `abs(f - f') < e / &2 /\ abs(g - g') < e / &2
10447       ==> abs((f + g) - (f' + g')) < e`];
10448     ALL_TAC] THEN
10449   SUBGOAL_THEN `!f:real^N->real. A(f) ==> C(f)` (LABEL_TAC "AC") THENL
10450    [EXPAND_TAC "A" THEN SIMP_TAC[]; ALL_TAC] THEN
10451   SUBGOAL_THEN `!f:real^N->real. C(f) ==> real_bounded(IMAGE f s)`
10452   (LABEL_TAC "bound") THENL
10453    [GEN_TAC THEN EXPAND_TAC "C" THEN
10454     REWRITE_TAC[REAL_BOUNDED; GSYM IMAGE_o] THEN
10455     REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1] THEN
10456     REWRITE_TAC[GSYM CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
10457     ASM_SIMP_TAC[COMPACT_IMP_BOUNDED; COMPACT_CONTINUOUS_IMAGE];
10458     ALL_TAC] THEN
10459   SUBGOAL_THEN `!f g:real^N->real. A(f) /\ A(g) ==> A(\x. f x * g x)`
10460   (LABEL_TAC "mul") THENL
10461    [MAP_EVERY X_GEN_TAC [`f:real^N->real`; `g:real^N->real`] THEN
10462     DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC th) THEN
10463     MAP_EVERY EXPAND_TAC ["A"; "C"] THEN SIMP_TAC[REAL_CONTINUOUS_MUL] THEN
10464     REWRITE_TAC[IMP_CONJ] THEN
10465     MAP_EVERY (DISCH_THEN o LABEL_TAC) ["cf"; "af"; "cg"; "ag"] THEN
10466     SUBGOAL_THEN
10467      `real_bounded(IMAGE (f:real^N->real) s) /\
10468       real_bounded(IMAGE (g:real^N->real) s)`
10469     MP_TAC THENL
10470      [ASM_SIMP_TAC[]; REWRITE_TAC[REAL_BOUNDED_POS_LT; FORALL_IN_IMAGE]] THEN
10471     DISCH_THEN(CONJUNCTS_THEN2
10472      (X_CHOOSE_THEN `Bf:real` STRIP_ASSUME_TAC)
10473      (X_CHOOSE_THEN `Bg:real` STRIP_ASSUME_TAC)) THEN
10474     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
10475     REMOVE_THEN "ag" (MP_TAC o SPEC `e / &2 / Bf`) THEN
10476     ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; LEFT_IMP_EXISTS_THM] THEN
10477     X_GEN_TAC `g':real^N->real` THEN STRIP_TAC THEN
10478     REMOVE_THEN "af" (MP_TAC o SPEC `e / &2 / (Bg + e / &2 / Bf)`) THEN
10479     ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; REAL_LT_ADD] THEN
10480     DISCH_THEN(X_CHOOSE_THEN `f':real^N->real` STRIP_ASSUME_TAC) THEN
10481     EXISTS_TAC `(\x. f'(x) * g'(x)):real^N->real` THEN
10482     ASM_SIMP_TAC[REAL_ARITH
10483      `f * g - f' * g':real = f * (g - g') + g' * (f - f')`] THEN
10484     X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
10485     SUBGOAL_THEN `e = Bf * e / &2 / Bf +
10486                       (Bg + e / &2 / Bf) * e / &2 / (Bg + e / &2 / Bf)`
10487     SUBST1_TAC THENL
10488      [MATCH_MP_TAC(REAL_ARITH `a = e / &2 /\ b = e / &2 ==> e = a + b`) THEN
10489       CONJ_TAC THEN MAP_EVERY MATCH_MP_TAC [REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN
10490       ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_ADD; REAL_HALF];
10491       MATCH_MP_TAC(REAL_ARITH
10492        `abs a < c /\ abs b < d ==> abs(a + b) < c + d`) THEN
10493       REWRITE_TAC[REAL_ABS_MUL] THEN CONJ_TAC THEN
10494       MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_SIMP_TAC[REAL_ABS_POS] THEN
10495       MATCH_MP_TAC(REAL_ARITH
10496        `!g. abs(g) < Bg /\ abs(g - g') < e ==> abs(g') < Bg + e`) THEN
10497       EXISTS_TAC `(g:real^N->real) x` THEN ASM_SIMP_TAC[]];
10498     ALL_TAC] THEN
10499   SUBGOAL_THEN
10500    `!x y. x IN s /\ y IN s /\ ~(x = y)
10501           ==> ?f:real^N->real. A(f) /\ ~(f x = f y)`
10502   (LABEL_TAC "sep") THENL
10503    [MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
10504     FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN
10505     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
10506     MAP_EVERY EXPAND_TAC ["A"; "C"] THEN
10507     ASM_MESON_TAC[REAL_SUB_REFL; REAL_ABS_0];
10508     ALL_TAC] THEN
10509   SUBGOAL_THEN `!f. A(f) ==> A(\x:real^N. abs(f x))` (LABEL_TAC "abs") THENL
10510    [SUBGOAL_THEN `!f. A(f) /\ (!x. x IN s ==> abs(f x) <= &1 / &4)
10511                       ==> A(\x:real^N. abs(f x))`
10512     ASSUME_TAC THENL
10513      [ALL_TAC;
10514       REPEAT STRIP_TAC THEN
10515       SUBGOAL_THEN `real_bounded(IMAGE (f:real^N->real) s)` MP_TAC THENL
10516        [ASM_SIMP_TAC[]; REWRITE_TAC[REAL_BOUNDED_POS_LT; FORALL_IN_IMAGE]] THEN
10517       DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
10518       SUBGOAL_THEN `A(\x:real^N. (&4 * B) * abs(inv(&4 * B) * f x)):bool`
10519       MP_TAC THENL
10520        [USE_THEN "mul" MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
10521         FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_ABS_MUL] THEN
10522         ASM_SIMP_TAC[REAL_ARITH `&0 < B ==> abs(B) = B`;
10523                      REAL_LT_INV_EQ; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN
10524         ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
10525         ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_LT_MUL;
10526                      REAL_OF_NUM_LT; ARITH; REAL_MUL_ASSOC] THEN
10527         CONV_TAC REAL_RAT_REDUCE_CONV THEN
10528         ASM_SIMP_TAC[REAL_MUL_LID; REAL_LT_IMP_LE];
10529         ASM_SIMP_TAC[REAL_ABS_MUL; REAL_ARITH `&0 < B ==> abs(B) = B`;
10530                      REAL_LT_INV_EQ; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN
10531         ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_RINV; REAL_MUL_LID;
10532                      REAL_ARITH `&0 < B ==> ~(&4 * B = &0)`]]] THEN
10533     X_GEN_TAC `f:real^N->real` THEN MAP_EVERY EXPAND_TAC ["A"; "C"] THEN
10534     DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THENL
10535      [DISCH_THEN(MP_TAC o CONJUNCT1 o CONJUNCT1) THEN
10536       MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
10537       REWRITE_TAC[] THEN
10538       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT; o_DEF]
10539         REAL_CONTINUOUS_WITHIN_COMPOSE) THEN
10540       REWRITE_TAC[real_continuous_withinreal] THEN
10541       MESON_TAC[ARITH_RULE `abs(x - y) < d ==> abs(abs x - abs y) < d`];
10542       ALL_TAC] THEN
10543     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
10544     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
10545     DISCH_THEN(fun t -> X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC t) THEN
10546     DISCH_THEN(MP_TAC o SPEC `min (e / &2) (&1 / &4)`) THEN
10547     ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
10548     REWRITE_TAC[REAL_LT_MIN; FORALL_AND_THM;
10549                 TAUT `(a ==> b /\ c) <=> (a ==> b) /\ (a ==> c)`] THEN
10550     DISCH_THEN(X_CHOOSE_THEN `p:real^N->real` STRIP_ASSUME_TAC) THEN
10551     MP_TAC(ISPECL [`\x. abs(x - &1 / &2)`; `e / &2`]
10552      BERNSTEIN_WEIERSTRASS) THEN
10553     REWRITE_TAC[] THEN ANTS_TAC THENL
10554      [ASM_REWRITE_TAC[real_continuous_on; REAL_HALF] THEN
10555       MESON_TAC[ARITH_RULE
10556        `abs(x - y) < d ==> abs(abs(x - a) - abs(y - a)) < d`];
10557       ALL_TAC] THEN
10558     DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN
10559     REWRITE_TAC[LE_REFL] THEN DISCH_TAC THEN
10560     EXISTS_TAC `\x:real^N. sum(0..n) (\k. abs(&k / &n - &1 / &2) *
10561                                           bernstein n k (&1 / &2 + p x))` THEN
10562     REWRITE_TAC[] THEN CONJ_TAC THENL
10563      [SUBGOAL_THEN
10564        `!m c z. P(\x:real^N.
10565             sum(0..m) (\k. c k * bernstein (z m) k (&1 / &2 + p x)))`
10566        (fun th -> REWRITE_TAC[th]) THEN
10567       SUBGOAL_THEN
10568        `!m k. P(\x:real^N. bernstein m k (&1 / &2 + p x))`
10569       ASSUME_TAC THENL
10570        [ALL_TAC; INDUCT_TAC THEN ASM_SIMP_TAC[SUM_CLAUSES_NUMSEG; LE_0]] THEN
10571       REPEAT GEN_TAC THEN REWRITE_TAC[bernstein] THEN
10572       REWRITE_TAC[REAL_ARITH `&1 - (&1 / &2 + p) = &1 / &2 + -- &1 * p`] THEN
10573       REPEAT(FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]) THEN
10574       SUBGOAL_THEN
10575        `!f:real^N->real k. P(f) ==> P(\x. f(x) pow k)`
10576        (fun th -> ASM_SIMP_TAC[th]) THEN
10577       GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[real_pow];
10578       REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
10579        `!p. abs(abs(p x) - s) < e / &2 /\
10580             abs(f x - p x) < e / &2
10581             ==> abs(abs(f x) - s) < e`) THEN
10582       EXISTS_TAC `p:real^N->real` THEN ASM_SIMP_TAC[] THEN
10583       GEN_REWRITE_TAC (PAT_CONV `\x. abs(abs x - a) < e`)
10584         [REAL_ARITH `x = (&1 / &2 + x) - &1 / &2`] THEN
10585       FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN
10586       MATCH_MP_TAC(REAL_ARITH
10587        `!f. abs(f) <= &1 / &4 /\ abs(f - p) < &1 / &4
10588             ==> &0 <= &1 / &2 + p /\ &1 / &2 + p <= &1`) THEN
10589       EXISTS_TAC `(f:real^N->real) x` THEN ASM_SIMP_TAC[]];
10590     ALL_TAC] THEN
10591   SUBGOAL_THEN `!f:real^N->real g. A(f) /\ A(g) ==> A(\x. max (f x) (g x))`
10592   (LABEL_TAC "max") THENL
10593    [REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH
10594      `max a b = inv(&2) * (a + b + abs(a + -- &1 * b))`] THEN
10595     REPEAT(FIRST_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[]);
10596     ALL_TAC] THEN
10597   SUBGOAL_THEN `!f:real^N->real g. A(f) /\ A(g) ==> A(\x. min (f x) (g x))`
10598   (LABEL_TAC "min") THENL
10599    [ASM_SIMP_TAC[REAL_ARITH `min a b = -- &1 * (max(-- &1 * a) (-- &1 * b))`];
10600     ALL_TAC] THEN
10601   SUBGOAL_THEN
10602    `!t. FINITE t /\ (!f. f IN t ==> A(f)) ==> A(\x:real^N. sup {f(x) | f IN t})`
10603   (LABEL_TAC "sup") THENL
10604    [REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
10605     ASM_SIMP_TAC[FORALL_IN_INSERT; SIMPLE_IMAGE; IMAGE_CLAUSES] THEN
10606     ASM_SIMP_TAC[SUP_INSERT_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN
10607     MAP_EVERY X_GEN_TAC [`f:real^N->real`; `t:(real^N->real)->bool`] THEN
10608     ASM_CASES_TAC `t:(real^N->real)->bool = {}` THEN ASM_SIMP_TAC[ETA_AX];
10609     ALL_TAC] THEN
10610   SUBGOAL_THEN
10611    `!t. FINITE t /\ (!f. f IN t ==> A(f)) ==> A(\x:real^N. inf {f(x) | f IN t})`
10612   (LABEL_TAC "inf") THENL
10613    [REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
10614     ASM_SIMP_TAC[FORALL_IN_INSERT; SIMPLE_IMAGE; IMAGE_CLAUSES] THEN
10615     ASM_SIMP_TAC[INF_INSERT_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN
10616     MAP_EVERY X_GEN_TAC [`f:real^N->real`; `t:(real^N->real)->bool`] THEN
10617     ASM_CASES_TAC `t:(real^N->real)->bool = {}` THEN ASM_SIMP_TAC[ETA_AX];
10618     ALL_TAC] THEN
10619   SUBGOAL_THEN
10620    `!f:real^N->real e.
10621       C(f) /\ &0 < e ==> ?g. A(g) /\ !x. x IN s ==> abs(f x - g x) < e`
10622   ASSUME_TAC THENL
10623    [ALL_TAC;
10624     X_GEN_TAC `f:real^N->real` THEN DISCH_TAC THEN EXPAND_TAC "A" THEN
10625     CONJ_TAC THENL [FIRST_X_ASSUM ACCEPT_TAC; ALL_TAC] THEN
10626     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
10627     FIRST_X_ASSUM(MP_TAC o SPECL [`f:real^N->real`; `e / &2`]) THEN
10628     ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN
10629     X_GEN_TAC `h:real^N->real` THEN EXPAND_TAC "A" THEN
10630     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
10631     DISCH_THEN(MP_TAC o SPEC `e / &2` o CONJUNCT2) THEN
10632     ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN
10633     ASM_MESON_TAC[REAL_ARITH
10634      `abs(f - h) < e / &2 /\ abs(h - g) < e / &2 ==> abs(f - g) < e`]] THEN
10635   MAP_EVERY X_GEN_TAC [`f:real^N->real`; `e:real`] THEN EXPAND_TAC "C" THEN
10636   STRIP_TAC THEN
10637   SUBGOAL_THEN
10638    `!x y. x IN s /\ y IN s
10639           ==> ?h:real^N->real. A(h) /\ h(x) = f(x) /\ h(y) = f(y)`
10640   MP_TAC THENL
10641    [REPEAT STRIP_TAC THEN ASM_CASES_TAC `y:real^N = x` THENL
10642      [EXISTS_TAC `\z:real^N. (f:real^N->real) x` THEN ASM_SIMP_TAC[];
10643       SUBGOAL_THEN `?h:real^N->real. A(h) /\ ~(h x = h y)`
10644       STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
10645       EXISTS_TAC `\z. (f y - f x) / (h y - h x) * (h:real^N->real)(z) +
10646                       (f x - (f y - f x) / (h y - h x) * h(x))` THEN
10647       ASM_SIMP_TAC[] THEN
10648       UNDISCH_TAC `~((h:real^N->real) x = h y)` THEN CONV_TAC REAL_FIELD];
10649       ALL_TAC] THEN
10650   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
10651   REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
10652   X_GEN_TAC `f2:real^N->real^N->real^N->real` THEN DISCH_TAC THEN
10653   ABBREV_TAC `G = \x y.
10654     {z | z IN s /\ (f2:real^N->real^N->real^N->real) x y z < f(z) + e}` THEN
10655   SUBGOAL_THEN `!x y:real^N. x IN s /\ y IN s ==> x IN G x y /\ y IN G x y`
10656   ASSUME_TAC THENL
10657    [EXPAND_TAC "G" THEN REWRITE_TAC[IN_ELIM_THM] THEN
10658     ASM_SIMP_TAC[REAL_LT_ADDR];
10659     ALL_TAC] THEN
10660   SUBGOAL_THEN
10661    `!x. x IN s ==> ?f1. A(f1) /\ f1 x = f x /\
10662                         !y:real^N. y IN s ==> f1 y < f y + e`
10663   MP_TAC THENL
10664    [REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o
10665      GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN
10666     DISCH_THEN(MP_TAC o SPEC
10667      `{(G:real^N->real^N->real^N->bool) x y | y IN s}`) THEN
10668     REWRITE_TAC[SIMPLE_IMAGE; UNIONS_IMAGE; FORALL_IN_IMAGE; ETA_AX] THEN
10669     ANTS_TAC THENL
10670      [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
10671       EXPAND_TAC "G" THEN REWRITE_TAC[] THEN X_GEN_TAC `w:real^N` THEN
10672       DISCH_TAC THEN
10673       MP_TAC(ISPECL [`lift o (\z:real^N. f2 (x:real^N) (w:real^N) z - f z)`;
10674                      `s:real^N->bool`;
10675                      `{x:real^1 | x$1 < e}`] CONTINUOUS_OPEN_IN_PREIMAGE) THEN
10676       REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT; IN_ELIM_THM] THEN
10677       REWRITE_TAC[GSYM drop; LIFT_DROP; o_DEF] THEN
10678       REWRITE_TAC[LIFT_SUB; GSYM REAL_CONTINUOUS_CONTINUOUS1;
10679                   REAL_ARITH `x < y + e <=> x - y < e`] THEN
10680       DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
10681       ONCE_REWRITE_TAC[GSYM o_DEF] THEN
10682       REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
10683       REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS1; ETA_AX] THEN
10684       ASM_MESON_TAC[];
10685       ALL_TAC] THEN
10686     ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN
10687     REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE; UNIONS_IMAGE] THEN
10688     DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
10689     EXISTS_TAC `\z:real^N. inf {f2 (x:real^N) (y:real^N) z | y IN t}` THEN
10690     REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
10691      [GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `x = min x x`] THEN
10692       REWRITE_TAC[REAL_MIN_INF; INSERT_AC] THEN AP_TERM_TAC THEN ASM SET_TAC[];
10693       REMOVE_THEN "inf" (MP_TAC o SPEC
10694        `IMAGE (\y z. (f2:real^N->real^N->real^N->real) x y z) t`) THEN
10695       ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN
10696       REWRITE_TAC[SIMPLE_IMAGE; ETA_AX] THEN
10697       ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
10698       REWRITE_TAC[GSYM IMAGE_o; o_DEF];
10699       SUBGOAL_THEN `~(t:real^N->bool = {})` ASSUME_TAC THENL
10700        [ASM SET_TAC[]; ALL_TAC] THEN
10701       ASM_SIMP_TAC[REAL_INF_LT_FINITE; SIMPLE_IMAGE;
10702                    FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN
10703       REWRITE_TAC[EXISTS_IN_IMAGE] THEN
10704       X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
10705       UNDISCH_TAC
10706        `s SUBSET {y:real^N | ?z:real^N. z IN t /\ y IN G (x:real^N) z}` THEN
10707       REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
10708       DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN
10709       EXPAND_TAC "G" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[]];
10710     GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
10711      [RIGHT_IMP_EXISTS_THM] THEN
10712     REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
10713     X_GEN_TAC `f1:real^N->real^N->real` THEN DISCH_TAC] THEN
10714   ABBREV_TAC `H = \x:real^N. {z:real^N | z IN s /\ f z - e < f1 x z}` THEN
10715   SUBGOAL_THEN `!x:real^N. x IN s ==> x IN (H x)` ASSUME_TAC THENL
10716    [EXPAND_TAC "H" THEN REWRITE_TAC[IN_ELIM_THM] THEN
10717     ASM_SIMP_TAC[REAL_ARITH `x - e < x <=> &0 < e`];
10718     ALL_TAC] THEN
10719   FIRST_ASSUM(MP_TAC o
10720   GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN
10721   DISCH_THEN(MP_TAC o SPEC
10722    `{(H:real^N->real^N->bool) x | x IN s}`) THEN
10723   REWRITE_TAC[SIMPLE_IMAGE; UNIONS_IMAGE; FORALL_IN_IMAGE; ETA_AX] THEN
10724   ANTS_TAC THENL
10725    [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN EXPAND_TAC "H" THEN
10726     REWRITE_TAC[] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
10727     MP_TAC(ISPECL [`lift o (\z:real^N. f z - f1 (x:real^N) z)`;
10728                    `s:real^N->bool`;
10729                    `{x:real^1 | x$1 < e}`] CONTINUOUS_OPEN_IN_PREIMAGE) THEN
10730     REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT; IN_ELIM_THM] THEN
10731     REWRITE_TAC[GSYM drop; LIFT_DROP; o_DEF] THEN
10732     GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV)
10733      [REAL_ARITH `x - y < z <=> x - z < y`] THEN
10734     DISCH_THEN MATCH_MP_TAC THEN
10735     REWRITE_TAC[LIFT_SUB; GSYM REAL_CONTINUOUS_CONTINUOUS1;
10736                 REAL_ARITH `x < y + e <=> x - y < e`] THEN
10737     MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
10738     ONCE_REWRITE_TAC[GSYM o_DEF] THEN
10739     REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
10740     REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS1; ETA_AX] THEN
10741     ASM_MESON_TAC[];
10742     ALL_TAC] THEN
10743   ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN
10744   REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE; UNIONS_IMAGE] THEN
10745   DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN
10746   EXISTS_TAC `\z:real^N. sup {f1 (x:real^N) z | x IN t}` THEN
10747   REWRITE_TAC[] THEN CONJ_TAC THENL
10748    [REMOVE_THEN "sup" (MP_TAC o SPEC `IMAGE (f1:real^N->real^N->real) t`) THEN
10749     ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN
10750     REWRITE_TAC[SIMPLE_IMAGE; ETA_AX] THEN
10751     ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
10752     REWRITE_TAC[GSYM IMAGE_o; o_DEF];
10753     ALL_TAC] THEN
10754   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
10755   SUBGOAL_THEN `~(t:real^N->bool = {})` ASSUME_TAC THENL
10756    [ASM SET_TAC[]; ALL_TAC] THEN
10757   REWRITE_TAC[SIMPLE_IMAGE; REAL_ARITH
10758    `abs(f - s) < e <=> f - e < s /\ s < f + e`] THEN
10759   ASM_SIMP_TAC[REAL_SUP_LT_FINITE; REAL_LT_SUP_FINITE;
10760                FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN
10761   REWRITE_TAC[EXISTS_IN_IMAGE; FORALL_IN_IMAGE] THEN
10762   CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
10763   UNDISCH_TAC `s SUBSET {y:real^N | ?x:real^N. x IN t /\ y IN H x}` THEN
10764   REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN
10765   DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
10766   EXPAND_TAC "H" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[]);;
10767
10768 let STONE_WEIERSTRASS = prove
10769  (`!(P:(real^N->real)->bool) (s:real^N->bool).
10770         compact s /\
10771         (!f. P(f) ==> !x. x IN s ==> f real_continuous (at x within s)) /\
10772         (!c. P(\x. c)) /\
10773         (!f g. P(f) /\ P(g) ==> P(\x. f x + g x)) /\
10774         (!f g. P(f) /\ P(g) ==> P(\x. f x * g x)) /\
10775         (!x y. x IN s /\ y IN s /\ ~(x = y) ==> ?f. P(f) /\ ~(f x = f y))
10776         ==> !f e. (!x. x IN s ==> f real_continuous (at x within s)) /\ &0 < e
10777                   ==> ?g. P(g) /\ !x. x IN s ==> abs(f x - g x) < e`,
10778   REPEAT GEN_TAC THEN STRIP_TAC THEN
10779   MATCH_MP_TAC STONE_WEIERSTRASS_ALT THEN ASM_SIMP_TAC[] THEN
10780   MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
10781   FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN
10782   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[]);;
10783
10784 (* ------------------------------------------------------------------------- *)
10785 (* Real and complex versions of Stone-Weierstrass theorem.                   *)
10786 (* ------------------------------------------------------------------------- *)
10787
10788 let REAL_STONE_WEIERSTRASS_ALT = prove
10789  (`!P s. real_compact s /\
10790          (!c. P (\x. c)) /\
10791          (!f g. P f /\ P g ==> P (\x. f x + g x)) /\
10792          (!f g. P f /\ P g ==> P (\x. f x * g x)) /\
10793          (!x y. x IN s /\ y IN s /\ ~(x = y)
10794                 ==> ?f. f real_continuous_on s /\ P f /\ ~(f x = f y))
10795          ==> !f e. f real_continuous_on s /\ &0 < e
10796                    ==> ?g. P g /\ !x. x IN s ==> abs(f x - g x) < e`,
10797   REPEAT STRIP_TAC THEN
10798   MP_TAC(ISPECL
10799    [`\f. (P:(real->real)->bool)(f o lift)`;
10800     `IMAGE lift s`] STONE_WEIERSTRASS_ALT) THEN
10801   ASM_SIMP_TAC[GSYM real_compact; o_DEF] THEN
10802   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
10803   REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN ANTS_TAC THENL
10804    [X_GEN_TAC `x:real` THEN DISCH_TAC THEN
10805     X_GEN_TAC `y:real` THEN REWRITE_TAC[LIFT_EQ] THEN STRIP_TAC THEN
10806     FIRST_X_ASSUM(MP_TAC o SPECL [`x:real`; `y:real`]) THEN
10807     ASM_REWRITE_TAC[] THEN
10808     DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN
10809     EXISTS_TAC `(g:real->real) o drop` THEN
10810     ASM_REWRITE_TAC[o_THM; LIFT_DROP; ETA_AX] THEN
10811     UNDISCH_TAC `g real_continuous_on s` THEN
10812     REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
10813     REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS_WITHINREAL] THEN
10814     REWRITE_TAC[real_continuous_within; continuous_within] THEN
10815     REWRITE_TAC[o_THM; LIFT_DROP; DIST_LIFT];
10816     DISCH_THEN(MP_TAC o SPEC `(f:real->real) o drop`) THEN ANTS_TAC THENL
10817      [UNDISCH_TAC `f real_continuous_on s` THEN
10818       REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
10819       REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS_WITHINREAL] THEN
10820       REWRITE_TAC[real_continuous_within; continuous_within] THEN
10821       REWRITE_TAC[o_THM; LIFT_DROP; DIST_LIFT];
10822       DISCH_THEN(MP_TAC o SPEC `e:real`) THEN
10823       ASM_REWRITE_TAC[o_DEF; LIFT_DROP] THEN
10824       DISCH_THEN(X_CHOOSE_THEN `g:real^1->real` STRIP_ASSUME_TAC) THEN
10825       EXISTS_TAC `(g:real^1->real) o lift` THEN ASM_REWRITE_TAC[o_DEF]]]);;
10826
10827 let REAL_STONE_WEIERSTRASS = prove
10828  (`!P s. real_compact s /\
10829          (!f. P f ==> f real_continuous_on s) /\
10830          (!c. P (\x. c)) /\
10831          (!f g. P f /\ P g ==> P (\x. f x + g x)) /\
10832          (!f g. P f /\ P g ==> P (\x. f x * g x)) /\
10833          (!x y. x IN s /\ y IN s /\ ~(x = y) ==> ?f. P f /\ ~(f x = f y))
10834          ==> !f e. f real_continuous_on s /\ &0 < e
10835                    ==> ?g. P g /\ !x. x IN s ==> abs(f x - g x) < e`,
10836   REPEAT GEN_TAC THEN STRIP_TAC THEN
10837   MATCH_MP_TAC REAL_STONE_WEIERSTRASS_ALT THEN ASM_SIMP_TAC[] THEN
10838   MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN STRIP_TAC THEN
10839   FIRST_X_ASSUM(MP_TAC o SPECL [`x:real`; `y:real`]) THEN
10840   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[]);;
10841
10842 let COMPLEX_STONE_WEIERSTRASS_ALT = prove
10843  (`!P s. compact s /\
10844          (!c. P (\x. c)) /\
10845          (!f. P f ==> P(\x. cnj(f x))) /\
10846          (!f g. P f /\ P g ==> P (\x. f x + g x)) /\
10847          (!f g. P f /\ P g ==> P (\x. f x * g x)) /\
10848          (!x y. x IN s /\ y IN s /\ ~(x = y)
10849                 ==> ?f. P f /\ f continuous_on s /\ ~(f x = f y))
10850          ==> !f:real^N->complex e.
10851                 f continuous_on s /\ &0 < e
10852                 ==> ?g. P g /\ !x. x IN s ==> norm(f x - g x) < e`,
10853   REPEAT GEN_TAC THEN STRIP_TAC THEN
10854   SUBGOAL_THEN `!f. P f ==> P(\x:real^N. Cx(Re(f x)))` ASSUME_TAC THENL
10855    [ASM_SIMP_TAC[CX_RE_CNJ; SIMPLE_COMPLEX_ARITH
10856      `x / Cx(&2) = inv(Cx(&2)) * x`];
10857     ALL_TAC] THEN
10858   SUBGOAL_THEN `!f. P f ==> P(\x:real^N. Cx(Im(f x)))` ASSUME_TAC THENL
10859    [ASM_SIMP_TAC[CX_IM_CNJ; SIMPLE_COMPLEX_ARITH
10860      `x - y = x + --Cx(&1) * y /\ x / Cx(&2) = inv(Cx(&2)) * x`] THEN
10861     REPEAT STRIP_TAC THEN REPEAT(FIRST_ASSUM MATCH_MP_TAC ORELSE CONJ_TAC) THEN
10862     ASM_SIMP_TAC[];
10863     ALL_TAC] THEN
10864   MP_TAC(ISPECL [`\x. x IN {Re o f | P (f:real^N->complex)}`; `s:real^N->bool`]
10865         STONE_WEIERSTRASS_ALT) THEN
10866   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN
10867   REWRITE_TAC[EXISTS_IN_GSPEC; IMP_IMP; GSYM CONJ_ASSOC] THEN ANTS_TAC THENL
10868    [ASM_REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM; IN_ELIM_THM] THEN
10869     REPEAT CONJ_TAC THENL
10870      [X_GEN_TAC `c:real` THEN EXISTS_TAC `\x:real^N. Cx(c)` THEN
10871       ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; RE_CX];
10872       MAP_EVERY X_GEN_TAC [`f:real^N->complex`; `g:real^N->complex`] THEN
10873       DISCH_TAC THEN EXISTS_TAC `(\x. f x + g x):real^N->complex` THEN
10874       ASM_SIMP_TAC[o_THM; RE_ADD; FUN_EQ_THM];
10875       MAP_EVERY X_GEN_TAC [`f:real^N->complex`; `g:real^N->complex`] THEN
10876       STRIP_TAC THEN
10877       EXISTS_TAC `\x:real^N. Cx(Re(f x)) * Cx(Re(g x))` THEN
10878       ASM_SIMP_TAC[FUN_EQ_THM; RE_CX; o_THM; RE_MUL_CX];
10879       MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
10880       FIRST_X_ASSUM(MP_TAC o SPECL  [`x:real^N`; `y:real^N`]) THEN
10881       ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
10882       X_GEN_TAC `f:real^N->complex` THEN
10883       REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
10884       GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [COMPLEX_EQ] THEN
10885       REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THENL
10886        [EXISTS_TAC `\x:real^N. Re(f x)` THEN ASM_REWRITE_TAC[o_DEF] THEN
10887         CONJ_TAC THENL
10888          [ALL_TAC; EXISTS_TAC `f:real^N->complex` THEN ASM_REWRITE_TAC[]];
10889         EXISTS_TAC `\x:real^N. Im(f x)` THEN ASM_REWRITE_TAC[o_DEF] THEN
10890         CONJ_TAC THENL
10891          [ALL_TAC;
10892           EXISTS_TAC `\x:real^N. Cx(Im(f x))` THEN ASM_SIMP_TAC[RE_CX]]] THEN
10893       X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN REWRITE_TAC[GSYM o_DEF] THEN
10894       MATCH_MP_TAC REAL_CONTINUOUS_CONTINUOUS_WITHIN_COMPOSE THEN
10895       SIMP_TAC[REAL_CONTINUOUS_COMPLEX_COMPONENTS_AT;
10896                REAL_CONTINUOUS_AT_WITHIN] THEN
10897       ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]];
10898     DISCH_THEN(LABEL_TAC "*") THEN X_GEN_TAC `f:real^N->complex` THEN
10899     DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
10900     REMOVE_THEN "*"
10901      (fun th -> MP_TAC(ISPEC `Re o (f:real^N->complex)` th) THEN
10902                 MP_TAC(ISPEC `Im o (f:real^N->complex)` th)) THEN
10903     MATCH_MP_TAC(TAUT `(p1 /\ p2) /\ (q1 /\ q2 ==> r)
10904                        ==> (p1 ==> q1) ==> (p2 ==> q2) ==> r`) THEN
10905     CONJ_TAC THENL
10906      [CONJ_TAC THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
10907       MATCH_MP_TAC REAL_CONTINUOUS_CONTINUOUS_WITHIN_COMPOSE THEN
10908       SIMP_TAC[REAL_CONTINUOUS_COMPLEX_COMPONENTS_AT;
10909                REAL_CONTINUOUS_AT_WITHIN] THEN
10910       ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN];
10911       ALL_TAC] THEN
10912     REWRITE_TAC[AND_FORALL_THM] THEN
10913     DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN
10914     ASM_REWRITE_TAC[REAL_HALF; o_THM] THEN
10915     DISCH_THEN(CONJUNCTS_THEN2
10916      (X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC)
10917      (X_CHOOSE_THEN `h:real^N->complex` STRIP_ASSUME_TAC)) THEN
10918     EXISTS_TAC `\x:real^N. Cx(Re(h x)) + ii * Cx(Re(g x))` THEN
10919     ASM_SIMP_TAC[] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
10920     GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [COMPLEX_EXPAND] THEN
10921     MATCH_MP_TAC(NORM_ARITH
10922      `norm(x1 - x2) < e / &2 /\ norm(y1 - y2) < e / &2
10923       ==> norm((x1 + y1) - (x2 + y2)) < e`) THEN
10924     ASM_SIMP_TAC[GSYM CX_SUB; COMPLEX_NORM_CX; GSYM COMPLEX_SUB_LDISTRIB;
10925                  COMPLEX_NORM_MUL; COMPLEX_NORM_II; REAL_MUL_LID]]);;
10926
10927 let COMPLEX_STONE_WEIERSTRASS = prove
10928  (`!P s. compact s /\
10929          (!f. P f ==> f continuous_on s) /\
10930          (!c. P (\x. c)) /\
10931          (!f. P f ==> P(\x. cnj(f x))) /\
10932          (!f g. P f /\ P g ==> P (\x. f x + g x)) /\
10933          (!f g. P f /\ P g ==> P (\x. f x * g x)) /\
10934          (!x y. x IN s /\ y IN s /\ ~(x = y) ==> ?f. P f /\ ~(f x = f y))
10935          ==> !f:real^N->complex e.
10936                 f continuous_on s /\ &0 < e
10937                 ==> ?g. P g /\ !x. x IN s ==> norm(f x - g x) < e`,
10938   REPEAT GEN_TAC THEN STRIP_TAC THEN
10939   MATCH_MP_TAC COMPLEX_STONE_WEIERSTRASS_ALT THEN ASM_SIMP_TAC[] THEN
10940   MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN
10941   FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN
10942   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[]);;
10943
10944 (* ------------------------------------------------------------------------- *)
10945 (* Stone-Weierstrass for R^n -> R polynomials.                               *)
10946 (* ------------------------------------------------------------------------- *)
10947
10948 let real_polynomial_function_RULES,
10949     real_polynomial_function_INDUCT,
10950     real_polynomial_function_CASES = new_inductive_definition
10951  `(!i. 1 <= i /\ i <= dimindex(:N)
10952        ==> real_polynomial_function(\x:real^N. x$i)) /\
10953   (!c. real_polynomial_function(\x:real^N. c)) /\
10954   (!f g. real_polynomial_function f /\ real_polynomial_function g
10955          ==> real_polynomial_function(\x:real^N. f x + g x)) /\
10956   (!f g. real_polynomial_function f /\ real_polynomial_function g
10957          ==> real_polynomial_function(\x:real^N. f x * g x))`;;
10958
10959 let REAL_CONTINUOUS_REAL_POLYMONIAL_FUNCTION = prove
10960  (`!f x:real^N.
10961         real_polynomial_function f ==> f real_continuous at x`,
10962   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
10963   MATCH_MP_TAC real_polynomial_function_INDUCT THEN
10964   SIMP_TAC[REAL_CONTINUOUS_ADD; REAL_CONTINUOUS_MUL;
10965            REAL_CONTINUOUS_CONST; REAL_CONTINUOUS_AT_COMPONENT]);;
10966
10967 let STONE_WEIERSTRASS_REAL_POLYNOMIAL_FUNCTION = prove
10968  (`!f:real^N->real s e.
10969         compact s /\
10970         (!x. x IN s ==> f real_continuous at x within s) /\
10971         &0 < e
10972         ==> ?g. real_polynomial_function g /\
10973                 !x. x IN s ==> abs(f x - g x) < e`,
10974   REPEAT STRIP_TAC THEN
10975   MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP]
10976         STONE_WEIERSTRASS) THEN
10977   ASM_REWRITE_TAC[real_polynomial_function_RULES] THEN
10978   SIMP_TAC[REAL_CONTINUOUS_REAL_POLYMONIAL_FUNCTION;
10979            REAL_CONTINUOUS_AT_WITHIN] THEN
10980   MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN
10981   REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
10982   GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [CART_EQ] THEN
10983   REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN
10984   X_GEN_TAC `i:num` THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. x$i` THEN
10985   ASM_SIMP_TAC[real_polynomial_function_RULES]);;
10986
10987 (* ------------------------------------------------------------------------- *)
10988 (*  Stone-Weierstrass for real^M->real^N polynomials.                        *)
10989 (* ------------------------------------------------------------------------- *)
10990
10991 let vector_polynomial_function = new_definition
10992  `vector_polynomial_function (f:real^M->real^N) <=>
10993         !i. 1 <= i /\ i <= dimindex(:N)
10994             ==> real_polynomial_function(\x. f(x)$i)`;;
10995
10996 let VECTOR_POLYNOMIAL_FUNCTION_CONST = prove
10997  (`!c. vector_polynomial_function(\x. c)`,
10998   SIMP_TAC[vector_polynomial_function; real_polynomial_function_RULES]);;
10999
11000 let VECTOR_POLYNOMIAL_FUNCTION_ID = prove
11001  (`vector_polynomial_function(\x. x)`,
11002   SIMP_TAC[vector_polynomial_function; real_polynomial_function_RULES]);;
11003
11004 let VECTOR_POLYNOMIAL_FUNCTION_COMPONENT = prove
11005  (`!f:real^M->real^N i.
11006         1 <= i /\ i <= dimindex(:N) /\ vector_polynomial_function f
11007         ==> vector_polynomial_function(\x. lift(f x$i))`,
11008   SIMP_TAC[vector_polynomial_function; FORALL_1; DIMINDEX_1; GSYM drop;
11009            LIFT_DROP]);;
11010
11011 let VECTOR_POLYNOMIAL_FUNCTION_ADD = prove
11012  (`!f g:real^M->real^N.
11013         vector_polynomial_function f /\ vector_polynomial_function g
11014         ==> vector_polynomial_function (\x. f x + g x)`,
11015
11016   REWRITE_TAC[vector_polynomial_function] THEN
11017   SIMP_TAC[VECTOR_ADD_COMPONENT; real_polynomial_function_RULES]);;
11018
11019 let VECTOR_POLYNOMIAL_FUNCTION_MUL = prove
11020  (`!f g:real^M->real^N.
11021         vector_polynomial_function(lift o f) /\ vector_polynomial_function g
11022         ==> vector_polynomial_function (\x. f x % g x)`,
11023   REWRITE_TAC[vector_polynomial_function; o_DEF; VECTOR_MUL_COMPONENT] THEN
11024   REWRITE_TAC[FORALL_1; DIMINDEX_1; GSYM drop; LIFT_DROP; ETA_AX] THEN
11025   SIMP_TAC[real_polynomial_function_RULES]);;
11026
11027 let VECTOR_POLYNOMIAL_FUNCTION_CMUL = prove
11028  (`!f:real^M->real^N c.
11029         vector_polynomial_function f
11030         ==> vector_polynomial_function (\x. c % f x)`,
11031   SIMP_TAC[VECTOR_POLYNOMIAL_FUNCTION_CONST; VECTOR_POLYNOMIAL_FUNCTION_MUL;
11032            ETA_AX; o_DEF]);;
11033
11034 let VECTOR_POLYNOMIAL_FUNCTION_NEG = prove
11035  (`!f:real^M->real^N.
11036         vector_polynomial_function f
11037         ==> vector_polynomial_function (\x. --(f x))`,
11038   REWRITE_TAC[VECTOR_ARITH `--x:real^N = --(&1) % x`] THEN
11039   REWRITE_TAC[VECTOR_POLYNOMIAL_FUNCTION_CMUL]);;
11040
11041 let VECTOR_POLYNOMIAL_FUNCTION_SUB = prove
11042  (`!f g:real^M->real^N.
11043         vector_polynomial_function f /\ vector_polynomial_function g
11044         ==> vector_polynomial_function (\x. f x - g x)`,
11045   SIMP_TAC[VECTOR_SUB; VECTOR_POLYNOMIAL_FUNCTION_ADD;
11046            VECTOR_POLYNOMIAL_FUNCTION_NEG]);;
11047
11048 let VECTOR_POLYNOMIAL_FUNCTION_VSUM = prove
11049  (`!f:real^M->A->real^N s.
11050         FINITE s /\ (!i. i IN s ==> vector_polynomial_function (\x. f x i))
11051         ==> vector_polynomial_function (\x. vsum s (f x))`,
11052   GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN
11053   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
11054   SIMP_TAC[VSUM_CLAUSES; FORALL_IN_INSERT; VECTOR_POLYNOMIAL_FUNCTION_CONST;
11055            VECTOR_POLYNOMIAL_FUNCTION_ADD]);;
11056
11057 let CONTINUOUS_VECTOR_POLYNOMIAL_FUNCTION = prove
11058  (`!f:real^M->real^N x.
11059         vector_polynomial_function f ==> f continuous at x`,
11060   REWRITE_TAC[vector_polynomial_function; CONTINUOUS_COMPONENTWISE] THEN
11061   REPEAT STRIP_TAC THEN
11062   MATCH_MP_TAC REAL_CONTINUOUS_REAL_POLYMONIAL_FUNCTION THEN
11063   ASM_SIMP_TAC[]);;
11064
11065 let CONTINUOUS_ON_VECTOR_POLYNOMIAL_FUNCTION = prove
11066  (`!f:real^M->real^N s.
11067         vector_polynomial_function f ==> f continuous_on s`,
11068   SIMP_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON;
11069            CONTINUOUS_VECTOR_POLYNOMIAL_FUNCTION]);;
11070
11071 let HAS_VECTOR_DERIVATIVE_VECTOR_POLYNOMIAL_FUNCTION = prove
11072  (`!p:real^1->real^N.
11073         vector_polynomial_function p
11074         ==> ?p'. vector_polynomial_function p' /\
11075                  !x. (p has_vector_derivative p'(x)) (at x)`,
11076   let lemma = prove
11077    (`!p:real^1->real.
11078           real_polynomial_function p
11079           ==> ?p'. real_polynomial_function p' /\
11080                  !x. ((p o lift) has_real_derivative (p'(lift x))) (atreal x)`,
11081     MATCH_MP_TAC
11082      (derive_strong_induction(real_polynomial_function_RULES,
11083                               real_polynomial_function_INDUCT)) THEN
11084     REWRITE_TAC[DIMINDEX_1; FORALL_1; o_DEF; GSYM drop; LIFT_DROP] THEN
11085     CONJ_TAC THENL
11086      [EXISTS_TAC `\x:real^1. &1` THEN
11087       REWRITE_TAC[real_polynomial_function_RULES; HAS_REAL_DERIVATIVE_ID];
11088       ALL_TAC] THEN
11089     CONJ_TAC THENL
11090      [X_GEN_TAC `c:real` THEN EXISTS_TAC `\x:real^1. &0` THEN
11091       REWRITE_TAC[real_polynomial_function_RULES; HAS_REAL_DERIVATIVE_CONST];
11092       ALL_TAC] THEN
11093     CONJ_TAC THEN
11094     MAP_EVERY X_GEN_TAC [`f:real^1->real`; `g:real^1->real`] THEN
11095     DISCH_THEN(CONJUNCTS_THEN2
11096      (CONJUNCTS_THEN2 ASSUME_TAC
11097        (X_CHOOSE_THEN `f':real^1->real` STRIP_ASSUME_TAC))
11098      (CONJUNCTS_THEN2 ASSUME_TAC
11099        (X_CHOOSE_THEN `g':real^1->real` STRIP_ASSUME_TAC)))
11100     THENL
11101      [EXISTS_TAC `\x. (f':real^1->real) x + g' x`;
11102       EXISTS_TAC `\x. (f:real^1->real) x * g' x + f' x * g x`] THEN
11103     ASM_SIMP_TAC[real_polynomial_function_RULES; HAS_REAL_DERIVATIVE_ADD;
11104                  HAS_REAL_DERIVATIVE_MUL_ATREAL]) in
11105   GEN_TAC THEN REWRITE_TAC[vector_polynomial_function] THEN DISCH_TAC THEN
11106   SUBGOAL_THEN
11107    `!i. 1 <= i /\ i <= dimindex(:N)
11108         ==> ?q. real_polynomial_function q /\
11109                 (!x. ((\x. lift(((p x):real^N)$i)) has_vector_derivative
11110                       lift(q x)) (at x))`
11111   MP_TAC THENL
11112    [X_GEN_TAC `i:num` THEN STRIP_TAC THEN
11113     FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN
11114     ASM_REWRITE_TAC[] THEN
11115     DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN
11116     REWRITE_TAC[HAS_REAL_VECTOR_DERIVATIVE_AT] THEN
11117     REWRITE_TAC[o_DEF; LIFT_DROP; FORALL_DROP];
11118     GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
11119     REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
11120     X_GEN_TAC `q:num->real^1->real` THEN DISCH_TAC THEN
11121     EXISTS_TAC `(\x. lambda i. (q:num->real^1->real) i x):real^1->real^N` THEN
11122     ASM_SIMP_TAC[LAMBDA_BETA; ETA_AX] THEN
11123     REWRITE_TAC[has_vector_derivative; has_derivative_at] THEN
11124     ONCE_REWRITE_TAC[LIM_COMPONENTWISE] THEN X_GEN_TAC `x:real^1` THEN
11125     SIMP_TAC[LINEAR_VMUL_DROP; LINEAR_ID] THEN X_GEN_TAC `i:num` THEN
11126     STRIP_TAC THEN
11127     REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN
11128     ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
11129     FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN
11130     REWRITE_TAC[has_vector_derivative; has_derivative_at] THEN
11131     ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; VEC_COMPONENT; VECTOR_SUB_COMPONENT;
11132                  VECTOR_ADD_COMPONENT; LAMBDA_BETA; REAL_TENDSTO] THEN
11133     SIMP_TAC[DROP_ADD; DROP_VEC; LIFT_DROP; DROP_CMUL; DROP_SUB; o_DEF]]);;
11134
11135 let STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION = prove
11136  (`!f:real^M->real^N s e.
11137         compact s /\ f continuous_on s /\ &0 < e
11138         ==> ?g. vector_polynomial_function g /\
11139                 !x. x IN s ==> norm(f x - g x) < e`,
11140   REPEAT STRIP_TAC THEN
11141   FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I
11142    [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN
11143   REWRITE_TAC[CONTINUOUS_COMPONENTWISE] THEN
11144   REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM] THEN DISCH_TAC THEN
11145   SUBGOAL_THEN
11146    `!i. 1 <= i /\ i <= dimindex(:N)
11147         ==> ?g. real_polynomial_function g /\
11148                 !x. x IN s ==> abs((f:real^M->real^N) x$i - g x) <
11149                                e / &(dimindex(:N))`
11150   MP_TAC THENL
11151    [REPEAT STRIP_TAC THEN
11152     MATCH_MP_TAC STONE_WEIERSTRASS_REAL_POLYNOMIAL_FUNCTION THEN
11153     ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1];
11154     GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
11155      [RIGHT_IMP_EXISTS_THM] THEN
11156     REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
11157     X_GEN_TAC `g:num->real^M->real` THEN DISCH_TAC THEN
11158     EXISTS_TAC `(\x. lambda i. g i x):real^M->real^N` THEN
11159     ASM_SIMP_TAC[vector_polynomial_function; LAMBDA_BETA; ETA_AX] THEN
11160     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
11161     W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN
11162     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN
11163     MATCH_MP_TAC SUM_BOUND_LT_GEN THEN
11164     REWRITE_TAC[FINITE_NUMSEG; CARD_NUMSEG_1; NUMSEG_EMPTY; NOT_LT] THEN
11165     ASM_SIMP_TAC[IN_NUMSEG; DIMINDEX_GE_1; LAMBDA_BETA;
11166                  VECTOR_SUB_COMPONENT]]);;
11167
11168 let STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION_SUBSPACE = prove
11169  (`!f:real^M->real^N s e t.
11170         compact s /\ f continuous_on s /\ &0 < e /\
11171         subspace t /\ IMAGE f s SUBSET t
11172         ==> ?g. vector_polynomial_function g /\ IMAGE g s SUBSET t /\
11173                 !x. x IN s ==> norm(f x - g x) < e`,
11174   REPEAT STRIP_TAC THEN
11175   FIRST_ASSUM(MP_TAC o MATCH_MP ORTHONORMAL_BASIS_SUBSPACE) THEN
11176   DISCH_THEN(X_CHOOSE_THEN `bas:real^N->bool` MP_TAC) THEN
11177   ASM_CASES_TAC `FINITE(bas:real^N->bool)` THENL
11178    [ALL_TAC; ASM_MESON_TAC[HAS_SIZE]] THEN
11179   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN
11180   ABBREV_TAC `n = CARD(bas:real^N->bool)` THEN
11181   REWRITE_TAC[INJECTIVE_ON_ALT; LEFT_IMP_EXISTS_THM] THEN
11182   X_GEN_TAC `b:num->real^N` THEN
11183   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC) THEN
11184   ASM_SIMP_TAC[REWRITE_RULE[INJECTIVE_ON_ALT] HAS_SIZE_IMAGE_INJ_EQ] THEN
11185   REWRITE_TAC[HAS_SIZE; FINITE_NUMSEG; CARD_NUMSEG_1] THEN
11186   ASM_CASES_TAC `dim(t:real^N->bool) = n` THEN ASM_REWRITE_TAC[] THEN
11187   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN STRIP_TAC THEN
11188   MP_TAC(ISPEC `t:real^N->bool` DIM_SUBSET_UNIV) THEN ASM_REWRITE_TAC[] THEN
11189   DISCH_TAC THEN MP_TAC(ISPECL
11190    [`(\x. lambda i. (f x:real^N) dot (b i)):real^M->real^N`;
11191     `s:real^M->bool`; `e:real`]
11192    STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION) THEN
11193   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
11194    [ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN
11195     SIMP_TAC[LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN
11196     MATCH_MP_TAC CONTINUOUS_ON_LIFT_DOT2 THEN
11197     ASM_REWRITE_TAC[CONTINUOUS_ON_CONST];
11198     DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC)] THEN
11199   EXISTS_TAC `(\x. vsum(1..n) (\i. (g x:real^N)$i % b i)):real^M->real^N` THEN
11200   REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
11201    [MATCH_MP_TAC VECTOR_POLYNOMIAL_FUNCTION_VSUM THEN
11202     REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
11203     REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_POLYNOMIAL_FUNCTION_MUL THEN
11204     REWRITE_TAC[VECTOR_POLYNOMIAL_FUNCTION_CONST; o_DEF] THEN
11205     MATCH_MP_TAC VECTOR_POLYNOMIAL_FUNCTION_COMPONENT THEN
11206     ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC;
11207     REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSPACE_VSUM THEN
11208     ASM_SIMP_TAC[SUBSPACE_MUL; FINITE_NUMSEG];
11209     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
11210     FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN
11211     ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[DOT_SYM] THEN
11212     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN
11213     SUBGOAL_THEN
11214      `vsum(IMAGE b (1..n)) (\v. (v dot f x) % v) = (f:real^M->real^N) x`
11215      (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th])
11216     THENL
11217      [MATCH_MP_TAC ORTHONORMAL_BASIS_EXPAND THEN
11218       ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM SET_TAC[];
11219       ASM_SIMP_TAC[REWRITE_RULE[INJECTIVE_ON_ALT] VSUM_IMAGE;
11220                    FINITE_NUMSEG] THEN
11221       REWRITE_TAC[GSYM VSUM_SUB_NUMSEG; o_DEF; GSYM VECTOR_SUB_RDISTRIB] THEN
11222       REWRITE_TAC[NORM_LE; GSYM NORM_POW_2] THEN
11223       W(MP_TAC o PART_MATCH (lhs o rand) NORM_VSUM_PYTHAGOREAN o
11224         lhand o snd) THEN
11225       RULE_ASSUM_TAC(REWRITE_RULE[PAIRWISE_IMAGE]) THEN
11226       RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN
11227       ASM_SIMP_TAC[pairwise; ORTHOGONAL_MUL; FINITE_NUMSEG] THEN
11228       DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[NORM_MUL] THEN
11229       REWRITE_TAC[NORM_POW_2] THEN GEN_REWRITE_TAC RAND_CONV [dot] THEN
11230       SIMP_TAC[GSYM REAL_POW_2; VECTOR_SUB_COMPONENT; LAMBDA_BETA] THEN
11231       MATCH_MP_TAC SUM_LE_INCLUDED THEN EXISTS_TAC `\n:num. n` THEN
11232       REWRITE_TAC[FINITE_NUMSEG; REAL_LE_POW_2] THEN
11233       ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
11234       REWRITE_TAC[UNWIND_THM2] THEN
11235       ONCE_REWRITE_TAC[TAUT `p ==> q /\ r <=> p ==> q /\ (q ==> r)`] THEN
11236       RULE_ASSUM_TAC(REWRITE_RULE[IN_NUMSEG]) THEN
11237       ASM_SIMP_TAC[LAMBDA_BETA; UNWIND_THM2; IN_NUMSEG] THEN
11238       REWRITE_TAC[REAL_MUL_RID; REAL_POW2_ABS; REAL_LE_REFL] THEN
11239       ASM_ARITH_TAC]]);;
11240
11241 let STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION_AFFINE = prove
11242  (`!f:real^M->real^N s e t.
11243         compact s /\ f continuous_on s /\ &0 < e /\
11244         affine t /\ IMAGE f s SUBSET t
11245         ==> ?g. vector_polynomial_function g /\ IMAGE g s SUBSET t /\
11246                 !x. x IN s ==> norm(f x - g x) < e`,
11247   REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN
11248   ASM_REWRITE_TAC[SUBSET_EMPTY; IMAGE_EQ_EMPTY] THENL
11249    [MESON_TAC[VECTOR_POLYNOMIAL_FUNCTION_CONST; NOT_IN_EMPTY];
11250     STRIP_TAC] THEN
11251   MP_TAC(ISPEC `t:real^N->bool` AFFINE_TRANSLATION_SUBSPACE) THEN
11252   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
11253   MAP_EVERY X_GEN_TAC [`a:real^N`; `u:real^N->bool`] THEN STRIP_TAC THEN
11254   FIRST_X_ASSUM SUBST_ALL_TAC THEN
11255   MP_TAC(ISPECL
11256    [`(\x. f x - a):real^M->real^N`; `s:real^M->bool`; `e:real`;
11257    `u:real^N->bool`] STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION_SUBSPACE) THEN
11258   ASM_SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST] THEN
11259   FIRST_ASSUM(MP_TAC o ISPEC `\x:real^N. x - a` o MATCH_MP IMAGE_SUBSET) THEN
11260   REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ADD_SUB; IMAGE_ID] THEN
11261   DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
11262   DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
11263   EXISTS_TAC `(\x. g x + a):real^M->real^N` THEN
11264   ASM_SIMP_TAC[VECTOR_POLYNOMIAL_FUNCTION_ADD;
11265                VECTOR_POLYNOMIAL_FUNCTION_CONST;
11266                VECTOR_ARITH `a - (b + c):real^N = a - c - b`] THEN
11267   FIRST_ASSUM(MP_TAC o ISPEC `\x:real^N. a + x` o MATCH_MP IMAGE_SUBSET) THEN
11268   REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ADD_AC]);;
11269
11270 (* ------------------------------------------------------------------------- *)
11271 (* One application is to pick a smooth approximation to a path, or just pick *)
11272 (* a smooth path anyway in an open connected set.                            *)
11273 (* ------------------------------------------------------------------------- *)
11274
11275 let PATH_VECTOR_POLYNOMIAL_FUNCTION = prove
11276  (`!g:real^1->real^N. vector_polynomial_function g ==> path g`,
11277   SIMP_TAC[path; CONTINUOUS_ON_VECTOR_POLYNOMIAL_FUNCTION]);;
11278
11279 let PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION = prove
11280  (`!g:real^1->real^N e.
11281         path g /\ &0 < e
11282         ==> ?p. vector_polynomial_function p /\
11283                 pathstart p = pathstart g /\
11284                 pathfinish p = pathfinish g /\
11285                 !t. t IN interval[vec 0,vec 1] ==> norm(p t - g t) < e`,
11286   REWRITE_TAC[path] THEN REPEAT STRIP_TAC THEN
11287   MP_TAC(ISPECL [`g:real^1->real^N`; `interval[vec 0:real^1,vec 1]`; `e / &4`]
11288         STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION) THEN
11289   ASM_REWRITE_TAC[COMPACT_INTERVAL; REAL_ARITH `&0 < x / &4 <=> &0 < x`] THEN
11290   DISCH_THEN(X_CHOOSE_THEN `q:real^1->real^N` STRIP_ASSUME_TAC) THEN
11291   EXISTS_TAC `\t. (q:real^1->real^N)(t) + (g(vec 0:real^1) - q(vec 0)) +
11292                 drop t % ((g(vec 1) - q(vec 1)) - (g(vec 0) - q(vec 0)))` THEN
11293   REWRITE_TAC[pathstart; pathfinish; DROP_VEC] THEN REPEAT CONJ_TAC THENL
11294    [SIMP_TAC[vector_polynomial_function; VECTOR_ADD_COMPONENT;
11295              VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT] THEN
11296     REPEAT STRIP_TAC THEN
11297     RULE_ASSUM_TAC(REWRITE_RULE[vector_polynomial_function]) THEN
11298     MATCH_MP_TAC(el 2 (CONJUNCTS real_polynomial_function_RULES)) THEN
11299     ASM_SIMP_TAC[real_polynomial_function_RULES; drop; DIMINDEX_1; ARITH];
11300     VECTOR_ARITH_TAC;
11301     VECTOR_ARITH_TAC;
11302     REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[VECTOR_SUB_LDISTRIB] THEN
11303     MATCH_MP_TAC(NORM_ARITH
11304      `norm(x - a) < e / &4 /\ norm b < e / &4 /\ norm c <= &1 * e / &4 /\
11305         norm d <= &1 * e / &4
11306       ==> norm((a + b + c - d) - x:real^N) < e`) THEN
11307     ASM_SIMP_TAC[NORM_MUL; IN_INTERVAL_1; DROP_VEC; REAL_POS] THEN
11308     CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN
11309     ASM_SIMP_TAC[REAL_LT_IMP_LE; IN_INTERVAL_1; DROP_VEC; REAL_POS;
11310                  REAL_LE_REFL; NORM_POS_LE] THEN
11311     RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN
11312     ASM_REAL_ARITH_TAC]);;
11313
11314 let CONNECTED_OPEN_VECTOR_POLYNOMIAL_CONNECTED = prove
11315  (`!s:real^N->bool.
11316         open s /\ connected s
11317         ==> !x y. x IN s /\ y IN s
11318                   ==> ?g. vector_polynomial_function g /\
11319                           path_image g SUBSET s /\
11320                           pathstart g = x /\
11321                           pathfinish g = y`,
11322   REPEAT STRIP_TAC THEN
11323   SUBGOAL_THEN `path_connected(s:real^N->bool)` MP_TAC THENL
11324    [ASM_SIMP_TAC[CONNECTED_OPEN_PATH_CONNECTED];
11325     REWRITE_TAC[path_connected]] THEN
11326   DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN
11327   ASM_REWRITE_TAC[] THEN
11328   DISCH_THEN(X_CHOOSE_THEN `p:real^1->real^N` STRIP_ASSUME_TAC) THEN
11329   SUBGOAL_THEN
11330    `?e. &0 < e /\ !x. x IN path_image p ==> ball(x:real^N,e) SUBSET s`
11331   STRIP_ASSUME_TAC THENL
11332    [ASM_CASES_TAC `s = (:real^N)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THENL
11333      [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN
11334     EXISTS_TAC `setdist(path_image p,(:real^N) DIFF s)` THEN CONJ_TAC THENL
11335      [ASM_REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN
11336       ASM_SIMP_TAC[SETDIST_POS_LE; SETDIST_EQ_0_COMPACT_CLOSED;
11337                    COMPACT_PATH_IMAGE; GSYM OPEN_CLOSED] THEN
11338       ASM_SIMP_TAC[PATH_IMAGE_NONEMPTY] THEN ASM SET_TAC[];
11339       X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN REWRITE_TAC[SUBSET] THEN
11340       X_GEN_TAC `w:real^N` THEN REWRITE_TAC[IN_BALL; GSYM REAL_NOT_LE] THEN
11341       MATCH_MP_TAC(SET_RULE
11342        `(w IN (UNIV DIFF s) ==> p) ==> (~p ==> w IN s)`) THEN
11343       ASM_SIMP_TAC[SETDIST_LE_DIST]];
11344     MP_TAC(ISPECL [`p:real^1->real^N`; `e:real`]
11345       PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION) THEN
11346     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
11347     X_GEN_TAC `q:real^1->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
11348     REWRITE_TAC[path_image; FORALL_IN_IMAGE; SUBSET] THEN RULE_ASSUM_TAC
11349      (REWRITE_RULE[SUBSET; path_image; FORALL_IN_IMAGE;IN_BALL; dist]) THEN
11350     ASM_MESON_TAC[NORM_SUB]]);;
11351
11352 (* ------------------------------------------------------------------------- *)
11353 (* Lipschitz property for real and vector polynomials.                       *)
11354 (* ------------------------------------------------------------------------- *)
11355
11356 let LIPSCHITZ_REAL_POLYNOMIAL_FUNCTION = prove
11357  (`!f:real^N->real s.
11358         real_polynomial_function f /\ bounded s
11359         ==> ?B. &0 < B /\
11360                 !x y. x IN s /\ y IN s ==> abs(f x - f y) <= B * norm(x - y)`,
11361   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN
11362   ASM_CASES_TAC `bounded(s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN
11363   ASM_CASES_TAC `s:real^N->bool = {}` THENL
11364    [ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN MESON_TAC[REAL_LT_01]; ALL_TAC] THEN
11365   MATCH_MP_TAC real_polynomial_function_INDUCT THEN REPEAT CONJ_TAC THENL
11366    [REPEAT STRIP_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN
11367     ASM_SIMP_TAC[REAL_MUL_LID; GSYM VECTOR_SUB_COMPONENT; COMPONENT_LE_NORM];
11368     GEN_TAC THEN EXISTS_TAC `&1` THEN
11369     SIMP_TAC[REAL_LT_01; REAL_SUB_REFL; REAL_ABS_NUM; REAL_MUL_LID;
11370              NORM_POS_LE];
11371     ALL_TAC; ALL_TAC] THEN
11372   MAP_EVERY X_GEN_TAC [`f:real^N->real`; `g:real^N->real`] THEN
11373   DISCH_THEN(CONJUNCTS_THEN2
11374     (X_CHOOSE_THEN `B1:real` STRIP_ASSUME_TAC)
11375     (X_CHOOSE_THEN `B2:real` STRIP_ASSUME_TAC))
11376   THENL
11377    [EXISTS_TAC `B1 + B2:real` THEN ASM_SIMP_TAC[REAL_LT_ADD] THEN
11378     REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH
11379      `abs(f - f') <= B1 * n /\ abs(g - g') <= B2 * n
11380       ==> abs((f + g) - (f' + g')) <= (B1 + B2) * n`) THEN
11381     ASM_SIMP_TAC[];
11382     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
11383     DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN
11384     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN
11385     DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
11386     EXISTS_TAC `B1 * (abs(g(a:real^N)) + B2 * &2 * B) +
11387                 B2 * (abs(f a) + B1 * &2 * B)` THEN
11388     CONJ_TAC THENL
11389      [MATCH_MP_TAC REAL_LT_ADD THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LT_MUL THEN
11390       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH
11391        `&0 < x ==> &0 < abs a + x`) THEN
11392       MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC;
11393       REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH
11394        `abs((f - f') * g) <= a * n /\ abs((g - g') * f') <= b * n
11395         ==> abs(f * g - f' * g') <= (a + b) * n`) THEN
11396       ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = (a * c) * b`] THEN
11397       REWRITE_TAC[REAL_ABS_MUL] THEN
11398       CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN
11399       ASM_SIMP_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC(REAL_ARITH
11400        `abs(g x - g a) <= C * norm(x - a) /\
11401         C * norm(x - a:real^N) <= C * B ==> abs(g x) <= abs(g a) + C * B`) THEN
11402       ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN MATCH_MP_TAC(NORM_ARITH
11403        `norm x <= B /\ norm a <= B ==> norm(x - a:real^N) <= &2 * B`) THEN
11404       ASM_SIMP_TAC[]]]);;
11405
11406 let LIPSCHITZ_VECTOR_POLYNOMIAL_FUNCTION = prove
11407  (`!f:real^M->real^N s.
11408         vector_polynomial_function f /\ bounded s
11409         ==> ?B. &0 < B /\
11410                 !x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)`,
11411   REWRITE_TAC[vector_polynomial_function] THEN REPEAT STRIP_TAC THEN
11412   SUBGOAL_THEN
11413    `?b. !i. 1 <= i /\ i <= dimindex(:N)
11414             ==> &0 < (b:real^N)$i /\
11415                 !x y. x IN s /\ y IN s
11416                       ==> abs((f:real^M->real^N) x$i - f y$i) <=
11417                           b$i * norm(x - y)`
11418   STRIP_ASSUME_TAC THENL
11419    [REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN REPEAT STRIP_TAC THEN
11420     MATCH_MP_TAC LIPSCHITZ_REAL_POLYNOMIAL_FUNCTION THEN
11421     ASM_SIMP_TAC[LIPSCHITZ_REAL_POLYNOMIAL_FUNCTION];
11422     EXISTS_TAC `&1 + sum(1..dimindex(:N)) (\i. (b:real^N)$i)` THEN
11423     CONJ_TAC THENL
11424      [MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &0 < &1 + x`) THEN
11425       MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN ASM_SIMP_TAC[REAL_LT_IMP_LE];
11426       REPEAT STRIP_TAC THEN
11427       W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN
11428       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN
11429       REWRITE_TAC[REAL_ADD_RDISTRIB; GSYM SUM_RMUL; REAL_MUL_LID] THEN
11430       MATCH_MP_TAC(NORM_ARITH `x <= y ==> x <= norm(a:real^N) + y`) THEN
11431       MATCH_MP_TAC SUM_LE_NUMSEG THEN
11432       ASM_SIMP_TAC[VECTOR_SUB_COMPONENT]]]);;
11433
11434 (* ------------------------------------------------------------------------- *)
11435 (* Differentiability of real and vector polynomial functions.                *)
11436 (* ------------------------------------------------------------------------- *)
11437
11438 let DIFFERENTIABLE_REAL_POLYNOMIAL_FUNCTION_AT = prove
11439  (`!f:real^N->real a.
11440         real_polynomial_function f ==> (lift o f) differentiable (at a)`,
11441   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN
11442   MATCH_MP_TAC real_polynomial_function_INDUCT THEN
11443   REWRITE_TAC[o_DEF; LIFT_ADD; LIFT_CMUL] THEN
11444   REWRITE_TAC[DIFFERENTIABLE_LIFT_COMPONENT; DIFFERENTIABLE_CONST] THEN
11445   SIMP_TAC[DIFFERENTIABLE_ADD] THEN REPEAT STRIP_TAC THEN
11446   MATCH_MP_TAC DIFFERENTIABLE_MUL_AT THEN
11447   ASM_REWRITE_TAC[o_DEF]);;
11448
11449 let DIFFERENTIABLE_ON_REAL_POLYNOMIAL_FUNCTION = prove
11450  (`!f:real^N->real s.
11451         real_polynomial_function f ==> (lift o f) differentiable_on s`,
11452   SIMP_TAC[DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON;
11453            DIFFERENTIABLE_REAL_POLYNOMIAL_FUNCTION_AT]);;
11454
11455 let DIFFERENTIABLE_VECTOR_POLYNOMIAL_FUNCTION = prove
11456  (`!f:real^M->real^N a.
11457         vector_polynomial_function f ==> f differentiable (at a)`,
11458   REWRITE_TAC[vector_polynomial_function] THEN REPEAT STRIP_TAC THEN
11459   ONCE_REWRITE_TAC[DIFFERENTIABLE_COMPONENTWISE_AT] THEN
11460   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN
11461   MATCH_MP_TAC DIFFERENTIABLE_REAL_POLYNOMIAL_FUNCTION_AT THEN
11462   ASM_SIMP_TAC[]);;
11463
11464 let DIFFERENTIABLE_ON_VECTOR_POLYNOMIAL_FUNCTION = prove
11465  (`!f:real^M->real^N s.
11466         vector_polynomial_function f ==> f differentiable_on s`,
11467   SIMP_TAC[DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON;
11468            DIFFERENTIABLE_VECTOR_POLYNOMIAL_FUNCTION]);;
11469
11470 (* ------------------------------------------------------------------------- *)
11471 (* Specific properties of complex measurable functions.                      *)
11472 (* ------------------------------------------------------------------------- *)
11473
11474 let MEASURABLE_ON_COMPLEX_MUL = prove
11475  (`!f g:real^N->complex s.
11476          f measurable_on s /\ g measurable_on s
11477          ==> (\x. f x * g x) measurable_on s`,
11478   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_COMBINE THEN
11479   ASM_REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_MUL_LZERO] THEN
11480   MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN
11481   CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN
11482   REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);;
11483
11484 let MEASURABLE_ON_COMPLEX_INV = prove
11485  (`!f:real^N->real^2.
11486      f measurable_on (:real^N) /\ negligible {x | f x = Cx(&0)}
11487      ==> (\x. inv(f x)) measurable_on (:real^N)`,
11488   GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
11489   REWRITE_TAC[measurable_on; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN
11490   MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `g:num->real^N->complex`] THEN
11491   STRIP_TAC THEN EXISTS_TAC `k UNION {x:real^N | f x = Cx(&0)}` THEN
11492   ASM_SIMP_TAC[NEGLIGIBLE_UNION] THEN
11493   SUBGOAL_THEN
11494    `!n. ?h. h continuous_on (:real^N) /\
11495             !x. x IN {x | g n x IN (:complex) DIFF ball(Cx(&0),inv(&n + &1))}
11496                 ==> (h:real^N->complex) x = inv(g n x)`
11497
11498   MP_TAC THENL
11499    [X_GEN_TAC `n:num` THEN MATCH_MP_TAC TIETZE_UNBOUNDED THEN CONJ_TAC THENL
11500      [REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN
11501       MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN
11502       REWRITE_TAC[GSYM OPEN_CLOSED; OPEN_BALL; ETA_AX] THEN
11503       ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV];
11504       REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN
11505       GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN
11506       MATCH_MP_TAC CONTINUOUS_COMPLEX_INV_AT THEN CONJ_TAC THENL
11507        [REWRITE_TAC[ETA_AX] THEN
11508         ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV];
11509         RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM; IN_UNIV; IN_DIFF]) THEN
11510         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_BALL]) THEN
11511         SIMP_TAC[CONTRAPOS_THM; DIST_REFL; REAL_LT_INV_EQ] THEN
11512         REAL_ARITH_TAC]];
11513     REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
11514     X_GEN_TAC `h:num->real^N->complex` THEN
11515     REWRITE_TAC[FORALL_AND_THM; IN_ELIM_THM; IN_DIFF; IN_UNION; IN_UNIV] THEN
11516     REWRITE_TAC[IN_BALL; DE_MORGAN_THM; REAL_NOT_LT] THEN
11517     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^N` THEN
11518     STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM THEN
11519     EXISTS_TAC `\n. inv((g:num->real^N->complex) n x)` THEN
11520     ASM_SIMP_TAC[o_DEF; LIM_COMPLEX_INV] THEN
11521     MATCH_MP_TAC LIM_EVENTUALLY THEN
11522     REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN
11523     SUBGOAL_THEN `&0 < norm((f:real^N->complex) x)` ASSUME_TAC THENL
11524      [ASM_REWRITE_TAC[COMPLEX_NORM_NZ]; ALL_TAC] THEN
11525     FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN
11526     ASM_REWRITE_TAC[LIM_SEQUENTIALLY] THEN
11527     DISCH_THEN(MP_TAC o SPEC `norm((f:real^N->complex) x) / &2`) THEN
11528     ASM_REWRITE_TAC[REAL_HALF] THEN
11529     DISCH_THEN(X_CHOOSE_THEN `N1:num` (LABEL_TAC "*")) THEN
11530     MP_TAC(SPEC `norm((f:real^N->complex) x) / &2` REAL_ARCH_INV) THEN
11531     ASM_REWRITE_TAC[REAL_HALF] THEN
11532     DISCH_THEN(X_CHOOSE_THEN `N2:num` STRIP_ASSUME_TAC) THEN
11533     EXISTS_TAC `N1 + N2 + 1` THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN
11534     REWRITE_TAC[VECTOR_SUB_EQ] THEN CONV_TAC SYM_CONV THEN
11535     FIRST_X_ASSUM MATCH_MP_TAC THEN
11536     REWRITE_TAC[GSYM COMPLEX_VEC_0; DIST_0] THEN
11537     REMOVE_THEN "*" (MP_TAC o SPEC `n:num`) THEN
11538     ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN
11539     DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH
11540      `dist(g,f) < norm(f) / &2 ==> norm(f) / &2 <= norm g`)) THEN
11541     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN
11542     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
11543      `x < y ==> z <= x ==> z <= y`)) THEN
11544     MATCH_MP_TAC REAL_LE_INV2 THEN
11545     ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN
11546     ASM_ARITH_TAC]);;
11547
11548 let MEASURABLE_ON_COMPLEX_DIV = prove
11549  (`!f g:real^N->complex s.
11550         f measurable_on s /\ g measurable_on (:real^N) /\
11551         negligible {x | g(x) = Cx(&0)}
11552         ==> (\x. f(x) / g(x)) measurable_on s`,
11553   let lemma = prove
11554    (`!f g:real^N->complex.
11555         f measurable_on (:real^N) /\ g measurable_on (:real^N) /\
11556         negligible {x | g(x) = Cx(&0)}
11557         ==> (\x. f(x) / g(x)) measurable_on (:real^N)`,
11558     REPEAT STRIP_TAC THEN REWRITE_TAC[complex_div] THEN
11559     ASM_SIMP_TAC[MEASURABLE_ON_COMPLEX_MUL; MEASURABLE_ON_COMPLEX_INV]) in
11560   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN
11561   REWRITE_TAC[IN_UNIV; ETA_AX] THEN DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN
11562   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
11563   REWRITE_TAC[FUN_EQ_THM; complex_div; COMPLEX_VEC_0] THEN
11564   GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[COMPLEX_MUL_LZERO]);;
11565
11566 (* ------------------------------------------------------------------------- *)
11567 (* Measurable real->real functions.                                          *)
11568 (* ------------------------------------------------------------------------- *)
11569
11570 parse_as_infix("real_measurable_on",(12,"right"));;
11571
11572 let real_measurable_on = new_definition
11573  `f real_measurable_on s <=>
11574         (lift o f o drop) measurable_on (IMAGE lift s)`;;
11575
11576 let real_lebesgue_measurable = new_definition
11577  `real_lebesgue_measurable s <=>
11578       (\x. if x IN s then &1 else &0) real_measurable_on (:real)`;;
11579
11580 let REAL_MEASURABLE_ON_UNIV = prove
11581  (`(\x.  if x IN s then f(x) else &0) real_measurable_on (:real) <=>
11582    f real_measurable_on s`,
11583   REWRITE_TAC[real_measurable_on; o_DEF; IMAGE_LIFT_UNIV] THEN
11584   SIMP_TAC[COND_RAND; LIFT_NUM; MEASURABLE_ON_UNIV; GSYM IN_IMAGE_LIFT_DROP]);;
11585
11586 let REAL_LEBESGUE_MEASURABLE = prove
11587  (`!s. real_lebesgue_measurable s <=> lebesgue_measurable (IMAGE lift s)`,
11588   REWRITE_TAC[real_lebesgue_measurable; lebesgue_measurable; COND_RAND;
11589     COND_RAND; real_measurable_on; indicator; IMAGE_LIFT_UNIV; o_DEF] THEN
11590   REWRITE_TAC[LIFT_NUM; IN_IMAGE_LIFT_DROP]);;
11591
11592 let REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE = prove
11593  (`!f g s.
11594         f real_measurable_on s /\
11595         g real_integrable_on s /\
11596         (!x. x IN s ==> abs(f x) <= g x)
11597         ==> f real_integrable_on s`,
11598   REWRITE_TAC[real_measurable_on; REAL_INTEGRABLE_ON] THEN
11599   REPEAT STRIP_TAC THEN
11600   MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN
11601   EXISTS_TAC `lift o g o drop` THEN
11602   ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; NORM_LIFT]);;
11603
11604 let REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE = prove
11605  (`!f g s.
11606         f real_measurable_on s /\
11607         g real_integrable_on s /\
11608         (!x. x IN s ==> abs(f x) <= g x)
11609         ==> f absolutely_real_integrable_on s`,
11610   REWRITE_TAC[real_measurable_on; REAL_INTEGRABLE_ON;
11611               ABSOLUTELY_REAL_INTEGRABLE_ON] THEN
11612   REPEAT STRIP_TAC THEN
11613   MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN
11614   EXISTS_TAC `lift o g o drop` THEN
11615   ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; NORM_LIFT]);;
11616
11617 let INTEGRABLE_SUBINTERVALS_IMP_REAL_MEASURABLE = prove
11618  (`!f. (!a b. f real_integrable_on real_interval[a,b])
11619        ==> f real_measurable_on (:real)`,
11620   REWRITE_TAC[real_measurable_on; REAL_INTEGRABLE_ON; IMAGE_LIFT_UNIV] THEN
11621   REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN
11622   MATCH_MP_TAC INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE THEN
11623   ASM_REWRITE_TAC[FORALL_LIFT]);;
11624
11625 let INTEGRABLE_IMP_REAL_MEASURABLE = prove
11626  (`!f:real->real s.
11627         f real_integrable_on s ==> f real_measurable_on s`,
11628   REWRITE_TAC[real_measurable_on; REAL_INTEGRABLE_ON] THEN
11629   REWRITE_TAC[INTEGRABLE_IMP_MEASURABLE]);;
11630
11631 let ABSOLUTELY_REAL_INTEGRABLE_REAL_MEASURABLE = prove
11632  (`!f s. f absolutely_real_integrable_on s <=>
11633          f real_measurable_on s /\ (\x. abs(f x)) real_integrable_on s`,
11634   REPEAT GEN_TAC THEN REWRITE_TAC[absolutely_real_integrable_on] THEN
11635   MATCH_MP_TAC(TAUT `(a ==> b) /\ (b /\ c ==> a) ==> (a /\ c <=> b /\ c)`) THEN
11636   REWRITE_TAC[INTEGRABLE_IMP_REAL_MEASURABLE] THEN STRIP_TAC THEN
11637   MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN
11638   EXISTS_TAC `\x. abs((f:real->real) x)` THEN ASM_REWRITE_TAC[REAL_LE_REFL]);;
11639
11640 let REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS = prove
11641  (`!f g. f real_measurable_on (:real) /\ g real_continuous_on (:real)
11642          ==> (g o f) real_measurable_on (:real)`,
11643   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_ON; real_measurable_on] THEN
11644   REWRITE_TAC[IMAGE_LIFT_UNIV] THEN
11645   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_COMPOSE_CONTINUOUS) THEN
11646   REWRITE_TAC[o_DEF; LIFT_DROP]);;
11647
11648 let REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_0 = prove
11649  (`!f:real->real g:real->real s.
11650         f real_measurable_on s /\ g real_continuous_on (:real) /\ g(&0) = &0
11651         ==> (g o f) real_measurable_on s`,
11652   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_MEASURABLE_ON_UNIV] THEN
11653   ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN
11654   DISCH_TAC THEN
11655   DISCH_THEN(MP_TAC o MATCH_MP REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS) THEN
11656   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
11657   REWRITE_TAC[FUN_EQ_THM; o_DEF] THEN ASM_MESON_TAC[]);;
11658
11659 let REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL = prove
11660  (`!f:real->real g:real->real a b.
11661         f real_measurable_on (:real) /\
11662         (!x. f(x) IN real_interval(a,b)) /\
11663         g real_continuous_on real_interval(a,b)
11664         ==> (g o f) real_measurable_on (:real)`,
11665   REPEAT GEN_TAC THEN
11666   MP_TAC(ISPECL [`lift o f o drop`; `lift o g o drop`; `lift a`; `lift b`]
11667         MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL) THEN
11668   REWRITE_TAC[real_measurable_on; REAL_CONTINUOUS_ON] THEN
11669   REWRITE_TAC[o_DEF; LIFT_DROP; IMAGE_LIFT_UNIV; IMAGE_LIFT_REAL_INTERVAL] THEN
11670   REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
11671   ASM_REWRITE_TAC[GSYM FORALL_DROP] THEN REPEAT GEN_TAC THEN
11672   REWRITE_TAC[INTERVAL_REAL_INTERVAL; LIFT_DROP] THEN ASM SET_TAC[]);;
11673
11674 let REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET = prove
11675  (`!f:real->real g:real->real s.
11676         real_closed s /\
11677         f real_measurable_on (:real) /\
11678         (!x. f(x) IN s) /\
11679         g real_continuous_on s
11680         ==> (g o f) real_measurable_on (:real)`,
11681   REPEAT GEN_TAC THEN
11682   MP_TAC(ISPECL [`lift o f o drop`; `lift o g o drop`; `IMAGE lift s`]
11683         MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET) THEN
11684   REWRITE_TAC[real_measurable_on; REAL_CONTINUOUS_ON; REAL_CLOSED] THEN
11685   REWRITE_TAC[o_DEF; LIFT_DROP; IMAGE_LIFT_UNIV; IMAGE_LIFT_REAL_INTERVAL] THEN
11686   REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
11687   ASM_REWRITE_TAC[GSYM FORALL_DROP] THEN REPEAT GEN_TAC THEN
11688   REWRITE_TAC[INTERVAL_REAL_INTERVAL; LIFT_DROP] THEN ASM SET_TAC[]);;
11689
11690 let REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET_0 = prove
11691  (`!f:real->real g:real->real s t.
11692         real_closed s /\
11693         f real_measurable_on t /\
11694         (!x. f(x) IN s) /\
11695         g real_continuous_on s /\
11696         &0 IN s /\ g(&0) = &0
11697         ==> (g o f) real_measurable_on t`,
11698   REPEAT GEN_TAC THEN
11699   MP_TAC(ISPECL [`lift o f o drop`; `lift o g o drop`;
11700                  `IMAGE lift s`; `IMAGE lift t`]
11701         MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET_0) THEN
11702   REWRITE_TAC[real_measurable_on; REAL_CONTINUOUS_ON; REAL_CLOSED] THEN
11703   REWRITE_TAC[o_DEF; LIFT_DROP; IMAGE_LIFT_UNIV; IMAGE_LIFT_REAL_INTERVAL] THEN
11704   REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
11705   ASM_REWRITE_TAC[GSYM FORALL_DROP] THEN
11706   ASM_SIMP_TAC[FUN_IN_IMAGE; LIFT_DROP; GSYM LIFT_NUM]);;
11707
11708 let CONTINUOUS_IMP_REAL_MEASURABLE_ON = prove
11709  (`!f. f real_continuous_on (:real) ==> f real_measurable_on (:real)`,
11710   REWRITE_TAC[REAL_CONTINUOUS_ON; real_measurable_on] THEN
11711   REWRITE_TAC[CONTINUOUS_IMP_MEASURABLE_ON; IMAGE_LIFT_UNIV]);;
11712
11713 let REAL_MEASURABLE_ON_CONST = prove
11714  (`!k:real. (\x. k) real_measurable_on (:real)`,
11715   SIMP_TAC[real_measurable_on; o_DEF; MEASURABLE_ON_CONST; IMAGE_LIFT_UNIV]);;
11716
11717 let REAL_MEASURABLE_ON_0 = prove
11718  (`!s. (\x. &0) real_measurable_on s`,
11719   GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_MEASURABLE_ON_UNIV] THEN
11720   REWRITE_TAC[REAL_MEASURABLE_ON_CONST; COND_ID]);;
11721
11722 let REAL_MEASURABLE_ON_LMUL = prove
11723  (`!c f s. f real_measurable_on s ==> (\x. c * f x) real_measurable_on s`,
11724   REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN
11725   DISCH_THEN(MP_TAC o SPEC `c:real` o MATCH_MP MEASURABLE_ON_CMUL) THEN
11726   REWRITE_TAC[o_DEF; LIFT_CMUL; LIFT_DROP]);;
11727
11728 let REAL_MEASURABLE_ON_RMUL = prove
11729  (`!c f s. f real_measurable_on s ==> (\x. f x * c) real_measurable_on s`,
11730   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
11731   REWRITE_TAC[REAL_MEASURABLE_ON_LMUL]);;
11732
11733 let REAL_MEASURABLE_ON_NEG = prove
11734  (`!f s. f real_measurable_on s ==> (\x. --(f x)) real_measurable_on s`,
11735   REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN
11736   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_NEG) THEN
11737   REWRITE_TAC[o_DEF; LIFT_NEG; LIFT_DROP]);;
11738
11739 let REAL_MEASURABLE_ON_NEG_EQ = prove
11740  (`!f s. (\x. --(f x)) real_measurable_on s <=> f real_measurable_on s`,
11741   REPEAT GEN_TAC THEN EQ_TAC THEN
11742   DISCH_THEN(MP_TAC o MATCH_MP REAL_MEASURABLE_ON_NEG) THEN
11743   REWRITE_TAC[REAL_NEG_NEG; ETA_AX]);;
11744
11745 let REAL_MEASURABLE_ON_ABS = prove
11746  (`!f s. f real_measurable_on s ==> (\x. abs(f x)) real_measurable_on s`,
11747   REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN
11748   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_NORM) THEN
11749   REWRITE_TAC[o_DEF; NORM_LIFT]);;
11750
11751 let REAL_MEASURABLE_ON_ADD = prove
11752  (`!f g s. f real_measurable_on s /\ g real_measurable_on s
11753            ==> (\x. f x + g x) real_measurable_on s`,
11754   REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN
11755   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_ADD) THEN
11756   REWRITE_TAC[o_DEF; LIFT_ADD; LIFT_DROP]);;
11757
11758 let REAL_MEASURABLE_ON_SUB = prove
11759  (`!f g s.
11760         f real_measurable_on s /\ g real_measurable_on s
11761         ==> (\x. f x - g x) real_measurable_on s`,
11762   REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN
11763   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_SUB) THEN
11764   REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP]);;
11765
11766 let REAL_MEASURABLE_ON_MAX = prove
11767  (`!f g s.
11768         f real_measurable_on s /\ g real_measurable_on s
11769         ==> (\x. max (f x) (g x)) real_measurable_on s`,
11770   REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN
11771   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_MAX) THEN
11772   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
11773   SIMP_TAC[FUN_EQ_THM; o_THM; CART_EQ; LAMBDA_BETA; DIMINDEX_1; FORALL_1] THEN
11774   REWRITE_TAC[GSYM drop; LIFT_DROP]);;
11775
11776 let REAL_MEASURABLE_ON_MIN = prove
11777  (`!f g s.
11778         f real_measurable_on s /\ g real_measurable_on s
11779         ==> (\x. min (f x) (g x)) real_measurable_on s`,
11780   REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN
11781   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_MIN) THEN
11782   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
11783   SIMP_TAC[FUN_EQ_THM; o_THM; CART_EQ; LAMBDA_BETA; DIMINDEX_1; FORALL_1] THEN
11784   REWRITE_TAC[GSYM drop; LIFT_DROP]);;
11785
11786 let REAL_MEASURABLE_ON_MUL = prove
11787  (`!f g s.
11788         f real_measurable_on s /\ g real_measurable_on s
11789         ==> (\x. f x * g x) real_measurable_on s`,
11790   REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN
11791   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_DROP_MUL) THEN
11792   REWRITE_TAC[o_DEF; LIFT_CMUL; LIFT_DROP]);;
11793
11794 let REAL_MEASURABLE_ON_SPIKE_SET = prove
11795  (`!f:real->real s t.
11796         real_negligible (s DIFF t UNION t DIFF s)
11797         ==> f real_measurable_on s
11798             ==> f real_measurable_on t`,
11799   REWRITE_TAC[real_measurable_on; real_negligible] THEN
11800   REPEAT GEN_TAC THEN DISCH_TAC THEN
11801   MATCH_MP_TAC MEASURABLE_ON_SPIKE_SET THEN POP_ASSUM MP_TAC THEN
11802   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN
11803   SET_TAC[]);;
11804
11805 let REAL_MEASURABLE_ON_RESTRICT = prove
11806  (`!f s. f real_measurable_on (:real) /\
11807          real_lebesgue_measurable s
11808          ==> (\x. if x IN s then f(x) else &0) real_measurable_on (:real)`,
11809   REPEAT GEN_TAC THEN
11810   REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE;
11811               IMAGE_LIFT_UNIV] THEN
11812   REWRITE_TAC[o_DEF; COND_RAND; LIFT_NUM; GSYM IN_IMAGE_LIFT_DROP] THEN
11813   DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_RESTRICT) THEN
11814   REWRITE_TAC[]);;
11815
11816 let REAL_MEASURABLE_ON_LIMIT = prove
11817  (`!f g s k.
11818         (!n. (f n) real_measurable_on s) /\
11819         real_negligible k /\
11820         (!x. x IN s DIFF k ==> ((\n. f n x) ---> g x) sequentially)
11821         ==> g real_measurable_on s`,
11822   REWRITE_TAC[real_measurable_on; real_negligible; TENDSTO_REAL] THEN
11823   REWRITE_TAC[o_DEF] THEN REPEAT STRIP_TAC THEN
11824   MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN MAP_EVERY EXISTS_TAC
11825    [`\n:num. lift o f n o drop`; `IMAGE lift k`] THEN
11826   ASM_REWRITE_TAC[] THEN
11827   SIMP_TAC[LIFT_DROP; SET_RULE `(!x. drop(lift x) = x)
11828             ==> IMAGE lift s DIFF IMAGE lift t = IMAGE lift (s DIFF t)`] THEN
11829   ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_DEF; LIFT_DROP]);;
11830
11831 let ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT = prove
11832  (`!f g s. f real_measurable_on s /\ real_bounded (IMAGE f s) /\
11833            g absolutely_real_integrable_on s
11834
11835            ==> (\x. f x * g x) absolutely_real_integrable_on s`,
11836   REPEAT STRIP_TAC THEN
11837   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_BOUNDED_POS]) THEN
11838   REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE] THEN
11839   X_GEN_TAC `B:real` THEN STRIP_TAC THEN MATCH_MP_TAC
11840    REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN
11841   EXISTS_TAC `\x. B * abs((g:real->real) x)` THEN
11842   ASM_SIMP_TAC[REAL_MEASURABLE_ON_MUL; INTEGRABLE_IMP_REAL_MEASURABLE;
11843     ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; REAL_INTEGRABLE_LMUL;
11844     ABSOLUTELY_REAL_INTEGRABLE_ABS] THEN
11845   ASM_SIMP_TAC[REAL_ABS_MUL; REAL_LE_RMUL; REAL_ABS_POS]);;
11846
11847 let REAL_COMPLEX_MEASURABLE_ON = prove
11848  (`!f s. f real_measurable_on s <=>
11849          (Cx o f o drop) measurable_on (IMAGE lift s)`,
11850   ONCE_REWRITE_TAC[GSYM REAL_MEASURABLE_ON_UNIV;
11851                    GSYM MEASURABLE_ON_UNIV] THEN
11852   ONCE_REWRITE_TAC[MEASURABLE_ON_COMPONENTWISE] THEN
11853   REWRITE_TAC[FORALL_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN
11854   REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on; IMAGE_LIFT_UNIV] THEN
11855   REWRITE_TAC[o_DEF; IN_IMAGE_LIFT_DROP] THEN
11856   REWRITE_TAC[COND_RAND; COND_RATOR; LIFT_NUM; COMPLEX_VEC_0] THEN
11857   REWRITE_TAC[RE_CX; IM_CX; COND_ID; MEASURABLE_ON_CONST; LIFT_NUM]);;
11858
11859 let REAL_MEASURABLE_ON_INV = prove
11860  (`!f. f real_measurable_on (:real) /\ real_negligible {x | f x = &0}
11861        ==> (\x. inv(f x)) real_measurable_on (:real)`,
11862   GEN_TAC THEN REWRITE_TAC[REAL_COMPLEX_MEASURABLE_ON] THEN
11863   REWRITE_TAC[o_DEF; CX_INV; IMAGE_LIFT_UNIV] THEN STRIP_TAC THEN
11864   MATCH_MP_TAC MEASURABLE_ON_COMPLEX_INV THEN ASM_REWRITE_TAC[CX_INJ] THEN
11865   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_negligible]) THEN
11866   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
11867   MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
11868   REWRITE_TAC[IN_ELIM_THM; LIFT_DROP] THEN MESON_TAC[LIFT_DROP]);;
11869
11870 let REAL_MEASURABLE_ON_DIV = prove
11871  (`!f g. f real_measurable_on s /\ g real_measurable_on (:real) /\
11872          real_negligible {x | g(x) = &0}
11873          ==> (\x. f(x) / g(x)) real_measurable_on s`,
11874   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_COMPLEX_MEASURABLE_ON] THEN
11875   REWRITE_TAC[o_DEF; CX_DIV; IMAGE_LIFT_UNIV] THEN STRIP_TAC THEN
11876   MATCH_MP_TAC MEASURABLE_ON_COMPLEX_DIV THEN ASM_REWRITE_TAC[CX_INJ] THEN
11877   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_negligible]) THEN
11878   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
11879   MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
11880   REWRITE_TAC[IN_ELIM_THM; LIFT_DROP] THEN MESON_TAC[LIFT_DROP]);;
11881
11882 (* ------------------------------------------------------------------------- *)
11883 (* Properties of real Lebesgue measurable sets.                              *)
11884 (* ------------------------------------------------------------------------- *)
11885
11886 let REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE = prove
11887  (`!s. real_measurable s ==> real_lebesgue_measurable s`,
11888   REWRITE_TAC[REAL_LEBESGUE_MEASURABLE; REAL_MEASURABLE_MEASURABLE;
11889               MEASURABLE_IMP_LEBESGUE_MEASURABLE]);;
11890
11891 let REAL_LEBESGUE_MEASURABLE_EMPTY = prove
11892  (`real_lebesgue_measurable {}`,
11893   REWRITE_TAC[REAL_LEBESGUE_MEASURABLE; IMAGE_CLAUSES;
11894               LEBESGUE_MEASURABLE_EMPTY]);;
11895
11896 let REAL_LEBESGUE_MEASURABLE_UNIV = prove
11897  (`real_lebesgue_measurable (:real)`,
11898   REWRITE_TAC[REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV;
11899               LEBESGUE_MEASURABLE_UNIV]);;
11900
11901 let REAL_LEBESGUE_MEASURABLE_COMPACT = prove
11902  (`!s. real_compact s ==> real_lebesgue_measurable s`,
11903   SIMP_TAC[REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE;
11904            REAL_MEASURABLE_COMPACT]);;
11905
11906 let REAL_LEBESGUE_MEASURABLE_INTERVAL = prove
11907  (`(!a b. real_lebesgue_measurable(real_interval[a,b])) /\
11908    (!a b. real_lebesgue_measurable(real_interval(a,b)))`,
11909   SIMP_TAC[REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE;
11910            REAL_MEASURABLE_REAL_INTERVAL]);;
11911
11912 let REAL_LEBESGUE_MEASURABLE_INTER = prove
11913  (`!s t. real_lebesgue_measurable s /\ real_lebesgue_measurable t
11914          ==> real_lebesgue_measurable(s INTER t)`,
11915   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LEBESGUE_MEASURABLE] THEN
11916   DISCH_THEN(MP_TAC o MATCH_MP LEBESGUE_MEASURABLE_INTER) THEN
11917   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MP_TAC LIFT_DROP THEN SET_TAC[]);;
11918
11919 let REAL_LEBESGUE_MEASURABLE_UNION = prove
11920  (`!s t:real->bool.
11921         real_lebesgue_measurable s /\ real_lebesgue_measurable t
11922         ==> real_lebesgue_measurable(s UNION t)`,
11923   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LEBESGUE_MEASURABLE] THEN
11924   DISCH_THEN(MP_TAC o MATCH_MP LEBESGUE_MEASURABLE_UNION) THEN
11925   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MP_TAC LIFT_DROP THEN SET_TAC[]);;
11926
11927 let REAL_LEBESGUE_MEASURABLE_COMPL = prove
11928  (`!s. real_lebesgue_measurable((:real) DIFF s) <=>
11929        real_lebesgue_measurable s`,
11930   GEN_TAC THEN REWRITE_TAC[REAL_LEBESGUE_MEASURABLE] THEN
11931   GEN_REWRITE_TAC (RAND_CONV) [GSYM LEBESGUE_MEASURABLE_COMPL] THEN
11932   AP_TERM_TAC THEN MP_TAC LIFT_DROP THEN SET_TAC[]);;
11933
11934 let REAL_LEBESGUE_MEASURABLE_DIFF = prove
11935  (`!s t:real->bool.
11936         real_lebesgue_measurable s /\ real_lebesgue_measurable t
11937         ==> real_lebesgue_measurable(s DIFF t)`,
11938   ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN
11939   SIMP_TAC[REAL_LEBESGUE_MEASURABLE_COMPL; REAL_LEBESGUE_MEASURABLE_INTER]);;
11940
11941 let REAL_LEBESGUE_MEASURABLE_ON_SUBINTERVALS = prove
11942  (`!s. real_lebesgue_measurable s <=>
11943        !a b. real_lebesgue_measurable(s INTER real_interval[a,b])`,
11944   GEN_TAC THEN REWRITE_TAC[REAL_LEBESGUE_MEASURABLE] THEN
11945   GEN_REWRITE_TAC LAND_CONV [LEBESGUE_MEASURABLE_ON_SUBINTERVALS] THEN
11946   REWRITE_TAC[FORALL_DROP; GSYM IMAGE_DROP_INTERVAL] THEN
11947   REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN AP_TERM_TAC THEN
11948   MP_TAC LIFT_DROP THEN SET_TAC[]);;
11949
11950 let REAL_LEBESGUE_MEASURABLE_CLOSED = prove
11951  (`!s. real_closed s ==> real_lebesgue_measurable s`,
11952   REWRITE_TAC[REAL_LEBESGUE_MEASURABLE; REAL_CLOSED;
11953               LEBESGUE_MEASURABLE_CLOSED]);;
11954
11955 let REAL_LEBESGUE_MEASURABLE_OPEN = prove
11956  (`!s. real_open s ==> real_lebesgue_measurable s`,
11957   REWRITE_TAC[REAL_LEBESGUE_MEASURABLE; REAL_OPEN;
11958               LEBESGUE_MEASURABLE_OPEN]);;
11959
11960 let REAL_LEBESGUE_MEASURABLE_UNIONS = prove
11961  (`!f. FINITE f /\ (!s. s IN f ==> real_lebesgue_measurable s)
11962        ==> real_lebesgue_measurable (UNIONS f)`,
11963   REWRITE_TAC[IMP_CONJ] THEN
11964   MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
11965   SIMP_TAC[UNIONS_0; UNIONS_INSERT; REAL_LEBESGUE_MEASURABLE_EMPTY] THEN
11966   REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN
11967   MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_UNION THEN ASM_SIMP_TAC[]);;
11968
11969 let REAL_LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT = prove
11970  (`!s:num->real->bool.
11971         (!n. real_lebesgue_measurable(s n))
11972         ==> real_lebesgue_measurable(UNIONS {s n | n IN (:num)})`,
11973   GEN_TAC THEN REWRITE_TAC[REAL_LEBESGUE_MEASURABLE] THEN DISCH_THEN(MP_TAC o
11974     MATCH_MP LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT) THEN
11975   REWRITE_TAC[IMAGE_UNIONS; SIMPLE_IMAGE] THEN
11976   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);;
11977
11978 let REAL_LEBESGUE_MEASURABLE_COUNTABLE_UNIONS = prove
11979  (`!f:(real->bool)->bool.
11980         COUNTABLE f /\ (!s. s IN f ==> real_lebesgue_measurable s)
11981         ==> real_lebesgue_measurable (UNIONS f)`,
11982   GEN_TAC THEN ASM_CASES_TAC `f:(real->bool)->bool = {}` THEN
11983   ASM_REWRITE_TAC[UNIONS_0; REAL_LEBESGUE_MEASURABLE_EMPTY] THEN STRIP_TAC THEN
11984   MP_TAC(ISPEC `f:(real->bool)->bool` COUNTABLE_AS_IMAGE) THEN
11985   ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
11986   ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN
11987   MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT THEN
11988   GEN_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
11989   ASM_REWRITE_TAC[IN_IMAGE; IN_UNIV] THEN MESON_TAC[]);;
11990
11991 let REAL_LEBESGUE_MEASURABLE_COUNTABLE_INTERS = prove
11992  (`!f:(real->bool)->bool.
11993         COUNTABLE f /\ (!s. s IN f ==> real_lebesgue_measurable s)
11994         ==> real_lebesgue_measurable (INTERS f)`,
11995   REPEAT STRIP_TAC THEN
11996   REWRITE_TAC[INTERS_UNIONS; REAL_LEBESGUE_MEASURABLE_COMPL] THEN
11997   MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN
11998   ASM_SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; COUNTABLE_IMAGE;
11999                REAL_LEBESGUE_MEASURABLE_COMPL]);;
12000
12001 let REAL_LEBESGUE_MEASURABLE_COUNTABLE_INTERS_EXPLICIT = prove
12002  (`!s:num->real->bool.
12003         (!n. real_lebesgue_measurable(s n))
12004         ==> real_lebesgue_measurable(INTERS {s n | n IN (:num)})`,
12005   REPEAT STRIP_TAC THEN
12006   MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_COUNTABLE_INTERS THEN
12007   ASM_SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE]);;
12008
12009 let REAL_LEBESGUE_MEASURABLE_INTERS = prove
12010  (`!f:(real->bool)->bool.
12011         FINITE f /\ (!s. s IN f ==> real_lebesgue_measurable s)
12012         ==> real_lebesgue_measurable (INTERS f)`,
12013   SIMP_TAC[REAL_LEBESGUE_MEASURABLE_COUNTABLE_INTERS; FINITE_IMP_COUNTABLE]);;
12014
12015 let REAL_LEBESGUE_MEASURABLE_IFF_MEASURABLE = prove
12016  (`!s. real_bounded s ==> (real_lebesgue_measurable s <=> real_measurable s)`,
12017   REWRITE_TAC[REAL_BOUNDED; REAL_LEBESGUE_MEASURABLE;
12018               REAL_MEASURABLE_MEASURABLE] THEN
12019   REWRITE_TAC[LEBESGUE_MEASURABLE_IFF_MEASURABLE]);;
12020
12021 let REAL_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET = prove
12022  (`!f s t. s SUBSET t /\ f real_measurable_on t /\
12023            real_lebesgue_measurable s
12024            ==> f real_measurable_on s`,
12025   REPEAT GEN_TAC THEN
12026   ONCE_REWRITE_TAC[GSYM REAL_MEASURABLE_ON_UNIV] THEN
12027   REWRITE_TAC[IN_UNIV] THEN
12028   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
12029   DISCH_THEN(MP_TAC o MATCH_MP REAL_MEASURABLE_ON_RESTRICT) THEN
12030   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
12031   REWRITE_TAC[FUN_EQ_THM] THEN ASM SET_TAC[]);;
12032
12033 let REAL_MEASURABLE_ON_MEASURABLE_SUBSET = prove
12034  (`!f s t. s SUBSET t /\ f real_measurable_on t /\ real_measurable s
12035            ==> f real_measurable_on s`,
12036   MESON_TAC[REAL_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET;
12037             REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE]);;
12038
12039 let REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET = prove
12040  (`!f s. f real_continuous_on s /\ real_closed s ==> f real_measurable_on s`,
12041   REWRITE_TAC[REAL_CONTINUOUS_ON; REAL_CLOSED; real_measurable_on] THEN
12042   REWRITE_TAC[CONTINUOUS_IMP_MEASURABLE_ON_CLOSED_SUBSET]);;
12043
12044 let REAL_MEASURABLE_ON_CASES = prove
12045  (`!P f g s.
12046         real_lebesgue_measurable {x | P x} /\
12047         f real_measurable_on s /\ g real_measurable_on s
12048         ==> (\x. if P x then f x else g x) real_measurable_on s`,
12049   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_MEASURABLE_ON_UNIV] THEN
12050   REPEAT STRIP_TAC THEN
12051   SUBGOAL_THEN
12052    `!x. (if x IN s then if P x then f x else g x else &0) =
12053         (if x IN {x | P x} then if x IN s then f x else &0 else &0) +
12054         (if x IN (:real) DIFF {x | P x}
12055          then if x IN s then g x else &0 else &0)`
12056    (fun th -> REWRITE_TAC[th])
12057   THENL
12058    [GEN_TAC THEN REWRITE_TAC[IN_UNIV; IN_ELIM_THM; IN_DIFF] THEN
12059     MESON_TAC[REAL_ADD_LID; REAL_ADD_RID];
12060     MATCH_MP_TAC REAL_MEASURABLE_ON_ADD THEN
12061     CONJ_TAC THEN MATCH_MP_TAC REAL_MEASURABLE_ON_RESTRICT THEN
12062     ASM_REWRITE_TAC[REAL_LEBESGUE_MEASURABLE_COMPL]]);;
12063
12064 (* ------------------------------------------------------------------------- *)
12065 (* Various common equivalent forms of function measurability.                *)
12066 (* ------------------------------------------------------------------------- *)
12067
12068 let REAL_MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_LT = prove
12069  (`!f. f real_measurable_on (:real) <=>
12070         !a. real_lebesgue_measurable {x | f(x) < a}`,
12071   REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV;
12072    MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_COMPONENT_LT] THEN
12073   REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; o_DEF; LIFT_DROP] THEN
12074   GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN
12075   CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
12076   REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);;
12077
12078 let REAL_MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_LE = prove
12079  (`!f. f real_measurable_on (:real) <=>
12080         !a. real_lebesgue_measurable {x | f(x) <= a}`,
12081   REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV;
12082    MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_COMPONENT_LE] THEN
12083   REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; o_DEF; LIFT_DROP] THEN
12084   GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN
12085   CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
12086   REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);;
12087
12088 let REAL_MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_GT = prove
12089  (`!f. f real_measurable_on (:real) <=>
12090         !a. real_lebesgue_measurable {x | f(x) > a}`,
12091   REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV;
12092    MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_COMPONENT_GT] THEN
12093   REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; o_DEF; LIFT_DROP] THEN
12094   GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN
12095   CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
12096   REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);;
12097
12098 let REAL_MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_GE = prove
12099  (`!f. f real_measurable_on (:real) <=>
12100         !a. real_lebesgue_measurable {x | f(x) >= a}`,
12101   REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV;
12102    MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_COMPONENT_GE] THEN
12103   REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; o_DEF; LIFT_DROP] THEN
12104   GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN
12105   CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
12106   REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);;
12107
12108 let REAL_MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL = prove
12109  (`!f. f real_measurable_on (:real) <=>
12110        !a b. real_lebesgue_measurable {x | f(x) IN real_interval(a,b)}`,
12111   REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV;
12112               MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL; FORALL_DROP] THEN
12113   GEN_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN AP_TERM_TAC THEN
12114   CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
12115   REWRITE_TAC[IN_ELIM_THM; o_DEF; GSYM IMAGE_DROP_INTERVAL; LIFT_DROP;
12116               FORALL_DROP; IN_IMAGE] THEN MESON_TAC[LIFT_DROP]);;
12117
12118 let REAL_MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL = prove
12119  (`!f. f real_measurable_on (:real) <=>
12120        !a b. real_lebesgue_measurable {x | f(x) IN real_interval[a,b]}`,
12121   REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV;
12122               MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL; FORALL_DROP] THEN
12123   GEN_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN AP_TERM_TAC THEN
12124   CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
12125   REWRITE_TAC[IN_ELIM_THM; o_DEF; GSYM IMAGE_DROP_INTERVAL; LIFT_DROP;
12126               FORALL_DROP; IN_IMAGE] THEN MESON_TAC[LIFT_DROP]);;
12127
12128 let REAL_MEASURABLE_ON_PREIMAGE_OPEN = prove
12129  (`!f. f real_measurable_on (:real) <=>
12130        !t. real_open t ==> real_lebesgue_measurable {x | f(x) IN t}`,
12131   REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV;
12132               MEASURABLE_ON_PREIMAGE_OPEN; REAL_OPEN] THEN
12133   GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL
12134    [X_GEN_TAC `t:real->bool` THEN DISCH_TAC THEN
12135     FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE lift t`) THEN
12136     ASM_REWRITE_TAC[];
12137     X_GEN_TAC `t:real^1->bool` THEN DISCH_TAC THEN
12138     FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE drop t`) THEN
12139     ASM_REWRITE_TAC[IMAGE_LIFT_DROP; GSYM IMAGE_o]] THEN
12140   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THENL
12141    [CONV_TAC SYM_CONV; ALL_TAC] THEN
12142   MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
12143   REWRITE_TAC[IN_IMAGE; o_DEF; IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);;
12144
12145 let REAL_MEASURABLE_ON_PREIMAGE_CLOSED = prove
12146  (`!f. f real_measurable_on (:real) <=>
12147        !t. real_closed t ==> real_lebesgue_measurable {x | f(x) IN t}`,
12148   REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV;
12149               MEASURABLE_ON_PREIMAGE_CLOSED; REAL_CLOSED] THEN
12150   GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL
12151    [X_GEN_TAC `t:real->bool` THEN DISCH_TAC THEN
12152     FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE lift t`) THEN
12153     ASM_REWRITE_TAC[];
12154     X_GEN_TAC `t:real^1->bool` THEN DISCH_TAC THEN
12155     FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE drop t`) THEN
12156     ASM_REWRITE_TAC[IMAGE_LIFT_DROP; GSYM IMAGE_o]] THEN
12157   MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THENL
12158    [CONV_TAC SYM_CONV; ALL_TAC] THEN
12159   MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
12160   REWRITE_TAC[IN_IMAGE; o_DEF; IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);;
12161
12162 let REAL_MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT = prove
12163  (`!f. f real_measurable_on (:real) <=>
12164        ?g. (!n. (g n) real_measurable_on (:real)) /\
12165            (!n. FINITE(IMAGE (g n) (:real))) /\
12166            (!x. ((\n. g n x) ---> f x) sequentially)`,
12167   GEN_TAC THEN REWRITE_TAC[real_measurable_on; IMAGE_LIFT_UNIV] THEN
12168   GEN_REWRITE_TAC LAND_CONV [MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT] THEN
12169   EQ_TAC THENL
12170    [DISCH_THEN(X_CHOOSE_THEN `g:num->real^1->real^1` STRIP_ASSUME_TAC) THEN
12171     EXISTS_TAC `\n:num. drop o g n o lift` THEN
12172     REWRITE_TAC[TENDSTO_REAL] THEN REPEAT CONJ_TAC THENL
12173      [ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX];
12174       GEN_TAC THEN REWRITE_TAC[IMAGE_o; IMAGE_LIFT_UNIV] THEN
12175       MATCH_MP_TAC FINITE_IMAGE THEN ASM_REWRITE_TAC[];
12176       X_GEN_TAC `x:real` THEN REWRITE_TAC[TENDSTO_REAL] THEN
12177       FIRST_X_ASSUM(MP_TAC o SPEC `lift x`) THEN
12178       REWRITE_TAC[o_DEF; LIFT_DROP]];
12179     DISCH_THEN(X_CHOOSE_THEN `g:num->real->real` STRIP_ASSUME_TAC) THEN
12180     EXISTS_TAC `\n:num. lift o g n o drop` THEN REPEAT CONJ_TAC THENL
12181      [ASM_REWRITE_TAC[];
12182       GEN_TAC THEN REWRITE_TAC[IMAGE_o; IMAGE_DROP_UNIV] THEN
12183       MATCH_MP_TAC FINITE_IMAGE THEN ASM_REWRITE_TAC[];
12184       X_GEN_TAC `x:real^1` THEN FIRST_X_ASSUM(MP_TAC o SPEC `drop x`) THEN
12185       REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_DROP]]]);;
12186
12187 let REAL_LEBESGUE_MEASURABLE_PREIMAGE_OPEN = prove
12188  (`!f t. f real_measurable_on (:real) /\ real_open t
12189          ==> real_lebesgue_measurable {x | f(x) IN t}`,
12190   SIMP_TAC[REAL_MEASURABLE_ON_PREIMAGE_OPEN]);;
12191
12192 let REAL_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED = prove
12193  (`!f t. f real_measurable_on (:real) /\ real_closed t
12194          ==> real_lebesgue_measurable {x | f(x) IN t}`,
12195   SIMP_TAC[REAL_MEASURABLE_ON_PREIMAGE_CLOSED]);;
12196
12197 (* ------------------------------------------------------------------------- *)
12198 (* Continuity of measure within a halfspace w.r.t. to the boundary.          *)
12199 (* ------------------------------------------------------------------------- *)
12200
12201 let REAL_CONTINUOUS_MEASURE_IN_HALFSPACE_LE = prove
12202  (`!(s:real^N->bool) a i.
12203         measurable s /\ 1 <= i /\ i <= dimindex(:N)
12204         ==> (\a. measure(s INTER {x | x$i <= a})) real_continuous atreal a`,
12205   REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1] THEN
12206   REWRITE_TAC[continuous_atreal; o_THM] THEN
12207   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
12208   SUBGOAL_THEN
12209    `?u v:real^N. abs(measure(s INTER interval[u,v]) - measure s) < e / &2 /\
12210                  ~(interval(u,v) = {}) /\ u$i < a /\ a < v$i`
12211   STRIP_ASSUME_TAC THENL
12212    [MP_TAC(ISPECL [`s:real^N->bool`; `e / &2`] MEASURE_LIMIT) THEN
12213     ASM_REWRITE_TAC[REAL_HALF] THEN
12214     DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
12215     MP_TAC(ISPEC `ball(vec 0:real^N,B)` BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
12216     REWRITE_TAC[BOUNDED_BALL; LEFT_IMP_EXISTS_THM] THEN
12217     MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN DISCH_TAC THEN
12218     EXISTS_TAC `(lambda j. min (a - &1) ((u:real^N)$j)):real^N` THEN
12219     EXISTS_TAC `(lambda j. max (a + &1) ((v:real^N)$j)):real^N` THEN
12220     CONJ_TAC THENL
12221      [FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM
12222        (MATCH_MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN
12223       SIMP_TAC[SUBSET_INTERVAL; LAMBDA_BETA] THEN REAL_ARITH_TAC;
12224       ASM_SIMP_TAC[INTERVAL_NE_EMPTY; LAMBDA_BETA] THEN REAL_ARITH_TAC];
12225     ALL_TAC] THEN
12226   MP_TAC(ISPECL
12227    [`indicator(s:real^N->bool)`; `u:real^N`; `v:real^N`; `u:real^N`;
12228     `(lambda j. if j = i then min ((v:real^N)$i) a else v$j):real^N`;
12229     `e / &2`]
12230       INDEFINITE_INTEGRAL_CONTINUOUS) THEN
12231   ASM_REWRITE_TAC[REAL_HALF] THEN ANTS_TAC THENL
12232    [ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN
12233     REWRITE_TAC[indicator; MESON[]
12234      `(if P then if Q then x else y else y) =
12235       (if P /\ Q then x else y)`] THEN
12236     REWRITE_TAC[GSYM IN_INTER; GSYM MEASURABLE_INTEGRABLE] THEN
12237     ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL] THEN
12238     RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
12239     ASM_SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; REAL_LE_REFL; REAL_LT_IMP_LE] THEN
12240     X_GEN_TAC `j:num` THEN STRIP_TAC THEN
12241     FIRST_X_ASSUM(MP_TAC o SPEC `j:num`) THEN ASM_REWRITE_TAC[] THEN
12242     COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
12243     ALL_TAC] THEN
12244   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
12245   EXISTS_TAC `min d (min (a - (u:real^N)$i) ((v:real^N)$i - a))` THEN
12246   ASM_REWRITE_TAC[REAL_LT_MIN; REAL_SUB_LT] THEN
12247   X_GEN_TAC `b:real` THEN STRIP_TAC THEN
12248   FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N`;
12249    `(lambda j. if j = i then min ((v:real^N)$i) b else v$j):real^N`]) THEN
12250   REWRITE_TAC[dist] THEN ANTS_TAC THENL
12251    [RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
12252     ASM_SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; REAL_LE_REFL; REAL_LT_IMP_LE] THEN
12253     ASM_SIMP_TAC[VECTOR_SUB_REFL; NORM_0; REAL_LT_IMP_LE] THEN CONJ_TAC THENL
12254      [X_GEN_TAC `j:num` THEN STRIP_TAC THEN
12255       FIRST_X_ASSUM(MP_TAC o SPEC `j:num`) THEN ASM_REWRITE_TAC[] THEN
12256       COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
12257       ASM_SIMP_TAC[NORM_LE_SQUARE; dot; REAL_LT_IMP_LE] THEN
12258       MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC
12259        `sum(1..dimindex(:N)) (\j. if j = i then d pow 2 else &0)` THEN
12260       CONJ_TAC THENL
12261        [MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN
12262         ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT] THEN
12263         COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
12264         REWRITE_TAC[GSYM REAL_POW_2; GSYM REAL_LE_SQUARE_ABS] THEN
12265         ASM_REAL_ARITH_TAC;
12266         ASM_REWRITE_TAC[SUM_DELTA; IN_NUMSEG; REAL_LE_REFL]]];
12267     SUBGOAL_THEN
12268      `!b. integral
12269            (interval[u:real^N,
12270                      (lambda j. if j = i then min (v$i) b else (v:real^N)$j)])
12271            (indicator s) =
12272           lift(measure(s INTER interval[u,v] INTER {x | x$i <= b}))`
12273      (fun th -> REWRITE_TAC[th])
12274     THENL
12275      [GEN_TAC THEN
12276       ASM_SIMP_TAC[MEASURE_INTEGRAL; MEASURABLE_INTER_HALFSPACE_LE;
12277                    MEASURABLE_INTER; MEASURABLE_INTERVAL; LIFT_DROP] THEN
12278       ONCE_REWRITE_TAC[GSYM INTEGRAL_RESTRICT_UNIV] THEN
12279       AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN
12280       ASM_SIMP_TAC[INTERVAL_SPLIT; indicator] THEN
12281       REWRITE_TAC[IN_INTER] THEN MESON_TAC[];
12282       REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN
12283       SUBGOAL_THEN
12284        `!b. measure(s INTER {x:real^N | x$i <= b}) =
12285             measure((s INTER interval[u,v]) INTER {x | x$i <= b}) +
12286             measure((s DIFF interval[u,v]) INTER {x | x$i <= b})`
12287        (fun th -> REWRITE_TAC[th])
12288       THENL
12289        [GEN_TAC THEN CONV_TAC SYM_CONV THEN
12290         MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNION_EQ THEN
12291         ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTER_HALFSPACE_LE;
12292                      MEASURABLE_INTERVAL; MEASURABLE_DIFF] THEN
12293         CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
12294         MATCH_MP_TAC(MESON[NEGLIGIBLE_EMPTY] `s = {} ==> negligible s`) THEN
12295         SET_TAC[];
12296         REWRITE_TAC[GSYM INTER_ASSOC] THEN MATCH_MP_TAC(REAL_ARITH
12297          `abs(nub - nua) < e / &2
12298           ==> abs(mub - mua) < e / &2
12299               ==> abs((mub + nub) - (mua + nua)) < e`) THEN
12300         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
12301          `y < e ==> x <= y ==> x < e`)) THEN
12302         SUBGOAL_THEN
12303          `abs(measure(s INTER interval [u,v]) - measure s) =
12304           measure(s DIFF interval[u:real^N,v])`
12305         SUBST1_TAC THENL
12306          [MATCH_MP_TAC(REAL_ARITH
12307            `x + z = y /\ &0 <= z ==> abs(x - y) = z`) THEN
12308           ASM_SIMP_TAC[MEASURE_POS_LE; MEASURABLE_DIFF;
12309                        MEASURABLE_INTERVAL] THEN
12310           MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNION_EQ THEN
12311           ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_DIFF;
12312                        MEASURABLE_INTERVAL] THEN
12313           CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
12314           MATCH_MP_TAC(MESON[NEGLIGIBLE_EMPTY] `s = {} ==> negligible s`) THEN
12315           SET_TAC[];
12316           MATCH_MP_TAC(REAL_ARITH
12317            `&0 <= x /\ x <= a /\ &0 <= y /\ y <= a ==> abs(x - y) <= a`) THEN
12318           ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTER_HALFSPACE_LE;
12319             MEASURABLE_INTERVAL; MEASURABLE_DIFF; MEASURE_POS_LE] THEN
12320           CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
12321           ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTER_HALFSPACE_LE;
12322             MEASURABLE_INTERVAL; MEASURABLE_DIFF; MEASURE_POS_LE] THEN
12323           SET_TAC[]]]]]);;
12324
12325 (* ------------------------------------------------------------------------- *)
12326 (* Second mean value theorem and monotone integrability.                     *)
12327 (* ------------------------------------------------------------------------- *)
12328
12329 let REAL_SECOND_MEAN_VALUE_THEOREM_FULL = prove
12330  (`!f g a b.
12331         ~(real_interval[a,b] = {}) /\
12332         f real_integrable_on real_interval[a,b] /\
12333         (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
12334                ==> g x <= g y)
12335         ==> ?c. c IN real_interval[a,b] /\
12336                 ((\x. g x * f x) has_real_integral
12337                  (g(a) * real_integral (real_interval[a,c]) f +
12338                   g(b) * real_integral (real_interval[c,b]) f))
12339                 (real_interval[a,b])`,
12340   REPEAT STRIP_TAC THEN
12341   MP_TAC(ISPECL [`lift o f o drop`; `(g:real->real) o drop`;
12342                  `lift a`; `lift b`]
12343     SECOND_MEAN_VALUE_THEOREM_FULL) THEN
12344   ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY] THEN
12345   ASM_REWRITE_TAC[GSYM REAL_INTEGRABLE_ON] THEN
12346   REWRITE_TAC[EXISTS_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
12347   ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP] THEN
12348   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN
12349   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN
12350   REWRITE_TAC[HAS_REAL_INTEGRAL; IMAGE_LIFT_REAL_INTERVAL] THEN
12351   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN
12352   REWRITE_TAC[o_DEF; LIFT_CMUL; LIFT_ADD] THEN AP_TERM_TAC THEN
12353   BINOP_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN
12354   REWRITE_TAC[LIFT_DROP] THEN
12355   W(MP_TAC o PART_MATCH (lhs o rand) REAL_INTEGRAL o rand o snd) THEN
12356   REWRITE_TAC[o_DEF] THEN ANTS_TAC THEN SIMP_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN
12357   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12358         REAL_INTEGRABLE_ON_SUBINTERVAL)) THEN
12359   REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN
12360   RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL; REAL_INTERVAL_EQ_EMPTY]) THEN
12361   ASM_REAL_ARITH_TAC);;
12362
12363 let REAL_SECOND_MEAN_VALUE_THEOREM = prove
12364  (`!f g a b.
12365         ~(real_interval[a,b] = {}) /\
12366         f real_integrable_on real_interval[a,b] /\
12367         (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
12368                ==> g x <= g y)
12369         ==> ?c. c IN real_interval[a,b] /\
12370                 real_integral (real_interval[a,b]) (\x. g x * f x) =
12371                  g(a) * real_integral (real_interval[a,c]) f +
12372                  g(b) * real_integral (real_interval[c,b]) f`,
12373   REPEAT GEN_TAC THEN
12374   DISCH_THEN(MP_TAC o MATCH_MP REAL_SECOND_MEAN_VALUE_THEOREM_FULL) THEN
12375   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN
12376   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
12377   FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN
12378   REWRITE_TAC[]);;
12379
12380 let REAL_SECOND_MEAN_VALUE_THEOREM_GEN_FULL = prove
12381  (`!f g a b u v.
12382         ~(real_interval[a,b] = {}) /\
12383         f real_integrable_on real_interval[a,b] /\
12384         (!x. x IN real_interval(a,b) ==> u <= g x /\ g x <= v) /\
12385         (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
12386                ==> g x <= g y)
12387         ==> ?c. c IN real_interval[a,b] /\
12388                 ((\x. g x * f x) has_real_integral
12389                  (u * real_integral (real_interval[a,c]) f +
12390                   v * real_integral (real_interval[c,b]) f))
12391                 (real_interval[a,b])`,
12392   REPEAT STRIP_TAC THEN
12393   MP_TAC(ISPECL [`lift o f o drop`; `(g:real->real) o drop`;
12394                  `lift a`; `lift b`; `u:real`; `v:real`]
12395     SECOND_MEAN_VALUE_THEOREM_GEN_FULL) THEN
12396   ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY] THEN
12397   ASM_REWRITE_TAC[GSYM REAL_INTEGRABLE_ON] THEN
12398   REWRITE_TAC[EXISTS_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
12399   ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP] THEN
12400   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN
12401   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN
12402   REWRITE_TAC[HAS_REAL_INTEGRAL; IMAGE_LIFT_REAL_INTERVAL] THEN
12403   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN
12404   REWRITE_TAC[o_DEF; LIFT_CMUL; LIFT_ADD] THEN AP_TERM_TAC THEN
12405   BINOP_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN
12406   REWRITE_TAC[LIFT_DROP] THEN
12407   W(MP_TAC o PART_MATCH (lhs o rand) REAL_INTEGRAL o rand o snd) THEN
12408   REWRITE_TAC[o_DEF] THEN ANTS_TAC THEN SIMP_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN
12409   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12410         REAL_INTEGRABLE_ON_SUBINTERVAL)) THEN
12411   REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN
12412   RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL; REAL_INTERVAL_EQ_EMPTY]) THEN
12413   ASM_REAL_ARITH_TAC);;
12414
12415 let REAL_SECOND_MEAN_VALUE_THEOREM_GEN = prove
12416  (`!f g a b u v.
12417         ~(real_interval[a,b] = {}) /\
12418         f real_integrable_on real_interval[a,b] /\
12419         (!x. x IN real_interval(a,b) ==> u <= g x /\ g x <= v) /\
12420         (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
12421                ==> g x <= g y)
12422         ==> ?c. c IN real_interval[a,b] /\
12423                 real_integral (real_interval[a,b]) (\x. g x * f x) =
12424                  u * real_integral (real_interval[a,c]) f +
12425                  v * real_integral (real_interval[c,b]) f`,
12426   REPEAT GEN_TAC THEN
12427   DISCH_THEN(MP_TAC o MATCH_MP REAL_SECOND_MEAN_VALUE_THEOREM_GEN_FULL) THEN
12428   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN
12429   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
12430   FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN
12431   REWRITE_TAC[]);;
12432
12433 let REAL_SECOND_MEAN_VALUE_THEOREM_BONNET_FULL = prove
12434  (`!f g a b.
12435         ~(real_interval[a,b] = {}) /\
12436         f real_integrable_on real_interval[a,b] /\
12437         (!x. x IN real_interval[a,b] ==> &0 <= g x) /\
12438         (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
12439                ==> g x <= g y)
12440         ==> ?c. c IN real_interval[a,b] /\
12441                 ((\x. g x * f x) has_real_integral
12442                  (g(b) * real_integral (real_interval[c,b]) f))
12443                 (real_interval[a,b])`,
12444   REPEAT STRIP_TAC THEN
12445   MP_TAC(ISPECL [`lift o f o drop`; `(g:real->real) o drop`;
12446                  `lift a`; `lift b`]
12447     SECOND_MEAN_VALUE_THEOREM_BONNET_FULL) THEN
12448   ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY] THEN
12449   ASM_REWRITE_TAC[GSYM REAL_INTEGRABLE_ON] THEN
12450   REWRITE_TAC[EXISTS_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
12451   ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP] THEN
12452   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN
12453   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN
12454   REWRITE_TAC[HAS_REAL_INTEGRAL; IMAGE_LIFT_REAL_INTERVAL] THEN
12455   MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN
12456   REWRITE_TAC[o_DEF; LIFT_CMUL; LIFT_ADD] THEN AP_TERM_TAC THEN
12457   AP_TERM_TAC THEN ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN
12458   REWRITE_TAC[LIFT_DROP] THEN
12459   W(MP_TAC o PART_MATCH (lhs o rand) REAL_INTEGRAL o rand o snd) THEN
12460   REWRITE_TAC[o_DEF] THEN ANTS_TAC THEN SIMP_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN
12461   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
12462         REAL_INTEGRABLE_ON_SUBINTERVAL)) THEN
12463   REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN
12464   RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL; REAL_INTERVAL_EQ_EMPTY]) THEN
12465   ASM_REAL_ARITH_TAC);;
12466
12467 let REAL_SECOND_MEAN_VALUE_THEOREM_BONNET = prove
12468  (`!f g a b.
12469         ~(real_interval[a,b] = {}) /\
12470         f real_integrable_on real_interval[a,b] /\
12471         (!x. x IN real_interval[a,b] ==> &0 <= g x) /\
12472         (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
12473                ==> g x <= g y)
12474         ==> ?c. c IN real_interval[a,b] /\
12475                 real_integral (real_interval[a,b]) (\x. g x * f x) =
12476                 g(b) * real_integral (real_interval[c,b]) f`,
12477   REPEAT GEN_TAC THEN
12478   DISCH_THEN(MP_TAC o MATCH_MP REAL_SECOND_MEAN_VALUE_THEOREM_BONNET_FULL) THEN
12479   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN
12480   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
12481   FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN
12482   REWRITE_TAC[]);;
12483
12484 let REAL_INTEGRABLE_INCREASING_PRODUCT = prove
12485  (`!f g a b.
12486         f real_integrable_on real_interval[a,b] /\
12487         (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
12488                ==> g(x) <= g(y))
12489         ==> (\x. g(x) * f(x)) real_integrable_on real_interval[a,b]`,
12490   REPEAT STRIP_TAC THEN
12491   MP_TAC(ISPECL [`lift o f o drop`; `(g:real->real) o drop`;
12492                  `lift a`; `lift b`]
12493     INTEGRABLE_INCREASING_PRODUCT) THEN
12494   ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL;
12495                   GSYM REAL_INTEGRABLE_ON] THEN
12496   ASM_SIMP_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
12497   ASM_SIMP_TAC[o_DEF; LIFT_DROP; REAL_INTEGRABLE_ON; LIFT_CMUL]);;
12498
12499 let REAL_INTEGRABLE_INCREASING_PRODUCT_UNIV = prove
12500  (`!f g B.
12501         f real_integrable_on (:real) /\
12502         (!x y. x <= y ==> g x <= g y) /\
12503         (!x. abs(g x) <= B)
12504          ==> (\x. g x * f x) real_integrable_on (:real)`,
12505   REPEAT STRIP_TAC THEN
12506   MP_TAC(ISPECL [`lift o f o drop`; `(g:real->real) o drop`; `B:real`]
12507     INTEGRABLE_INCREASING_PRODUCT_UNIV) THEN
12508   ASM_REWRITE_TAC[GSYM IMAGE_LIFT_UNIV;
12509                   GSYM REAL_INTEGRABLE_ON] THEN
12510   ASM_SIMP_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
12511   ASM_SIMP_TAC[o_DEF; LIFT_DROP; REAL_INTEGRABLE_ON; LIFT_CMUL]);;
12512
12513 let REAL_INTEGRABLE_INCREASING = prove
12514  (`!f a b.
12515         (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
12516                ==> f(x) <= f(y))
12517         ==> f real_integrable_on real_interval[a,b]`,
12518   REPEAT STRIP_TAC THEN
12519   MP_TAC(ISPECL [`lift o f o drop`; `lift a`; `lift b`]
12520     INTEGRABLE_INCREASING_1) THEN
12521   ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL;
12522                   GSYM REAL_INTEGRABLE_ON] THEN
12523   DISCH_THEN MATCH_MP_TAC THEN
12524   ASM_SIMP_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
12525   ASM_SIMP_TAC[o_DEF; LIFT_DROP; REAL_INTEGRABLE_ON; LIFT_CMUL]);;
12526
12527 let REAL_INTEGRABLE_DECREASING_PRODUCT = prove
12528  (`!f g a b.
12529         f real_integrable_on real_interval[a,b] /\
12530         (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
12531                ==> g(y) <= g(x))
12532         ==> (\x. g(x) * f(x)) real_integrable_on real_interval[a,b]`,
12533   REPEAT STRIP_TAC THEN
12534   MP_TAC(ISPECL [`lift o f o drop`; `(g:real->real) o drop`;
12535                  `lift a`; `lift b`]
12536     INTEGRABLE_DECREASING_PRODUCT) THEN
12537   ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL;
12538                   GSYM REAL_INTEGRABLE_ON] THEN
12539   ASM_SIMP_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
12540   ASM_SIMP_TAC[o_DEF; LIFT_DROP; REAL_INTEGRABLE_ON; LIFT_CMUL]);;
12541
12542 let REAL_INTEGRABLE_DECREASING_PRODUCT_UNIV = prove
12543  (`!f g B.
12544         f real_integrable_on (:real) /\
12545         (!x y. x <= y ==> g y <= g x) /\
12546         (!x. abs(g x) <= B)
12547          ==> (\x. g x * f x) real_integrable_on (:real)`,
12548   REPEAT STRIP_TAC THEN
12549   MP_TAC(ISPECL [`lift o f o drop`; `(g:real->real) o drop`; `B:real`]
12550     INTEGRABLE_DECREASING_PRODUCT_UNIV) THEN
12551   ASM_REWRITE_TAC[GSYM IMAGE_LIFT_UNIV;
12552                   GSYM REAL_INTEGRABLE_ON] THEN
12553   ASM_SIMP_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
12554   ASM_SIMP_TAC[o_DEF; LIFT_DROP; REAL_INTEGRABLE_ON; LIFT_CMUL]);;
12555
12556 let REAL_INTEGRABLE_DECREASING = prove
12557  (`!f a b.
12558         (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
12559                ==> f(y) <= f(x))
12560         ==> f real_integrable_on real_interval[a,b]`,
12561   REPEAT STRIP_TAC THEN
12562   MP_TAC(ISPECL [`lift o f o drop`; `lift a`; `lift b`]
12563     INTEGRABLE_DECREASING_1) THEN
12564   ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL;
12565                   GSYM REAL_INTEGRABLE_ON] THEN
12566   DISCH_THEN MATCH_MP_TAC THEN
12567   ASM_SIMP_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
12568   ASM_SIMP_TAC[o_DEF; LIFT_DROP; REAL_INTEGRABLE_ON; LIFT_CMUL]);;
12569
12570 (* ------------------------------------------------------------------------- *)
12571 (* Measurability and absolute integrability of monotone functions.           *)
12572 (* ------------------------------------------------------------------------- *)
12573
12574 let REAL_MEASURABLE_ON_INCREASING_UNIV = prove
12575  (`!f. (!x y. x <= y ==> f x <= f y) ==> f real_measurable_on (:real)`,
12576   REPEAT STRIP_TAC THEN
12577   REWRITE_TAC[REAL_MEASURABLE_ON_PREIMAGE_OPEN_HALFSPACE_LE] THEN
12578   X_GEN_TAC `y:real` THEN
12579   REPEAT_TCL STRIP_THM_THEN ASSUME_TAC
12580    (SET_RULE `{x | (f:real->real) x <= y} = {} \/
12581               {x | (f:real->real) x <= y} = UNIV \/
12582               ?a b. f a <= y /\ ~(f b <= y)`) THEN
12583   ASM_REWRITE_TAC[REAL_LEBESGUE_MEASURABLE_EMPTY;
12584                   REAL_LEBESGUE_MEASURABLE_UNIV] THEN
12585   MP_TAC(ISPEC `{x | (f:real->real) x <= y}` SUP) THEN
12586   REWRITE_TAC[IN_ELIM_THM; EXTENSION; NOT_IN_EMPTY] THEN ANTS_TAC THENL
12587    [ASM_MESON_TAC[REAL_LE_TOTAL; REAL_LE_TRANS]; ALL_TAC] THEN
12588   ABBREV_TAC `s = sup {x | (f:real->real) x <= y}` THEN STRIP_TAC THEN
12589   SUBGOAL_THEN
12590     `(!x. (f:real->real) x <= y <=> x < s) \/
12591      (!x. (f:real->real) x <= y <=> x <= s)`
12592   STRIP_ASSUME_TAC THENL
12593    [ASM_CASES_TAC `(f:real->real) s <= y` THEN
12594     ASM_MESON_TAC[REAL_LE_TRANS; REAL_NOT_LE; REAL_LE_ANTISYM; REAL_LE_TOTAL];
12595     ASM_SIMP_TAC[REAL_OPEN_HALFSPACE_LT; REAL_LEBESGUE_MEASURABLE_OPEN];
12596     ASM_SIMP_TAC[REAL_CLOSED_HALFSPACE_LE; REAL_LEBESGUE_MEASURABLE_CLOSED]]);;
12597
12598 let REAL_MEASURABLE_ON_INCREASING = prove
12599  (`!f a b. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
12600                   ==> f x <= f y)
12601            ==> f real_measurable_on real_interval[a,b]`,
12602   REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN
12603   ASM_CASES_TAC `real_interval[a,b] = {}` THENL
12604    [ONCE_REWRITE_TAC[GSYM REAL_MEASURABLE_ON_UNIV] THEN
12605     ASM_REWRITE_TAC[NOT_IN_EMPTY; REAL_MEASURABLE_ON_0];
12606     RULE_ASSUM_TAC(REWRITE_RULE[REAL_INTERVAL_EQ_EMPTY; REAL_NOT_LT])] THEN
12607   ABBREV_TAC `g = \x. if x < a then f(a)
12608                       else if b < x then f(b)
12609                       else (f:real->real) x` THEN
12610   SUBGOAL_THEN `g real_measurable_on real_interval[a,b]` MP_TAC THENL
12611    [ALL_TAC;
12612     ONCE_REWRITE_TAC[GSYM REAL_MEASURABLE_ON_UNIV] THEN EXPAND_TAC "g" THEN
12613     SIMP_TAC[IN_REAL_INTERVAL; GSYM REAL_NOT_LT]] THEN
12614   MATCH_MP_TAC REAL_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN
12615   EXISTS_TAC `(:real)` THEN
12616   REWRITE_TAC[SUBSET_UNIV; REAL_LEBESGUE_MEASURABLE_INTERVAL] THEN
12617   MATCH_MP_TAC REAL_MEASURABLE_ON_INCREASING_UNIV THEN EXPAND_TAC "g" THEN
12618   ASM_MESON_TAC[REAL_LT_LE; REAL_LE_TRANS; REAL_LE_TOTAL; REAL_LE_ANTISYM;
12619                 REAL_NOT_LT; REAL_LT_IMP_LE; REAL_LE_REFL]);;
12620
12621 let REAL_MEASURABLE_ON_DECREASING_UNIV = prove
12622  (`!f. (!x y. x <= y ==> f y <= f x) ==> f real_measurable_on (:real)`,
12623   REPEAT STRIP_TAC THEN
12624   GEN_REWRITE_TAC I [GSYM REAL_MEASURABLE_ON_NEG_EQ] THEN
12625   MATCH_MP_TAC REAL_MEASURABLE_ON_INCREASING_UNIV THEN
12626   ASM_SIMP_TAC[REAL_LE_NEG2]);;
12627
12628 let REAL_MEASURABLE_ON_DECREASING = prove
12629  (`!f a b. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
12630                   ==> f y <= f x)
12631            ==> f real_measurable_on real_interval[a,b]`,
12632   REPEAT STRIP_TAC THEN
12633   GEN_REWRITE_TAC I [GSYM REAL_MEASURABLE_ON_NEG_EQ] THEN
12634   MATCH_MP_TAC REAL_MEASURABLE_ON_INCREASING THEN
12635   ASM_SIMP_TAC[REAL_LE_NEG2]);;
12636
12637 let ABSOLUTELY_REAL_INTEGRABLE_INCREASING_PRODUCT = prove
12638  (`!f g a b.
12639         (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
12640                ==> f x <= f y) /\
12641         g absolutely_real_integrable_on real_interval[a,b]
12642         ==> (\x. f x * g x) absolutely_real_integrable_on real_interval[a,b]`,
12643   REPEAT STRIP_TAC THEN
12644   MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN
12645   ASM_SIMP_TAC[REAL_MEASURABLE_ON_INCREASING] THEN
12646   REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN
12647   EXISTS_TAC `abs((f:real->real) a) + abs((f:real->real) b)` THEN
12648   REPEAT STRIP_TAC THEN MATCH_MP_TAC
12649    (REAL_ARITH `a <= x /\ x <= b ==> abs x <= abs a + abs b`) THEN
12650   CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
12651   ASM_REWRITE_TAC[] THEN
12652   ASM_MESON_TAC[IN_REAL_INTERVAL; REAL_LE_TRANS; REAL_LE_REFL]);;
12653
12654 let ABSOLUTELY_REAL_INTEGRABLE_INCREASING = prove
12655  (`!f a b. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
12656                   ==> f x <= f y)
12657            ==> f absolutely_real_integrable_on real_interval[a,b]`,
12658   REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN
12659   GEN_REWRITE_TAC (LAND_CONV o ABS_CONV) [GSYM REAL_MUL_RID] THEN
12660   MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_INCREASING_PRODUCT THEN
12661   ASM_REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST]);;
12662
12663 let ABSOLUTELY_REAL_INTEGRABLE_DECREASING_PRODUCT = prove
12664  (`!f g a b.
12665         (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
12666                ==> f y <= f x) /\
12667         g absolutely_real_integrable_on real_interval[a,b]
12668         ==> (\x. f x * g x) absolutely_real_integrable_on real_interval[a,b]`,
12669   REPEAT STRIP_TAC THEN
12670   MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN
12671   ASM_SIMP_TAC[REAL_MEASURABLE_ON_DECREASING] THEN
12672   REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN
12673   EXISTS_TAC `abs((f:real->real) a) + abs((f:real->real) b)` THEN
12674   REPEAT STRIP_TAC THEN MATCH_MP_TAC
12675    (REAL_ARITH `b <= x /\ x <= a ==> abs x <= abs a + abs b`) THEN
12676   CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
12677   ASM_REWRITE_TAC[] THEN
12678   ASM_MESON_TAC[IN_REAL_INTERVAL; REAL_LE_TRANS; REAL_LE_REFL]);;
12679
12680 let ABSOLUTELY_REAL_INTEGRABLE_DECREASING = prove
12681  (`!f a b. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
12682                   ==> f y <= f x)
12683            ==> f absolutely_real_integrable_on real_interval[a,b]`,
12684   REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN
12685   GEN_REWRITE_TAC (LAND_CONV o ABS_CONV) [GSYM REAL_MUL_RID] THEN
12686   MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_DECREASING_PRODUCT THEN
12687   ASM_REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST]);;
12688
12689 (* ------------------------------------------------------------------------- *)
12690 (* Real functions of bounded variation.                                      *)
12691 (* ------------------------------------------------------------------------- *)
12692
12693 parse_as_infix("has_bounded_real_variation_on",(12,"right"));;
12694
12695 let has_bounded_real_variation_on = new_definition
12696  `f has_bounded_real_variation_on s <=>
12697   (lift o f o drop) has_bounded_variation_on (IMAGE lift s)`;;
12698
12699 let real_variation = new_definition
12700  `real_variation s f = vector_variation (IMAGE lift s) (lift o f o drop)`;;
12701
12702 let HAS_BOUNDED_REAL_VARIATION_ON_EQ = prove
12703  (`!f g s.
12704         (!x. x IN s ==> f x = g x) /\ f has_bounded_real_variation_on s
12705
12706
12707         ==> g has_bounded_real_variation_on s`,
12708   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
12709   REWRITE_TAC[IMP_CONJ; has_bounded_real_variation_on] THEN
12710   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_EQ) THEN
12711   ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP]);;
12712
12713 let HAS_BOUNDED_REAL_VARIATION_ON_SUBSET = prove
12714  (`!f s t. f has_bounded_real_variation_on s /\ t SUBSET s
12715            ==> f has_bounded_real_variation_on t`,
12716   REWRITE_TAC[has_bounded_real_variation_on] THEN
12717   MESON_TAC[HAS_BOUNDED_VARIATION_ON_SUBSET; IMAGE_SUBSET]);;
12718
12719 let HAS_BOUNDED_REAL_VARIATION_ON_LMUL = prove
12720  (`!f c s. f has_bounded_real_variation_on s
12721            ==> (\x. c * f x) has_bounded_real_variation_on s`,
12722   REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN
12723   REWRITE_TAC[o_DEF; LIFT_CMUL; HAS_BOUNDED_VARIATION_ON_CMUL]);;
12724
12725 let HAS_BOUNDED_REAL_VARIATION_ON_RMUL = prove
12726  (`!f c s. f has_bounded_real_variation_on s
12727            ==> (\x. f x * c) has_bounded_real_variation_on s`,
12728   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
12729   REWRITE_TAC[HAS_BOUNDED_REAL_VARIATION_ON_LMUL]);;
12730
12731 let HAS_BOUNDED_REAL_VARIATION_ON_NEG = prove
12732  (`!f s. f has_bounded_real_variation_on s
12733          ==> (\x. --f x) has_bounded_real_variation_on s`,
12734   REWRITE_TAC[has_bounded_real_variation_on; o_DEF; LIFT_NEG] THEN
12735   REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_NEG]);;
12736
12737 let HAS_BOUNDED_REAL_VARIATION_ON_ADD = prove
12738  (`!f g s. f has_bounded_real_variation_on s /\
12739            g has_bounded_real_variation_on s
12740            ==> (\x. f x + g x) has_bounded_real_variation_on s`,
12741   REWRITE_TAC[has_bounded_real_variation_on; o_DEF; LIFT_ADD] THEN
12742   REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_ADD]);;
12743
12744 let HAS_BOUNDED_REAL_VARIATION_ON_SUB = prove
12745  (`!f g s. f has_bounded_real_variation_on s /\
12746            g has_bounded_real_variation_on s
12747            ==> (\x. f x - g x) has_bounded_real_variation_on s`,
12748   REWRITE_TAC[has_bounded_real_variation_on; o_DEF; LIFT_SUB] THEN
12749   REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_SUB]);;
12750
12751 let HAS_BOUNDED_REAL_VARIATION_ON_NULL = prove
12752  (`!f a b. b <= a ==> f has_bounded_real_variation_on real_interval[a,b]`,
12753   REPEAT STRIP_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN
12754   REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN
12755   MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_NULL THEN
12756   ASM_REWRITE_TAC[BOUNDED_INTERVAL; CONTENT_EQ_0_1; LIFT_DROP]);;
12757
12758 let HAS_BOUNDED_REAL_VARIATION_ON_EMPTY = prove
12759  (`!f. f has_bounded_real_variation_on {}`,
12760   REWRITE_TAC[IMAGE_CLAUSES; has_bounded_real_variation_on] THEN
12761   REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_EMPTY]);;
12762
12763 let HAS_BOUNDED_REAL_VARIATION_ON_ABS = prove
12764  (`!f s. f has_bounded_real_variation_on s
12765          ==> (\x. abs(f x)) has_bounded_real_variation_on s`,
12766   REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN
12767   DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_ON_NORM) THEN
12768   REWRITE_TAC[o_DEF; NORM_REAL; GSYM drop; LIFT_DROP]);;
12769
12770 let HAS_BOUNDED_REAL_VARIATION_ON_MAX = prove
12771  (`!f g s. f has_bounded_real_variation_on s /\
12772            g has_bounded_real_variation_on s
12773            ==> (\x. max (f x) (g x)) has_bounded_real_variation_on s`,
12774   REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN
12775   DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_ON_MAX) THEN
12776   REWRITE_TAC[o_DEF; LIFT_DROP]);;
12777
12778 let HAS_BOUNDED_REAL_VARIATION_ON_MIN = prove
12779  (`!f g s. f has_bounded_real_variation_on s /\
12780            g has_bounded_real_variation_on s
12781            ==> (\x. min (f x) (g x)) has_bounded_real_variation_on s`,
12782   REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN
12783   DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_ON_MIN) THEN
12784   REWRITE_TAC[o_DEF; LIFT_DROP]);;
12785
12786 let HAS_BOUNDED_REAL_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL = prove
12787  (`!f a b. f has_bounded_real_variation_on real_interval[a,b]
12788            ==> real_bounded(IMAGE f (real_interval[a,b]))`,
12789   REPEAT GEN_TAC THEN
12790   REWRITE_TAC[has_bounded_real_variation_on; REAL_BOUNDED] THEN
12791   REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN
12792   DISCH_THEN(MP_TAC o MATCH_MP
12793     HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL) THEN
12794   REWRITE_TAC[IMAGE_o; IMAGE_DROP_INTERVAL; LIFT_DROP]);;
12795
12796 let HAS_BOUNDED_REAL_VARIATION_ON_MUL = prove
12797  (`!f g a b.
12798         f has_bounded_real_variation_on real_interval[a,b] /\
12799         g has_bounded_real_variation_on real_interval[a,b]
12800         ==> (\x. f x * g x) has_bounded_real_variation_on real_interval[a,b]`,
12801   REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN
12802   REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN
12803   DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_ON_MUL) THEN
12804   REWRITE_TAC[o_DEF; LIFT_CMUL; LIFT_DROP]);;
12805
12806 let REAL_VARIATION_POS_LE = prove
12807  (`!f s. f has_bounded_real_variation_on s ==> &0 <= real_variation s f`,
12808   REWRITE_TAC[real_variation; has_bounded_real_variation_on] THEN
12809   REWRITE_TAC[VECTOR_VARIATION_POS_LE]);;
12810
12811 let REAL_VARIATION_GE_ABS_FUNCTION = prove
12812  (`!f s a b.
12813         f has_bounded_real_variation_on s /\ real_segment[a,b] SUBSET s
12814         ==> abs(f b - f a) <= real_variation s f`,
12815   REWRITE_TAC[has_bounded_real_variation_on] THEN REPEAT STRIP_TAC THEN
12816   MP_TAC(ISPECL
12817    [`lift o f o drop`; `IMAGE lift s`; `lift a`; `lift b`]
12818    VECTOR_VARIATION_GE_NORM_FUNCTION) THEN
12819   ASM_SIMP_TAC[GSYM IMAGE_LIFT_REAL_SEGMENT;
12820                IMAGE_EQ_EMPTY; IMAGE_SUBSET] THEN
12821   REWRITE_TAC[real_variation; o_THM; LIFT_DROP; GSYM LIFT_SUB; NORM_LIFT]);;
12822
12823 let REAL_VARIATION_GE_FUNCTION = prove
12824  (`!f s a b.
12825         f has_bounded_real_variation_on s /\ real_segment[a,b] SUBSET s
12826         ==> f b - f a <= real_variation s f`,
12827   REPEAT STRIP_TAC THEN
12828   MATCH_MP_TAC(REAL_ARITH `abs x <= a ==> x <= a`) THEN
12829   ASM_MESON_TAC[REAL_VARIATION_GE_ABS_FUNCTION]);;
12830
12831 let REAL_VARIATION_MONOTONE = prove
12832  (`!f s t. f has_bounded_real_variation_on s /\ t SUBSET s
12833            ==> real_variation t f <= real_variation s f`,
12834   REWRITE_TAC[has_bounded_real_variation_on; real_variation] THEN
12835   REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_MONOTONE THEN
12836   ASM_SIMP_TAC[IMAGE_SUBSET]);;
12837
12838 let REAL_VARIATION_NEG = prove
12839  (`!f s. real_variation s (\x. --(f x)) = real_variation s f`,
12840   SIMP_TAC[real_variation; o_DEF; LIFT_NEG; VECTOR_VARIATION_NEG]);;
12841
12842 let REAL_VARIATION_TRIANGLE = prove
12843  (`!f g s. f has_bounded_real_variation_on s /\
12844            g has_bounded_real_variation_on s
12845            ==> real_variation s (\x. f x + g x)
12846                <= real_variation s f + real_variation s g`,
12847   REPEAT GEN_TAC THEN
12848   REWRITE_TAC[has_bounded_real_variation_on; real_variation] THEN
12849   DISCH_THEN(MP_TAC o MATCH_MP VECTOR_VARIATION_TRIANGLE) THEN
12850   REWRITE_TAC[o_DEF; LIFT_ADD]);;
12851
12852 let HAS_BOUNDED_REAL_VARIATION_ON_COMBINE = prove
12853  (`!f a b c.
12854         a <= c /\ c <= b
12855         ==> (f has_bounded_real_variation_on real_interval[a,b] <=>
12856              f has_bounded_real_variation_on real_interval[a,c] /\
12857              f has_bounded_real_variation_on real_interval[c,b])`,
12858   REWRITE_TAC[has_bounded_real_variation_on; IMAGE_LIFT_REAL_INTERVAL] THEN
12859   REPEAT STRIP_TAC THEN MP_TAC(ISPECL
12860    [`lift o f o drop`; `lift a`; `lift b`; `lift c`]
12861         HAS_BOUNDED_VARIATION_ON_COMBINE) THEN
12862   ASM_REWRITE_TAC[LIFT_DROP; has_bounded_real_variation_on;
12863       IMAGE_LIFT_REAL_INTERVAL]);;
12864
12865 let REAL_VARIATION_COMBINE = prove
12866  (`!f a b c.
12867         a <= c /\ c <= b /\
12868         f has_bounded_real_variation_on real_interval[a,b]
12869         ==> real_variation (real_interval[a,c]) f +
12870             real_variation (real_interval[c,b]) f =
12871             real_variation (real_interval[a,b]) f`,
12872   REWRITE_TAC[has_bounded_real_variation_on; IMAGE_LIFT_REAL_INTERVAL] THEN
12873   REPEAT STRIP_TAC THEN MP_TAC(ISPECL
12874    [`lift o f o drop`; `lift a`; `lift b`; `lift c`]
12875         VECTOR_VARIATION_COMBINE) THEN
12876   ASM_REWRITE_TAC[LIFT_DROP; real_variation; IMAGE_LIFT_REAL_INTERVAL]);;
12877
12878 let REAL_VARIATION_MINUS_FUNCTION_MONOTONE = prove
12879  (`!f a b c d.
12880         f has_bounded_real_variation_on real_interval[a,b] /\
12881         real_interval[c,d] SUBSET real_interval[a,b] /\
12882         ~(real_interval[c,d] = {})
12883         ==> real_variation (real_interval[c,d]) f - (f d - f c) <=
12884             real_variation (real_interval[a,b]) f - (f b - f a)`,
12885   REWRITE_TAC[has_bounded_real_variation_on; IMAGE_LIFT_REAL_INTERVAL] THEN
12886   REPEAT STRIP_TAC THEN
12887   MP_TAC(ISPECL
12888    [`lift o f o drop`; `lift a`; `lift b`; `lift c`; `lift d`]
12889    VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE) THEN
12890   ASM_SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; real_variation;
12891                 IMAGE_EQ_EMPTY; IMAGE_SUBSET] THEN
12892   REWRITE_TAC[o_THM; LIFT_DROP; DROP_SUB]);;
12893
12894 let INCREASING_BOUNDED_REAL_VARIATION = prove
12895  (`!f a b.
12896       (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
12897              ==> f x <= f y)
12898       ==> f has_bounded_real_variation_on real_interval[a,b]`,
12899   REPEAT STRIP_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN
12900   REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN
12901   MATCH_MP_TAC INCREASING_BOUNDED_VARIATION THEN
12902   REWRITE_TAC[IN_INTERVAL_1; GSYM FORALL_DROP; o_THM; LIFT_DROP] THEN
12903   RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN ASM_MESON_TAC[]);;
12904
12905 let INCREASING_REAL_VARIATION = prove
12906  (`!f a b.
12907         ~(real_interval[a,b] = {}) /\
12908         (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
12909                ==> f x <= f y)
12910         ==> real_variation (real_interval[a,b]) f = f b - f a`,
12911   REPEAT STRIP_TAC THEN
12912   REWRITE_TAC[real_variation; IMAGE_LIFT_REAL_INTERVAL] THEN
12913   MP_TAC(ISPECL [`lift o f o drop`; `lift a`; `lift b`]
12914         INCREASING_VECTOR_VARIATION) THEN
12915   REWRITE_TAC[o_THM; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN
12916   ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY] THEN
12917   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
12918   REWRITE_TAC[LIFT_DROP] THEN ASM_MESON_TAC[]);;
12919
12920 let HAS_BOUNDED_REAL_VARIATION_AFFINITY2_EQ = prove
12921  (`!m c f s.
12922         (\x. f (m * x + c)) has_bounded_real_variation_on
12923
12924
12925         IMAGE (\x. inv m * x + --(inv m * c)) s <=>
12926         m = &0 \/ f has_bounded_real_variation_on s`,
12927   REPEAT GEN_TAC THEN
12928   MP_TAC(ISPECL [`m:real`; `lift c`; `lift o f o drop`; `IMAGE lift s`]
12929         HAS_BOUNDED_VARIATION_AFFINITY2_EQ) THEN
12930   REWRITE_TAC[o_DEF; has_bounded_real_variation_on; GSYM IMAGE_o;
12931    DROP_ADD; DROP_CMUL; LIFT_ADD; LIFT_CMUL; LIFT_NEG; LIFT_DROP]);;
12932
12933 let REAL_VARIATION_AFFINITY2 = prove
12934  (`!m c f s.
12935         real_variation (IMAGE (\x. inv m * x + --(inv m * c)) s)
12936                        (\x. f (m * x + c)) =
12937         if m = &0 then &0 else real_variation s f`,
12938   REPEAT GEN_TAC THEN
12939   MP_TAC(ISPECL [`m:real`; `lift c`; `lift o f o drop`; `IMAGE lift s`]
12940          VECTOR_VARIATION_AFFINITY2) THEN
12941   REWRITE_TAC[o_DEF; real_variation; GSYM IMAGE_o;
12942    DROP_ADD; DROP_CMUL; LIFT_ADD; LIFT_CMUL; LIFT_NEG; LIFT_DROP]);;
12943
12944 let HAS_BOUNDED_REAL_VARIATION_AFFINITY_EQ = prove
12945  (`!m c f s.
12946         (\x. f (m * x + c)) has_bounded_real_variation_on s <=>
12947         m = &0 \/ f has_bounded_real_variation_on IMAGE (\x. m * x + c) s`,
12948   REPEAT GEN_TAC THEN
12949   MP_TAC(ISPECL [`m:real`; `lift c`; `lift o f o drop`; `IMAGE lift s`]
12950         HAS_BOUNDED_VARIATION_AFFINITY_EQ) THEN
12951   REWRITE_TAC[o_DEF; has_bounded_real_variation_on; GSYM IMAGE_o;
12952    DROP_ADD; DROP_CMUL; LIFT_ADD; LIFT_CMUL; LIFT_NEG; LIFT_DROP]);;
12953
12954 let REAL_VARIATION_AFFINITY = prove
12955  (`!m c f s.
12956         real_variation s (\x. f (m * x + c)) =
12957         if m = &0 then &0 else real_variation (IMAGE (\x. m * x + c) s) f`,
12958   REPEAT GEN_TAC THEN
12959   MP_TAC(ISPECL [`m:real`; `lift c`; `lift o f o drop`; `IMAGE lift s`]
12960          VECTOR_VARIATION_AFFINITY) THEN
12961   REWRITE_TAC[o_DEF; real_variation; GSYM IMAGE_o;
12962    DROP_ADD; DROP_CMUL; LIFT_ADD; LIFT_CMUL; LIFT_NEG; LIFT_DROP]);;
12963
12964 let HAS_BOUNDED_REAL_VARIATION_TRANSLATION2_EQ = prove
12965  (`!a f s.
12966       (\x. f(a + x)) has_bounded_real_variation_on (IMAGE (\x. --a + x) s) <=>
12967       f has_bounded_real_variation_on s`,
12968   REPEAT GEN_TAC THEN
12969   MP_TAC(ISPECL [`lift a`; `lift o f o drop`; `IMAGE lift s`]
12970         HAS_BOUNDED_VARIATION_TRANSLATION2_EQ) THEN
12971   REWRITE_TAC[o_DEF; has_bounded_real_variation_on; GSYM IMAGE_o;
12972               DROP_ADD; LIFT_DROP; LIFT_ADD; LIFT_NEG]);;
12973
12974 let REAL_VARIATION_TRANSLATION2 = prove
12975  (`!a f s. real_variation (IMAGE (\x. --a + x) s) (\x. f(a + x)) =
12976            real_variation s f`,
12977   REPEAT GEN_TAC THEN
12978   MP_TAC(ISPECL [`lift a`; `lift o f o drop`; `IMAGE lift s`]
12979         VECTOR_VARIATION_TRANSLATION2) THEN
12980   REWRITE_TAC[o_DEF; real_variation; GSYM IMAGE_o;
12981               DROP_ADD; LIFT_DROP; LIFT_ADD; LIFT_NEG]);;
12982
12983 let HAS_BOUNDED_REAL_VARIATION_TRANSLATION_EQ = prove
12984  (`!a f s. (\x. f(a + x)) has_bounded_real_variation_on s <=>
12985            f has_bounded_real_variation_on (IMAGE (\x. a + x) s)`,
12986   REPEAT GEN_TAC THEN
12987   MP_TAC(ISPECL [`lift a`; `lift o f o drop`; `IMAGE lift s`]
12988         HAS_BOUNDED_VARIATION_TRANSLATION_EQ) THEN
12989   REWRITE_TAC[o_DEF; has_bounded_real_variation_on; GSYM IMAGE_o;
12990               DROP_ADD; LIFT_DROP; LIFT_ADD; LIFT_NEG]);;
12991
12992 let REAL_VARIATION_TRANSLATION = prove
12993  (`!a f s. real_variation s (\x. f(a + x)) =
12994            real_variation (IMAGE (\x. a + x) s) f`,
12995   REPEAT GEN_TAC THEN
12996   MP_TAC(ISPECL [`lift a`; `lift o f o drop`; `IMAGE lift s`]
12997         VECTOR_VARIATION_TRANSLATION) THEN
12998   REWRITE_TAC[o_DEF; real_variation; GSYM IMAGE_o;
12999               DROP_ADD; LIFT_DROP; LIFT_ADD; LIFT_NEG]);;
13000
13001 let HAS_BOUNDED_REAL_VARIATION_TRANSLATION_EQ_INTERVAL = prove
13002  (`!a f u v.
13003         (\x. f(a + x)) has_bounded_real_variation_on real_interval[u,v] <=>
13004         f has_bounded_real_variation_on real_interval[a+u,a+v]`,
13005   REWRITE_TAC[REAL_INTERVAL_TRANSLATION;
13006               HAS_BOUNDED_REAL_VARIATION_TRANSLATION_EQ]);;
13007
13008 let REAL_VARIATION_TRANSLATION_INTERVAL = prove
13009  (`!a f u v.
13010         real_variation (real_interval[u,v]) (\x. f(a + x)) =
13011         real_variation (real_interval[a+u,a+v]) f`,
13012   REWRITE_TAC[REAL_INTERVAL_TRANSLATION;
13013                 REAL_VARIATION_TRANSLATION]);;
13014
13015 let HAS_BOUNDED_REAL_VARIATION_TRANSLATION = prove
13016  (`!f s a. f has_bounded_real_variation_on s
13017            ==> (\x. f(a + x)) has_bounded_real_variation_on
13018                (IMAGE (\x. --a + x) s)`,
13019   REWRITE_TAC[HAS_BOUNDED_REAL_VARIATION_TRANSLATION2_EQ]);;
13020
13021 let HAS_BOUNDED_REAL_VARIATION_REFLECT2_EQ = prove
13022  (`!f s. (\x. f(--x)) has_bounded_real_variation_on (IMAGE (--) s) <=>
13023          f has_bounded_real_variation_on s`,
13024   REPEAT GEN_TAC THEN
13025   MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`]
13026         HAS_BOUNDED_VARIATION_REFLECT2_EQ) THEN
13027   REWRITE_TAC[o_DEF; has_bounded_real_variation_on; GSYM IMAGE_o;
13028               DROP_NEG; LIFT_DROP; LIFT_NEG]);;
13029
13030 let REAL_VARIATION_REFLECT2 = prove
13031  (`!f s. real_variation (IMAGE (--) s) (\x. f(--x)) =
13032          real_variation s f`,
13033   REPEAT GEN_TAC THEN
13034   MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`]
13035         VECTOR_VARIATION_REFLECT2) THEN
13036   REWRITE_TAC[o_DEF; real_variation; GSYM IMAGE_o;
13037               DROP_NEG; LIFT_DROP; LIFT_NEG]);;
13038
13039 let HAS_BOUNDED_REAL_VARIATION_REFLECT_EQ = prove
13040  (`!f s. (\x. f(--x)) has_bounded_real_variation_on s <=>
13041          f has_bounded_real_variation_on (IMAGE (--) s)`,
13042   REPEAT GEN_TAC THEN
13043   MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`]
13044         HAS_BOUNDED_VARIATION_REFLECT_EQ) THEN
13045   REWRITE_TAC[o_DEF; has_bounded_real_variation_on; GSYM IMAGE_o;
13046               DROP_NEG; LIFT_DROP; LIFT_NEG]);;
13047
13048 let REAL_VARIATION_REFLECT = prove
13049  (`!f s. real_variation s (\x. f(--x)) =
13050          real_variation (IMAGE (--) s) f`,
13051   REPEAT GEN_TAC THEN
13052   MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`]
13053         VECTOR_VARIATION_REFLECT) THEN
13054   REWRITE_TAC[o_DEF; real_variation; GSYM IMAGE_o;
13055               DROP_NEG; LIFT_DROP; LIFT_NEG]);;
13056
13057 let HAS_BOUNDED_REAL_VARIATION_REFLECT_EQ_INTERVAL = prove
13058  (`!f u v. (\x. f(--x)) has_bounded_real_variation_on real_interval[u,v] <=>
13059            f has_bounded_real_variation_on real_interval[--v,--u]`,
13060   REWRITE_TAC[GSYM REFLECT_REAL_INTERVAL;
13061               HAS_BOUNDED_REAL_VARIATION_REFLECT_EQ]);;
13062
13063 let REAL_VARIATION_REFLECT_INTERVAL = prove
13064  (`!f u v. real_variation (real_interval[u,v]) (\x. f(--x)) =
13065            real_variation (real_interval[--v,--u]) f`,
13066   REWRITE_TAC[GSYM REFLECT_REAL_INTERVAL; REAL_VARIATION_REFLECT]);;
13067
13068 let HAS_BOUNDED_REAL_VARIATION_DARBOUX = prove
13069  (`!f a b.
13070      f has_bounded_real_variation_on real_interval[a,b] <=>
13071      ?g h. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
13072                   ==> g x <= g y) /\
13073            (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
13074                   ==> h x <= h y) /\
13075            (!x. f x = g x - h x)`,
13076   REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN
13077   REWRITE_TAC[HAS_BOUNDED_VARIATION_DARBOUX; IMAGE_LIFT_REAL_INTERVAL] THEN
13078   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE;
13079               GSYM IMAGE_LIFT_REAL_INTERVAL; LIFT_DROP] THEN
13080   REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN
13081   EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; o_THM] THENL
13082    [MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `h:real^1->real^1`] THEN
13083     STRIP_TAC THEN
13084     MAP_EVERY EXISTS_TAC [`drop o g o lift`; `drop o h o lift`] THEN
13085     ASM_REWRITE_TAC[o_THM] THEN REWRITE_TAC[GSYM LIFT_EQ; FORALL_DROP] THEN
13086     ASM_REWRITE_TAC[LIFT_DROP; LIFT_SUB];
13087     MAP_EVERY X_GEN_TAC [`g:real->real`; `h:real->real`] THEN
13088     STRIP_TAC THEN
13089     MAP_EVERY EXISTS_TAC [`lift o g o drop`; `lift o h o drop`] THEN
13090     ASM_REWRITE_TAC[o_THM; LIFT_DROP] THEN REWRITE_TAC[LIFT_SUB]]);;
13091
13092 let HAS_BOUNDED_REAL_VARIATION_DARBOUX_STRICT = prove
13093  (`!f a b.
13094      f has_bounded_real_variation_on real_interval[a,b] <=>
13095      ?g h. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x < y
13096                   ==> g x < g y) /\
13097            (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x < y
13098                   ==> h x < h y) /\
13099            (!x. f x = g x - h x)`,
13100   REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN
13101   REWRITE_TAC[HAS_BOUNDED_VARIATION_DARBOUX_STRICT;
13102               IMAGE_LIFT_REAL_INTERVAL] THEN
13103   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE;
13104               GSYM IMAGE_LIFT_REAL_INTERVAL; LIFT_DROP] THEN
13105   REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN
13106   EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; o_THM] THENL
13107    [MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `h:real^1->real^1`] THEN
13108     STRIP_TAC THEN
13109     MAP_EVERY EXISTS_TAC [`drop o g o lift`; `drop o h o lift`] THEN
13110     ASM_REWRITE_TAC[o_THM] THEN REWRITE_TAC[GSYM LIFT_EQ; FORALL_DROP] THEN
13111     ASM_REWRITE_TAC[LIFT_DROP; LIFT_SUB];
13112     MAP_EVERY X_GEN_TAC [`g:real->real`; `h:real->real`] THEN
13113     STRIP_TAC THEN
13114     MAP_EVERY EXISTS_TAC [`lift o g o drop`; `lift o h o drop`] THEN
13115     ASM_REWRITE_TAC[o_THM; LIFT_DROP] THEN REWRITE_TAC[LIFT_SUB]]);;
13116
13117 let INCREASING_LEFT_LIMIT = prove
13118  (`!f a b c.
13119         (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
13120                ==> f x <= f y) /\
13121         c IN real_interval[a,b]
13122        ==> ?l. (f ---> l) (atreal c within real_interval[a,c])`,
13123   REPEAT STRIP_TAC THEN REWRITE_TAC[TENDSTO_REAL; GSYM EXISTS_LIFT] THEN
13124   REWRITE_TAC[LIM_WITHINREAL_WITHIN; IMAGE_LIFT_REAL_INTERVAL] THEN
13125   MATCH_MP_TAC INCREASING_LEFT_LIMIT_1 THEN EXISTS_TAC `lift b` THEN
13126   SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
13127   ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; FUN_IN_IMAGE]);;
13128
13129 let DECREASING_LEFT_LIMIT = prove
13130  (`!f a b c.
13131         (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
13132                ==> f y <= f x) /\
13133         c IN real_interval[a,b]
13134         ==> ?l. (f ---> l) (atreal c within real_interval[a,c])`,
13135   REPEAT STRIP_TAC THEN REWRITE_TAC[TENDSTO_REAL; GSYM EXISTS_LIFT] THEN
13136   REWRITE_TAC[LIM_WITHINREAL_WITHIN; IMAGE_LIFT_REAL_INTERVAL] THEN
13137   MATCH_MP_TAC DECREASING_LEFT_LIMIT_1 THEN EXISTS_TAC `lift b` THEN
13138   SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
13139   ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; FUN_IN_IMAGE]);;
13140
13141 let INCREASING_RIGHT_LIMIT = prove
13142  (`!f a b c.
13143         (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
13144                ==> f x <= f y) /\
13145         c IN real_interval[a,b]
13146        ==> ?l. (f ---> l) (atreal c within real_interval[c,b])`,
13147   REPEAT STRIP_TAC THEN REWRITE_TAC[TENDSTO_REAL; GSYM EXISTS_LIFT] THEN
13148   REWRITE_TAC[LIM_WITHINREAL_WITHIN; IMAGE_LIFT_REAL_INTERVAL] THEN
13149   MATCH_MP_TAC INCREASING_RIGHT_LIMIT_1 THEN EXISTS_TAC `lift a` THEN
13150   SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
13151   ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; FUN_IN_IMAGE]);;
13152
13153 let DECREASING_RIGHT_LIMIT = prove
13154  (`!f a b c.
13155         (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
13156                ==> f y <= f x) /\
13157         c IN real_interval[a,b]
13158         ==> ?l. (f ---> l) (atreal c within real_interval[c,b])`,
13159   REPEAT STRIP_TAC THEN REWRITE_TAC[TENDSTO_REAL; GSYM EXISTS_LIFT] THEN
13160   REWRITE_TAC[LIM_WITHINREAL_WITHIN; IMAGE_LIFT_REAL_INTERVAL] THEN
13161   MATCH_MP_TAC DECREASING_RIGHT_LIMIT_1 THEN EXISTS_TAC `lift a` THEN
13162   SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
13163   ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; FUN_IN_IMAGE]);;
13164
13165 let HAS_BOUNDED_REAL_VARIATION_LEFT_LIMIT = prove
13166  (`!f a b c.
13167         f has_bounded_real_variation_on real_interval[a,b] /\
13168         c IN real_interval[a,b]
13169         ==> ?l. (f ---> l) (atreal c within real_interval[a,c])`,
13170   REWRITE_TAC[has_bounded_real_variation_on] THEN REPEAT STRIP_TAC THEN
13171   REWRITE_TAC[TENDSTO_REAL; GSYM EXISTS_LIFT] THEN
13172   REWRITE_TAC[LIM_WITHINREAL_WITHIN; IMAGE_LIFT_REAL_INTERVAL] THEN
13173   MATCH_MP_TAC HAS_BOUNDED_VECTOR_VARIATION_LEFT_LIMIT THEN
13174   EXISTS_TAC `lift b` THEN
13175   ASM_SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; GSYM o_ASSOC; FUN_IN_IMAGE]);;
13176
13177 let HAS_BOUNDED_REAL_VARIATION_RIGHT_LIMIT = prove
13178  (`!f a b c.
13179         f has_bounded_real_variation_on real_interval[a,b] /\
13180         c IN real_interval[a,b]
13181         ==> ?l. (f ---> l) (atreal c within real_interval[c,b])`,
13182   REWRITE_TAC[has_bounded_real_variation_on] THEN REPEAT STRIP_TAC THEN
13183   REWRITE_TAC[TENDSTO_REAL; GSYM EXISTS_LIFT] THEN
13184   REWRITE_TAC[LIM_WITHINREAL_WITHIN; IMAGE_LIFT_REAL_INTERVAL] THEN
13185   MATCH_MP_TAC HAS_BOUNDED_VECTOR_VARIATION_RIGHT_LIMIT THEN
13186   EXISTS_TAC `lift a` THEN
13187   ASM_SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; GSYM o_ASSOC; FUN_IN_IMAGE]);;
13188
13189 let REAL_VARIATION_CONTINUOUS_LEFT = prove
13190  (`!f a b c.
13191         f has_bounded_real_variation_on real_interval[a,b] /\
13192         c IN real_interval[a,b]
13193         ==> ((\x. real_variation(real_interval[a,x]) f)
13194              real_continuous (atreal c within real_interval[a,c]) <=>
13195             f real_continuous (atreal c within real_interval[a,c]))`,
13196   REWRITE_TAC[has_bounded_real_variation_on; real_variation] THEN
13197   REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL;
13198         REAL_CONTINUOUS_CONTINUOUS_WITHINREAL] THEN
13199   REWRITE_TAC[o_DEF; LIFT_DROP] THEN REPEAT STRIP_TAC THEN
13200   MATCH_MP_TAC VECTOR_VARIATION_CONTINUOUS_LEFT THEN
13201   EXISTS_TAC `lift b` THEN ASM_REWRITE_TAC[] THEN
13202   ASM_SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; FUN_IN_IMAGE]);;
13203
13204 let REAL_VARIATION_CONTINUOUS_RIGHT = prove
13205  (`!f a b c.
13206         f has_bounded_real_variation_on real_interval[a,b] /\
13207         c IN real_interval[a,b]
13208         ==> ((\x. real_variation(real_interval[a,x]) f)
13209              real_continuous (atreal c within real_interval[c,b]) <=>
13210             f real_continuous (atreal c within real_interval[c,b]))`,
13211   REWRITE_TAC[has_bounded_real_variation_on; real_variation] THEN
13212   REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL;
13213         REAL_CONTINUOUS_CONTINUOUS_WITHINREAL] THEN
13214   REWRITE_TAC[o_DEF; LIFT_DROP] THEN REPEAT STRIP_TAC THEN
13215   MATCH_MP_TAC VECTOR_VARIATION_CONTINUOUS_RIGHT THEN
13216   ASM_REWRITE_TAC[] THEN
13217   ASM_SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; FUN_IN_IMAGE]);;
13218
13219 let REAL_VARIATION_CONTINUOUS = prove
13220  (`!f a b c.
13221         f has_bounded_real_variation_on real_interval[a,b] /\
13222         c IN real_interval[a,b]
13223         ==> ((\x. real_variation(real_interval[a,x]) f)
13224              real_continuous (atreal c within real_interval[a,b]) <=>
13225             f real_continuous (atreal c within real_interval[a,b]))`,
13226   REWRITE_TAC[has_bounded_real_variation_on; real_variation] THEN
13227   REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL;
13228         REAL_CONTINUOUS_CONTINUOUS_WITHINREAL] THEN
13229   REWRITE_TAC[o_DEF; LIFT_DROP] THEN REPEAT STRIP_TAC THEN
13230   MATCH_MP_TAC VECTOR_VARIATION_CONTINUOUS THEN
13231   ASM_REWRITE_TAC[] THEN
13232   ASM_SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; FUN_IN_IMAGE]);;
13233
13234 let HAS_BOUNDED_REAL_VARIATION_DARBOUX_STRONG = prove
13235  (`!f a b.
13236      f has_bounded_real_variation_on real_interval[a,b]
13237      ==> ?g h.
13238           (!x. f x = g x - h x) /\
13239           (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
13240                  ==> g x <= g y) /\
13241           (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y
13242                  ==> h x <= h y) /\
13243           (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x < y
13244                  ==> g x < g y) /\
13245           (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x < y
13246                  ==> h x < h y) /\
13247           (!x. x IN real_interval[a,b] /\
13248                f real_continuous (atreal x within real_interval[a,x])
13249                ==> g real_continuous (atreal x within real_interval[a,x]) /\
13250                    h real_continuous (atreal x within real_interval[a,x])) /\
13251           (!x. x IN real_interval[a,b] /\
13252                f real_continuous (atreal x within real_interval[x,b])
13253                ==> g real_continuous (atreal x within real_interval[x,b]) /\
13254                    h real_continuous (atreal x within real_interval[x,b])) /\
13255           (!x. x IN real_interval[a,b] /\
13256                f real_continuous (atreal x within real_interval[a,b])
13257                ==> g real_continuous (atreal x within real_interval[a,b]) /\
13258                    h real_continuous (atreal x within real_interval[a,b]))`,
13259   REPEAT STRIP_TAC THEN
13260   MAP_EVERY EXISTS_TAC
13261    [`\x. x + real_variation (real_interval[a,x]) f`;
13262     `\x. x + real_variation (real_interval[a,x]) f - f x`] THEN
13263   REWRITE_TAC[REAL_ARITH `(x + l) - (x + l - f):real = f`] THEN
13264   REPEAT STRIP_TAC THENL
13265    [MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[] THEN
13266     MATCH_MP_TAC REAL_VARIATION_MONOTONE;
13267     MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[] THEN
13268     MATCH_MP_TAC(REAL_ARITH
13269      `!x. a - (b - x) <= c - (d - x) ==> a - b <= c - d`) THEN
13270     EXISTS_TAC `(f:real->real) a` THEN
13271     MATCH_MP_TAC REAL_VARIATION_MINUS_FUNCTION_MONOTONE;
13272     MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_REWRITE_TAC[] THEN
13273     MATCH_MP_TAC REAL_VARIATION_MONOTONE;
13274     MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_REWRITE_TAC[] THEN
13275     MATCH_MP_TAC(REAL_ARITH
13276      `!x. a - (b - x) <= c - (d - x) ==> a - b <= c - d`) THEN
13277     EXISTS_TAC `(f:real->real) a` THEN
13278     MATCH_MP_TAC REAL_VARIATION_MINUS_FUNCTION_MONOTONE;
13279     MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN
13280     REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN
13281     MP_TAC(ISPECL [`f:real->real`; `a:real`; `b:real`; `x:real`]
13282         REAL_VARIATION_CONTINUOUS_LEFT) THEN
13283     ASM_REWRITE_TAC[];
13284     MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN
13285     REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN
13286     MATCH_MP_TAC REAL_CONTINUOUS_SUB THEN ASM_REWRITE_TAC[] THEN
13287     MP_TAC(ISPECL [`f:real->real`; `a:real`; `b:real`; `x:real`]
13288         REAL_VARIATION_CONTINUOUS_LEFT) THEN
13289     ASM_REWRITE_TAC[];
13290     MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN
13291     REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN
13292     MP_TAC(ISPECL [`f:real->real`; `a:real`; `b:real`; `x:real`]
13293         REAL_VARIATION_CONTINUOUS_RIGHT) THEN
13294     ASM_REWRITE_TAC[];
13295     MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN
13296     REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN
13297     MATCH_MP_TAC REAL_CONTINUOUS_SUB THEN ASM_REWRITE_TAC[] THEN
13298     MP_TAC(ISPECL [`f:real->real`; `a:real`; `b:real`; `x:real`]
13299         REAL_VARIATION_CONTINUOUS_RIGHT) THEN
13300     ASM_REWRITE_TAC[];
13301     MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN
13302     REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN
13303     MP_TAC(ISPECL [`f:real->real`; `a:real`; `b:real`; `x:real`]
13304         REAL_VARIATION_CONTINUOUS) THEN
13305     ASM_REWRITE_TAC[];
13306     MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN
13307     REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN
13308     MATCH_MP_TAC REAL_CONTINUOUS_SUB THEN ASM_REWRITE_TAC[] THEN
13309     MP_TAC(ISPECL [`f:real->real`; `a:real`; `b:real`; `x:real`]
13310         REAL_VARIATION_CONTINUOUS) THEN
13311     ASM_REWRITE_TAC[]] THEN
13312   (CONJ_TAC THENL
13313      [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
13314        HAS_BOUNDED_REAL_VARIATION_ON_SUBSET));
13315       ALL_TAC] THEN
13316     RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN
13317     REWRITE_TAC[SUBSET_REAL_INTERVAL; REAL_INTERVAL_EQ_EMPTY] THEN
13318     ASM_REAL_ARITH_TAC));;
13319
13320 let HAS_BOUNDED_REAL_VARIATION_COUNTABLE_DISCONTINUITIES = prove
13321  (`!f a b. f has_bounded_real_variation_on real_interval[a,b]
13322            ==> COUNTABLE {x | x IN real_interval[a,b] /\
13323                               ~(f real_continuous atreal x)}`,
13324   REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN
13325   REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS_ATREAL] THEN
13326   REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN DISCH_THEN(MP_TAC o
13327     MATCH_MP HAS_BOUNDED_VARIATION_COUNTABLE_DISCONTINUITIES) THEN
13328   DISCH_THEN(MP_TAC o ISPEC `drop` o MATCH_MP COUNTABLE_IMAGE) THEN
13329   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN
13330   REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_LIFT; LIFT_DROP; UNWIND_THM1] THEN
13331   REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IN_ELIM_THM] THEN
13332   REWRITE_TAC[EXISTS_IN_IMAGE; GSYM CONJ_ASSOC; EXISTS_DROP; LIFT_DROP] THEN
13333   MESON_TAC[LIFT_DROP]);;
13334
13335 (* ------------------------------------------------------------------------- *)
13336 (* Lebesgue density theorem. This isn't about R specifically, but it's most  *)
13337 (* naturally stated as a real limit so it ends up here in this file.         *)
13338 (* ------------------------------------------------------------------------- *)
13339
13340 let LEBESGUE_DENSITY_THEOREM = prove
13341  (`!s:real^N->bool.
13342       lebesgue_measurable s
13343       ==> ?k. negligible k /\
13344               !x. ~(x IN k)
13345                   ==> ((\e. measure(s INTER cball(x,e)) / measure(cball(x,e)))
13346                        ---> (if x IN s then &1 else &0))
13347                       (atreal(&0) within {e | &0 < e})`,
13348   REPEAT STRIP_TAC THEN MP_TAC (ISPEC
13349    `indicator(s:real^N->bool)` ABSOLUTELY_INTEGRABLE_LEBESGUE_POINTS) THEN
13350   ANTS_TAC THENL
13351    [REPEAT GEN_TAC THEN REWRITE_TAC[indicator] THEN
13352     MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN CONJ_TAC THENL
13353      [MESON_TAC[VEC_COMPONENT; REAL_POS]; ALL_TAC] THEN
13354     REWRITE_TAC[INTEGRABLE_RESTRICT_INTER] THEN
13355     ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN
13356     REWRITE_TAC[GSYM MEASURABLE_INTEGRABLE] THEN
13357     MATCH_MP_TAC MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE THEN
13358     ASM_REWRITE_TAC[MEASURABLE_INTERVAL];
13359     ALL_TAC] THEN
13360   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^N->bool` THEN
13361   STRIP_TAC THEN ASM_REWRITE_TAC[REALLIM_WITHINREAL; IN_ELIM_THM] THEN
13362   X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN
13363   STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
13364    [`x:real^N`; `e / &(dimindex(:N)) pow dimindex(:N)`]) THEN
13365   ASM_SIMP_TAC[REAL_LT_DIV; REAL_POW_LT;
13366                REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN
13367   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN
13368   ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN X_GEN_TAC `h:real` THEN STRIP_TAC THEN
13369   FIRST_X_ASSUM(MP_TAC o SPEC `h:real`) THEN
13370   ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
13371   SIMP_TAC[REAL_LT_RDIV_EQ;  REAL_POW_LT;
13372            REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN
13373   MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN
13374   ASM_SIMP_TAC[MEASURE_CBALL_POS; REAL_FIELD
13375    `&0 < y ==> x / y - a = inv(y) * (x - a * y)`] THEN
13376   REWRITE_TAC[REAL_ABS_MUL; NORM_MUL] THEN ONCE_REWRITE_TAC
13377    [REAL_ARITH `x <= (abs a * b) * c <=> x <= (abs(a) * c) * b`] THEN
13378   MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN
13379   CONJ_TAC THENL
13380    [SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_POW_LT;
13381              REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN
13382     REWRITE_TAC[REAL_ABS_INV; real_div; GSYM REAL_INV_MUL] THEN
13383     MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL
13384      [REWRITE_TAC[GSYM REAL_ABS_NZ; CONTENT_EQ_0] THEN
13385       REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT;
13386                   VECTOR_SUB_COMPONENT] THEN ASM_REAL_ARITH_TAC;
13387       SIMP_TAC[real_abs; CONTENT_POS_LE; MEASURE_POS_LE; MEASURABLE_CBALL] THEN
13388       MATCH_MP_TAC REAL_LE_TRANS THEN
13389       EXISTS_TAC `measure(interval[x - h / &(dimindex(:N)) % vec 1:real^N,
13390                                    x + h / &(dimindex(:N)) % vec 1]) *
13391                   &(dimindex (:N)) pow dimindex (:N)` THEN
13392       CONJ_TAC THENL
13393        [REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN
13394         REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT;
13395                     VECTOR_SUB_COMPONENT; REAL_MUL_RID] THEN
13396         ASM_SIMP_TAC[REAL_ARITH `x - h <= x + h <=> &0 <= h`;
13397                      REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE] THEN
13398         REWRITE_TAC[REAL_ARITH `(x + h) - (x - h) = &2 * h`;
13399                     PRODUCT_CONST_NUMSEG_1; REAL_POW_DIV; REAL_POW_MUL] THEN
13400         MATCH_MP_TAC(REAL_ARITH `x = y ==> y <= x`) THEN
13401         REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN
13402         MATCH_MP_TAC REAL_DIV_RMUL THEN
13403         REWRITE_TAC[REAL_POW_EQ_0; REAL_OF_NUM_EQ; DIMINDEX_NONZERO];
13404         MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[REAL_POS; REAL_POW_LE] THEN
13405         MATCH_MP_TAC MEASURE_SUBSET THEN
13406         REWRITE_TAC[MEASURABLE_INTERVAL; MEASURABLE_CBALL] THEN
13407         REWRITE_TAC[SUBSET; IN_INTERVAL; IN_CBALL] THEN
13408         X_GEN_TAC `y:real^N` THEN
13409         REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT;
13410                     VECTOR_SUB_COMPONENT; REAL_MUL_RID; REAL_ARITH
13411                      `x - h <= y /\ y <= x + h <=> abs(x - y) <= h`] THEN
13412         STRIP_TAC THEN REWRITE_TAC[dist] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
13413         EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((x - y:real^N)$i))` THEN
13414         REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_GEN THEN
13415         ASM_REWRITE_TAC[CARD_NUMSEG_1; VECTOR_SUB_COMPONENT; IN_NUMSEG] THEN
13416         REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1]]];
13417     REWRITE_TAC[NORM_REAL; GSYM drop] THEN
13418     MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= abs y`) THEN
13419     MATCH_MP_TAC REAL_LE_TRANS THEN
13420     EXISTS_TAC `drop(integral (cball(x:real^N,h))
13421                    (\t. lift(norm(indicator s t - indicator s x))))` THEN
13422     CONJ_TAC THENL
13423      [ASM_SIMP_TAC[MEASURE_INTEGRAL; MEASURABLE_CBALL;
13424                    MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE] THEN
13425       REWRITE_TAC[GSYM INTEGRAL_RESTRICT_INTER; GSYM DROP_CMUL] THEN
13426       SIMP_TAC[GSYM INTEGRAL_CMUL; GSYM MEASURABLE; MEASURABLE_CBALL] THEN
13427       REWRITE_TAC[GSYM DROP_SUB; COND_RATOR; COND_RAND] THEN
13428       REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID] THEN
13429       ASM_SIMP_TAC[GSYM INTEGRAL_SUB; INTEGRABLE_RESTRICT_INTER;
13430                    GSYM MEASURABLE; MEASURABLE_CBALL; INTEGRABLE_ON_CONST;
13431                    MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE] THEN
13432       REWRITE_TAC[GSYM NORM_REAL; drop] THEN REWRITE_TAC[GSYM drop] THEN
13433       MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN
13434       ASM_SIMP_TAC[INTEGRABLE_SUB; INTEGRABLE_RESTRICT_INTER;
13435                    GSYM MEASURABLE; MEASURABLE_CBALL; INTEGRABLE_ON_CONST;
13436                    MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE] THEN
13437       CONJ_TAC THENL
13438        [ALL_TAC;
13439         GEN_TAC THEN DISCH_TAC THEN
13440         REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[indicator]) THEN
13441         REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP; DROP_VEC] THEN
13442         REAL_ARITH_TAC];
13443       REWRITE_TAC[NORM_REAL; GSYM drop; LIFT_DROP] THEN
13444       MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN
13445       REPEAT CONJ_TAC THENL
13446        [REWRITE_TAC[SUBSET; IN_CBALL; IN_INTERVAL] THEN
13447         REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT;
13448                     VECTOR_SUB_COMPONENT; REAL_MUL_RID; REAL_ARITH
13449                        `x - h <= y /\ y <= x + h <=> abs(x - y) <= h`] THEN
13450         REWRITE_TAC[dist; GSYM VECTOR_SUB_COMPONENT] THEN
13451         MESON_TAC[REAL_LE_TRANS; COMPONENT_LE_NORM];
13452         ALL_TAC;
13453         ALL_TAC;
13454         REWRITE_TAC[LIFT_DROP; REAL_ABS_POS]]]] THEN
13455   REWRITE_TAC[GSYM NORM_REAL; drop] THEN
13456   MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN
13457   MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN
13458   MATCH_MP_TAC(INST_TYPE [`:1`,`:P`]
13459     ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND) THEN
13460   EXISTS_TAC `(\x. vec 1):real^N->real^1` THEN
13461
13462   REWRITE_TAC[DROP_VEC; GSYM MEASURABLE; MEASURABLE_INTERVAL;
13463               MEASURABLE_CBALL] THEN
13464   (CONJ_TAC THENL
13465     [GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[indicator] THEN
13466      REPEAT(COND_CASES_TAC THEN
13467             ASM_REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; DROP_VEC]) THEN
13468      CONV_TAC REAL_RAT_REDUCE_CONV;
13469      ALL_TAC]) THEN
13470   MATCH_MP_TAC INTEGRABLE_SUB THEN
13471   REWRITE_TAC[INTEGRABLE_ON_CONST; MEASURABLE_INTERVAL; MEASURABLE_CBALL] THEN
13472   REWRITE_TAC[indicator; INTEGRABLE_RESTRICT_INTER] THEN
13473   REWRITE_TAC[GSYM MEASURABLE] THEN
13474   ASM_SIMP_TAC[MEASURABLE_CBALL; MEASURABLE_INTERVAL;
13475                MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE]);;
13476
13477 (* ------------------------------------------------------------------------- *)
13478 (* Injective map into R is also an open map w.r.t. the universe, and this    *)
13479 (* is actually an implication in both directions for an interval. Compare    *)
13480 (* the local form in INJECTIVE_INTO_1D_IMP_OPEN_MAP (not a bi-implication).  *)
13481 (* ------------------------------------------------------------------------- *)
13482
13483 let INJECTIVE_EQ_1D_OPEN_MAP_UNIV = prove
13484  (`!f:real^1->real^1 s.
13485         f continuous_on s /\ is_interval s
13486         ==>  ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=>
13487               (!t. open t /\ t SUBSET s ==> open(IMAGE f t)))`,
13488   REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL
13489    [ONCE_REWRITE_TAC[OPEN_SUBOPEN] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN
13490     X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN
13491     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
13492     DISCH_THEN(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[] THEN
13493     REWRITE_TAC[BALL_1] THEN
13494     DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
13495     EXISTS_TAC `IMAGE (f:real^1->real^1)
13496                       (segment (x - lift d,x + lift d))` THEN
13497     MP_TAC(ISPECL
13498      [`f:real^1->real^1`; `x - lift d`; `x + lift d`]
13499      CONTINUOUS_INJECTIVE_IMAGE_OPEN_SEGMENT_1) THEN
13500     REWRITE_TAC[SEGMENT_1; DROP_ADD; DROP_SUB; LIFT_DROP] THEN
13501     ASM_CASES_TAC `drop x - d <= drop x + d` THENL
13502      [ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM SEGMENT_1];
13503       ASM_REAL_ARITH_TAC] THEN
13504     ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN
13505     REPEAT STRIP_TAC THENL
13506      [ASM_REWRITE_TAC[OPEN_SEGMENT_1];
13507       MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1] THEN
13508       REWRITE_TAC[DROP_ADD; DROP_SUB; LIFT_DROP] THEN ASM_REAL_ARITH_TAC;
13509       MATCH_MP_TAC IMAGE_SUBSET THEN
13510       ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET_TRANS]];
13511     MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN
13512     MP_TAC(ISPECL [`f:real^1->real^1`; `x:real^1`; `y:real^1`]
13513         CONTINUOUS_IVT_LOCAL_EXTREMUM) THEN
13514     ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
13515      [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT_EQ; IS_INTERVAL_CONVEX_1;
13516                     CONTINUOUS_ON_SUBSET];
13517       DISCH_THEN(X_CHOOSE_TAC `z:real^1`) THEN
13518       FIRST_ASSUM(MP_TAC o SPEC `segment(x:real^1,y)`) THEN
13519       REWRITE_TAC[OPEN_SEGMENT_1; NOT_IMP] THEN CONJ_TAC THENL
13520        [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; IS_INTERVAL_CONVEX_1;
13521                       SUBSET_TRANS; SEGMENT_OPEN_SUBSET_CLOSED];
13522         FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC) THEN
13523         REWRITE_TAC[open_def; FORALL_IN_IMAGE] THEN
13524         DISCH_THEN(MP_TAC o SPEC `z:real^1`) THEN ASM_REWRITE_TAC[] THEN
13525         DISCH_THEN(X_CHOOSE_THEN `e:real`
13526          (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
13527         FIRST_X_ASSUM DISJ_CASES_TAC THENL
13528          [DISCH_THEN(MP_TAC o SPEC `(f:real^1->real^1) z + lift(e / &2)`);
13529           DISCH_THEN(MP_TAC o SPEC `(f:real^1->real^1) z - lift(e / &2)`)] THEN
13530         ASM_REWRITE_TAC[NORM_ARITH `dist(a + b:real^N,a) = norm b`;
13531                         NORM_ARITH `dist(a - b:real^N,a) = norm b`; NORM_LIFT;
13532                         REAL_ARITH `abs(e / &2) < e <=> &0 < e`] THEN
13533         REWRITE_TAC[IN_IMAGE] THEN
13534         DISCH_THEN(X_CHOOSE_THEN `w:real^1` (STRIP_ASSUME_TAC o GSYM)) THEN
13535         FIRST_X_ASSUM(MP_TAC o SPEC `w:real^1`) THEN
13536         ASM_SIMP_TAC[REWRITE_RULE[SUBSET] SEGMENT_OPEN_SUBSET_CLOSED] THEN
13537         REWRITE_TAC[DROP_ADD; DROP_SUB; LIFT_DROP] THEN
13538         ASM_REAL_ARITH_TAC]]]);;
13539
13540 (* ------------------------------------------------------------------------- *)
13541 (* Map f:S^m->S^n for m < n is nullhomotopic.                                *)
13542 (* ------------------------------------------------------------------------- *)
13543
13544 let INESSENTIAL_SPHEREMAP_LOWDIM_GEN = prove
13545  (`!f:real^M->real^N s t.
13546      convex s /\ bounded s /\ convex t /\ bounded t /\ aff_dim s < aff_dim t /\
13547      f continuous_on relative_frontier s /\
13548      IMAGE f (relative_frontier s) SUBSET (relative_frontier t)
13549      ==> ?c. homotopic_with (\z. T)
13550                 (relative_frontier s,relative_frontier t) f (\x. c)`,
13551   let lemma1 = prove
13552    (`!f:real^N->real^N s t.
13553         subspace s /\ subspace t /\ dim s < dim t /\ s SUBSET t /\
13554         f differentiable_on sphere(vec 0,&1) INTER s
13555         ==> ~(IMAGE f (sphere(vec 0,&1) INTER s) = sphere(vec 0,&1) INTER t)`,
13556     REPEAT STRIP_TAC THEN
13557     ABBREV_TAC
13558      `(g:real^N->real^N) =
13559       \x. norm(x) % (f:real^N->real^N)(inv(norm x) % x)` THEN
13560     SUBGOAL_THEN
13561      `(g:real^N->real^N) differentiable_on s DELETE (vec 0)`
13562     ASSUME_TAC THENL
13563      [EXPAND_TAC "g" THEN MATCH_MP_TAC DIFFERENTIABLE_ON_MUL THEN
13564       SIMP_TAC[o_DEF; DIFFERENTIABLE_ON_NORM; IN_DELETE] THEN
13565       GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
13566       MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN CONJ_TAC THENL
13567        [MATCH_MP_TAC DIFFERENTIABLE_ON_MUL THEN
13568         REWRITE_TAC[DIFFERENTIABLE_ON_ID] THEN
13569         SUBGOAL_THEN
13570          `lift o (\x:real^N. inv(norm x)) =
13571           (lift o inv o drop) o (\x. lift(norm x))`
13572         SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN
13573         MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN
13574         SIMP_TAC[DIFFERENTIABLE_ON_NORM; IN_DELETE] THEN
13575         MATCH_MP_TAC DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON THEN
13576         SIMP_TAC[FORALL_IN_IMAGE; IN_DELETE; GSYM REAL_DIFFERENTIABLE_AT] THEN
13577         REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN
13578         MATCH_MP_TAC REAL_DIFFERENTIABLE_INV_ATREAL THEN
13579         ASM_REWRITE_TAC[REAL_DIFFERENTIABLE_ID; NORM_EQ_0];
13580         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
13581             DIFFERENTIABLE_ON_SUBSET)) THEN
13582         ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; IN_INTER;
13583                      SUBSPACE_MUL; NORM_MUL; IN_DELETE] THEN
13584         SIMP_TAC[REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0]];
13585       ALL_TAC] THEN
13586     SUBGOAL_THEN
13587      `IMAGE (g:real^N->real^N) (s DELETE vec 0) = t DELETE (vec 0)`
13588     ASSUME_TAC THENL
13589      [UNDISCH_TAC `IMAGE (f:real^N->real^N) (sphere (vec 0,&1) INTER s) =
13590                    sphere (vec 0,&1) INTER t` THEN
13591       REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN
13592       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE;
13593                   IN_INTER; IN_SPHERE_0] THEN
13594       EXPAND_TAC "g" THEN REWRITE_TAC[IN_IMAGE; IN_INTER; IN_SPHERE_0] THEN
13595       SIMP_TAC[IN_DELETE; VECTOR_MUL_EQ_0; NORM_EQ_0] THEN
13596       MATCH_MP_TAC(TAUT
13597        `(p ==> r) /\ (p ==> q ==> s) ==> p /\ q ==> r /\ s`) THEN
13598       CONJ_TAC THENL [ALL_TAC; DISCH_TAC] THEN
13599       DISCH_THEN(fun th -> X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
13600         MP_TAC(SPEC `inv(norm x) % x:real^N` th)) THEN
13601       ASM_SIMP_TAC[SUBSPACE_MUL; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM;
13602                    REAL_MUL_LINV; NORM_EQ_0;
13603                    NORM_ARITH `norm x = &1 ==> ~(x:real^N = vec 0)`] THEN
13604       DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN
13605       EXISTS_TAC `norm(x:real^N) % y:real^N` THEN
13606       ASM_SIMP_TAC[SUBSPACE_MUL; NORM_MUL; REAL_ABS_NORM; REAL_MUL_RID] THEN
13607       ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; NORM_EQ_0] THEN
13608       ASM_REWRITE_TAC[VECTOR_MUL_LID; VECTOR_MUL_EQ_0; NORM_EQ_0] THEN
13609       ASM_SIMP_TAC[NORM_ARITH `norm x = &1 ==> ~(x:real^N = vec 0)`] THEN
13610       UNDISCH_THEN `inv(norm x) % x = (f:real^N->real^N) y`
13611        (SUBST1_TAC o SYM) THEN
13612       ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; NORM_EQ_0] THEN
13613       REWRITE_TAC[VECTOR_MUL_LID];
13614       ALL_TAC] THEN
13615     MP_TAC(ISPECL [`t:real^N->bool`; `(:real^N)`]
13616           DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS) THEN
13617     ASM_REWRITE_TAC[SUBSPACE_UNIV; DIM_UNIV; IN_UNIV; SUBSET_UNIV] THEN
13618     ABBREV_TAC `t' = {y:real^N | !x. x IN t ==> orthogonal x y}` THEN
13619     DISCH_TAC THEN
13620     SUBGOAL_THEN `subspace(t':real^N->bool)` ASSUME_TAC THENL
13621      [EXPAND_TAC "t'" THEN REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTORS];
13622       ALL_TAC] THEN
13623     SUBGOAL_THEN
13624      `?fst snd. linear fst /\ linear snd /\
13625                 (!z. fst(z) IN t /\ snd z IN t' /\ fst z + snd z = z) /\
13626                 (!x y:real^N. x IN t /\ y IN t'
13627                               ==> fst(x + y) = x /\ snd(x + y) = y)`
13628     STRIP_ASSUME_TAC THENL
13629      [MP_TAC(ISPEC `t:real^N->bool` ORTHOGONAL_SUBSPACE_DECOMP_EXISTS) THEN
13630       REWRITE_TAC[SKOLEM_THM] THEN
13631       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `fst:real^N->real^N` THEN
13632       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `snd:real^N->real^N` THEN
13633       DISCH_THEN(MP_TAC o GSYM) THEN
13634       ASM_SIMP_TAC[SPAN_OF_SUBSPACE; FORALL_AND_THM] THEN STRIP_TAC THEN
13635       MATCH_MP_TAC(TAUT `r /\ (r ==> p /\ q /\ s) ==> p /\ q /\ r /\ s`) THEN
13636       CONJ_TAC THENL
13637        [EXPAND_TAC "t'" THEN REWRITE_TAC[IN_ELIM_THM] THEN
13638         ASM_MESON_TAC[ORTHOGONAL_SYM];
13639         DISCH_TAC] THEN
13640       MATCH_MP_TAC(TAUT `r /\ (r ==> p /\ q) ==> p /\ q /\ r`) THEN
13641       CONJ_TAC THENL
13642        [REPEAT GEN_TAC THEN STRIP_TAC THEN
13643         MATCH_MP_TAC ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE THEN
13644         MAP_EVERY EXISTS_TAC [`t:real^N->bool`; `t':real^N->bool`] THEN
13645         ASM_SIMP_TAC[SPAN_OF_SUBSPACE] THEN ASM SET_TAC[];
13646         DISCH_TAC] THEN
13647       REWRITE_TAC[linear] THEN
13648       MATCH_MP_TAC(TAUT `(p /\ r) /\ (q /\ s) ==> (p /\ q) /\ (r /\ s)`) THEN
13649       REWRITE_TAC[AND_FORALL_THM] THEN CONJ_TAC THEN REPEAT GEN_TAC THEN
13650       MATCH_MP_TAC ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE THEN
13651       MAP_EVERY EXISTS_TAC [`t:real^N->bool`; `t':real^N->bool`] THEN
13652       ASM_SIMP_TAC[SPAN_OF_SUBSPACE; SUBSPACE_ADD; SUBSPACE_MUL] THEN
13653       (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
13654       ASM_REWRITE_TAC[GSYM VECTOR_ADD_LDISTRIB] THEN
13655       ONCE_REWRITE_TAC[VECTOR_ARITH
13656        `(x + y) + (x' + y'):real^N = (x + x') + (y + y')`] THEN
13657       ASM_REWRITE_TAC[];
13658       ALL_TAC] THEN
13659     MP_TAC(ISPECL
13660      [`\x:real^N. (g:real^N->real^N)(fst x) + snd x`;
13661       `{x + y:real^N | x IN (s DELETE vec 0) /\ y IN t'}`]
13662         NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE) THEN
13663     REWRITE_TAC[LE_REFL; NOT_IMP] THEN REPEAT CONJ_TAC THENL
13664      [MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN
13665       MP_TAC(ISPECL [`s:real^N->bool`; `t':real^N->bool`] DIM_SUMS_INTER) THEN
13666       ASM_REWRITE_TAC[IN_DELETE] THEN
13667       FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE
13668        `t' + t = n ==> s < t /\ d' <= d /\ i = 0
13669            ==> d + i = s + t' ==> d' < n`)) THEN
13670       ASM_REWRITE_TAC[DIM_EQ_0] THEN CONJ_TAC THENL
13671        [MATCH_MP_TAC DIM_SUBSET THEN SET_TAC[]; EXPAND_TAC "t'"] THEN
13672       REWRITE_TAC[SUBSET; IN_INTER; IN_SING; IN_ELIM_THM] THEN
13673       ASM_MESON_TAC[SUBSET; ORTHOGONAL_REFL];
13674       MATCH_MP_TAC DIFFERENTIABLE_ON_ADD THEN
13675       ASM_SIMP_TAC[DIFFERENTIABLE_ON_LINEAR] THEN
13676       GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
13677       MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN
13678       ASM_SIMP_TAC[DIFFERENTIABLE_ON_LINEAR] THEN
13679       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
13680         DIFFERENTIABLE_ON_SUBSET)) THEN
13681       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN
13682       RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[IN_DELETE];
13683       SUBGOAL_THEN
13684        `~negligible {x + y | x IN IMAGE (g:real^N->real^N) (s DELETE vec 0) /\
13685                              y IN t'}`
13686       MP_TAC THENL
13687        [ASM_REWRITE_TAC[] THEN
13688         SUBGOAL_THEN `negligible(t':real^N->bool)` MP_TAC THENL
13689          [MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN ASM_ARITH_TAC;
13690           REWRITE_TAC[TAUT `p ==> ~q <=> ~(p /\ q)`]] THEN
13691         REWRITE_TAC[GSYM NEGLIGIBLE_UNION_EQ] THEN
13692         MP_TAC NOT_NEGLIGIBLE_UNIV THEN MATCH_MP_TAC EQ_IMP THEN
13693         AP_TERM_TAC THEN AP_TERM_TAC THEN
13694         REWRITE_TAC[EXTENSION; IN_UNION; IN_UNIV; IN_ELIM_THM; IN_DELETE] THEN
13695         X_GEN_TAC `z:real^N` THEN
13696         REWRITE_TAC[TAUT `p \/ q <=> ~p ==> q`] THEN DISCH_TAC THEN
13697         EXISTS_TAC `(fst:real^N->real^N) z` THEN
13698         EXISTS_TAC `(snd:real^N->real^N) z` THEN
13699         ASM_SIMP_TAC[] THEN ASM_MESON_TAC[VECTOR_ADD_LID];
13700         REWRITE_TAC[CONTRAPOS_THM] THEN
13701         MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN
13702         REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM;
13703                     FORALL_IN_IMAGE; IN_DELETE] THEN
13704         X_GEN_TAC `x:real^N` THEN REPEAT DISCH_TAC THEN
13705         X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
13706         REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `x + y:real^N` THEN
13707         RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[] THEN ASM
13708         SET_TAC[]]]) in
13709   let lemma2 = prove
13710    (`!f:real^N->real^N s t.
13711           subspace s /\ subspace t /\ dim s < dim t /\ s SUBSET t /\
13712           f continuous_on sphere(vec 0,&1) INTER s /\
13713           IMAGE f (sphere(vec 0,&1) INTER s) SUBSET sphere(vec 0,&1) INTER t
13714           ==> ?c. homotopic_with (\x. T)
13715                           (sphere(vec 0,&1) INTER s,sphere(vec 0,&1) INTER t)
13716                           f (\x. c)`,
13717     REPEAT STRIP_TAC THEN
13718     MP_TAC(ISPECL [`f:real^N->real^N`; `sphere(vec 0:real^N,&1) INTER s`;
13719                    `&1 / &2`; `t:real^N->bool`;]
13720           STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION_SUBSPACE) THEN
13721     CONV_TAC REAL_RAT_REDUCE_CONV THEN
13722     ASM_SIMP_TAC[COMPACT_INTER_CLOSED; COMPACT_SPHERE; CLOSED_SUBSPACE] THEN
13723     ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE]] THEN
13724     DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC) THEN
13725     SUBGOAL_THEN
13726      `!x. x IN sphere(vec 0,&1) INTER s ==> ~((g:real^N->real^N) x = vec 0)`
13727     ASSUME_TAC THENL
13728      [X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN
13729       FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
13730       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
13731       REWRITE_TAC[FORALL_IN_IMAGE; IN_SPHERE_0] THEN
13732       RULE_ASSUM_TAC(REWRITE_RULE[IN_SPHERE_0]) THEN
13733       DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
13734       ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_INTER; IN_SPHERE_0] THEN
13735       CONV_TAC NORM_ARITH;
13736       ALL_TAC] THEN
13737     SUBGOAL_THEN `(g:real^N->real^N) differentiable_on
13738                   sphere(vec 0,&1) INTER s`
13739     ASSUME_TAC THENL
13740      [ASM_SIMP_TAC[DIFFERENTIABLE_ON_VECTOR_POLYNOMIAL_FUNCTION]; ALL_TAC] THEN
13741     ABBREV_TAC `(h:real^N->real^N) = \x. inv(norm(g x)) % g x` THEN
13742     SUBGOAL_THEN
13743      `!x. x IN sphere(vec 0,&1) INTER s
13744           ==> (h:real^N->real^N) x IN sphere(vec 0,&1) INTER t`
13745     ASSUME_TAC THENL
13746      [REPEAT STRIP_TAC THEN EXPAND_TAC "h" THEN
13747       ASM_SIMP_TAC[SUBSPACE_MUL; IN_INTER; IN_SPHERE_0; NORM_MUL] THEN
13748       REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NORM] THEN
13749       ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0; GSYM IN_SPHERE_0];
13750       ALL_TAC] THEN
13751     SUBGOAL_THEN
13752      `(h:real^N->real^N) differentiable_on sphere(vec 0,&1) INTER s`
13753     ASSUME_TAC THENL
13754      [EXPAND_TAC "h" THEN MATCH_MP_TAC DIFFERENTIABLE_ON_MUL THEN
13755       ASM_SIMP_TAC[DIFFERENTIABLE_ON_VECTOR_POLYNOMIAL_FUNCTION; o_DEF] THEN
13756       SUBGOAL_THEN
13757        `(\x. lift(inv(norm((g:real^N->real^N) x)))) =
13758         (lift o inv o drop) o (\x. lift(norm x)) o (g:real^N->real^N)`
13759       SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN
13760       MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN CONJ_TAC THENL
13761        [MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN
13762         ASM_SIMP_TAC[DIFFERENTIABLE_ON_VECTOR_POLYNOMIAL_FUNCTION] THEN
13763         MATCH_MP_TAC DIFFERENTIABLE_ON_NORM THEN
13764         ASM_REWRITE_TAC[SET_RULE
13765          `~(z IN IMAGE f s) <=> !x. x IN s ==> ~(f x = z)`];
13766         MATCH_MP_TAC DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON THEN
13767         REWRITE_TAC[GSYM REAL_DIFFERENTIABLE_AT] THEN
13768         REWRITE_TAC[FORALL_IN_IMAGE; IN_SPHERE_0] THEN
13769         X_GEN_TAC `x:real^N` THEN
13770         ASM_CASES_TAC `x:real^N = vec 0` THEN
13771         ASM_REWRITE_TAC[NORM_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN DISCH_TAC THEN
13772         REWRITE_TAC[GSYM REAL_DIFFERENTIABLE_AT; o_THM] THEN
13773         GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN
13774         MATCH_MP_TAC REAL_DIFFERENTIABLE_INV_ATREAL THEN
13775         ASM_SIMP_TAC[REAL_DIFFERENTIABLE_ID; NORM_EQ_0; IN_SPHERE_0]];
13776       ALL_TAC] THEN
13777     SUBGOAL_THEN
13778      `?c. homotopic_with (\z. T)
13779              (sphere(vec 0,&1) INTER s,sphere(vec 0,&1) INTER t)
13780              (h:real^N->real^N) (\x. c)`
13781     MP_TAC THENL
13782      [ALL_TAC;
13783       MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
13784       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_TRANS) THEN
13785       SUBGOAL_THEN
13786        `homotopic_with (\z. T)
13787                        (sphere(vec 0:real^N,&1) INTER s,t DELETE (vec 0:real^N))
13788                        f g`
13789       MP_TAC THENL
13790        [MATCH_MP_TAC HOMOTOPIC_WITH_LINEAR THEN
13791         ASM_SIMP_TAC[CONTINUOUS_ON_VECTOR_POLYNOMIAL_FUNCTION] THEN
13792         X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[SET_RULE
13793           `s SUBSET t DELETE v <=> s SUBSET t /\ ~(v IN s)`] THEN
13794         CONJ_TAC THENL
13795          [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
13796           ASM_SIMP_TAC[SUBSPACE_IMP_CONVEX] THEN ASM SET_TAC[];
13797           DISCH_THEN(MP_TAC o MATCH_MP SEGMENT_BOUND) THEN
13798           SUBGOAL_THEN
13799            `(f:real^N->real^N) x IN sphere(vec 0,&1) /\
13800             norm(f x - g x) < &1/ &2`
13801           MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
13802           REWRITE_TAC[IN_SPHERE_0] THEN CONV_TAC NORM_ARITH];
13803         DISCH_THEN(MP_TAC o
13804           ISPECL [`\y:real^N. inv(norm y) % y`;
13805                   `sphere(vec 0:real^N,&1) INTER t`] o
13806           MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
13807           HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN
13808         ASM_REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL
13809          [CONJ_TAC THENL
13810            [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
13811             REWRITE_TAC[o_DEF; CONTINUOUS_ON_ID] THEN
13812             MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
13813             SIMP_TAC[IN_DELETE; NORM_EQ_0] THEN
13814             REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_NORM];
13815             REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE; IN_INTER] THEN
13816             ASM_SIMP_TAC[SUBSPACE_MUL; IN_SPHERE_0; NORM_MUL; REAL_ABS_MUL] THEN
13817             SIMP_TAC[REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0]];
13818           MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN
13819           RULE_ASSUM_TAC(REWRITE_RULE
13820            [SUBSET; IN_INTER; FORALL_IN_IMAGE; IN_SPHERE_0]) THEN
13821           ASM_SIMP_TAC[IN_SPHERE_0; IN_INTER;
13822                        REAL_INV_1; VECTOR_MUL_LID]]]] THEN
13823     SUBGOAL_THEN
13824      `?c. c IN (sphere(vec 0,&1) INTER t) DIFF
13825                (IMAGE (h:real^N->real^N) (sphere(vec 0,&1) INTER s))`
13826     MP_TAC THENL
13827      [MATCH_MP_TAC(SET_RULE
13828        `t SUBSET s /\ ~(t = s) ==> ?a. a IN s DIFF t`) THEN
13829       CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC lemma1] THEN
13830       ASM_REWRITE_TAC[];
13831       REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_INTER; IN_DIFF; IN_IMAGE] THEN
13832       REWRITE_TAC[SET_RULE
13833        `~(?x. P x /\ x IN s /\ x IN t) <=>
13834         (!x. x IN s INTER t ==> ~(P x))`] THEN
13835       X_GEN_TAC `c:real^N` THEN STRIP_TAC] THEN
13836     EXISTS_TAC `--c:real^N` THEN
13837     SUBGOAL_THEN
13838      `homotopic_with (\z. T)
13839                      (sphere(vec 0:real^N,&1) INTER s,t DELETE (vec 0:real^N))
13840                      h (\x. --c)`
13841     MP_TAC THENL
13842      [MATCH_MP_TAC HOMOTOPIC_WITH_LINEAR THEN
13843       ASM_SIMP_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_ON; CONTINUOUS_ON_CONST] THEN
13844       X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[SET_RULE
13845         `s SUBSET t DELETE v <=> s SUBSET t /\ ~(v IN s)`] THEN
13846       CONJ_TAC THENL
13847        [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN
13848         ASM_SIMP_TAC[SUBSPACE_IMP_CONVEX; INSERT_SUBSET; SUBSPACE_NEG] THEN
13849         ASM SET_TAC[];
13850         DISCH_TAC THEN MP_TAC(ISPECL
13851          [`(h:real^N->real^N) x`; `vec 0:real^N`; `--c:real^N`]
13852          MIDPOINT_BETWEEN) THEN
13853         ASM_REWRITE_TAC[BETWEEN_IN_SEGMENT; DIST_0; NORM_NEG] THEN
13854         SUBGOAL_THEN `((h:real^N->real^N) x) IN sphere(vec 0,&1) /\
13855                       (c:real^N) IN sphere(vec 0,&1)`
13856         MP_TAC THENL [ASM SET_TAC[]; SIMP_TAC[IN_SPHERE_0]] THEN
13857         STRIP_TAC THEN REWRITE_TAC[midpoint; VECTOR_ARITH
13858          `vec 0:real^N = inv(&2) % (x + --y) <=> x = y`] THEN
13859         ASM SET_TAC[]];
13860       DISCH_THEN(MP_TAC o
13861         ISPECL [`\y:real^N. inv(norm y) % y`;
13862                 `sphere(vec 0:real^N,&1) INTER t`] o
13863         MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
13864         HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN
13865       ASM_REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL
13866        [CONJ_TAC THENL
13867          [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN
13868           REWRITE_TAC[o_DEF; CONTINUOUS_ON_ID] THEN
13869           MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
13870           SIMP_TAC[IN_DELETE; NORM_EQ_0] THEN
13871           REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_NORM];
13872           REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE; IN_INTER] THEN
13873           ASM_SIMP_TAC[SUBSPACE_MUL; IN_SPHERE_0; NORM_MUL; REAL_ABS_MUL] THEN
13874           SIMP_TAC[REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0]];
13875         MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN
13876         RULE_ASSUM_TAC(REWRITE_RULE
13877          [SUBSET; IN_INTER; FORALL_IN_IMAGE; IN_SPHERE_0]) THEN
13878         ASM_SIMP_TAC[IN_SPHERE_0; IN_INTER; REAL_INV_1; VECTOR_MUL_LID;
13879                      NORM_NEG]]]) in
13880   let lemma3 = prove
13881    (`!s:real^M->bool u:real^N->bool.
13882           bounded s /\ convex s /\ subspace u /\ aff_dim s <= &(dim u)
13883           ==> ?t. subspace t /\ t SUBSET u /\
13884                   (~(s = {}) ==> aff_dim t = aff_dim s) /\
13885                   (relative_frontier s) homeomorphic
13886                   (sphere(vec 0,&1) INTER t)`,
13887     REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL
13888      [STRIP_TAC THEN EXISTS_TAC `{vec 0:real^N}` THEN
13889       ASM_REWRITE_TAC[SUBSPACE_TRIVIAL; RELATIVE_FRONTIER_EMPTY] THEN
13890       ASM_SIMP_TAC[HOMEOMORPHIC_EMPTY;
13891                    SET_RULE `s INTER {a} = {} <=> ~(a IN s)`;
13892                    IN_SPHERE_0; NORM_0; SING_SUBSET; SUBSPACE_0] THEN
13893       CONV_TAC REAL_RAT_REDUCE_CONV;
13894       FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^M` MP_TAC o
13895           GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
13896       GEOM_ORIGIN_TAC `a:real^M` THEN
13897       SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; INT_OF_NUM_LE; GSYM DIM_UNIV] THEN
13898       REPEAT STRIP_TAC] THEN
13899     FIRST_ASSUM(MP_TAC o MATCH_MP CHOOSE_SUBSPACE_OF_SUBSPACE) THEN
13900     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN
13901     ASM_SIMP_TAC[SPAN_OF_SUBSPACE; AFF_DIM_DIM_SUBSPACE; INT_OF_NUM_EQ] THEN
13902     STRIP_TAC THEN
13903     TRANS_TAC HOMEOMORPHIC_TRANS
13904      `relative_frontier(ball(vec 0:real^N,&1) INTER t)` THEN
13905     CONJ_TAC THENL
13906      [MATCH_MP_TAC HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS THEN
13907       ASM_SIMP_TAC[CONVEX_INTER; BOUNDED_INTER; BOUNDED_BALL;
13908                    SUBSPACE_IMP_CONVEX; CONVEX_BALL] THEN
13909       ONCE_REWRITE_TAC[INTER_COMM] THEN
13910       FIRST_ASSUM(ASSUME_TAC o MATCH_MP SUBSPACE_0) THEN
13911       SUBGOAL_THEN `~(t INTER ball(vec 0:real^N,&1) = {})` ASSUME_TAC THENL
13912        [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `vec 0:real^N` THEN
13913         ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_LT_01];
13914         ASM_SIMP_TAC[AFF_DIM_CONVEX_INTER_OPEN; OPEN_BALL;
13915                      SUBSPACE_IMP_CONVEX] THEN
13916         ASM_SIMP_TAC[AFF_DIM_DIM_0; HULL_INC]];
13917       MATCH_MP_TAC(MESON[HOMEOMORPHIC_REFL] `s = t ==> s homeomorphic t`) THEN
13918       SIMP_TAC[GSYM FRONTIER_BALL; REAL_LT_01] THEN
13919       MATCH_MP_TAC RELATIVE_FRONTIER_CONVEX_INTER_AFFINE THEN
13920       ASM_SIMP_TAC[CONVEX_BALL; SUBSPACE_IMP_AFFINE;
13921                    GSYM MEMBER_NOT_EMPTY] THEN
13922       EXISTS_TAC `vec 0:real^N` THEN
13923       ASM_SIMP_TAC[CENTRE_IN_BALL; INTERIOR_OPEN; OPEN_BALL;
13924                    SUBSPACE_0; IN_INTER; REAL_LT_01]]) in
13925     ONCE_REWRITE_TAC[MESON[] `(!a b c. P a b c) <=> (!b c a. P a b c)`] THEN
13926     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
13927     REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
13928     REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN REPEAT GEN_TAC THEN
13929     ASM_CASES_TAC `s:real^M->bool = {}` THENL
13930      [ASM_SIMP_TAC[HOMOTOPIC_WITH; RELATIVE_FRONTIER_EMPTY; PCROSS_EMPTY;
13931                    NOT_IN_EMPTY; IMAGE_CLAUSES; CONTINUOUS_ON_EMPTY];
13932       ALL_TAC] THEN
13933     ASM_CASES_TAC `t:real^N->bool = {}` THEN
13934     ASM_SIMP_TAC[AFF_DIM_EMPTY; GSYM INT_NOT_LE; AFF_DIM_GE] THEN
13935     STRIP_TAC THEN
13936     MP_TAC(ISPECL [`t:real^N->bool`; `(:real^N)`] lemma3) THEN
13937     ASM_REWRITE_TAC[DIM_UNIV; SUBSPACE_UNIV; AFF_DIM_LE_UNIV] THEN
13938     DISCH_THEN(X_CHOOSE_THEN `t':real^N->bool` STRIP_ASSUME_TAC) THEN
13939     FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT) THEN
13940     DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP
13941       HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY_NULL th]) THEN
13942     MP_TAC(ISPECL [`s:real^M->bool`; `t':real^N->bool`] lemma3) THEN
13943     ASM_SIMP_TAC[GSYM AFF_DIM_DIM_SUBSPACE] THEN
13944     ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN
13945     DISCH_THEN(X_CHOOSE_THEN `s':real^N->bool` STRIP_ASSUME_TAC) THEN
13946     FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT) THEN
13947     DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP
13948       HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL th]) THEN
13949     REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma2 THEN
13950     ASM_SIMP_TAC[GSYM INT_OF_NUM_LT; GSYM AFF_DIM_DIM_SUBSPACE] THEN
13951     ASM_INT_ARITH_TAC);;
13952
13953 let INESSENTIAL_SPHEREMAP_LOWDIM = prove
13954  (`!f:real^M->real^N a r b s.
13955         dimindex(:M) < dimindex(:N) /\
13956         f continuous_on sphere(a,r) /\
13957         IMAGE f (sphere(a,r)) SUBSET (sphere(b,s))
13958         ==> ?c. homotopic_with (\z. T) (sphere(a,r),sphere(b,s)) f (\x. c)`,
13959   REPEAT GEN_TAC THEN ASM_CASES_TAC `s <= &0` THEN
13960   ASM_SIMP_TAC[NULLHOMOTOPIC_INTO_CONTRACTIBLE; CONTRACTIBLE_SPHERE] THEN
13961   ASM_CASES_TAC `r <= &0` THEN
13962   ASM_SIMP_TAC[NULLHOMOTOPIC_FROM_CONTRACTIBLE; CONTRACTIBLE_SPHERE] THEN
13963   ASM_SIMP_TAC[GSYM FRONTIER_CBALL; INTERIOR_CBALL; BALL_EQ_EMPTY;
13964                CONV_RULE(RAND_CONV SYM_CONV) (SPEC_ALL
13965                RELATIVE_FRONTIER_NONEMPTY_INTERIOR)] THEN
13966   STRIP_TAC THEN MATCH_MP_TAC INESSENTIAL_SPHEREMAP_LOWDIM_GEN THEN
13967   ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; AFF_DIM_CBALL] THEN
13968   ASM_REWRITE_TAC[GSYM REAL_NOT_LE; INT_OF_NUM_LT]);;
13969
13970 let HOMEOMORPHIC_SPHERES_EQ,HOMOTOPY_EQUIVALENT_SPHERES_EQ =
13971  (CONJ_PAIR o prove)
13972  (`(!a:real^M b:real^N r s.
13973         sphere(a,r) homeomorphic sphere(b,s) <=>
13974         r < &0 /\ s < &0 \/ r = &0 /\ s = &0 \/
13975         &0 < r /\ &0 < s /\ dimindex(:M) = dimindex(:N)) /\
13976    (!a:real^M b:real^N r s.
13977         sphere(a,r) homotopy_equivalent sphere(b,s) <=>
13978         r < &0 /\ s < &0 \/ r = &0 /\ s = &0 \/
13979         &0 < r /\ &0 < s /\ dimindex(:M) = dimindex(:N))`,
13980   let lemma = prove
13981    (`!a:real^M r b:real^N s.
13982           dimindex(:M) < dimindex(:N) /\ &0 < r /\ &0 < s
13983           ==> ~(sphere(a,r) homotopy_equivalent sphere(b,s))`,
13984     REPEAT STRIP_TAC THEN
13985     FIRST_ASSUM(MP_TAC o ISPEC `sphere(a:real^M,r)` o
13986         MATCH_MP HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY) THEN
13987     MATCH_MP_TAC(TAUT `~p /\ q ==> (p <=> q) ==> F`) THEN CONJ_TAC THENL
13988      [SUBGOAL_THEN `~(sphere(a:real^M,r) = {})` MP_TAC THENL
13989        [REWRITE_TAC[SPHERE_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC;
13990         REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM]] THEN
13991       X_GEN_TAC `c:real^M` THEN DISCH_TAC THEN
13992       DISCH_THEN(MP_TAC o SPECL[`\a:real^M. a`; `(\a. c):real^M->real^M`]) THEN
13993       SIMP_TAC[CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID;
13994                IMAGE_ID; SUBSET_REFL] THEN
13995       REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
13996       SUBGOAL_THEN `~(contractible(sphere(a:real^M,r)))` MP_TAC THENL
13997        [REWRITE_TAC[CONTRACTIBLE_SPHERE] THEN ASM_REAL_ARITH_TAC;
13998         REWRITE_TAC[contractible] THEN MESON_TAC[]];
13999       MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^M->real^N`] THEN
14000       STRIP_TAC THEN
14001       MP_TAC(ISPEC `g:real^M->real^N` INESSENTIAL_SPHEREMAP_LOWDIM) THEN
14002       MP_TAC(ISPEC `f:real^M->real^N` INESSENTIAL_SPHEREMAP_LOWDIM) THEN
14003       ASM_REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN DISCH_THEN
14004        (MP_TAC o SPECL [`a:real^M`; `r:real`; `b:real^N`; `s:real`]) THEN
14005       ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ; RIGHT_IMP_FORALL_THM] THEN
14006       REPEAT GEN_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN
14007        (fun th -> CONJUNCTS_THEN (ASSUME_TAC o MATCH_MP
14008                          HOMOTOPIC_WITH_IMP_SUBSET) th THEN
14009                   MP_TAC th) THEN
14010       MATCH_MP_TAC(MESON[HOMOTOPIC_WITH_TRANS; HOMOTOPIC_WITH_SYM]
14011           `homotopic_with p (s,t) c d
14012             ==> homotopic_with p (s,t) f c /\
14013                 homotopic_with p (s,t) g d
14014                 ==> homotopic_with p (s,t) f g`) THEN
14015       REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN DISJ2_TAC THEN
14016       MP_TAC(ISPECL [`b:real^N`; `s:real`] PATH_CONNECTED_SPHERE) THEN
14017       ANTS_TAC THENL
14018        [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE
14019          `m < n ==> 1 <= m ==> 2 <= n`)) THEN REWRITE_TAC[DIMINDEX_GE_1];
14020         REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
14021         DISCH_THEN MATCH_MP_TAC THEN
14022         SUBGOAL_THEN `~(sphere(a:real^M,r) = {})` MP_TAC THENL
14023          [REWRITE_TAC[SPHERE_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC;
14024           ASM SET_TAC[]]]]) in
14025   REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN
14026   MATCH_MP_TAC(TAUT
14027    `(r ==> p) /\ (q ==> r) /\ (p ==> q) ==> (r <=> q) /\ (p <=> q)`) THEN
14028   REWRITE_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT] THEN
14029   ASM_CASES_TAC `r < &0` THEN
14030   ASM_SIMP_TAC[SPHERE_EMPTY; SPHERE_EQ_EMPTY;
14031                HOMEOMORPHIC_EMPTY; HOMOTOPY_EQUIVALENT_EMPTY]
14032   THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
14033   ASM_CASES_TAC `s < &0` THEN
14034   ASM_SIMP_TAC[SPHERE_EMPTY; SPHERE_EQ_EMPTY;
14035                HOMEOMORPHIC_EMPTY; HOMOTOPY_EQUIVALENT_EMPTY]
14036   THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
14037   ASM_CASES_TAC `r = &0` THEN
14038   ASM_SIMP_TAC[SPHERE_SING; REAL_LT_REFL; HOMEOMORPHIC_SING;
14039                HOMOTOPY_EQUIVALENT_SING; CONTRACTIBLE_SPHERE;
14040                ONCE_REWRITE_RULE[HOMOTOPY_EQUIVALENT_SYM]
14041                    HOMOTOPY_EQUIVALENT_SING]
14042   THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
14043   ASM_CASES_TAC `s = &0` THEN
14044   ASM_SIMP_TAC[SPHERE_SING; REAL_LT_REFL; HOMEOMORPHIC_SING;
14045                HOMOTOPY_EQUIVALENT_SING; CONTRACTIBLE_SPHERE;
14046                ONCE_REWRITE_RULE[HOMOTOPY_EQUIVALENT_SYM]
14047                    HOMOTOPY_EQUIVALENT_SING]
14048   THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
14049   SUBGOAL_THEN `&0 < r /\ &0 < s` STRIP_ASSUME_TAC THENL
14050    [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN
14051   CONJ_TAC THENL
14052    [DISCH_THEN(fun th ->
14053       let t = `?a:real^M b:real^N. ~(sphere(a,r) homeomorphic sphere(b,s))` in
14054       MP_TAC(DISCH t (GEOM_EQUAL_DIMENSION_RULE th (ASSUME t)))) THEN
14055     ASM_SIMP_TAC[HOMEOMORPHIC_SPHERES] THEN MESON_TAC[];
14056     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
14057     REWRITE_TAC[ARITH_RULE `~(m:num = n) <=> m < n \/ n < m`] THEN
14058     STRIP_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[HOMOTOPY_EQUIVALENT_SYM]] THEN
14059     ASM_SIMP_TAC[lemma]]);;
14060
14061 (* ------------------------------------------------------------------------- *)
14062 (* Some technical lemmas about extending maps from cell complexes.           *)
14063 (* ------------------------------------------------------------------------- *)
14064
14065 let EXTEND_MAP_CELL_COMPLEX_TO_SPHERE,
14066     EXTEND_MAP_CELL_COMPLEX_TO_SPHERE_COFINITE = (CONJ_PAIR o prove)
14067  (`(!f:real^M->real^N m s t.
14068         FINITE m /\ (!c. c IN m ==> polytope c /\ aff_dim c < aff_dim t) /\
14069         (!c1 c2. c1 IN m /\ c2 IN m
14070                  ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2) /\
14071         s SUBSET UNIONS m /\ closed s /\ convex t /\ bounded t /\
14072         f continuous_on s /\ IMAGE f s SUBSET relative_frontier t
14073         ==> ?g. g continuous_on UNIONS m /\
14074                 IMAGE g (UNIONS m) SUBSET relative_frontier t /\
14075                 !x. x IN s ==> g x = f x) /\
14076    (!f:real^M->real^N m s t.
14077         FINITE m /\ (!c. c IN m ==> polytope c /\ aff_dim c <= aff_dim t) /\
14078         (!c1 c2. c1 IN m /\ c2 IN m
14079                  ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2) /\
14080         s SUBSET UNIONS m /\ closed s /\ convex t /\ bounded t /\
14081         f continuous_on s /\ IMAGE f s SUBSET relative_frontier t
14082         ==> ?k g. FINITE k /\ DISJOINT k s /\
14083                   g continuous_on (UNIONS m DIFF k) /\
14084                   IMAGE g (UNIONS m DIFF k) SUBSET relative_frontier t /\
14085                   !x. x IN s ==> g x = f x)`,
14086   let wemma = prove
14087    (`!h:real^M->real^N k t f.
14088           (!s. s IN f ==> ?g. g continuous_on s /\
14089                               IMAGE g s SUBSET t /\
14090                               !x. x IN s INTER k ==> g x = h x) /\
14091           FINITE f /\ (!s. s IN f ==> closed s) /\
14092           (!s t. s IN f /\ t IN f /\ ~(s = t) ==> (s INTER t) SUBSET k)
14093           ==> ?g. g continuous_on (UNIONS f) /\
14094                   IMAGE g (UNIONS f) SUBSET t /\
14095                   !x. x IN (UNIONS f) INTER k ==> g x = h x`,
14096     REPLICATE_TAC 3 GEN_TAC THEN
14097     ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> q ==> p /\ r ==> s`] THEN
14098     MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
14099     REWRITE_TAC[UNIONS_0; IMAGE_CLAUSES; EMPTY_SUBSET; CONTINUOUS_ON_EMPTY;
14100                 INTER_EMPTY; NOT_IN_EMPTY] THEN
14101     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_INSERT] THEN
14102     REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; SUBSET_REFL] THEN
14103     MAP_EVERY X_GEN_TAC [`s:real^M->bool`; `u:(real^M->bool)->bool`] THEN
14104     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC
14105      (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN
14106     ASM_SIMP_TAC[UNIONS_INSERT] THEN
14107     DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
14108     ASM_CASES_TAC `(s:real^M->bool) UNION UNIONS u = UNIONS u` THENL
14109      [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN
14110     FIRST_X_ASSUM(X_CHOOSE_THEN `f:real^M->real^N` STRIP_ASSUME_TAC) THEN
14111     EXISTS_TAC `\x. if x IN s then (f:real^M->real^N) x else g x` THEN
14112     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
14113     MATCH_MP_TAC CONTINUOUS_ON_CASES THEN ASM_SIMP_TAC[CLOSED_UNIONS] THEN
14114     ASM SET_TAC[]) in
14115   let lemma = prove
14116    (`!h:real^M->real^N k t f.
14117           (!s. s IN f ==> ?g. g continuous_on s /\
14118                               IMAGE g s SUBSET t /\
14119                               !x. x IN s INTER k ==> g x = h x) /\
14120           FINITE f /\ (!s. s IN f ==> closed s) /\
14121           (!s t. s IN f /\ t IN f /\ ~(s SUBSET t) /\ ~(t SUBSET s)
14122                  ==> (s INTER t) SUBSET k)
14123           ==> ?g. g continuous_on (UNIONS f) /\
14124                   IMAGE g (UNIONS f) SUBSET t /\
14125                   !x. x IN (UNIONS f) INTER k ==> g x = h x`,
14126     REPEAT STRIP_TAC THEN
14127     FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP UNIONS_MAXIMAL_SETS) THEN
14128     MATCH_MP_TAC wemma THEN
14129     ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM] THEN ASM SET_TAC[]) in
14130   let zemma = prove
14131    (`!f:real^M->real^N m n t.
14132           FINITE m /\ (!c. c IN m ==> polytope c) /\
14133           n SUBSET m /\ (!c. c IN m DIFF n ==> aff_dim c < aff_dim t) /\
14134           (!c1 c2. c1 IN m /\ c2 IN m
14135                    ==> (c1 INTER c2) face_of c1 /\ (c1 INTER c2) face_of c2) /\
14136           convex t /\ bounded t /\
14137           f continuous_on (UNIONS n) /\
14138           IMAGE f (UNIONS n) SUBSET relative_frontier t
14139           ==> ?g. g continuous_on (UNIONS m) /\
14140                   IMAGE g (UNIONS m) SUBSET relative_frontier t /\
14141                   (!x. x IN UNIONS n ==> g x = f x)`,
14142     REPEAT STRIP_TAC THEN
14143     ASM_CASES_TAC `m DIFF n:(real^M->bool)->bool = {}` THENL
14144      [SUBGOAL_THEN `(UNIONS m:real^M->bool) SUBSET UNIONS n` ASSUME_TAC THENL
14145        [ASM SET_TAC[]; EXISTS_TAC `f:real^M->real^N`] THEN
14146       REWRITE_TAC[] THEN CONJ_TAC THENL
14147        [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]];
14148       ALL_TAC] THEN
14149     SUBGOAL_THEN
14150      `!i. &i <= aff_dim t
14151           ==> ?g. g continuous_on
14152                   (UNIONS
14153                    (n UNION {d | ?c. c IN m /\ d face_of c /\
14154                                       aff_dim d < &i})) /\
14155                   IMAGE g (UNIONS
14156                    (n UNION {d | ?c. c IN m /\ d face_of c /\
14157                                       aff_dim d < &i}))
14158                   SUBSET relative_frontier t /\
14159                   (!x. x IN UNIONS n ==> g x = (f:real^M->real^N) x)`
14160     MP_TAC THENL
14161      [ALL_TAC;
14162       MP_TAC(ISPEC `aff_dim(t:real^N->bool)` INT_OF_NUM_EXISTS) THEN
14163       MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN
14164       CONJ_TAC THENL
14165        [ASM_MESON_TAC[AFF_DIM_GE; MEMBER_NOT_EMPTY;
14166                       INT_ARITH `--(&1):int <= s /\ s < t ==> &0 <= t`];
14167         ALL_TAC] THEN
14168       DISCH_THEN(X_CHOOSE_TAC `i:num`) THEN
14169       DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN
14170       SUBGOAL_THEN
14171        `UNIONS (n UNION {d | ?c. c IN m /\ d face_of c /\ aff_dim d < &i}) =
14172         UNIONS m:real^M->bool`
14173        (fun th -> REWRITE_TAC[th]) THEN
14174       FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
14175       MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
14176        [MATCH_MP_TAC UNIONS_MONO THEN REWRITE_TAC[IN_UNION] THEN
14177         REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN
14178         REWRITE_TAC[FORALL_AND_THM; FORALL_IN_GSPEC] THEN
14179         CONJ_TAC THENL [ASM_MESON_TAC[SUBSET]; GEN_TAC] THEN
14180         MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[FACE_OF_IMP_SUBSET];
14181         MATCH_MP_TAC SUBSET_UNIONS THEN REWRITE_TAC[SUBSET; IN_UNION] THEN
14182         X_GEN_TAC `d:real^M->bool` THEN DISCH_TAC THEN
14183         ASM_CASES_TAC `(d:real^M->bool) IN n` THEN
14184         ASM_SIMP_TAC[IN_ELIM_THM] THEN
14185         EXISTS_TAC `d:real^M->bool` THEN
14186         ASM_SIMP_TAC[FACE_OF_REFL; POLYTOPE_IMP_CONVEX] THEN
14187         ASM SET_TAC[]]] THEN
14188     MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
14189      [REWRITE_TAC[INT_ARITH `d < &0 <=> (--(&1) <= d ==> d:int = --(&1))`] THEN
14190       REWRITE_TAC[AFF_DIM_GE; AFF_DIM_EQ_MINUS1] THEN
14191       SUBGOAL_THEN
14192        `{d:real^M->bool| ?c. c IN m /\ d face_of c /\ d = {}} = {{}}`
14193        (fun th -> REWRITE_TAC[th])
14194       THENL
14195        [GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `d:real^M->bool` THEN
14196         REWRITE_TAC[IN_SING; IN_ELIM_THM] THEN
14197         ASM_CASES_TAC `d:real^M->bool = {}` THEN
14198         ASM_REWRITE_TAC[EMPTY_FACE_OF] THEN ASM SET_TAC[];
14199         REWRITE_TAC[UNIONS_UNION; UNIONS_1; UNION_EMPTY] THEN
14200         ASM_MESON_TAC[]];
14201       ALL_TAC] THEN
14202     X_GEN_TAC `p:num` THEN REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN
14203     REWRITE_TAC[INT_ARITH `p + &1 <= x <=> p:int < x`] THEN
14204     DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN
14205     ASM_SIMP_TAC[INT_LT_IMP_LE] THEN
14206     DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` STRIP_ASSUME_TAC) THEN
14207     REWRITE_TAC[INT_ARITH `x:int < p + &1 <=> x <= p`] THEN
14208     SUBGOAL_THEN `~(t:real^N->bool = {})` ASSUME_TAC THENL
14209      [ASM_MESON_TAC[AFF_DIM_EMPTY; INT_ARITH `~(&p:int < --(&1))`];
14210       ALL_TAC] THEN
14211     SUBGOAL_THEN `~(relative_frontier t:real^N->bool = {})` ASSUME_TAC THENL
14212      [ASM_REWRITE_TAC[RELATIVE_FRONTIER_EQ_EMPTY] THEN DISCH_TAC THEN
14213       MP_TAC(ISPEC `t:real^N->bool` AFFINE_BOUNDED_EQ_LOWDIM) THEN
14214       ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC;
14215       ALL_TAC] THEN
14216     SUBGOAL_THEN
14217      `!d. d IN n UNION {d | ?c. c IN m /\ d face_of c /\ aff_dim d <= &p}
14218           ==> ?g. (g:real^M->real^N) continuous_on d /\
14219                   IMAGE g d SUBSET relative_frontier t /\
14220                   !x. x IN d INTER
14221                       UNIONS
14222                     (n UNION {d | ?c. c IN m /\ d face_of c /\ aff_dim d < &p})
14223                       ==> g x = h x`
14224     MP_TAC THENL
14225      [X_GEN_TAC `d:real^M->bool` THEN
14226       ASM_CASES_TAC `(d:real^M->bool) SUBSET UNIONS
14227                  (n UNION {d | ?c. c IN m /\ d face_of c /\ aff_dim d < &p})`
14228       THENL
14229        [DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `h:real^M->real^N` THEN
14230         REWRITE_TAC[] THEN CONJ_TAC THENL
14231          [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]];
14232         ALL_TAC] THEN
14233       ASM_CASES_TAC `?a:real^M. d = {a}` THENL
14234        [FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^M` SUBST_ALL_TAC) THEN
14235         DISCH_THEN(K ALL_TAC) THEN ASM_SIMP_TAC[CONTINUOUS_ON_SING; SET_RULE
14236          `~({a} SUBSET s) ==> ~(x IN {a} INTER s)`] THEN
14237         REWRITE_TAC[SUBSET; FORALL_IN_IMAGE;
14238                     FORALL_IN_INSERT; NOT_IN_EMPTY] THEN
14239         MATCH_MP_TAC(MESON[] `(?c. P(\x. c)) ==> (?f. P f)`) THEN
14240         ASM SET_TAC[];
14241         ALL_TAC] THEN
14242       SUBGOAL_THEN `~(d:real^M->bool = {})` ASSUME_TAC THENL
14243        [ASM SET_TAC[]; ALL_TAC] THEN
14244       FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE
14245        `~(s SUBSET UNIONS f) ==> ~(s IN f)`)) THEN
14246       REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP
14247        (SET_RULE `~(d IN s UNION t) /\ d IN s UNION u
14248                   ==> ~(d IN s) /\ d IN u DIFF t`)) THEN
14249       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
14250       DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
14251        `d IN
14252         {d | ?c. c IN m /\ d face_of c /\ aff_dim d <= &p} DIFF
14253         {d | ?c. c IN m /\ d face_of c /\ aff_dim d < &p}
14254         ==> ?c. c IN m /\ d face_of c /\
14255                 (aff_dim d <= &p /\ ~(aff_dim d < &p))`)) THEN
14256       REWRITE_TAC[INT_ARITH `d:int <= p /\ ~(d < p) <=> d = p`] THEN
14257       DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN
14258       MP_TAC(ISPECL [`h:real^M->real^N`; `relative_frontier d:real^M->bool`;
14259         `t:real^N->bool`] NULLHOMOTOPIC_INTO_RELATIVE_FRONTIER_EXTENSION) THEN
14260       ASM_REWRITE_TAC[CLOSED_RELATIVE_FRONTIER;
14261                       RELATIVE_FRONTIER_EQ_EMPTY] THEN
14262       SUBGOAL_THEN
14263        `relative_frontier d SUBSET
14264         UNIONS {e:real^M->bool | e face_of c /\ aff_dim e < &p}`
14265       ASSUME_TAC THENL
14266        [W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_FRONTIER_OF_POLYHEDRON o
14267           lhand o snd) THEN
14268         ANTS_TAC THENL
14269          [ASM_MESON_TAC[POLYTOPE_IMP_POLYHEDRON; FACE_OF_POLYTOPE_POLYTOPE];
14270           DISCH_THEN SUBST1_TAC] THEN
14271         MATCH_MP_TAC SUBSET_UNIONS THEN
14272         ASM_SIMP_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM; facet_of] THEN
14273         X_GEN_TAC `f:real^M->bool` THEN REPEAT STRIP_TAC THENL
14274          [ASM_MESON_TAC[FACE_OF_TRANS]; INT_ARITH_TAC];
14275         ALL_TAC] THEN
14276       ANTS_TAC THENL
14277        [REPEAT CONJ_TAC THENL
14278          [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14279             CONTINUOUS_ON_SUBSET)) THEN
14280           ASM SET_TAC[];
14281           ASM_MESON_TAC[AFFINE_BOUNDED_EQ_TRIVIAL; FACE_OF_POLYTOPE_POLYTOPE;
14282                         POLYTOPE_IMP_BOUNDED];
14283           ASM SET_TAC[]];
14284         ALL_TAC] THEN
14285       MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN
14286       CONJ_TAC THENL
14287        [MATCH_MP_TAC INESSENTIAL_SPHEREMAP_LOWDIM_GEN THEN
14288         ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
14289          [ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE; POLYTOPE_IMP_CONVEX];
14290           ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE; POLYTOPE_IMP_BOUNDED];
14291           FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14292             CONTINUOUS_ON_SUBSET)) THEN
14293           ASM SET_TAC[];
14294           ASM SET_TAC[]];
14295         MATCH_MP_TAC MONO_EXISTS] THEN
14296       X_GEN_TAC `g:real^M->real^N` THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL
14297        [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV];
14298         ASM SET_TAC[];
14299         ALL_TAC] THEN
14300       REWRITE_TAC[INTER_UNIONS] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
14301        (SET_RULE `(!x. x IN s ==> P x) ==> t SUBSET s
14302                   ==> !x. x IN t ==> P x`)) THEN
14303       REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN
14304       X_GEN_TAC `e:real^M->bool` THEN DISCH_TAC THEN
14305       MATCH_MP_TAC FACE_OF_SUBSET_RELATIVE_FRONTIER THEN CONJ_TAC THENL
14306        [MATCH_MP_TAC(MESON[]
14307          `(d INTER e) face_of d /\ (d INTER e) face_of e
14308           ==> (d INTER e) face_of d`) THEN
14309         MATCH_MP_TAC FACE_OF_INTER_SUBFACE THEN
14310         EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
14311         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNION]) THEN
14312         REWRITE_TAC[IN_ELIM_THM] THEN
14313         STRIP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
14314         ASM_MESON_TAC[FACE_OF_REFL; SUBSET; POLYTOPE_IMP_CONVEX];
14315         REWRITE_TAC[SET_RULE `d INTER e = d <=> d SUBSET e`] THEN
14316         DISCH_TAC THEN
14317         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNION]) THEN
14318         REWRITE_TAC[IN_ELIM_THM] THEN
14319         DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN
14320         ASM_MESON_TAC[AFF_DIM_SUBSET; INT_NOT_LE]];
14321       ALL_TAC] THEN
14322     DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] lemma)) THEN
14323     ANTS_TAC THENL
14324      [ALL_TAC;
14325       MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN ASM SET_TAC[]] THEN
14326     CONJ_TAC THENL
14327      [REWRITE_TAC[FINITE_UNION] THEN
14328       CONJ_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN
14329       MATCH_MP_TAC FINITE_SUBSET THEN
14330       EXISTS_TAC `UNIONS {{d:real^M->bool | d face_of c} | c IN m}` THEN
14331       CONJ_TAC THENL
14332        [REWRITE_TAC[FINITE_UNIONS; FORALL_IN_GSPEC] THEN
14333         ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN
14334         ASM_MESON_TAC[FINITE_POLYTOPE_FACES];
14335         REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]];
14336       ALL_TAC] THEN
14337     CONJ_TAC THENL
14338      [REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN
14339       ASM_MESON_TAC[FACE_OF_IMP_CLOSED; POLYTOPE_IMP_CLOSED;
14340                     POLYTOPE_IMP_CONVEX; SUBSET];
14341       ALL_TAC] THEN
14342     MAP_EVERY X_GEN_TAC [`d:real^M->bool`; `e:real^M->bool`] THEN
14343     REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN
14344     DISCH_THEN(CONJUNCTS_THEN2 (DISJ_CASES_THEN2 ASSUME_TAC
14345      (X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC)) MP_TAC)
14346     THENL [ASM SET_TAC[]; ALL_TAC] THEN
14347     DISCH_THEN(CONJUNCTS_THEN2 (DISJ_CASES_THEN2 ASSUME_TAC
14348      (X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC)) MP_TAC)
14349     THENL [ASM SET_TAC[]; STRIP_TAC] THEN
14350     REWRITE_TAC[UNIONS_UNION] THEN
14351     MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s SUBSET t UNION u`) THEN
14352     MATCH_MP_TAC(SET_RULE `x IN s ==> x SUBSET UNIONS s`) THEN
14353     REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `c:real^M->bool` THEN
14354     ASM_REWRITE_TAC[] THEN
14355     SUBGOAL_THEN `d INTER e face_of (d:real^M->bool) /\
14356                   d INTER e face_of e`
14357     STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[FACE_OF_INTER_SUBFACE]; ALL_TAC] THEN
14358     CONJ_TAC THENL [ASM_MESON_TAC[FACE_OF_TRANS]; ALL_TAC] THEN
14359     TRANS_TAC INT_LTE_TRANS `aff_dim(d:real^M->bool)` THEN
14360     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN
14361     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
14362      [ASM_MESON_TAC[POLYTOPE_IMP_CONVEX; FACE_OF_IMP_CONVEX];
14363       ASM SET_TAC[]]) in
14364   let memma = prove
14365    (`!h:real^M->real^N k t u f.
14366           (!s. s IN f ==> ?a g. ~(a IN u) /\ g continuous_on (s DELETE a) /\
14367                                IMAGE g (s DELETE a) SUBSET t /\
14368                                !x. x IN s INTER k ==> g x = h x) /\
14369           FINITE f /\ (!s. s IN f ==> closed s) /\
14370           (!s t. s IN f /\ t IN f /\ ~(s = t) ==> (s INTER t) SUBSET k)
14371           ==> ?c g. FINITE c /\ DISJOINT c u /\ CARD c <= CARD f /\
14372                     g continuous_on (UNIONS f DIFF c) /\
14373                     IMAGE g (UNIONS f DIFF c) SUBSET t /\
14374                     !x. x IN (UNIONS f DIFF c) INTER k ==> g x = h x`,
14375     REPLICATE_TAC 4 GEN_TAC THEN
14376     ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> q ==> p /\ r ==> s`] THEN
14377     MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
14378     REWRITE_TAC[UNIONS_0; IMAGE_CLAUSES; EMPTY_SUBSET; CONTINUOUS_ON_EMPTY;
14379                 INTER_EMPTY; NOT_IN_EMPTY; EMPTY_DIFF] THEN
14380     CONJ_TAC THENL
14381      [MESON_TAC[DISJOINT_EMPTY; FINITE_EMPTY; CARD_CLAUSES; LE_REFL];
14382       ALL_TAC] THEN
14383     REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_INSERT] THEN
14384     REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; SUBSET_REFL] THEN
14385     MAP_EVERY X_GEN_TAC [`s:real^M->bool`; `u:(real^M->bool)->bool`] THEN
14386     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC
14387      (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN
14388     ASM_SIMP_TAC[UNIONS_INSERT] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
14389     MAP_EVERY X_GEN_TAC [`c:real^M->bool`; `g:real^M->real^N`] THEN
14390     STRIP_TAC THEN ASM_SIMP_TAC[CARD_CLAUSES] THEN
14391     ASM_CASES_TAC `(s:real^M->bool) UNION UNIONS u = UNIONS u` THENL
14392      [ASM_SIMP_TAC[] THEN ASM_MESON_TAC[ARITH_RULE `x <= y ==> x <= SUC y`];
14393       ALL_TAC] THEN
14394     FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^M`
14395      (X_CHOOSE_THEN `f:real^M->real^N` STRIP_ASSUME_TAC)) THEN
14396     EXISTS_TAC `(a:real^M) INSERT c` THEN
14397     ASM_SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; RIGHT_EXISTS_AND_THM] THEN
14398     REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ASM_ARITH_TAC; ALL_TAC] THEN
14399     EXISTS_TAC `\x. if x IN s then (f:real^M->real^N) x else g x` THEN
14400     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
14401     MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
14402     EXISTS_TAC `(s DIFF ((a:real^M) INSERT c)) UNION
14403                 (UNIONS u DIFF ((a:real^M) INSERT c))` THEN
14404     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
14405     MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN REPEAT CONJ_TAC THENL
14406      [REWRITE_TAC[CLOSED_IN_CLOSED] THEN
14407       EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[];
14408       REWRITE_TAC[CLOSED_IN_CLOSED] THEN
14409       EXISTS_TAC `UNIONS u:real^M->bool` THEN ASM_SIMP_TAC[CLOSED_UNIONS];
14410       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14411             CONTINUOUS_ON_SUBSET));
14412       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14413             CONTINUOUS_ON_SUBSET));
14414       ALL_TAC] THEN
14415     ASM SET_TAC[]) in
14416   let temma = prove
14417    (`!h:real^M->real^N k t u f.
14418           (!s. s IN f ==> ?a g. ~(a IN u) /\ g continuous_on (s DELETE a) /\
14419                                 IMAGE g (s DELETE a) SUBSET t /\
14420                                 !x. x IN s INTER k ==> g x = h x) /\
14421           FINITE f /\ (!s. s IN f ==> closed s) /\
14422           (!s t. s IN f /\ t IN f /\  ~(s SUBSET t) /\ ~(t SUBSET s)
14423                  ==> (s INTER t) SUBSET k)
14424           ==> ?c g. FINITE c /\ DISJOINT c u /\ CARD c <= CARD f /\
14425                     g continuous_on (UNIONS f DIFF c) /\
14426                     IMAGE g (UNIONS f DIFF c) SUBSET t /\
14427                     !x. x IN (UNIONS f DIFF c) INTER k ==> g x = h x`,
14428     REPEAT STRIP_TAC THEN
14429     MP_TAC(ISPECL [`h:real^M->real^N`; `k:real^M->bool`; `t:real^N->bool`;
14430                    `u:real^M->bool`;
14431                    `{t:real^M->bool | t IN f /\
14432                                       (!u. u IN f ==> ~(t PSUBSET u))}`]
14433           memma) THEN
14434     ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM; UNIONS_MAXIMAL_SETS] THEN
14435     ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
14436     REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
14437     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
14438     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14439           LE_TRANS)) THEN
14440     MATCH_MP_TAC CARD_SUBSET THEN
14441     ASM_SIMP_TAC[] THEN SET_TAC[]) in
14442   let bemma = prove
14443    (`!f:real^M->real^N m n t.
14444         FINITE m /\ (!c. c IN m ==> polytope c) /\
14445         n SUBSET m /\ (!c. c IN m DIFF n ==> aff_dim c <= aff_dim t) /\
14446         (!c1 c2. c1 IN m /\ c2 IN m
14447                  ==> (c1 INTER c2) face_of c1 /\ (c1 INTER c2) face_of c2) /\
14448         convex t /\ bounded t /\
14449         f continuous_on (UNIONS n) /\
14450         IMAGE f (UNIONS n) SUBSET relative_frontier t
14451         ==> ?k g. FINITE k /\ DISJOINT k (UNIONS n) /\ CARD k <= CARD m /\
14452                   g continuous_on (UNIONS m DIFF k) /\
14453                   IMAGE g (UNIONS m DIFF k) SUBSET relative_frontier t /\
14454                   (!x. x IN UNIONS n ==> g x = f x)`,
14455     REPEAT STRIP_TAC THEN
14456     MP_TAC(ISPECL [`f:real^M->real^N`;
14457          `n UNION {d:real^M->bool | ?c. c IN m DIFF n /\ d face_of c /\
14458                                         aff_dim d < aff_dim(t:real^N->bool)}`;
14459          `n:(real^M->bool)->bool`; `t:real^N->bool`] zemma) THEN
14460     ASM_REWRITE_TAC[SUBSET_UNION; SET_RULE
14461      `(n UNION m) DIFF n = m DIFF n`] THEN
14462     SIMP_TAC[IN_DIFF; IN_ELIM_THM; LEFT_IMP_EXISTS_THM;
14463              LEFT_AND_EXISTS_THM] THEN
14464     ANTS_TAC THENL
14465      [REPEAT CONJ_TAC THENL
14466        [ASM_REWRITE_TAC[FINITE_UNION] THEN
14467         CONJ_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN
14468         MATCH_MP_TAC FINITE_SUBSET THEN
14469         EXISTS_TAC `UNIONS {{d:real^M->bool | d face_of c} | c IN m}` THEN
14470         CONJ_TAC THENL
14471          [REWRITE_TAC[FINITE_UNIONS; FORALL_IN_GSPEC] THEN
14472           ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN
14473           ASM_MESON_TAC[FINITE_POLYTOPE_FACES];
14474           REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]];
14475         REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN
14476         ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE; SUBSET];
14477         REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN
14478         ASM_MESON_TAC[FACE_OF_INTER_SUBFACE; SUBSET; FACE_OF_REFL;
14479                       POLYTOPE_IMP_CONVEX; FACE_OF_IMP_CONVEX]];
14480       ALL_TAC] THEN
14481     DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` STRIP_ASSUME_TAC) THEN
14482     SUBGOAL_THEN
14483      `!d. d IN m
14484           ==> ?a g. ~(a IN UNIONS n) /\
14485                     (g:real^M->real^N) continuous_on (d DELETE a) /\
14486                     IMAGE g (d DELETE a) SUBSET relative_frontier t /\
14487                     !x. x IN d INTER
14488                          UNIONS
14489                           (n UNION {d | ?c. (c IN m /\ ~(c IN n)) /\
14490                                             d face_of c /\
14491                                             aff_dim d < aff_dim t})
14492                         ==> g x = h x`
14493     MP_TAC THENL
14494      [X_GEN_TAC `d:real^M->bool` THEN DISCH_TAC THEN
14495       ASM_CASES_TAC `(d:real^M->bool) SUBSET
14496                      UNIONS(n UNION {d | ?c. (c IN m /\ ~(c IN n)) /\
14497                                              d face_of c /\
14498                                      aff_dim d < aff_dim(t:real^N->bool)})`
14499       THENL
14500        [SUBGOAL_THEN `~(UNIONS n = (:real^M))` MP_TAC THENL
14501          [MATCH_MP_TAC(MESON[NOT_BOUNDED_UNIV]
14502            `bounded s ==> ~(s = UNIV)`) THEN
14503           MATCH_MP_TAC BOUNDED_UNIONS THEN
14504           ASM_MESON_TAC[POLYTOPE_IMP_BOUNDED; SUBSET; FINITE_SUBSET];
14505           GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [EXTENSION]] THEN
14506         REWRITE_TAC[IN_UNIV; NOT_FORALL_THM] THEN
14507         MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^M` THEN
14508         STRIP_TAC THEN EXISTS_TAC `h:real^M->real^N` THEN
14509         ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
14510          [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET;
14511                         SET_RULE `s SUBSET t ==> s DELETE a SUBSET t`];
14512           ASM SET_TAC[]];
14513         ALL_TAC] THEN
14514       ASM_CASES_TAC `(d:real^M->bool) IN n` THENL [ASM SET_TAC[]; ALL_TAC] THEN
14515       DISJ_CASES_THEN MP_TAC (SPEC
14516        `relative_interior(d:real^M->bool) = {}` EXCLUDED_MIDDLE)
14517       THENL
14518        [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY; POLYTOPE_IMP_CONVEX] THEN
14519         ASM SET_TAC[];
14520         REWRITE_TAC[GSYM MEMBER_NOT_EMPTY]] THEN
14521       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^M` THEN STRIP_TAC THEN
14522       SUBGOAL_THEN
14523        `relative_frontier d SUBSET
14524         UNIONS {e:real^M->bool | e face_of d /\
14525                                  aff_dim e < aff_dim(t:real^N->bool)}`
14526       ASSUME_TAC THENL
14527        [W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_FRONTIER_OF_POLYHEDRON o
14528           lhand o snd) THEN
14529         ANTS_TAC THENL
14530          [ASM_MESON_TAC[POLYTOPE_IMP_POLYHEDRON; FACE_OF_POLYTOPE_POLYTOPE];
14531           DISCH_THEN SUBST1_TAC] THEN
14532         MATCH_MP_TAC SUBSET_UNIONS THEN
14533         ASM_SIMP_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM; facet_of] THEN
14534         ASM_SIMP_TAC[INT_ARITH `d - &1:int < t <=> d <= t`; IN_DIFF];
14535         ALL_TAC] THEN
14536       MP_TAC(ISPECL [`d:real^M->bool`; `a:real^M`]
14537           RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL) THEN
14538       ASM_SIMP_TAC[POLYTOPE_IMP_CONVEX; POLYTOPE_IMP_BOUNDED] THEN
14539       REWRITE_TAC[retract_of; LEFT_IMP_EXISTS_THM; retraction] THEN
14540       X_GEN_TAC `r:real^M->real^M` THEN STRIP_TAC THEN
14541       EXISTS_TAC `(h:real^M->real^N) o (r:real^M->real^M)` THEN
14542       REPEAT CONJ_TAC THENL
14543        [REWRITE_TAC[IN_UNIONS] THEN
14544         DISCH_THEN(X_CHOOSE_THEN `e:real^M->bool` STRIP_ASSUME_TAC) THEN
14545         SUBGOAL_THEN
14546          `e INTER d face_of e /\ e INTER d face_of (d:real^M->bool)`
14547         MP_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
14548         DISCH_THEN(MP_TAC o MATCH_MP
14549           (REWRITE_RULE[IMP_CONJ] FACE_OF_SUBSET_RELATIVE_FRONTIER) o
14550           CONJUNCT2) THEN
14551         REWRITE_TAC[NOT_IMP; relative_frontier] THEN
14552         MP_TAC(ISPEC `d:real^M->bool` RELATIVE_INTERIOR_SUBSET) THEN
14553         ASM SET_TAC[];
14554         MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
14555         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14556             CONTINUOUS_ON_SUBSET)) THEN
14557         SIMP_TAC[HULL_SUBSET; SET_RULE
14558                   `s SUBSET t ==> s DELETE a SUBSET t DELETE a`];
14559         REWRITE_TAC[IMAGE_o] THEN
14560         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
14561          `IMAGE h t SUBSET u ==> s SUBSET t ==> IMAGE h s SUBSET u`));
14562         SIMP_TAC[INTER_UNIONS; o_THM] THEN
14563         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
14564          (SET_RULE `(!x. x IN s ==> r x = x) ==> t SUBSET s
14565                     ==> !x. x IN t ==> h(r x) = h x`)) THEN
14566         REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN
14567         X_GEN_TAC `e:real^M->bool` THEN DISCH_TAC THEN
14568         MATCH_MP_TAC FACE_OF_SUBSET_RELATIVE_FRONTIER THEN
14569         CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
14570         MATCH_MP_TAC(MESON[]
14571          `(d INTER e) face_of d /\ (d INTER e) face_of e
14572           ==> (d INTER e) face_of d`) THEN
14573         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNION]) THEN
14574         REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THENL
14575          [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
14576         MATCH_MP_TAC FACE_OF_INTER_SUBFACE THEN
14577         MAP_EVERY EXISTS_TAC [`d:real^M->bool`; `c:real^M->bool`] THEN
14578         ASM_SIMP_TAC[FACE_OF_REFL; POLYTOPE_IMP_CONVEX]] THEN
14579       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
14580        `IMAGE r (h DELETE a) SUBSET t ==> d SUBSET h /\ t SUBSET u
14581         ==> IMAGE r (d DELETE a) SUBSET u`)) THEN
14582       REWRITE_TAC[HULL_SUBSET] THEN ASM SET_TAC[];
14583       ALL_TAC] THEN
14584     DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] temma)) THEN
14585     ANTS_TAC THENL
14586      [ALL_TAC;
14587       REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
14588       STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]] THEN
14589     ASM_SIMP_TAC[POLYTOPE_IMP_CLOSED] THEN
14590     MAP_EVERY X_GEN_TAC [`d:real^M->bool`; `e:real^M->bool`] THEN
14591     STRIP_TAC THEN REWRITE_TAC[UNIONS_UNION] THEN
14592     ASM_CASES_TAC `(d:real^M->bool) IN n` THENL [ASM SET_TAC[]; ALL_TAC] THEN
14593     MATCH_MP_TAC(SET_RULE `x IN s ==> x SUBSET t UNION UNIONS s`) THEN
14594     REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `d:real^M->bool` THEN
14595     ASM_REWRITE_TAC[] THEN
14596     ASM_CASES_TAC `d INTER e:real^M->bool = d` THENL
14597       [ASM SET_TAC[]; ALL_TAC] THEN
14598     ASM_SIMP_TAC[] THEN TRANS_TAC INT_LTE_TRANS `aff_dim(d:real^M->bool)` THEN
14599     ASM_SIMP_TAC[IN_DIFF] THEN MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN
14600     ASM_MESON_TAC[POLYTOPE_IMP_CONVEX]) in
14601   CONJ_TAC THENL
14602    [REPEAT STRIP_TAC THEN
14603     SUBGOAL_THEN `compact(s:real^M->bool)` ASSUME_TAC THENL
14604      [ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN
14605       ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_UNIONS; POLYTOPE_IMP_BOUNDED];
14606       ALL_TAC] THEN
14607     MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`;
14608                    `relative_frontier t:real^N->bool`]
14609           NEIGHBOURHOOD_EXTENSION_INTO_ANR) THEN
14610     ASM_SIMP_TAC[LEFT_FORALL_IMP_THM; ANR_RELATIVE_FRONTIER_CONVEX] THEN
14611     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
14612     MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `g:real^M->real^N`] THEN
14613     STRIP_TAC THEN
14614     MP_TAC(ISPECL [`s:real^M->bool`; `(:real^M) DIFF v`]
14615           SEPARATE_COMPACT_CLOSED) THEN
14616     ASM_SIMP_TAC[GSYM OPEN_CLOSED; IN_DIFF; IN_UNIV] THEN
14617     ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
14618     ONCE_REWRITE_TAC[TAUT `p /\ ~q ==> r <=> p /\ ~r ==> q`] THEN
14619     REWRITE_TAC[REAL_NOT_LE; LEFT_IMP_EXISTS_THM] THEN
14620     X_GEN_TAC `d:real` THEN STRIP_TAC THEN
14621     MP_TAC(ISPECL [`m:(real^M->bool)->bool`; `aff_dim(t:real^N->bool) - &1`;
14622                    `d:real`] CELL_COMPLEX_SUBDIVISION_EXISTS) THEN
14623     ASM_SIMP_TAC[INT_ARITH `x:int <= t - &1 <=> x < t`] THEN
14624     DISCH_THEN(X_CHOOSE_THEN `n:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
14625     MP_TAC(ISPECL
14626      [`g:real^M->real^N`; `n:(real^M->bool)->bool`;
14627       `{c:real^M->bool | c IN n /\ c SUBSET v}`; `t:real^N->bool`]
14628      zemma) THEN
14629     ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
14630      [ASM_SIMP_TAC[SUBSET_RESTRICT; IN_DIFF] THEN CONJ_TAC THENL
14631        [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14632           CONTINUOUS_ON_SUBSET)) THEN
14633         ASM SET_TAC[];
14634         ASM SET_TAC[]];
14635       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^M->real^N` THEN
14636       STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN
14637       DISCH_TAC THEN TRANS_TAC EQ_TRANS `(g:real^M->real^N) x` THEN
14638       CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
14639       SUBGOAL_THEN `(x:real^M) IN UNIONS n` MP_TAC THENL
14640        [ASM SET_TAC[]; ALL_TAC] THEN
14641       REWRITE_TAC[IN_UNIONS] THEN MATCH_MP_TAC MONO_EXISTS THEN
14642       X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
14643       ASM_REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[SUBSET] THEN
14644       X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
14645       EXISTS_TAC `x:real^M` THEN ASM_REWRITE_TAC[] THEN
14646       MATCH_MP_TAC REAL_LET_TRANS THEN
14647       EXISTS_TAC `diameter(c:real^M->bool)` THEN
14648       ASM_SIMP_TAC[dist] THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN
14649       ASM_SIMP_TAC[POLYTOPE_IMP_BOUNDED]];
14650     REPEAT STRIP_TAC THEN
14651     SUBGOAL_THEN `compact(s:real^M->bool)` ASSUME_TAC THENL
14652      [ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN
14653       ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_UNIONS; POLYTOPE_IMP_BOUNDED];
14654       ALL_TAC] THEN
14655     MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`;
14656                    `relative_frontier t:real^N->bool`]
14657           NEIGHBOURHOOD_EXTENSION_INTO_ANR) THEN
14658     ASM_SIMP_TAC[LEFT_FORALL_IMP_THM; ANR_RELATIVE_FRONTIER_CONVEX] THEN
14659     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
14660     MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `g:real^M->real^N`] THEN
14661     STRIP_TAC THEN
14662     MP_TAC(ISPECL [`s:real^M->bool`; `(:real^M) DIFF v`]
14663           SEPARATE_COMPACT_CLOSED) THEN
14664     ASM_SIMP_TAC[GSYM OPEN_CLOSED; IN_DIFF; IN_UNIV] THEN
14665     ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
14666     ONCE_REWRITE_TAC[TAUT `p /\ ~q ==> r <=> p /\ ~r ==> q`] THEN
14667     REWRITE_TAC[REAL_NOT_LE; LEFT_IMP_EXISTS_THM] THEN
14668     X_GEN_TAC `d:real` THEN STRIP_TAC THEN
14669     MP_TAC(ISPECL [`m:(real^M->bool)->bool`; `aff_dim(t:real^N->bool)`;
14670                    `d:real`] CELL_COMPLEX_SUBDIVISION_EXISTS) THEN
14671     ASM_SIMP_TAC[] THEN
14672     DISCH_THEN(X_CHOOSE_THEN `n:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN
14673     MP_TAC(ISPECL
14674      [`g:real^M->real^N`; `n:(real^M->bool)->bool`;
14675       `{c:real^M->bool | c IN n /\ c SUBSET v}`; `t:real^N->bool`]
14676      bemma) THEN
14677     ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
14678      [ASM_SIMP_TAC[SUBSET_RESTRICT; IN_DIFF] THEN CONJ_TAC THENL
14679        [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14680           CONTINUOUS_ON_SUBSET)) THEN
14681         ASM SET_TAC[];
14682         ASM SET_TAC[]];
14683       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN
14684       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^M->real^N` THEN
14685       STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
14686        [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
14687          `DISJOINT k u ==> s SUBSET u ==> DISJOINT k s`)) THEN
14688         REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC;
14689         X_GEN_TAC `x:real^M` THEN
14690         DISCH_TAC THEN TRANS_TAC EQ_TRANS `(g:real^M->real^N) x` THEN
14691         CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]] THEN
14692       (SUBGOAL_THEN `(x:real^M) IN UNIONS n` MP_TAC THENL
14693         [ASM SET_TAC[]; ALL_TAC] THEN
14694        REWRITE_TAC[IN_UNIONS] THEN MATCH_MP_TAC MONO_EXISTS THEN
14695        X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
14696        ASM_REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[SUBSET] THEN
14697        X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
14698        EXISTS_TAC `x:real^M` THEN ASM_REWRITE_TAC[] THEN
14699        MATCH_MP_TAC REAL_LET_TRANS THEN
14700         EXISTS_TAC `diameter(c:real^M->bool)` THEN
14701        ASM_SIMP_TAC[dist] THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN
14702        ASM_SIMP_TAC[POLYTOPE_IMP_BOUNDED])]]);;
14703
14704 (* ------------------------------------------------------------------------- *)
14705 (* Special cases and corollaries involving spheres.                          *)
14706 (* ------------------------------------------------------------------------- *)
14707
14708 let EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_SIMPLE = prove
14709  (`!f:real^M->real^N s t u.
14710         compact s /\ convex u /\ bounded u /\ aff_dim t <= aff_dim u /\
14711         s SUBSET t /\ f continuous_on s /\ IMAGE f s SUBSET relative_frontier u
14712         ==> ?k g. FINITE k /\ k SUBSET t /\ DISJOINT k s /\
14713                   g continuous_on (t DIFF k) /\
14714                   IMAGE g (t DIFF k) SUBSET relative_frontier u /\
14715                   !x. x IN s ==> g x = f x`,
14716   let lemma = prove
14717    (`!f:A->B->bool P k.
14718         INFINITE {x | P x} /\ FINITE k /\
14719         (!x y. P x /\ P y /\ ~(x = y) ==> DISJOINT (f x) (f y))
14720         ==> ?x. P x /\ DISJOINT k (f x)`,
14721     REWRITE_TAC[INFINITE] THEN REPEAT STRIP_TAC THEN
14722     REWRITE_TAC[SET_RULE `(?x. P x /\ DISJOINT k (f x)) <=>
14723                           ~(!x. ?y. P x ==> y IN k /\ y IN f x)`] THEN
14724     REWRITE_TAC[SKOLEM_THM] THEN
14725     DISCH_THEN(X_CHOOSE_TAC `g:A->B`) THEN
14726     MP_TAC(ISPECL [`g:A->B`; `{x:A | P x}`] FINITE_IMAGE_INJ_EQ) THEN
14727     ASM_REWRITE_TAC[IN_ELIM_THM; NOT_IMP] THEN
14728     CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
14729     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
14730       (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN
14731     ASM SET_TAC[]) in
14732   SUBGOAL_THEN
14733    `!f:real^M->real^N s t u.
14734         compact s /\ convex u /\ bounded u /\ aff_dim t <= aff_dim u /\
14735         s SUBSET t /\ f continuous_on s /\ IMAGE f s SUBSET relative_frontier u
14736         ==> ?k g. FINITE k /\ DISJOINT k s /\
14737                   g continuous_on (t DIFF k) /\
14738                   IMAGE g (t DIFF k) SUBSET relative_frontier u /\
14739                   !x. x IN s ==> g x = f x`
14740   MP_TAC THENL
14741    [ALL_TAC;
14742     REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
14743     DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
14744     ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
14745     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN
14746     DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC) THEN
14747     EXISTS_TAC `k INTER t:real^M->bool` THEN
14748     ASM_SIMP_TAC[FINITE_INTER; INTER_SUBSET] THEN
14749     REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC; ASM SET_TAC[]] THEN
14750     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14751             CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]] THEN
14752   SUBGOAL_THEN
14753    `!f:real^M->real^N s t u.
14754         compact s /\ s SUBSET t /\ affine t /\
14755         convex u /\ bounded u /\ aff_dim t <= aff_dim u /\
14756         f continuous_on s /\ IMAGE f s SUBSET relative_frontier u
14757         ==> ?k g. FINITE k /\ DISJOINT k s /\
14758                   g continuous_on (t DIFF k) /\
14759                   IMAGE g (t DIFF k) SUBSET relative_frontier u /\
14760                   !x. x IN s ==> g x = f x`
14761   ASSUME_TAC THENL
14762    [ALL_TAC;
14763     REPEAT STRIP_TAC THEN
14764     SUBGOAL_THEN
14765      `?k g. FINITE k /\ DISJOINT k s /\
14766             g continuous_on (affine hull t DIFF k) /\
14767             IMAGE g (affine hull t DIFF k) SUBSET relative_frontier u /\
14768             !x. x IN s ==> g x = (f:real^M->real^N) x`
14769     MP_TAC THENL
14770      [FIRST_X_ASSUM MATCH_MP_TAC THEN
14771       ASM_SIMP_TAC[AFF_DIM_AFFINE_HULL; AFFINE_AFFINE_HULL] THEN
14772       TRANS_TAC SUBSET_TRANS `t:real^M->bool` THEN
14773       ASM_REWRITE_TAC[HULL_SUBSET];
14774       REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
14775       STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
14776       CONJ_TAC THENL
14777        [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14778             CONTINUOUS_ON_SUBSET));
14779         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
14780             SUBSET_TRANS)) THEN
14781         MATCH_MP_TAC IMAGE_SUBSET] THEN
14782       MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF k SUBSET t DIFF k`) THEN
14783       REWRITE_TAC[HULL_SUBSET]]] THEN
14784   REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL
14785    [ASM_CASES_TAC `relative_frontier(u:real^N->bool) = {}` THENL
14786      [RULE_ASSUM_TAC(REWRITE_RULE[RELATIVE_FRONTIER_EQ_EMPTY]) THEN
14787       UNDISCH_TAC `bounded(u:real^N->bool)` THEN
14788       ASM_SIMP_TAC[AFFINE_BOUNDED_EQ_LOWDIM] THEN DISCH_TAC THEN
14789       SUBGOAL_THEN `aff_dim(t:real^M->bool) <= &0` MP_TAC THENL
14790        [ASM_INT_ARITH_TAC; ALL_TAC] THEN
14791       SIMP_TAC[AFF_DIM_GE; INT_ARITH
14792        `--(&1):int <= x ==> (x <= &0 <=> x = --(&1) \/ x = &0)`] THEN
14793       REWRITE_TAC[AFF_DIM_EQ_MINUS1; AFF_DIM_EQ_0] THEN
14794       DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC (X_CHOOSE_TAC `a:real^M`)) THEN
14795       EXISTS_TAC `{a:real^M}` THEN
14796       ASM_REWRITE_TAC[DISJOINT_EMPTY; FINITE_SING; NOT_IN_EMPTY;
14797                       EMPTY_DIFF; DIFF_EQ_EMPTY; IMAGE_CLAUSES;
14798                       CONTINUOUS_ON_EMPTY; EMPTY_SUBSET];
14799       EXISTS_TAC `{}:real^M->bool` THEN
14800       FIRST_X_ASSUM(X_CHOOSE_TAC `y:real^N` o
14801         GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
14802       ASM_SIMP_TAC[FINITE_EMPTY; DISJOINT_EMPTY; NOT_IN_EMPTY; DIFF_EMPTY] THEN
14803       EXISTS_TAC `(\x. y):real^M->real^N` THEN
14804       REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]];
14805     ALL_TAC] THEN
14806   FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN
14807   DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC) THEN
14808   REWRITE_TAC[INSERT_SUBSET] THEN
14809   DISCH_THEN(X_CHOOSE_THEN `b:real^M` STRIP_ASSUME_TAC) THEN
14810   MP_TAC(ISPECL
14811    [`f:real^M->real^N`;
14812     `{interval[--(b + vec 1):real^M,b + vec 1] INTER t}`;
14813     `s:real^M->bool`; `u:real^N->bool`]
14814    EXTEND_MAP_CELL_COMPLEX_TO_SPHERE_COFINITE) THEN
14815   SUBGOAL_THEN
14816    `interval[--b,b] SUBSET interval[--(b + vec 1):real^M,b + vec 1]`
14817   ASSUME_TAC THENL
14818    [REWRITE_TAC[SUBSET_INTERVAL; VECTOR_ADD_COMPONENT; VECTOR_NEG_COMPONENT;
14819                 VEC_COMPONENT] THEN
14820     REAL_ARITH_TAC;
14821     ALL_TAC] THEN
14822   ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FINITE_SING] THEN
14823   REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; IMP_IMP] THEN
14824   REWRITE_TAC[INTER_IDEMPOT; UNIONS_1; FACE_OF_REFL_EQ; SUBSET_INTER] THEN
14825   ANTS_TAC THENL
14826    [ASM_SIMP_TAC[HULL_SUBSET; COMPACT_IMP_CLOSED] THEN REPEAT CONJ_TAC THENL
14827      [MATCH_MP_TAC POLYTOPE_INTER_POLYHEDRON THEN
14828       ASM_SIMP_TAC[POLYTOPE_INTERVAL; AFFINE_IMP_POLYHEDRON];
14829       TRANS_TAC INT_LE_TRANS `aff_dim(t:real^M->bool)` THEN
14830       ASM_SIMP_TAC[AFF_DIM_SUBSET; INTER_SUBSET];
14831       ASM_SIMP_TAC[CONVEX_INTER; CONVEX_INTERVAL; AFFINE_IMP_CONVEX];
14832       ASM SET_TAC[]];
14833     REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN
14834   MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `g:real^M->real^N`] THEN
14835   STRIP_TAC THEN EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN
14836   SUBGOAL_THEN
14837    `?d:real. (&1 / &2 <= d /\ d <= &1) /\
14838              DISJOINT k (frontier(interval[--(b + lambda i. d):real^M,
14839                                              (b + lambda i. d)]))`
14840   STRIP_ASSUME_TAC THENL
14841    [MATCH_MP_TAC lemma THEN
14842     ASM_SIMP_TAC[INFINITE; FINITE_REAL_INTERVAL; REAL_NOT_LE] THEN
14843     CONV_TAC REAL_RAT_REDUCE_CONV THEN
14844     MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[] THEN
14845     CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
14846     MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN REPEAT STRIP_TAC THEN
14847     REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE
14848      `c SUBSET i' ==> DISJOINT (c DIFF i) (c' DIFF i')`) THEN
14849     REWRITE_TAC[INTERIOR_INTERVAL; CLOSURE_INTERVAL] THEN
14850     SIMP_TAC[SUBSET_INTERVAL; VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT;
14851              LAMBDA_BETA] THEN
14852     ASM_REAL_ARITH_TAC;
14853     ALL_TAC] THEN
14854   ABBREV_TAC `c:real^M = b + lambda i. d` THEN SUBGOAL_THEN
14855    `interval[--b:real^M,b] SUBSET interval(--c,c) /\
14856     interval[--b:real^M,b] SUBSET interval[--c,c] /\
14857     interval[--c,c] SUBSET interval[--(b + vec 1):real^M,b + vec 1]`
14858   STRIP_ASSUME_TAC THENL
14859    [REWRITE_TAC[SUBSET_INTERVAL] THEN EXPAND_TAC "c" THEN REPEAT CONJ_TAC THEN
14860     SIMP_TAC[VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN
14861     MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
14862     REWRITE_TAC[VEC_COMPONENT] THEN ASM_REAL_ARITH_TAC;
14863     ALL_TAC] THEN
14864   EXISTS_TAC
14865    `(g:real^M->real^N) o
14866     closest_point (interval[--c,c] INTER t)` THEN
14867   REPEAT CONJ_TAC THENL
14868    [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
14869      [MATCH_MP_TAC CONTINUOUS_ON_CLOSEST_POINT THEN
14870       ASM_SIMP_TAC[CONVEX_INTER; CLOSED_INTER; CLOSED_INTERVAL; CLOSED_AFFINE;
14871         AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; CONVEX_INTERVAL] THEN
14872       ASM SET_TAC[];
14873       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
14874           CONTINUOUS_ON_SUBSET))];
14875     REWRITE_TAC[IMAGE_o] THEN
14876     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
14877         SUBSET_TRANS)) THEN
14878     MATCH_MP_TAC IMAGE_SUBSET;
14879     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[o_THM] THEN
14880     TRANS_TAC EQ_TRANS `(g:real^M->real^N) x` THEN
14881     CONJ_TAC THENL [AP_TERM_TAC; ASM SET_TAC[]] THEN
14882     MATCH_MP_TAC CLOSEST_POINT_SELF THEN
14883     ASM_SIMP_TAC[IN_INTER; HULL_INC] THEN ASM SET_TAC[]] THEN
14884   (REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF] THEN
14885    X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN CONJ_TAC THENL
14886     [MATCH_MP_TAC(SET_RULE
14887       `closest_point s x IN s /\ s SUBSET u ==> closest_point s x IN u`) THEN
14888      CONJ_TAC THENL [MATCH_MP_TAC CLOSEST_POINT_IN_SET; ASM SET_TAC[]] THEN
14889      ASM_SIMP_TAC[CLOSED_INTER; CLOSED_INTERVAL; CLOSED_AFFINE] THEN
14890      ASM SET_TAC[];
14891      ALL_TAC] THEN
14892    ASM_CASES_TAC `x IN interval[--c:real^M,c]` THEN
14893    ASM_SIMP_TAC[CLOSEST_POINT_SELF; IN_INTER] THEN
14894    MATCH_MP_TAC(SET_RULE
14895     `closest_point s x IN relative_frontier s /\
14896      DISJOINT k (relative_frontier s)
14897      ==> ~(closest_point s x IN k)`) THEN
14898    CONJ_TAC THENL
14899     [MATCH_MP_TAC CLOSEST_POINT_IN_RELATIVE_FRONTIER THEN
14900      ASM_SIMP_TAC[CLOSED_INTER; CLOSED_AFFINE; CLOSED_INTERVAL] THEN
14901      CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_DIFF]] THEN CONJ_TAC THENL
14902       [ALL_TAC; ASM_MESON_TAC[SUBSET; RELATIVE_INTERIOR_SUBSET; IN_INTER]] THEN
14903      ONCE_REWRITE_TAC[INTER_COMM] THEN
14904      W(MP_TAC o PART_MATCH (lhs o rand)
14905        AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR o rand o snd) THEN
14906      ASM_SIMP_TAC[HULL_HULL; AFFINE_AFFINE_HULL; AFFINE_IMP_CONVEX] THEN
14907      ASM_SIMP_TAC[HULL_P] THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
14908      REWRITE_TAC[INTERIOR_INTERVAL] THEN ASM SET_TAC[];
14909      W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_FRONTIER_CONVEX_INTER_AFFINE o
14910        rand o snd) THEN
14911      ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
14912      REWRITE_TAC[CONVEX_INTERVAL; AFFINE_AFFINE_HULL; INTERIOR_INTERVAL] THEN
14913      ASM SET_TAC[]]));;
14914
14915 let EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_GEN = prove
14916  (`!f:real^M->real^N s t u p.
14917         compact s /\ convex u /\ bounded u /\
14918         affine t /\ aff_dim t <= aff_dim u /\ s SUBSET t /\
14919         f continuous_on s /\ IMAGE f s SUBSET relative_frontier u /\
14920         (!c. c IN components(t DIFF s) /\ bounded c ==> ~(c INTER p = {}))
14921         ==> ?k g. FINITE k /\ k SUBSET p /\ k SUBSET t /\ DISJOINT k s /\
14922                   g continuous_on (t DIFF k) /\
14923                   IMAGE g (t DIFF k) SUBSET relative_frontier u /\
14924                   !x. x IN s ==> g x = f x`,
14925   let lemma0 = prove
14926    (`!u t s v. closed_in (subtopology euclidean u) v /\ t SUBSET u /\
14927                s = v INTER t
14928                ==> closed_in (subtopology euclidean t) s`,
14929     REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED; LEFT_AND_EXISTS_THM] THEN
14930     MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]) in
14931   let lemma1 = prove
14932    (`!f:A->B->bool P k.
14933         INFINITE {x | P x} /\ FINITE k /\
14934         (!x y. P x /\ P y /\ ~(x = y) ==> DISJOINT (f x) (f y))
14935         ==> ?x. P x /\ DISJOINT k (f x)`,
14936     REWRITE_TAC[INFINITE] THEN REPEAT STRIP_TAC THEN
14937     REWRITE_TAC[SET_RULE `(?x. P x /\ DISJOINT k (f x)) <=>
14938                           ~(!x. ?y. P x ==> y IN k /\ y IN f x)`] THEN
14939     REWRITE_TAC[SKOLEM_THM] THEN
14940     DISCH_THEN(X_CHOOSE_TAC `g:A->B`) THEN
14941     MP_TAC(ISPECL [`g:A->B`; `{x:A | P x}`] FINITE_IMAGE_INJ_EQ) THEN
14942     ASM_REWRITE_TAC[IN_ELIM_THM; NOT_IMP] THEN
14943     CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
14944     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
14945       (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN
14946     ASM SET_TAC[]) in
14947   let lemma2 = prove
14948    (`!f:real^M->real^N s t k p u.
14949           FINITE k /\ affine u /\
14950           f continuous_on ((u:real^M->bool) DIFF k) /\
14951           IMAGE f ((u:real^M->bool) DIFF k) SUBSET t /\
14952           (!c. c IN components((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})
14953                ==> ~(c INTER p = {})) /\
14954           closed_in (subtopology euclidean u) s /\ DISJOINT k s /\ k SUBSET u
14955           ==> ?g. g continuous_on ((u:real^M->bool) DIFF p) /\
14956                   IMAGE g ((u:real^M->bool) DIFF p) SUBSET t /\
14957                   !x. x IN s ==> g x = f x`,
14958     REPEAT GEN_TAC THEN ASM_CASES_TAC `k:real^M->bool = {}` THENL
14959      [ASM_REWRITE_TAC[DIFF_EMPTY] THEN REPEAT STRIP_TAC THEN
14960       EXISTS_TAC `f:real^M->real^N` THEN REWRITE_TAC[] THEN CONJ_TAC THENL
14961        [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_DIFF]; ASM SET_TAC[]];
14962       STRIP_TAC] THEN
14963     FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN
14964     SUBGOAL_THEN `~(((u:real^M->bool) DIFF s) INTER k = {})` MP_TAC THENL
14965      [ASM SET_TAC[]; ALL_TAC] THEN
14966     GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV o LAND_CONV)
14967      [UNIONS_COMPONENTS] THEN
14968     REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN
14969     REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN
14970     X_GEN_TAC `co:real^M->bool` THEN STRIP_TAC THEN
14971     SUBGOAL_THEN `locally connected (u:real^M->bool)` ASSUME_TAC THENL
14972      [ASM_SIMP_TAC[AFFINE_IMP_CONVEX; CONVEX_IMP_LOCALLY_CONNECTED];
14973       ALL_TAC] THEN
14974     SUBGOAL_THEN
14975      `!c. c IN components ((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})
14976           ==> ?a g. a IN c /\ a IN p /\
14977                     g continuous_on (s UNION (c DELETE a)) /\
14978                     IMAGE g (s UNION (c DELETE a)) SUBSET t /\
14979                     !x. x IN s ==> g x = (f:real^M->real^N) x`
14980     MP_TAC THENL
14981      [X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
14982       FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
14983       FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN
14984       ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
14985       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^M` THEN
14986       STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
14987       SUBGOAL_THEN `open_in (subtopology euclidean u) (c:real^M->bool)`
14988       MP_TAC THENL
14989        [MATCH_MP_TAC OPEN_IN_TRANS THEN
14990         EXISTS_TAC `u DIFF s:real^M->bool` THEN
14991         ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN
14992         MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN
14993         ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
14994         EXISTS_TAC `u:real^M->bool` THEN
14995         ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL];
14996         DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th)] THEN
14997       REWRITE_TAC[OPEN_IN_CONTAINS_CBALL] THEN
14998       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `a:real^M`)) THEN
14999       ASM_REWRITE_TAC[] THEN
15000       DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
15001       SUBGOAL_THEN `ball(a:real^M,d) INTER u SUBSET c` ASSUME_TAC THENL
15002        [ASM_MESON_TAC[BALL_SUBSET_CBALL; SUBSET_TRANS;
15003                       SET_RULE `b SUBSET c ==> b INTER u SUBSET c INTER u`];
15004         ALL_TAC] THEN
15005       MP_TAC(ISPECL
15006       [`ball(a:real^M,d) INTER u`; `c:real^M->bool`;
15007         `s UNION c:real^M->bool`; `c INTER k:real^M->bool`]
15008           HOMEOMORPHISM_GROUPING_POINTS_EXISTS_GEN) THEN
15009       ASM_REWRITE_TAC[INTER_SUBSET; SUBSET_UNION; UNION_SUBSET] THEN
15010       ANTS_TAC THENL
15011        [REPEAT CONJ_TAC THENL
15012          [MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN
15013           EXISTS_TAC `u:real^M->bool` THEN
15014           ASM_SIMP_TAC[HULL_MINIMAL; HULL_SUBSET];
15015           MP_TAC(ISPECL [`c:real^M->bool`; `u:real^M->bool`]
15016              AFFINE_HULL_OPEN_IN) THEN
15017           ASM_SIMP_TAC[HULL_P] THEN ASM SET_TAC[];
15018           REWRITE_TAC[HULL_SUBSET];
15019           ASM_MESON_TAC[IN_COMPONENTS_CONNECTED];
15020           ASM_MESON_TAC[FINITE_SUBSET; INTER_SUBSET];
15021           MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN
15022           EXISTS_TAC `u:real^M->bool` THEN
15023           ASM_REWRITE_TAC[] THEN
15024           ASM_MESON_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; INTER_COMM];
15025           REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
15026           EXISTS_TAC `a:real^M` THEN REWRITE_TAC[CENTRE_IN_BALL] THEN
15027           ASM SET_TAC[]];
15028         REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM]] THEN
15029       MAP_EVERY X_GEN_TAC [`h:real^M->real^M`; `k:real^M->real^M`] THEN
15030       REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN
15031       MP_TAC(ISPECL [`cball(a:real^M,d) INTER u`; `a:real^M`]
15032           RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL) THEN
15033       MP_TAC(ISPECL [`cball(a:real^M,d)`; `u:real^M->bool`]
15034           RELATIVE_INTERIOR_CONVEX_INTER_AFFINE) THEN
15035       MP_TAC(ISPECL [`cball(a:real^M,d)`; `u:real^M->bool`]
15036           RELATIVE_FRONTIER_CONVEX_INTER_AFFINE) THEN
15037       MP_TAC(ISPECL [`u:real^M->bool`; `cball(a:real^M,d)`]
15038           (ONCE_REWRITE_RULE[INTER_COMM]
15039              AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR)) THEN
15040       ASM_SIMP_TAC[CONVEX_CBALL; FRONTIER_CBALL; INTERIOR_CBALL] THEN
15041       SUBGOAL_THEN `a IN ball(a:real^M,d) INTER u` ASSUME_TAC THENL
15042        [ASM_REWRITE_TAC[CENTRE_IN_BALL; IN_INTER] THEN ASM SET_TAC[];
15043         ALL_TAC] THEN
15044       REPLICATE_TAC 3
15045        (ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC]) THEN
15046       ASM_SIMP_TAC[CONVEX_INTER; CONVEX_CBALL; AFFINE_IMP_CONVEX] THEN
15047       ANTS_TAC THENL
15048        [ASM_MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET; BOUNDED_CBALL];
15049         ALL_TAC] THEN
15050       ASM_REWRITE_TAC[retract_of; retraction] THEN
15051       DISCH_THEN(X_CHOOSE_THEN `r:real^M->real^M` STRIP_ASSUME_TAC) THEN
15052       EXISTS_TAC
15053        `(f:real^M->real^N) o (k:real^M->real^M) o
15054         (\x. if x IN ball(a,d) then r x else x)` THEN
15055       REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
15056        [ALL_TAC;
15057         X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[o_THM] THEN
15058         COND_CASES_TAC THENL
15059          [ASM SET_TAC[]; AP_TERM_TAC THEN ASM SET_TAC[]]] THEN
15060       ABBREV_TAC `j = \x:real^M. if x IN ball(a,d) then r x else x` THEN
15061       SUBGOAL_THEN
15062        `(j:real^M->real^M) continuous_on ((u:real^M->bool) DELETE a)`
15063       ASSUME_TAC THENL
15064        [EXPAND_TAC "j" THEN
15065         SUBGOAL_THEN
15066          `u DELETE (a:real^M) =
15067           (cball(a,d) DELETE a) INTER u UNION
15068           ((u:real^M->bool) DIFF ball(a,d))`
15069          (fun th -> SUBST1_TAC th THEN
15070                     MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
15071                     SUBST1_TAC(SYM th))
15072         THENL
15073          [MP_TAC(ISPECL [`a:real^M`; `d:real`] BALL_SUBSET_CBALL) THEN
15074           ASM SET_TAC[];
15075           ALL_TAC] THEN
15076         REWRITE_TAC[IN_DIFF; IN_INTER; IN_DELETE; CONTINUOUS_ON_ID] THEN
15077         REPEAT CONJ_TAC THENL
15078          [ALL_TAC; ALL_TAC;
15079           FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15080             CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[];
15081           REWRITE_TAC[GSYM BALL_UNION_SPHERE] THEN ASM SET_TAC[]] THEN
15082         REWRITE_TAC[CLOSED_IN_CLOSED] THENL
15083          [EXISTS_TAC `cball(a:real^M,d)` THEN REWRITE_TAC[CLOSED_CBALL];
15084           EXISTS_TAC `(:real^M) DIFF ball(a,d)` THEN
15085           REWRITE_TAC[GSYM OPEN_CLOSED; OPEN_BALL]] THEN
15086         MP_TAC(ISPECL [`a:real^M`; `d:real`] BALL_SUBSET_CBALL) THEN
15087         MP_TAC(ISPECL [`a:real^M`; `d:real`] CENTRE_IN_BALL) THEN
15088         ASM SET_TAC[];
15089         ALL_TAC] THEN
15090       SUBGOAL_THEN
15091        `IMAGE (j:real^M->real^M) (s UNION c DELETE a) SUBSET
15092         (s UNION c DIFF ball(a,d))`
15093       ASSUME_TAC THENL
15094        [EXPAND_TAC "j" THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
15095         X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
15096         COND_CASES_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
15097         SUBGOAL_THEN `(r:real^M->real^M) x IN sphere(a,d)` MP_TAC THENL
15098          [MP_TAC(ISPECL [`a:real^M`; `d:real`] CENTRE_IN_BALL) THEN
15099           ASM SET_TAC[];
15100           REWRITE_TAC[GSYM CBALL_DIFF_BALL] THEN ASM SET_TAC[]];
15101         ALL_TAC] THEN
15102       CONJ_TAC THENL
15103        [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN
15104         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15105             CONTINUOUS_ON_SUBSET))
15106         THENL [ASM SET_TAC[]; ASM SET_TAC[]; ALL_TAC];
15107         ONCE_REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
15108          (SET_RULE `IMAGE f u SUBSET t
15109                     ==> s SUBSET u ==> IMAGE f s SUBSET t`))] THEN
15110       REWRITE_TAC[IMAGE_o] THEN
15111       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
15112         `s SUBSET u ==> IMAGE f u SUBSET t ==> IMAGE f s SUBSET t`)) THEN
15113       REWRITE_TAC[SUBSET; IN_UNIV; IN_DIFF; FORALL_IN_IMAGE] THEN
15114       ASM SET_TAC[];
15115       ALL_TAC] THEN
15116     GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN
15117     REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN
15118     MAP_EVERY X_GEN_TAC
15119      [`a:(real^M->bool)->real^M`; `h:(real^M->bool)->real^M->real^N`] THEN
15120     DISCH_TAC THEN MP_TAC(ISPECL
15121      [`h:(real^M->bool)->real^M->real^N`;
15122       `\c:real^M->bool. s UNION (c DELETE (a c))`;
15123       `s UNION UNIONS
15124        { c DELETE (a c) |
15125          c IN components ((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})}`;
15126       `{c | c IN components ((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})}`]
15127      PASTING_LEMMA_EXISTS_CLOSED) THEN
15128     SUBGOAL_THEN
15129      `FINITE {c | c IN components((u:real^M->bool) DIFF s) /\
15130                   ~(c INTER k = {})}`
15131     ASSUME_TAC THENL
15132      [MP_TAC(ISPECL
15133        [`\c:real^M->bool. c INTER k`;
15134         `{c | c IN components ((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})}`]
15135        FINITE_IMAGE_INJ_EQ) THEN
15136       REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL
15137        [MESON_TAC[COMPONENTS_EQ;
15138                   SET_RULE
15139                     `s INTER k = t INTER k /\ ~(s INTER k = {})
15140                      ==> ~(s INTER t = {})`];
15141         DISCH_THEN(SUBST1_TAC o SYM) THEN
15142         REWRITE_TAC[GSYM SIMPLE_IMAGE; IN_ELIM_THM]] THEN
15143       MP_TAC(ISPEC
15144        `{c INTER k |c| c IN components((u:real^M->bool) DIFF s) /\
15145                        ~(c INTER k = {})}`
15146         FINITE_UNIONS) THEN
15147       MATCH_MP_TAC(TAUT `p ==> (p <=> q /\ r) ==> q`) THEN
15148       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15149         FINITE_SUBSET)) THEN
15150       REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[];
15151       ALL_TAC] THEN
15152     ASM_REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL
15153      [REPEAT CONJ_TAC THENL
15154        [REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[];
15155         X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN ASM_SIMP_TAC[] THEN
15156         MATCH_MP_TAC lemma0 THEN
15157         MAP_EVERY EXISTS_TAC [`u:real^M->bool`; `s UNION c:real^M->bool`] THEN
15158         REPEAT CONJ_TAC THENL
15159          [MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENT THEN
15160           ASM_REWRITE_TAC[];
15161           ASM_REWRITE_TAC[UNION_SUBSET; UNIONS_SUBSET; FORALL_IN_GSPEC] THEN
15162           MESON_TAC[IN_COMPONENTS_SUBSET;
15163                     SET_RULE `c SUBSET u DIFF s ==> c DELETE a SUBSET u`];
15164           ASM_SIMP_TAC[CLOSED_UNION_COMPLEMENT_COMPONENT; UNIONS_GSPEC] THEN
15165           MATCH_MP_TAC(SET_RULE
15166            `~(a IN t) /\ c DELETE a SUBSET t
15167             ==> s UNION c DELETE a = (s UNION c) INTER (s UNION t)`) THEN
15168           CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
15169           REWRITE_TAC[IN_ELIM_THM; IN_DELETE] THEN
15170           DISCH_THEN(X_CHOOSE_THEN `c':real^M->bool` STRIP_ASSUME_TAC) THEN
15171           MP_TAC(ISPECL [`(u:real^M->bool) DIFF s`;
15172                           `c:real^M->bool`; `c':real^M->bool`]
15173             COMPONENTS_EQ) THEN
15174           ASM_CASES_TAC `c':real^M->bool = c` THENL
15175            [ASM_MESON_TAC[]; ALL_TAC] THEN
15176           ASM SET_TAC[]];
15177         MAP_EVERY X_GEN_TAC
15178          [`c1:real^M->bool`; `c2:real^M->bool`; `x:real^M`] THEN
15179         STRIP_TAC THEN ASM_CASES_TAC `c2:real^M->bool = c1` THEN
15180         ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE
15181           `x IN u INTER (s UNION c1 DELETE a) INTER (s UNION c2 DELETE b)
15182            ==> (c1 INTER c2 = {}) ==> x IN s`)) THEN
15183         ANTS_TAC THENL [ASM_MESON_TAC[COMPONENTS_EQ]; ASM_SIMP_TAC[]]];
15184       DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC)] THEN
15185     MP_TAC
15186      (ISPECL [`\x. x IN s UNION
15187                         UNIONS {c | c IN components((u:real^M->bool) DIFF s) /\
15188                                     c INTER k = {}}`;
15189               `f:real^M->real^N`;
15190               `g:real^M->real^N`;
15191               `s UNION
15192                UNIONS {c | c IN components((u:real^M->bool) DIFF s) /\
15193                            c INTER k = {}}`;
15194               `s UNION
15195                UNIONS { c DELETE (a c) |
15196                         c IN components((u:real^M->bool) DIFF s) /\
15197                         ~(c INTER k = {})}`]
15198           CONTINUOUS_ON_CASES_LOCAL) THEN
15199     ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
15200      [REPEAT CONJ_TAC THENL
15201        [MATCH_MP_TAC lemma0 THEN EXISTS_TAC `u:real^M->bool` THEN
15202         EXISTS_TAC `u DIFF
15203                     UNIONS {c DELETE a c |
15204                             c IN components ((u:real^M->bool) DIFF s) /\
15205                             ~(c INTER k = {})}` THEN
15206         REPEAT CONJ_TAC THENL
15207           [MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN
15208            MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN
15209            X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN
15210            MATCH_MP_TAC OPEN_IN_DELETE THEN MATCH_MP_TAC OPEN_IN_TRANS THEN
15211            EXISTS_TAC `u DIFF s:real^M->bool` THEN
15212            ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN
15213            MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN
15214            ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
15215            EXISTS_TAC `u:real^M->bool` THEN
15216            ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL];
15217            ASM_REWRITE_TAC[UNION_SUBSET] THEN
15218            REWRITE_TAC[UNIONS_SUBSET; IN_ELIM_THM] THEN
15219            MESON_TAC[IN_COMPONENTS_SUBSET;
15220                      SET_RULE `c SUBSET u DIFF s ==> c DELETE a SUBSET u /\
15221                                                      c SUBSET u`];
15222            REWRITE_TAC[SET_RULE
15223             `(s UNION t) UNION (s UNION u) = (s UNION t) UNION u`] THEN
15224            MATCH_MP_TAC(SET_RULE
15225             `s SUBSET u /\ t INTER s = {}
15226              ==> s = (u DIFF t) INTER (s UNION t)`) THEN
15227            CONJ_TAC THENL
15228             [ASM_REWRITE_TAC[UNION_SUBSET] THEN
15229              REWRITE_TAC[UNIONS_SUBSET; IN_ELIM_THM] THEN
15230              MESON_TAC[IN_COMPONENTS_SUBSET;
15231                        SET_RULE `c SUBSET u DIFF s ==> c DELETE a SUBSET u /\
15232                                                        c SUBSET u`];
15233              ALL_TAC] THEN
15234            REWRITE_TAC[EMPTY_UNION; SET_RULE
15235             `c INTER (s UNION t) = (s INTER c) UNION (c INTER t)`] THEN
15236            CONJ_TAC THENL
15237             [MATCH_MP_TAC(SET_RULE
15238               `t SUBSET UNIV DIFF s ==> s INTER t = {}`) THEN
15239              REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN GEN_TAC THEN
15240              DISCH_THEN(CONJUNCTS_THEN2
15241                (MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)
15242                MP_TAC) THEN ASM SET_TAC[];
15243              REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN
15244              X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
15245              X_GEN_TAC `c':real^M->bool` THEN STRIP_TAC THEN
15246              MP_TAC(ISPECL [`(u:real^M->bool) DIFF s`;
15247                             `c:real^M->bool`; `c':real^M->bool`]
15248                COMPONENTS_EQ) THEN
15249              ASM_CASES_TAC `c':real^M->bool = c` THENL
15250               [ASM_MESON_TAC[]; ASM SET_TAC[]]]];
15251         MATCH_MP_TAC lemma0 THEN EXISTS_TAC `u:real^M->bool` THEN
15252         EXISTS_TAC
15253          `UNIONS {s UNION c |c| c IN components ((u:real^M->bool) DIFF s) /\
15254                                 ~(c INTER k = {})}` THEN
15255         REPEAT CONJ_TAC THENL
15256          [MATCH_MP_TAC CLOSED_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN
15257           ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
15258           ASM_SIMP_TAC[FINITE_IMAGE] THEN REPEAT STRIP_TAC THEN
15259           MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENT THEN
15260           ASM_REWRITE_TAC[];
15261           ASM_REWRITE_TAC[UNION_SUBSET] THEN
15262           REWRITE_TAC[UNIONS_SUBSET; IN_ELIM_THM] THEN
15263           MESON_TAC[IN_COMPONENTS_SUBSET;
15264                     SET_RULE `c SUBSET u DIFF s ==> c DELETE a SUBSET u /\
15265                                                     c SUBSET u`];
15266           MATCH_MP_TAC(SET_RULE
15267            `t SUBSET u /\ u INTER s SUBSET t ==> t = u INTER (s UNION t)`) THEN
15268           CONJ_TAC THENL
15269            [REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]; ALL_TAC] THEN
15270           MATCH_MP_TAC(SET_RULE
15271            `u INTER t SUBSET s ==> u INTER (s UNION t) SUBSET s UNION v`) THEN
15272           MATCH_MP_TAC(SET_RULE
15273           `((UNIV DIFF s) INTER t) INTER u SUBSET s
15274            ==> t INTER u SUBSET s`) THEN
15275           GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o TOP_DEPTH_CONV)
15276            [INTER_UNIONS] THEN
15277           REWRITE_TAC[SET_RULE
15278            `{g x | x IN {f y | P y}} = {g(f y) | P y}`] THEN
15279           REWRITE_TAC[SET_RULE
15280            `(UNIV DIFF s) INTER (s UNION c) = c DIFF s`] THEN
15281           REWRITE_TAC[SET_RULE
15282            `t INTER u SUBSET s <=> t INTER ((UNIV DIFF s) INTER u) = {}`] THEN
15283           ONCE_REWRITE_TAC[INTER_UNIONS] THEN
15284           REWRITE_TAC[EMPTY_UNIONS; FORALL_IN_GSPEC; INTER_UNIONS] THEN
15285           X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
15286           X_GEN_TAC `c':real^M->bool` THEN STRIP_TAC THEN
15287           MP_TAC(ISPECL [`(u:real^M->bool) DIFF s`;
15288                `c:real^M->bool`; `c':real^M->bool`]
15289             COMPONENTS_EQ) THEN
15290           ASM_CASES_TAC `c':real^M->bool = c` THENL
15291            [ASM_MESON_TAC[]; ASM SET_TAC[]]];
15292         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15293           CONTINUOUS_ON_SUBSET)) THEN
15294         REWRITE_TAC[UNION_SUBSET] THEN
15295         CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
15296         REWRITE_TAC[UNIONS_SUBSET; IN_ELIM_THM] THEN
15297         GEN_TAC THEN
15298         DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)
15299           MP_TAC) THEN ASM SET_TAC[];
15300         REWRITE_TAC[TAUT `p /\ ~p <=> F`] THEN X_GEN_TAC `x:real^M` THEN
15301         REWRITE_TAC[IN_UNION] THEN
15302         ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THENL
15303          [ASM SET_TAC[]; ALL_TAC] THEN
15304         REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_DELETE] THEN
15305         DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `c:real^M->bool`)
15306           (X_CHOOSE_TAC `c':real^M->bool`)) THEN
15307         MP_TAC(ISPECL [`(u:real^M->bool) DIFF s`;
15308                         `c:real^M->bool`; `c':real^M->bool`]
15309             COMPONENTS_EQ) THEN
15310         ASM_CASES_TAC `c':real^M->bool = c` THENL
15311          [ASM_MESON_TAC[]; ASM SET_TAC[]]];
15312       MATCH_MP_TAC(MESON[CONTINUOUS_ON_SUBSET]
15313        `t SUBSET s /\ P f
15314         ==> f continuous_on s ==> ?g. g continuous_on t /\ P g`) THEN
15315       REWRITE_TAC[] THEN CONJ_TAC THENL
15316        [REWRITE_TAC[SET_RULE
15317          `(s UNION t) UNION (s UNION u) = s UNION (t UNION u)`] THEN
15318         MATCH_MP_TAC(SET_RULE
15319          `(u DIFF s) DIFF p SUBSET t
15320           ==> u DIFF p SUBSET s UNION t`) THEN
15321         GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [UNIONS_COMPONENTS] THEN
15322         REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[];
15323         SIMP_TAC[IN_UNION]] THEN
15324       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF; IN_UNION; IN_UNIV] THEN
15325       X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN
15326       ASM_CASES_TAC `(x:real^M) IN s` THENL [ASM SET_TAC[]; ALL_TAC] THEN
15327       ASM_REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN COND_CASES_TAC THENL
15328        [ASM SET_TAC[]; ALL_TAC] THEN
15329       SUBGOAL_THEN
15330         `x IN ((u:real^M->bool) DIFF s)` MP_TAC THENL
15331           [ASM SET_TAC[]; ALL_TAC] THEN
15332       GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [UNIONS_COMPONENTS] THEN
15333       REWRITE_TAC[IN_UNIONS] THEN
15334       DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN
15335       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN
15336       DISCH_THEN(MP_TAC o SPEC `c:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN
15337       DISCH_TAC THEN
15338       FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `c:real^M->bool`]) THEN
15339       ASM_REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]]) in
15340   let lemma3 = prove
15341    (`!f:real^M->real^N s t u p.
15342           compact s /\ convex u /\ bounded u /\
15343           affine t /\ aff_dim t <= aff_dim u /\ s SUBSET t /\
15344           f continuous_on s /\ IMAGE f s SUBSET relative_frontier u /\
15345           (!c. c IN components(t DIFF s) ==> ~(c INTER p = {}))
15346           ==> ?k g. FINITE k /\ k SUBSET p /\ k SUBSET t /\ DISJOINT k s /\
15347                     g continuous_on (t DIFF k) /\
15348                     IMAGE g (t DIFF k) SUBSET relative_frontier u /\
15349                     !x. x IN s ==> g x = f x`,
15350     REPEAT STRIP_TAC THEN
15351     MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`;
15352                    `t:real^M->bool`; `u:real^N->bool`]
15353           EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_SIMPLE) THEN
15354     ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
15355     MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `g:real^M->real^N`] THEN
15356     STRIP_TAC THEN
15357     SUBGOAL_THEN
15358      `!x. ?y. x IN k
15359               ==> ?c. c IN components (t DIFF s:real^M->bool) /\
15360                       x IN c /\ y IN c /\ y IN p`
15361     MP_TAC THENL
15362      [X_GEN_TAC `x:real^M` THEN REWRITE_TAC[RIGHT_EXISTS_IMP_THM] THEN
15363       DISCH_TAC THEN
15364       SUBGOAL_THEN `(x:real^M) IN (t DIFF s)` MP_TAC THENL
15365        [ASM SET_TAC[]; ALL_TAC] THEN
15366       GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [UNIONS_COMPONENTS] THEN
15367       ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
15368       REWRITE_TAC[IN_UNIONS; RIGHT_EXISTS_AND_THM] THEN
15369       MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[];
15370       REWRITE_TAC[SKOLEM_THM] THEN
15371       DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^M` (LABEL_TAC "*"))] THEN
15372     EXISTS_TAC `IMAGE (h:real^M->real^M) k` THEN
15373     MP_TAC(ISPECL
15374      [`g:real^M->real^N`; `s:real^M->bool`;
15375       `relative_frontier u:real^N->bool`; `k:real^M->bool`;
15376       `IMAGE (h:real^M->real^M) k`; `t:real^M->bool`] lemma2) THEN
15377     ASM_SIMP_TAC[AFFINE_AFFINE_HULL; FINITE_IMAGE] THEN ANTS_TAC THENL
15378      [CONJ_TAC THENL
15379        [X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
15380         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
15381         ONCE_REWRITE_TAC[INTER_COMM] THEN
15382         REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; EXISTS_IN_IMAGE; IN_INTER] THEN
15383         MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^M` THEN
15384         STRIP_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `x:real^M`) THEN
15385         ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
15386         X_GEN_TAC `c':real^M->bool` THEN STRIP_TAC THEN
15387         MP_TAC(ISPECL [`(t:real^M->bool) DIFF s`;
15388                        `c:real^M->bool`; `c':real^M->bool`]
15389           COMPONENTS_EQ) THEN
15390         ASM_CASES_TAC `c':real^M->bool = c` THENL [ALL_TAC; ASM SET_TAC[]] THEN
15391         ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
15392         MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN
15393         EXISTS_TAC `(:real^M)` THEN
15394         ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN
15395         ASM_SIMP_TAC[COMPACT_IMP_CLOSED; SUBSET_UNIV]];
15396       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^M->real^N` THEN
15397       STRIP_TAC THEN ASM_SIMP_TAC[] THEN
15398       REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s ==> ~(x IN t)`] THEN
15399       ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
15400       ASM_MESON_TAC[IN_COMPONENTS_SUBSET; SUBSET; IN_DIFF]]) in
15401   REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL
15402    [ASM_CASES_TAC `relative_frontier(u:real^N->bool) = {}` THENL
15403      [RULE_ASSUM_TAC(REWRITE_RULE[RELATIVE_FRONTIER_EQ_EMPTY]) THEN
15404       UNDISCH_TAC `bounded(u:real^N->bool)` THEN
15405       ASM_SIMP_TAC[AFFINE_BOUNDED_EQ_LOWDIM] THEN DISCH_TAC THEN
15406       SUBGOAL_THEN `aff_dim(t:real^M->bool) <= &0` MP_TAC THENL
15407        [ASM_INT_ARITH_TAC; ALL_TAC] THEN
15408       SIMP_TAC[AFF_DIM_GE; INT_ARITH
15409        `--(&1):int <= x ==> (x <= &0 <=> x = --(&1) \/ x = &0)`] THEN
15410       REWRITE_TAC[AFF_DIM_EQ_MINUS1; AFF_DIM_EQ_0] THEN
15411       DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC (X_CHOOSE_TAC `a:real^M`)) THENL
15412        [EXISTS_TAC `{}:real^M->bool` THEN
15413         ASM_REWRITE_TAC[EMPTY_DIFF; FINITE_EMPTY; CONTINUOUS_ON_EMPTY;
15414                         IMAGE_CLAUSES; NOT_IN_EMPTY] THEN
15415         SET_TAC[];
15416         FIRST_X_ASSUM(MP_TAC o SPEC `{a:real^M}`) THEN
15417         ASM_REWRITE_TAC[DIFF_EMPTY; IN_COMPONENTS_SELF] THEN
15418         REWRITE_TAC[CONNECTED_SING; NOT_INSERT_EMPTY; BOUNDED_SING] THEN
15419         DISCH_TAC THEN EXISTS_TAC `{a:real^M}` THEN
15420         ASM_REWRITE_TAC[DIFF_EQ_EMPTY; CONTINUOUS_ON_EMPTY; NOT_IN_EMPTY;
15421                         FINITE_SING; IMAGE_CLAUSES; EMPTY_SUBSET] THEN
15422         ASM SET_TAC[]];
15423       EXISTS_TAC `{}:real^M->bool` THEN
15424       FIRST_X_ASSUM(X_CHOOSE_TAC `y:real^N` o
15425         GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
15426       ASM_SIMP_TAC[FINITE_EMPTY; DISJOINT_EMPTY; NOT_IN_EMPTY; DIFF_EMPTY] THEN
15427       EXISTS_TAC `(\x. y):real^M->real^N` THEN
15428       REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]];
15429     ALL_TAC] THEN
15430   FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN
15431   DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC) THEN
15432   REWRITE_TAC[INSERT_SUBSET] THEN
15433   DISCH_THEN(X_CHOOSE_THEN `b:real^M` STRIP_ASSUME_TAC) THEN
15434   MP_TAC(ISPECL
15435    [`f:real^M->real^N`; `s:real^M->bool`;
15436     `t:real^M->bool`; `u:real^N->bool`;
15437     `p UNION (UNIONS {c | c IN components (t DIFF s) /\ ~bounded c} DIFF
15438               interval[--(b + vec 1):real^M,b + vec 1])`]
15439         lemma3) THEN
15440   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
15441    [X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN
15442     ASM_CASES_TAC `bounded(c:real^M->bool)` THENL
15443      [FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN
15444       ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
15445       ALL_TAC] THEN
15446     SUBGOAL_THEN
15447      `~(c SUBSET interval[--(b + vec 1):real^M,b + vec 1])`
15448     MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
15449     ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_INTERVAL];
15450     ALL_TAC] THEN
15451   REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
15452   MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `g:real^M->real^N`] THEN
15453   STRIP_TAC THEN
15454   EXISTS_TAC `k INTER interval[--(b + vec 1):real^M,b + vec 1]` THEN
15455   ASM_SIMP_TAC[FINITE_INTER; RIGHT_EXISTS_AND_THM] THEN
15456   REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
15457   SUBGOAL_THEN
15458    `interval[--b,b] SUBSET interval[--(b + vec 1):real^M,b + vec 1]`
15459   ASSUME_TAC THENL
15460    [REWRITE_TAC[SUBSET_INTERVAL; VECTOR_ADD_COMPONENT; VECTOR_NEG_COMPONENT;
15461                 VEC_COMPONENT] THEN
15462     REAL_ARITH_TAC;
15463     ALL_TAC] THEN
15464   SUBGOAL_THEN
15465    `?d:real. (&1 / &2 <= d /\ d <= &1) /\
15466              DISJOINT k (frontier(interval[--(b + lambda i. d):real^M,
15467                                              (b + lambda i. d)]))`
15468   STRIP_ASSUME_TAC THENL
15469    [MATCH_MP_TAC lemma1 THEN
15470     ASM_SIMP_TAC[INFINITE; FINITE_REAL_INTERVAL; REAL_NOT_LE] THEN
15471     CONV_TAC REAL_RAT_REDUCE_CONV THEN
15472     MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[] THEN
15473     CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN
15474     MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN REPEAT STRIP_TAC THEN
15475     REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE
15476      `c SUBSET i' ==> DISJOINT (c DIFF i) (c' DIFF i')`) THEN
15477     REWRITE_TAC[INTERIOR_INTERVAL; CLOSURE_INTERVAL] THEN
15478     SIMP_TAC[SUBSET_INTERVAL; VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT;
15479              LAMBDA_BETA] THEN
15480     ASM_REAL_ARITH_TAC;
15481     ALL_TAC] THEN
15482   ABBREV_TAC `c:real^M = b + lambda i. d` THEN SUBGOAL_THEN
15483    `interval[--b:real^M,b] SUBSET interval(--c,c) /\
15484     interval[--b:real^M,b] SUBSET interval[--c,c] /\
15485     interval[--c,c] SUBSET interval[--(b + vec 1):real^M,b + vec 1]`
15486   STRIP_ASSUME_TAC THENL
15487    [REWRITE_TAC[SUBSET_INTERVAL] THEN EXPAND_TAC "c" THEN REPEAT CONJ_TAC THEN
15488     SIMP_TAC[VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN
15489     MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
15490     REWRITE_TAC[VEC_COMPONENT] THEN ASM_REAL_ARITH_TAC;
15491     ALL_TAC] THEN
15492   EXISTS_TAC
15493    `(g:real^M->real^N) o
15494     closest_point (interval[--c,c] INTER t)` THEN
15495   REPEAT CONJ_TAC THENL
15496    [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL
15497      [MATCH_MP_TAC CONTINUOUS_ON_CLOSEST_POINT THEN
15498       ASM_SIMP_TAC[CONVEX_INTER; CLOSED_INTER; CLOSED_INTERVAL; CLOSED_AFFINE;
15499         AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; CONVEX_INTERVAL] THEN
15500       ASM SET_TAC[];
15501       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15502           CONTINUOUS_ON_SUBSET))];
15503     REWRITE_TAC[IMAGE_o] THEN
15504     FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
15505         SUBSET_TRANS)) THEN
15506     MATCH_MP_TAC IMAGE_SUBSET;
15507     X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[o_THM] THEN
15508     TRANS_TAC EQ_TRANS `(g:real^M->real^N) x` THEN
15509     CONJ_TAC THENL [AP_TERM_TAC; ASM SET_TAC[]] THEN
15510     MATCH_MP_TAC CLOSEST_POINT_SELF THEN
15511     ASM_SIMP_TAC[IN_INTER; HULL_INC] THEN ASM SET_TAC[]] THEN
15512   (REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF] THEN
15513    X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN CONJ_TAC THENL
15514     [MATCH_MP_TAC(SET_RULE
15515       `closest_point s x IN s /\ s SUBSET u ==> closest_point s x IN u`) THEN
15516      CONJ_TAC THENL [MATCH_MP_TAC CLOSEST_POINT_IN_SET; ASM SET_TAC[]] THEN
15517      ASM_SIMP_TAC[CLOSED_INTER; CLOSED_INTERVAL; CLOSED_AFFINE] THEN
15518      ASM SET_TAC[];
15519      ALL_TAC] THEN
15520    ASM_CASES_TAC `x IN interval[--c:real^M,c]` THEN
15521    ASM_SIMP_TAC[CLOSEST_POINT_SELF; IN_INTER] THENL
15522     [ASM SET_TAC[]; ALL_TAC] THEN
15523    MATCH_MP_TAC(SET_RULE
15524     `closest_point s x IN relative_frontier s /\
15525      DISJOINT k (relative_frontier s)
15526      ==> ~(closest_point s x IN k)`) THEN
15527    CONJ_TAC THENL
15528     [MATCH_MP_TAC CLOSEST_POINT_IN_RELATIVE_FRONTIER THEN
15529      ASM_SIMP_TAC[CLOSED_INTER; CLOSED_AFFINE; CLOSED_INTERVAL] THEN
15530      CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_DIFF]] THEN CONJ_TAC THENL
15531       [ALL_TAC; ASM_MESON_TAC[SUBSET; RELATIVE_INTERIOR_SUBSET; IN_INTER]] THEN
15532      ONCE_REWRITE_TAC[INTER_COMM] THEN
15533      W(MP_TAC o PART_MATCH (lhs o rand)
15534        AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR o rand o snd) THEN
15535      ASM_SIMP_TAC[HULL_HULL; AFFINE_AFFINE_HULL; AFFINE_IMP_CONVEX] THEN
15536      ASM_SIMP_TAC[HULL_P] THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
15537      REWRITE_TAC[INTERIOR_INTERVAL] THEN ASM SET_TAC[];
15538      W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_FRONTIER_CONVEX_INTER_AFFINE o
15539        rand o snd) THEN
15540      ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
15541      REWRITE_TAC[CONVEX_INTERVAL; AFFINE_AFFINE_HULL; INTERIOR_INTERVAL] THEN
15542      ASM SET_TAC[]]));;
15543
15544 let EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE = prove
15545  (`!f:real^M->real^N s t a r p.
15546         compact s /\ affine t /\ aff_dim t <= &(dimindex(:N)) /\ s SUBSET t /\
15547         &0 <= r /\ f continuous_on s /\ IMAGE f s SUBSET sphere(a,r) /\
15548         (!c. c IN components(t DIFF s) /\ bounded c ==> ~(c INTER p = {}))
15549         ==> ?k g. FINITE k /\ k SUBSET p /\ k SUBSET t /\ DISJOINT k s /\
15550                   g continuous_on (t DIFF k) /\
15551                   IMAGE g (t DIFF k) SUBSET sphere(a,r) /\
15552                   !x. x IN s ==> g x = f x`,
15553   REPEAT GEN_TAC THEN ASM_CASES_TAC `r = &0` THENL
15554    [ASM_SIMP_TAC[SPHERE_SING] THEN STRIP_TAC THEN
15555     EXISTS_TAC `{}:real^M->bool` THEN
15556     EXISTS_TAC `(\x. a):real^M->real^N` THEN
15557     REWRITE_TAC[CONTINUOUS_ON_CONST; FINITE_EMPTY] THEN ASM SET_TAC[];
15558     MP_TAC(ISPECL [`a:real^N`; `r:real`] RELATIVE_FRONTIER_CBALL) THEN
15559     ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
15560     STRIP_TAC THEN MATCH_MP_TAC EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_GEN THEN
15561     ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; AFF_DIM_CBALL] THEN
15562     COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]);;
15563
15564 let EXTEND_MAP_UNIV_TO_SPHERE_COFINITE = prove
15565  (`!f:real^M->real^N s a r p.
15566      dimindex(:M) <= dimindex(:N) /\ &0 <= r /\
15567      compact s /\ f continuous_on s /\ IMAGE f s SUBSET sphere(a,r) /\
15568      (!c. c IN components((:real^M) DIFF s) /\ bounded c
15569           ==> ~(c INTER p = {}))
15570      ==> ?k g. FINITE k /\ k SUBSET p /\ DISJOINT k s /\
15571                g continuous_on ((:real^M) DIFF k) /\
15572                IMAGE g ((:real^M) DIFF k) SUBSET sphere(a,r) /\
15573                !x. x IN s ==> g x = f x`,
15574   REPEAT STRIP_TAC THEN
15575   MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `(:real^M)`;
15576                  `a:real^N`; `r:real`; `p:real^M->bool`]
15577         EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE) THEN
15578   ASM_REWRITE_TAC[AFFINE_UNIV; SUBSET_UNIV; AFF_DIM_UNIV; INT_OF_NUM_LE]);;
15579
15580 let EXTEND_MAP_UNIV_TO_SPHERE_NO_BOUNDED_COMPONENT = prove
15581  (`!f:real^M->real^N s a r.
15582      dimindex(:M) <= dimindex(:N) /\ &0 <= r /\
15583      compact s /\ f continuous_on s /\ IMAGE f s SUBSET sphere(a,r) /\
15584      (!c. c IN components((:real^M) DIFF s) ==> ~bounded c)
15585      ==> ?g. g continuous_on (:real^M) /\
15586              IMAGE g (:real^M) SUBSET sphere(a,r) /\
15587              !x. x IN s ==> g x = f x`,
15588   REPEAT STRIP_TAC THEN
15589   MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`;  `a:real^N`; `r:real`;
15590                  `{}:real^M->bool`] EXTEND_MAP_UNIV_TO_SPHERE_COFINITE) THEN
15591   ASM_SIMP_TAC[IMP_CONJ; SUBSET_EMPTY; RIGHT_EXISTS_AND_THM] THEN
15592   ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN
15593   REWRITE_TAC[UNWIND_THM2; FINITE_EMPTY; DISJOINT_EMPTY; DIFF_EMPTY] THEN
15594   MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]);;
15595
15596 let EXTEND_MAP_SPHERE_TO_SPHERE_GEN = prove
15597  (`!f:real^M->real^N c s t.
15598         closed c /\ c SUBSET relative_frontier s /\ convex s /\ bounded s /\
15599         convex t /\ bounded t /\ aff_dim s <= aff_dim t /\
15600         f continuous_on c /\ IMAGE f c SUBSET relative_frontier t
15601          ==> ?g. g continuous_on (relative_frontier s) /\
15602                  IMAGE g (relative_frontier s) SUBSET relative_frontier t /\
15603                  !x. x IN c ==> g x = f x`,
15604   REPEAT STRIP_TAC THEN
15605   SUBGOAL_THEN
15606    `?p:real^M->bool. polytope p /\ aff_dim p = aff_dim(s:real^M->bool)`
15607   STRIP_ASSUME_TAC THENL
15608    [MATCH_MP_TAC CHOOSE_POLYTOPE THEN
15609     ASM_REWRITE_TAC[AFF_DIM_GE; AFF_DIM_LE_UNIV];
15610     ALL_TAC] THEN
15611   MP_TAC(ISPECL [`s:real^M->bool`; `p:real^M->bool`]
15612         HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS) THEN
15613   ASM_SIMP_TAC[POLYTOPE_IMP_CONVEX; POLYTOPE_IMP_BOUNDED; homeomorphic] THEN
15614   REWRITE_TAC[HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN
15615   MAP_EVERY X_GEN_TAC [`h:real^M->real^M`; `k:real^M->real^M`] THEN
15616   STRIP_TAC THEN
15617   MP_TAC(ISPECL
15618    [`(f:real^M->real^N) o (k:real^M->real^M)`;
15619     `{f:real^M->bool | f face_of p /\ ~(f = p)}`;
15620     `IMAGE (h:real^M->real^M) c`;
15621     `t:real^N->bool`] EXTEND_MAP_CELL_COMPLEX_TO_SPHERE) THEN
15622   ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN
15623   ASM_SIMP_TAC[GSYM RELATIVE_FRONTIER_OF_POLYHEDRON_ALT;
15624                POLYTOPE_IMP_POLYHEDRON] THEN
15625   REWRITE_TAC[IN_ELIM_THM; GSYM IMAGE_o; o_THM] THEN ANTS_TAC THENL
15626    [REPEAT CONJ_TAC THENL
15627      [MATCH_MP_TAC FINITE_SUBSET THEN
15628       EXISTS_TAC `{f:real^M->bool | f face_of p}` THEN
15629       ASM_SIMP_TAC[FINITE_POLYTOPE_FACES] THEN SET_TAC[];
15630       ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE;
15631                     FACE_OF_AFF_DIM_LT; POLYTOPE_IMP_CONVEX; INT_LTE_TRANS];
15632       ASM_MESON_TAC[FACE_OF_INTER; FACE_OF_SUBSET;
15633                     INTER_SUBSET; FACE_OF_INTER; FACE_OF_IMP_SUBSET];
15634       ASM SET_TAC[];
15635       MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
15636       MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
15637       CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN
15638       ASM_REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN
15639       FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
15640         BOUNDED_SUBSET)) THEN
15641       ASM_SIMP_TAC[BOUNDED_RELATIVE_FRONTIER];
15642       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
15643       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15644         CONTINUOUS_ON_SUBSET)) THEN
15645       ASM SET_TAC[];
15646       REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]];
15647     DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN
15648     EXISTS_TAC `(g:real^M->real^N) o (h:real^M->real^M)` THEN
15649     REWRITE_TAC[IMAGE_o; o_THM] THEN
15650     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
15651     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
15652     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15653       CONTINUOUS_ON_SUBSET)) THEN
15654     ASM SET_TAC[]]);;
15655
15656 let EXTEND_MAP_SPHERE_TO_SPHERE = prove
15657  (`!f:real^M->real^N c a r b s.
15658         dimindex(:M) <= dimindex(:N) /\ closed c /\ c SUBSET sphere(a,r) /\
15659         f continuous_on c /\ IMAGE f c SUBSET sphere(b,s) /\
15660         (&0 <= r /\ c = {} ==> &0 <= s)
15661         ==> ?g. g continuous_on sphere(a,r) /\
15662                 IMAGE g (sphere(a,r)) SUBSET sphere(b,s) /\
15663                 !x. x IN c ==> g x = f x`,
15664   REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THEN
15665   ASM_SIMP_TAC[SPHERE_EMPTY; NOT_IN_EMPTY; CONTINUOUS_ON_EMPTY;
15666                IMAGE_CLAUSES; EMPTY_SUBSET]
15667   THENL [MESON_TAC[]; ASM_REWRITE_TAC[GSYM REAL_NOT_LT]] THEN
15668   ASM_CASES_TAC `sphere(b:real^N,s) = {}` THENL
15669    [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SPHERE_EQ_EMPTY]) THEN
15670     ASM SET_TAC[];
15671     FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SPHERE_EQ_EMPTY])] THEN
15672   REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
15673   RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN
15674   ASM_CASES_TAC `r = &0` THEN
15675   ASM_SIMP_TAC[SPHERE_SING; CONTINUOUS_ON_SING; REAL_LE_REFL] THENL
15676    [ASM_CASES_TAC `c:real^M->bool = {}` THENL
15677      [DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC(MESON[]
15678        `(?c. P(\x. c)) ==> ?f. P f`) THEN ASM SET_TAC[];
15679       DISCH_TAC THEN EXISTS_TAC `f:real^M->real^N` THEN ASM SET_TAC[]];
15680     ALL_TAC] THEN
15681   ASM_CASES_TAC `s = &0` THENL
15682    [ASM_SIMP_TAC[SPHERE_SING] THEN STRIP_TAC THEN
15683     EXISTS_TAC `(\x. b):real^M->real^N` THEN
15684     REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[];
15685     ALL_TAC] THEN
15686   STRIP_TAC THEN
15687   MP_TAC(ISPECL [`f:real^M->real^N`; `c:real^M->bool`;
15688                  `cball(a:real^M,r)`; `cball(b:real^N,s)`]
15689         EXTEND_MAP_SPHERE_TO_SPHERE_GEN) THEN
15690   ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; AFF_DIM_CBALL;
15691                   RELATIVE_FRONTIER_CBALL] THEN
15692   DISCH_THEN MATCH_MP_TAC THEN
15693   REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[INT_OF_NUM_LE]) THEN
15694   ASM_REAL_ARITH_TAC);;
15695
15696 let EXTEND_MAP_SPHERE_TO_SPHERE_COFINITE_GEN = prove
15697  (`!f:real^M->real^N s t u p.
15698         convex t /\ bounded t /\ convex u /\ bounded u /\
15699         aff_dim t <= aff_dim u + &1 /\
15700         closed s /\ s SUBSET relative_frontier t /\
15701         f continuous_on s /\ IMAGE f s SUBSET relative_frontier u /\
15702         (!c. c IN components(relative_frontier t DIFF s) ==> ~(c INTER p = {}))
15703         ==> ?k g. FINITE k /\ k SUBSET p /\
15704                   k SUBSET relative_frontier t /\ DISJOINT k s /\
15705                   g continuous_on (relative_frontier t DIFF k) /\
15706                   IMAGE g (relative_frontier t DIFF k) SUBSET
15707                   relative_frontier u /\
15708                   !x. x IN s ==> g x = f x`,
15709   REPEAT GEN_TAC THEN
15710   ASM_CASES_TAC `s = (relative_frontier t:real^M->bool)` THENL
15711    [ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
15712     MAP_EVERY EXISTS_TAC [`{}:real^M->bool`; `f:real^M->real^N`] THEN
15713     ASM_REWRITE_TAC[FINITE_EMPTY; DIFF_EMPTY] THEN SET_TAC[];
15714     POP_ASSUM MP_TAC] THEN
15715   ASM_CASES_TAC `relative_frontier t:real^M->bool = {}` THENL
15716    [ASM SET_TAC[]; REPEAT STRIP_TAC] THEN
15717   SUBGOAL_THEN
15718    `?c q:real^M. c IN components (relative_frontier t DIFF s) /\
15719                  q IN c /\ q IN relative_frontier t /\ ~(q IN s) /\ q IN p`
15720   STRIP_ASSUME_TAC THENL
15721    [MP_TAC(ISPEC `(relative_frontier t:real^M->bool) DIFF s`
15722       UNIONS_COMPONENTS) THEN
15723     DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
15724      `s = u ==> ~(s = {}) ==> ~(u = {})`)) THEN
15725     ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[EMPTY_UNIONS]] THEN
15726     REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN
15727     MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^M->bool` THEN
15728     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
15729     FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN
15730     ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
15731     MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN
15732     ASM_REWRITE_TAC[GSYM IN_DIFF] THEN
15733     ASM_MESON_TAC[SUBSET; IN_COMPONENTS_SUBSET];
15734     ALL_TAC] THEN
15735   SUBGOAL_THEN
15736    `?af. affine af /\ aff_dim(t:real^M->bool) = aff_dim(af:real^M->bool) + &1`
15737   STRIP_ASSUME_TAC THENL
15738    [MP_TAC(ISPECL [`(:real^M)`; `aff_dim(t:real^M->bool) - &1`]
15739         CHOOSE_AFFINE_SUBSET) THEN
15740     REWRITE_TAC[SUBSET_UNIV; AFFINE_UNIV] THEN ANTS_TAC THENL
15741      [MATCH_MP_TAC(INT_ARITH
15742        `&0:int <= t /\ t <= n ==> --a <= t - a /\ t - &1 <= n`) THEN
15743       REWRITE_TAC[AFF_DIM_LE_UNIV; AFF_DIM_UNIV; AFF_DIM_POS_LE] THEN
15744       ASM_MESON_TAC[RELATIVE_FRONTIER_EMPTY; NOT_IN_EMPTY];
15745       MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN INT_ARITH_TAC];
15746     ALL_TAC] THEN
15747   MP_TAC(ISPECL [`t:real^M->bool`; `af:real^M->bool`; `q:real^M`]
15748         HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN) THEN
15749   ASM_REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN
15750   MAP_EVERY X_GEN_TAC [`h:real^M->real^M`; `k:real^M->real^M`] THEN
15751   STRIP_TAC THEN MP_TAC(ISPECL
15752    [`(f:real^M->real^N) o (k:real^M->real^M)`;
15753     `IMAGE (h:real^M->real^M) s`;
15754     `(af:real^M->bool)`;
15755     `u:real^N->bool`;
15756     `IMAGE (h:real^M->real^M) (p INTER relative_frontier t DELETE q)`]
15757    EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_GEN) THEN
15758   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
15759    [REPEAT CONJ_TAC THENL
15760      [MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN CONJ_TAC THENL
15761        [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15762           CONTINUOUS_ON_SUBSET)) THEN
15763         ASM SET_TAC[];
15764         ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET;
15765                       COMPACT_RELATIVE_FRONTIER_BOUNDED]];
15766       ASM_INT_ARITH_TAC;
15767       ASM SET_TAC[];
15768       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
15769       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15770           CONTINUOUS_ON_SUBSET)) THEN
15771       ASM SET_TAC[];
15772       REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
15773       X_GEN_TAC `l:real^M->bool` THEN STRIP_TAC THEN
15774       SUBGOAL_THEN `~(l:real^M->bool = {})` ASSUME_TAC THENL
15775        [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]; ALL_TAC] THEN
15776       SUBGOAL_THEN `?x:real^M. x IN l` STRIP_ASSUME_TAC THENL
15777        [ASM SET_TAC[]; ALL_TAC] THEN
15778       SUBGOAL_THEN `l SUBSET af DIFF IMAGE (h:real^M->real^M) s`
15779       ASSUME_TAC THENL
15780        [ASM_MESON_TAC[IN_COMPONENTS_SUBSET]; ALL_TAC] THEN
15781       SUBGOAL_THEN `connected(l:real^M->bool)` ASSUME_TAC THENL
15782        [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN
15783       SUBGOAL_THEN
15784        `?r. r IN components (relative_frontier t DIFF s) /\
15785             IMAGE (k:real^M->real^M) l SUBSET r`
15786       STRIP_ASSUME_TAC THENL
15787        [REWRITE_TAC[IN_COMPONENTS; LEFT_AND_EXISTS_THM] THEN
15788         EXISTS_TAC `connected_component (relative_frontier t DIFF s)
15789                                         ((k:real^M->real^M) x)` THEN
15790         EXISTS_TAC `(k:real^M->real^M) x` THEN REWRITE_TAC[] THEN
15791         CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
15792         MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN
15793         ASM_SIMP_TAC[FUN_IN_IMAGE] THEN
15794         CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
15795         MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
15796         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15797           CONTINUOUS_ON_SUBSET)) THEN
15798         ASM SET_TAC[];
15799         ALL_TAC] THEN
15800       FIRST_X_ASSUM(MP_TAC o SPEC `r:real^M->bool`) THEN
15801       ASM_REWRITE_TAC[] THEN
15802       GEN_REWRITE_TAC LAND_CONV [GSYM MEMBER_NOT_EMPTY] THEN
15803       REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_INTER] THEN
15804       X_GEN_TAC `z:real^M` THEN STRIP_TAC THEN
15805       SUBGOAL_THEN `r SUBSET ((relative_frontier t:real^M->bool) DIFF s)`
15806       ASSUME_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_SUBSET]; ALL_TAC] THEN
15807       SUBGOAL_THEN `connected(r:real^M->bool)` ASSUME_TAC THENL
15808        [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN
15809       ASM_CASES_TAC `(q:real^M) IN r` THENL
15810        [ALL_TAC;
15811         REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
15812         EXISTS_TAC `(h:real^M->real^M) z` THEN REWRITE_TAC[IN_INTER] THEN
15813         CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
15814         MATCH_MP_TAC(SET_RULE `!s. x IN s /\ s SUBSET t ==> x IN t`) THEN
15815         EXISTS_TAC `IMAGE (h:real^M->real^M) r` THEN
15816         ASM_SIMP_TAC[FUN_IN_IMAGE] THEN MATCH_MP_TAC COMPONENTS_MAXIMAL THEN
15817         EXISTS_TAC `af DIFF IMAGE (h:real^M->real^M) s` THEN
15818         ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
15819          [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
15820           FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15821             CONTINUOUS_ON_SUBSET)) THEN
15822           ASM SET_TAC[];
15823           REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF; IN_ELIM_THM] THEN
15824           X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN
15825           CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
15826           REWRITE_TAC[SET_RULE
15827            `~(h y IN IMAGE h s) <=> !y'. y' IN s ==> ~(h y = h y')`] THEN
15828           X_GEN_TAC `y':real^M` THEN DISCH_TAC THEN
15829           DISCH_THEN(MP_TAC o AP_TERM `k:real^M->real^M`) THEN
15830           MATCH_MP_TAC(MESON[]
15831            `k(h y) = y /\ k(h y') = y' /\ ~(y = y')
15832             ==> k(h y) = k(h y') ==> F`) THEN
15833           ASM SET_TAC[];
15834           ASM SET_TAC[]]] THEN
15835       SUBGOAL_THEN
15836        `?n. open_in (subtopology euclidean (relative_frontier t)) n /\
15837             (q:real^M) IN n /\ n INTER IMAGE (k:real^M->real^M) l = {}`
15838       STRIP_ASSUME_TAC THENL
15839        [EXISTS_TAC `relative_frontier t DIFF
15840                     IMAGE (k:real^M->real^M) (closure l)` THEN
15841         SUBGOAL_THEN `closure l SUBSET (af:real^M->bool)` ASSUME_TAC THENL
15842          [MATCH_MP_TAC CLOSURE_MINIMAL THEN
15843           ASM_SIMP_TAC[CLOSED_AFFINE] THEN ASM SET_TAC[];
15844           ALL_TAC] THEN
15845         REPEAT CONJ_TAC THENL
15846          [MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
15847           MATCH_MP_TAC CLOSED_SUBSET THEN
15848           CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
15849           MATCH_MP_TAC COMPACT_IMP_CLOSED THEN
15850           MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN
15851           ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN
15852           FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15853             CONTINUOUS_ON_SUBSET)) THEN
15854           ASM SET_TAC[];
15855           ASM SET_TAC[];
15856           MP_TAC(ISPEC `l:real^M->bool` CLOSURE_SUBSET) THEN SET_TAC[]];
15857         ALL_TAC] THEN
15858       FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
15859       SUBGOAL_THEN
15860        `?w. connected w /\ w SUBSET r DELETE q /\
15861             (k:real^M->real^M) x IN w /\ ~((n DELETE q) INTER w = {})`
15862       STRIP_ASSUME_TAC THENL
15863        [ALL_TAC;
15864         MATCH_MP_TAC(TAUT `F ==> p`) THEN
15865         SUBGOAL_THEN `IMAGE (h:real^M->real^M) w SUBSET l` MP_TAC THENL
15866          [ALL_TAC; ASM SET_TAC[]] THEN
15867         MATCH_MP_TAC COMPONENTS_MAXIMAL THEN
15868         EXISTS_TAC `af DIFF IMAGE (h:real^M->real^M) s` THEN
15869         ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
15870          [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN
15871           FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
15872             CONTINUOUS_ON_SUBSET)) THEN
15873           ASM SET_TAC[];
15874           REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF; IN_ELIM_THM] THEN
15875           X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN
15876           CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
15877           REWRITE_TAC[SET_RULE
15878            `~(h y IN IMAGE h s) <=> !y'. y' IN s ==> ~(h y = h y')`] THEN
15879           X_GEN_TAC `y':real^M` THEN DISCH_TAC THEN
15880           DISCH_THEN(MP_TAC o AP_TERM `k:real^M->real^M`) THEN
15881           MATCH_MP_TAC(MESON[]
15882            `k(h y) = y /\ k(h y') = y' /\ ~(y = y')
15883             ==> k(h y) = k(h y') ==> F`) THEN
15884           ASM SET_TAC[];
15885           ASM SET_TAC[]]] THEN
15886       SUBGOAL_THEN `path_connected(r:real^M->bool)` MP_TAC THENL
15887        [W(MP_TAC o PART_MATCH (lhand o rand) PATH_CONNECTED_EQ_CONNECTED_LPC o
15888           snd) THEN
15889         ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
15890         MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
15891         EXISTS_TAC `(relative_frontier t:real^M->bool)` THEN
15892         ASM_SIMP_TAC[LOCALLY_PATH_CONNECTED_SPHERE_GEN] THEN
15893         MATCH_MP_TAC OPEN_IN_TRANS THEN
15894         EXISTS_TAC `(relative_frontier t:real^M->bool) DIFF s` THEN
15895         CONJ_TAC THENL
15896          [MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN
15897           ASM_REWRITE_TAC[] THEN
15898           MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN
15899           EXISTS_TAC `(relative_frontier t:real^M->bool)` THEN
15900           ASM_SIMP_TAC[LOCALLY_CONNECTED_SPHERE_GEN];
15901           ALL_TAC] THEN
15902         MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN
15903         MATCH_MP_TAC CLOSED_SUBSET THEN ASM_REWRITE_TAC[];
15904         ALL_TAC] THEN
15905       REWRITE_TAC[PATH_CONNECTED_ARCWISE] THEN
15906       DISCH_THEN(MP_TAC o SPECL [`(k:real^M->real^M) x`; `q:real^M`]) THEN
15907       ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
15908       DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC) THEN
15909       FIRST_X_ASSUM(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC o
15910         GEN_REWRITE_RULE I [arc]) THEN
15911       DISCH_TAC THEN
15912       SUBGOAL_THEN
15913        `open_in (subtopology euclidean (interval[vec 0,vec 1]))
15914                 {x | x IN interval[vec 0,vec 1] /\
15915                      (g:real^1->real^M) x IN n}`
15916       MP_TAC THENL
15917        [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN
15918         EXISTS_TAC `(relative_frontier t:real^M->bool)` THEN
15919         ASM_REWRITE_TAC[GSYM path; GSYM path_image] THEN
15920         ASM SET_TAC[];
15921         ALL_TAC] THEN
15922       REWRITE_TAC[OPEN_IN_CONTAINS_CBALL] THEN
15923       REWRITE_TAC[IN_ELIM_THM; SUBSET_RESTRICT] THEN
15924       DISCH_THEN(MP_TAC o SPEC `vec 1:real^1`) THEN
15925       REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN
15926       ANTS_TAC THENL [ASM_MESON_TAC[pathfinish]; ALL_TAC] THEN
15927       DISCH_THEN(X_CHOOSE_THEN `r:real`
15928         (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
15929       ABBREV_TAC `t' = lift(&1 - min (&1 / &2) r)` THEN
15930       SUBGOAL_THEN `t' IN interval[vec 0:real^1,vec 1]` ASSUME_TAC THENL
15931        [EXPAND_TAC "t'" THEN SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN
15932         ASM_REAL_ARITH_TAC;
15933         ALL_TAC] THEN
15934       GEN_REWRITE_TAC LAND_CONV [SUBSET] THEN
15935       DISCH_THEN(MP_TAC o SPEC `t':real^1`) THEN
15936       ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM; IN_CBALL; DIST_REAL;
15937                       DROP_VEC; GSYM drop] THEN
15938       ANTS_TAC THENL
15939        [EXPAND_TAC "t'" THEN REWRITE_TAC[LIFT_DROP] THEN ASM_REAL_ARITH_TAC;
15940         DISCH_TAC] THEN
15941       EXISTS_TAC `IMAGE (g:real^1->real^M) (interval[vec 0,t'])` THEN
15942       REPEAT CONJ_TAC THENL
15943        [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
15944         REWRITE_TAC[CONNECTED_INTERVAL] THEN
15945         MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN
15946         EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN
15947         ASM_REWRITE_TAC[GSYM path; SUBSET_INTERVAL_1] THEN
15948         ASM_REWRITE_TAC[REAL_LE_REFL; GSYM IN_INTERVAL_1];
15949         REWRITE_TAC[SET_RULE
15950          `s SUBSET t DELETE q <=> s SUBSET t /\ !x. x IN s ==> ~(x = q)`] THEN
15951         CONJ_TAC THENL
15952          [TRANS_TAC SUBSET_TRANS
15953             `IMAGE (g:real^1->real^M) (interval[vec 0,vec 1])` THEN
15954           CONJ_TAC THENL
15955            [MATCH_MP_TAC IMAGE_SUBSET THEN
15956             ASM_REWRITE_TAC[REAL_LE_REFL; GSYM IN_INTERVAL_1;
15957                             SUBSET_INTERVAL_1];
15958             ASM_REWRITE_TAC[GSYM path_image]];
15959           REWRITE_TAC[FORALL_IN_IMAGE] THEN
15960           X_GEN_TAC `t'':real^1` THEN DISCH_TAC THEN
15961           FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV)
15962            [SYM th]) THEN
15963           REWRITE_TAC[pathfinish] THEN DISCH_TAC THEN
15964           FIRST_X_ASSUM(MP_TAC o SPECL [`t'':real^1`; `vec 1:real^1`]) THEN
15965           ASM_REWRITE_TAC[GSYM DROP_EQ] THEN
15966           UNDISCH_TAC `t'' IN interval[vec 0:real^1,t']` THEN
15967           EXPAND_TAC "t'" THEN
15968           REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
15969           ASM_REAL_ARITH_TAC];
15970         REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 0:real^1` THEN
15971         CONJ_TAC THENL [ASM_MESON_TAC[pathstart]; ALL_TAC] THEN
15972         EXPAND_TAC "t'" THEN
15973         REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
15974         ASM_REAL_ARITH_TAC;
15975         REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
15976         ONCE_REWRITE_TAC[INTER_COMM] THEN
15977         REWRITE_TAC[EXISTS_IN_IMAGE; IN_INTER] THEN
15978         EXISTS_TAC `t':real^1` THEN CONJ_TAC THENL
15979          [EXPAND_TAC "t'" THEN
15980           REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
15981           ASM_REAL_ARITH_TAC;
15982           ASM_REWRITE_TAC[IN_DELETE] THEN
15983           FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV)
15984            [SYM th]) THEN
15985           REWRITE_TAC[pathfinish] THEN DISCH_TAC THEN
15986           FIRST_X_ASSUM(MP_TAC o SPECL [`t':real^1`; `vec 1:real^1`]) THEN
15987           ASM_REWRITE_TAC[GSYM DROP_EQ] THEN
15988           EXPAND_TAC "t'" THEN
15989           REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN
15990           ASM_REAL_ARITH_TAC]]];
15991     ALL_TAC] THEN
15992   ASM_SIMP_TAC[DOT_BASIS; LE_REFL; DIMINDEX_GE_1; LEFT_IMP_EXISTS_THM] THEN
15993   MAP_EVERY X_GEN_TAC [`tk:real^M->bool`; `g:real^M->real^N`] THEN
15994   REWRITE_TAC[o_THM] THEN
15995   STRIP_TAC THEN EXISTS_TAC `q INSERT IMAGE (k:real^M->real^M) tk` THEN
15996   EXISTS_TAC `(g:real^M->real^N) o (h:real^M->real^M)` THEN
15997   ASM_SIMP_TAC[FINITE_INSERT; FINITE_IMAGE; o_THM] THEN REPEAT CONJ_TAC THENL
15998    [MATCH_MP_TAC(SET_RULE
15999      `a IN t /\ s SUBSET t DELETE a ==> a INSERT s SUBSET t`) THEN
16000     ASM_REWRITE_TAC[] THEN
16001     TRANS_TAC SUBSET_TRANS
16002       `p INTER (relative_frontier t:real^M->bool) DELETE q` THEN
16003     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
16004     ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
16005      (SET_RULE `t SUBSET IMAGE h s ==> IMAGE k (IMAGE h s) SUBSET s
16006             ==> IMAGE k t SUBSET s`)) THEN
16007     REWRITE_TAC[GSYM IMAGE_o] THEN
16008     MATCH_MP_TAC(SET_RULE
16009      `(!x. x IN s ==> f x = x) ==> IMAGE f s SUBSET s`) THEN
16010     REWRITE_TAC[o_THM] THEN ASM SET_TAC[];
16011     ASM SET_TAC[];
16012     ASM SET_TAC[];
16013     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
16014     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
16015         CONTINUOUS_ON_SUBSET)) THEN
16016     ASM SET_TAC[];
16017     REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
16018     ASM SET_TAC[]]);;
16019
16020 let EXTEND_MAP_SPHERE_TO_SPHERE_COFINITE = prove
16021  (`!f:real^M->real^N s a d b e p.
16022         dimindex(:M) <= dimindex(:N) + 1 /\
16023         (&0 < d /\ s = {} ==> &0 <= e) /\
16024         closed s /\ s SUBSET sphere(a,d) /\
16025         f continuous_on s /\ IMAGE f s SUBSET sphere(b,e) /\
16026         (!c. c IN components(sphere(a,d) DIFF s) ==> ~(c INTER p = {}))
16027         ==> ?k g. FINITE k /\ k SUBSET p /\
16028                   k SUBSET sphere(a,d) /\ DISJOINT k s /\
16029                   g continuous_on (sphere(a,d) DIFF k) /\
16030                   IMAGE g (sphere(a,d) DIFF k) SUBSET sphere(b,e) /\
16031                   !x. x IN s ==> g x = f x`,
16032   REPEAT GEN_TAC THEN ASM_CASES_TAC `s = sphere(a:real^M,d)` THENL
16033    [ASM_REWRITE_TAC[] THEN STRIP_TAC THEN
16034     MAP_EVERY EXISTS_TAC [`{}:real^M->bool`; `f:real^M->real^N`] THEN
16035     ASM_REWRITE_TAC[FINITE_EMPTY; DIFF_EMPTY] THEN SET_TAC[];
16036     POP_ASSUM MP_TAC] THEN
16037   ASM_CASES_TAC `d < &0` THENL
16038    [ASM_SIMP_TAC[SPHERE_EMPTY] THEN SET_TAC[]; ALL_TAC] THEN
16039   ASM_CASES_TAC `d = &0` THENL
16040    [ASM_SIMP_TAC[SPHERE_SING] THEN
16041     ASM_CASES_TAC `s:real^M->bool = {}` THENL
16042      [ASM_REWRITE_TAC[]; ASM SET_TAC[]] THEN
16043     REPEAT STRIP_TAC THEN
16044     EXISTS_TAC `{a:real^M}` THEN
16045     REWRITE_TAC[FINITE_SING; CONTINUOUS_ON_EMPTY; DIFF_EQ_EMPTY] THEN
16046     FIRST_X_ASSUM(MP_TAC o SPEC `{a:real^M}`) THEN
16047     REWRITE_TAC[DIFF_EMPTY; IN_COMPONENTS_SELF; CONNECTED_SING] THEN
16048     REWRITE_TAC[IMAGE_CLAUSES] THEN SET_TAC[];
16049     ALL_TAC] THEN
16050   SUBGOAL_THEN `&0 < d` ASSUME_TAC THENL
16051    [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
16052   ASM_CASES_TAC `e = &0` THENL
16053    [ASM_SIMP_TAC[SPHERE_SING] THEN REPEAT STRIP_TAC THEN
16054     EXISTS_TAC `{}:real^M->bool` THEN
16055     EXISTS_TAC `(\x. b):real^M->real^N` THEN
16056     REWRITE_TAC[CONTINUOUS_ON_CONST; FINITE_EMPTY] THEN ASM SET_TAC[];
16057     REPEAT STRIP_TAC] THEN
16058   SUBGOAL_THEN `&0 <= e` ASSUME_TAC THENL
16059    [ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_SIMP_TAC[] THEN
16060     MP_TAC(SYM(ISPECL [`b:real^N`; `e:real`] SPHERE_EQ_EMPTY)) THEN
16061     SIMP_TAC[GSYM REAL_NOT_LT] THEN ASM SET_TAC[];
16062     ALL_TAC] THEN
16063   SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL
16064    [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
16065   MP_TAC(ISPECL
16066    [`f:real^M->real^N`; `s:real^M->bool`; `cball(a:real^M,d)`;
16067     `cball(b:real^N,e)`; `p:real^M->bool`]
16068    EXTEND_MAP_SPHERE_TO_SPHERE_COFINITE_GEN) THEN
16069   ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL] THEN
16070   REWRITE_TAC[AFF_DIM_CBALL] THEN
16071   MP_TAC(ISPECL [`a:real^M`; `d:real`] RELATIVE_FRONTIER_CBALL) THEN
16072   MP_TAC(ISPECL [`b:real^N`; `e:real`] RELATIVE_FRONTIER_CBALL) THEN
16073   ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN SUBST1_TAC) THEN
16074   ASM_REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_LE]);;
16075
16076 (* ------------------------------------------------------------------------- *)
16077 (* Borsuk-style characterization of separation.                              *)
16078 (* ------------------------------------------------------------------------- *)
16079
16080 let CONTINUOUS_ON_BORSUK_MAP = prove
16081  (`!s a:real^N.
16082         ~(a IN s) ==> (\x. inv(norm (x - a)) % (x - a)) continuous_on s`,
16083   REPEAT STRIP_TAC THEN
16084   MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF] THEN CONJ_TAC THENL
16085     [MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV); ALL_TAC] THEN
16086   SIMP_TAC[CONTINUOUS_ON_LIFT_NORM_COMPOSE; CONTINUOUS_ON_SUB;
16087            CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN
16088   REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_MESON_TAC[]);;
16089
16090 let BORSUK_MAP_INTO_SPHERE = prove
16091  (`!s a:real^N.
16092         IMAGE (\x. inv(norm (x - a)) % (x - a)) s SUBSET sphere(vec 0,&1) <=>
16093         ~(a IN s)`,
16094   REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0] THEN
16095   REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN
16096   REWRITE_TAC[REAL_FIELD `inv x * x = &1 <=> ~(x = &0)`] THEN
16097   REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN MESON_TAC[]);;
16098
16099 let BORSUK_MAPS_HOMOTOPIC_IN_PATH_COMPONENT = prove
16100  (`!s a b. path_component ((:real^N) DIFF s) a b
16101            ==> homotopic_with (\x. T) (s,sphere(vec 0,&1))
16102                    (\x. inv(norm(x - a)) % (x - a))
16103                    (\x. inv(norm(x - b)) % (x - b))`,
16104   REPEAT GEN_TAC THEN REWRITE_TAC[path_component; LEFT_IMP_EXISTS_THM] THEN
16105   REWRITE_TAC[path; path_image; pathstart; pathfinish; SUBSET;
16106               FORALL_IN_IMAGE; IN_UNIV; IN_DIFF] THEN
16107   X_GEN_TAC `g:real^1->real^N` THEN STRIP_TAC THEN
16108   SIMP_TAC[HOMOTOPIC_WITH] THEN
16109   EXISTS_TAC `\z. inv(norm(sndcart z - g(fstcart z))) %
16110                   (sndcart z - (g:real^1->real^N)(fstcart z))` THEN
16111   ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_SPHERE_0;
16112                SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
16113   CONJ_TAC THENL
16114    [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL
16115      [MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN
16116       ASM_SIMP_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART;
16117                    NORM_EQ_0; VECTOR_SUB_EQ] THEN CONJ_TAC
16118       THENL [MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE; ASM_MESON_TAC[]];
16119       ALL_TAC] THEN
16120     MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
16121     SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
16122     GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
16123     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
16124     SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN
16125     REWRITE_TAC[IMAGE_FSTCART_PCROSS] THEN ASM_MESON_TAC[CONTINUOUS_ON_EMPTY];
16126     REPEAT STRIP_TAC THEN
16127     REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN
16128     MATCH_MP_TAC REAL_MUL_LINV THEN
16129     ASM_REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_MESON_TAC[]]);;
16130
16131 let NON_EXTENSIBLE_BORSUK_MAP = prove
16132  (`!s c a:real^N.
16133         compact s /\ c IN components((:real^N) DIFF s) /\ bounded c /\ a IN c
16134         ==> ~(?g. g continuous_on (s UNION c) /\
16135                   IMAGE g (s UNION c) SUBSET sphere (vec 0,&1) /\
16136                   (!x. x IN s ==> g x = inv(norm(x - a)) % (x - a)))`,
16137   REPEAT STRIP_TAC THEN
16138   FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
16139   REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN
16140   ASM_REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN
16141   SUBGOAL_THEN `c = connected_component ((:real^N) DIFF s) a` SUBST_ALL_TAC
16142   THENL [ASM_MESON_TAC[IN_COMPONENTS; CONNECTED_COMPONENT_EQ]; ALL_TAC] THEN
16143   MP_TAC(ISPECL
16144    [`s UNION connected_component ((:real^N) DIFF s) a`; `a:real^N`]
16145       BOUNDED_SUBSET_BALL) THEN
16146   ASM_SIMP_TAC[BOUNDED_UNION; COMPACT_IMP_BOUNDED] THEN
16147   DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
16148   FIRST_ASSUM(MP_TAC o SPEC `a:real^N` o MATCH_MP NO_RETRACTION_CBALL) THEN
16149   REWRITE_TAC[retract_of; retraction] THEN
16150   EXISTS_TAC `\x. if x IN connected_component ((:real^N) DIFF s) a
16151                   then a + r % g(x)
16152                   else a + r % inv(norm(x - a)) % (x - a)` THEN
16153   REWRITE_TAC[SPHERE_SUBSET_CBALL] THEN REPEAT CONJ_TAC THENL
16154    [SUBGOAL_THEN `cball(a:real^N,r) =
16155                   (s UNION connected_component ((:real^N) DIFF s) a) UNION
16156                   (cball(a,r) DIFF connected_component ((:real^N) DIFF s) a)`
16157     SUBST1_TAC THENL
16158      [MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN ASM
16159       SET_TAC[];
16160       ALL_TAC] THEN
16161     MATCH_MP_TAC CONTINUOUS_ON_CASES THEN REPEAT CONJ_TAC THENL
16162      [MATCH_MP_TAC CLOSED_UNION_COMPLEMENT_COMPONENT THEN
16163       ASM_SIMP_TAC[IN_COMPONENTS; COMPACT_IMP_CLOSED; IN_UNIV; IN_DIFF] THEN
16164       ASM_MESON_TAC[];
16165       MATCH_MP_TAC CLOSED_DIFF THEN
16166       ASM_SIMP_TAC[CLOSED_CBALL; OPEN_CONNECTED_COMPONENT; GSYM closed;
16167                    COMPACT_IMP_CLOSED];
16168       MATCH_MP_TAC CONTINUOUS_ON_ADD THEN SIMP_TAC[CONTINUOUS_ON_CONST] THEN
16169       MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN ASM_SIMP_TAC[CONTINUOUS_ON_CONST];
16170       MATCH_MP_TAC CONTINUOUS_ON_ADD THEN SIMP_TAC[CONTINUOUS_ON_CONST] THEN
16171       MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN
16172       MATCH_MP_TAC CONTINUOUS_ON_BORSUK_MAP THEN
16173       ASM_SIMP_TAC[CENTRE_IN_CBALL; IN_DIFF; REAL_LT_IMP_LE] THEN
16174       REWRITE_TAC[IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
16175       ASM_REWRITE_TAC[IN_DIFF; IN_UNIV];
16176       REPEAT STRIP_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
16177       FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]];
16178
16179       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
16180       REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
16181       ASM_REWRITE_TAC[IN_SPHERE; NORM_ARITH `dist(a:real^N,a + x) = norm x`;
16182                       NORM_MUL] THEN
16183       ASM_SIMP_TAC[REAL_ABS_INV; REAL_ABS_NORM; VECTOR_SUB_EQ;
16184         REAL_FIELD `&0 < r ==> abs r = r /\ (r * x = r <=> x = &1)`;
16185         REAL_FIELD `inv x * x = &1 <=> ~(x = &0)`; NORM_EQ_0]
16186       THENL
16187        [ONCE_REWRITE_TAC[GSYM IN_SPHERE_0] THEN ASM SET_TAC[];
16188         UNDISCH_TAC `~(x IN connected_component ((:real^N) DIFF s) a)` THEN
16189         SIMP_TAC[CONTRAPOS_THM; IN] THEN
16190         ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ; IN_DIFF; IN_UNIV]];
16191       SIMP_TAC[IN_SPHERE; ONCE_REWRITE_RULE[NORM_SUB] dist] THEN
16192       ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN
16193       REWRITE_TAC[VECTOR_ARITH `a + &1 % (x - a):real^N = x`] THEN
16194       REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
16195       FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
16196        `s UNION t SUBSET u ==> !x. x IN t /\ ~(x IN u) ==> wev`)) THEN
16197       EXISTS_TAC `x:real^N` THEN
16198       ASM_REWRITE_TAC[ONCE_REWRITE_RULE[NORM_SUB] dist; IN_BALL;
16199                       REAL_LT_REFL]]);;
16200
16201 let BORSUK_MAP_ESSENTIAL_BOUNDED_COMPONENT = prove
16202  (`!s a. compact s /\ ~(a IN s)
16203          ==> (bounded(connected_component ((:real^N) DIFF s) a) <=>
16204               ~(?c. homotopic_with (\x. T) (s,sphere(vec 0:real^N,&1))
16205                                    (\x. inv(norm(x - a)) % (x - a)) (\x. c)))`,
16206   REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL
16207    [ASM_SIMP_TAC[DIFF_EMPTY; CONNECTED_COMPONENT_UNIV; NOT_BOUNDED_UNIV] THEN
16208     SIMP_TAC[HOMOTOPIC_WITH; NOT_IN_EMPTY; PCROSS_EMPTY; IMAGE_CLAUSES;
16209              CONTINUOUS_ON_EMPTY; EMPTY_SUBSET];
16210     ALL_TAC] THEN
16211   EQ_TAC THENL
16212    [ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN
16213     REPEAT DISCH_TAC THEN
16214     MP_TAC(ISPECL
16215      [`\x:real^N. inv(norm(x - a)) % (x - a)`; `s:real^N->bool`;
16216       `vec 0:real^N`; `&1`]
16217      NULLHOMOTOPIC_INTO_SPHERE_EXTENSION) THEN
16218     ASM_SIMP_TAC[COMPACT_IMP_CLOSED; NOT_IMP; CONTINUOUS_ON_BORSUK_MAP;
16219                  BORSUK_MAP_INTO_SPHERE] THEN
16220     MP_TAC(ISPECL [`s:real^N->bool`;
16221         `connected_component ((:real^N) DIFF s) a`;
16222         `a:real^N`] NON_EXTENSIBLE_BORSUK_MAP) THEN
16223     ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
16224      [GEN_REWRITE_TAC RAND_CONV [IN] THEN
16225       REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
16226       ASM_REWRITE_TAC[IN_COMPONENTS; IN_DIFF; IN_UNIV] THEN ASM_MESON_TAC[];
16227       REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN
16228       GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
16229        [MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; SET_TAC[]]];
16230     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN
16231     DISCH_TAC THEN
16232     FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL o
16233       MATCH_MP COMPACT_IMP_BOUNDED) THEN
16234     DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN
16235     SUBGOAL_THEN
16236      `?b. b IN connected_component ((:real^N) DIFF s) a /\
16237           ~(b IN ball(vec 0,r))`
16238     MP_TAC THENL
16239      [REWRITE_TAC[SET_RULE `(?b. b IN s /\ ~(b IN t)) <=> ~(s SUBSET t)`] THEN
16240       ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL];
16241       DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC)] THEN
16242     SUBGOAL_THEN
16243      `?c. homotopic_with (\x. T) (ball(vec 0:real^N,r),sphere (vec 0,&1))
16244                          (\x. inv (norm (x - b)) % (x - b)) (\x. c)`
16245     MP_TAC THENL
16246      [MATCH_MP_TAC NULLHOMOTOPIC_FROM_CONTRACTIBLE THEN
16247       ASM_SIMP_TAC[CONTINUOUS_ON_BORSUK_MAP; BORSUK_MAP_INTO_SPHERE;
16248                    CONVEX_IMP_CONTRACTIBLE; CONVEX_BALL];
16249       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN STRIP_TAC] THEN
16250     MATCH_MP_TAC HOMOTOPIC_WITH_TRANS THEN
16251     EXISTS_TAC `\x:real^N. inv(norm (x - b)) % (x - b)` THEN CONJ_TAC THENL
16252      [MATCH_MP_TAC BORSUK_MAPS_HOMOTOPIC_IN_PATH_COMPONENT THEN
16253       ASM_SIMP_TAC[OPEN_PATH_CONNECTED_COMPONENT; GSYM closed;
16254                    COMPACT_IMP_CLOSED] THEN  ASM_MESON_TAC[IN];
16255       ASM_MESON_TAC[HOMOTOPIC_WITH_SUBSET_LEFT]]]);;
16256
16257 let HOMOTOPIC_BORSUK_MAPS_IN_BOUNDED_COMPONENT = prove
16258  (`!s a b.
16259         compact s /\ ~(a IN s) /\ ~(b IN s) /\
16260         bounded (connected_component ((:real^N) DIFF s) a) /\
16261         homotopic_with (\x. T) (s,sphere(vec 0,&1))
16262                                (\x. inv(norm(x - a)) % (x - a))
16263                                (\x. inv(norm(x - b)) % (x - b))
16264         ==> connected_component ((:real^N) DIFF s) a b`,
16265   REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [GSYM IN] THEN
16266   MP_TAC(ISPECL
16267    [`s:real^N->bool`; `connected_component ((:real^N) DIFF s) a`;
16268     `a:real^N`] NON_EXTENSIBLE_BORSUK_MAP) THEN
16269   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
16270    [GEN_REWRITE_TAC RAND_CONV [IN] THEN
16271     REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN
16272     ASM_REWRITE_TAC[IN_COMPONENTS; IN_DIFF; IN_UNIV] THEN ASM_MESON_TAC[];
16273     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM]] THEN
16274   DISCH_TAC THEN REWRITE_TAC[] THEN
16275   MATCH_MP_TAC BORSUK_HOMOTOPY_EXTENSION THEN
16276   EXISTS_TAC `\x:real^N. inv(norm(x - b)) % (x - b)` THEN
16277   ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN
16278   ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN
16279   ASM_SIMP_TAC[CONTINUOUS_ON_BORSUK_MAP; IN_UNION; BORSUK_MAP_INTO_SPHERE] THEN
16280   REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL
16281    [MATCH_MP_TAC CLOSED_UNION_COMPLEMENT_COMPONENT THEN
16282     ASM_SIMP_TAC[COMPACT_IMP_CLOSED; IN_COMPONENTS; IN_DIFF; IN_UNIV] THEN
16283     ASM_MESON_TAC[];
16284     EXISTS_TAC `(:real^N) DELETE (vec 0)` THEN
16285     ASM_SIMP_TAC[SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE; REAL_LT_01;
16286                  OPEN_DELETE; OPEN_UNIV]]);;
16287
16288 let BORSUK_MAPS_HOMOTOPIC_IN_CONNECTED_COMPONENT_EQ = prove
16289  (`!s a b. 2 <= dimindex(:N) /\ compact s /\ ~(a IN s) /\ ~(b IN s)
16290            ==> (homotopic_with (\x. T) (s,sphere(vec 0,&1))
16291                    (\x. inv(norm(x - a)) % (x - a))
16292                    (\x. inv(norm(x - b)) % (x - b)) <=>
16293                 connected_component ((:real^N) DIFF s) a b)`,
16294   REPEAT STRIP_TAC THEN EQ_TAC THENL
16295    [DISCH_TAC;
16296     ASM_SIMP_TAC[GSYM OPEN_PATH_CONNECTED_COMPONENT; GSYM closed;
16297                  COMPACT_IMP_CLOSED] THEN
16298     REWRITE_TAC[BORSUK_MAPS_HOMOTOPIC_IN_PATH_COMPONENT]] THEN
16299   ASM_CASES_TAC `bounded(connected_component ((:real^N) DIFF s) a)` THENL
16300    [MATCH_MP_TAC HOMOTOPIC_BORSUK_MAPS_IN_BOUNDED_COMPONENT THEN
16301     ASM_REWRITE_TAC[];
16302     ALL_TAC] THEN
16303   ASM_CASES_TAC `bounded(connected_component ((:real^N) DIFF s) b)` THENL
16304    [ONCE_REWRITE_TAC[CONNECTED_COMPONENT_SYM_EQ] THEN
16305     MATCH_MP_TAC HOMOTOPIC_BORSUK_MAPS_IN_BOUNDED_COMPONENT THEN
16306     ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN
16307     ASM_REWRITE_TAC[];
16308     ALL_TAC] THEN
16309   MP_TAC(ISPECL [`(:real^N) DIFF s`; `a:real^N`; `b:real^N`]
16310         COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT) THEN
16311   ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EQ; IN_DIFF; IN_UNIV;
16312                   SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN
16313   ASM_SIMP_TAC[COMPACT_IMP_BOUNDED]);;
16314
16315 let BORSUK_SEPARATION_THEOREM_GEN = prove
16316  (`!s:real^N->bool.
16317     compact s
16318     ==> ((!c. c IN components((:real^N) DIFF s) ==> ~bounded c) <=>
16319          (!f. f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0:real^N,&1)
16320               ==> ?c. homotopic_with (\x. T) (s,sphere(vec 0,&1)) f (\x. c)))`,
16321   REPEAT STRIP_TAC THEN EQ_TAC THENL
16322    [ALL_TAC;
16323     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
16324     REWRITE_TAC[NOT_FORALL_THM; components; EXISTS_IN_GSPEC; NOT_IMP;
16325                 IN_UNIV; IN_DIFF] THEN
16326     DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
16327     EXISTS_TAC `\x:real^N. inv(norm(x - a)) % (x - a)` THEN
16328     ASM_SIMP_TAC[GSYM BORSUK_MAP_ESSENTIAL_BOUNDED_COMPONENT;
16329                  CONTINUOUS_ON_BORSUK_MAP; BORSUK_MAP_INTO_SPHERE]] THEN
16330   DISCH_TAC THEN X_GEN_TAC `f:real^N->real^N` THEN STRIP_TAC THEN
16331   MP_TAC(ISPECL
16332    [`f:real^N->real^N`; `s:real^N->bool`; `vec 0:real^N`; `&1:real`]
16333         EXTEND_MAP_UNIV_TO_SPHERE_NO_BOUNDED_COMPONENT) THEN
16334   ASM_REWRITE_TAC[LE_REFL; REAL_POS] THEN
16335   DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC) THEN
16336   MP_TAC(ISPECL
16337    [`g:real^N->real^N`; `(:real^N)`; `sphere(vec 0:real^N,&1)`]
16338         NULLHOMOTOPIC_FROM_CONTRACTIBLE) THEN
16339   ASM_REWRITE_TAC[CONTRACTIBLE_UNIV] THEN
16340   MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
16341   DISCH_THEN(MP_TAC o SPEC `s:real^N->bool` o MATCH_MP
16342    (REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_SUBSET_LEFT)) THEN
16343   REWRITE_TAC[SUBSET_UNIV] THEN
16344   MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT]
16345         HOMOTOPIC_WITH_EQ) THEN
16346   ASM_SIMP_TAC[]);;
16347
16348 let BORSUK_SEPARATION_THEOREM = prove
16349  (`!s:real^N->bool.
16350       2 <= dimindex(:N) /\ compact s
16351       ==> (connected((:real^N) DIFF s) <=>
16352            !f. f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0:real^N,&1)
16353                ==> ?c. homotopic_with (\x. T) (s,sphere(vec 0,&1)) f (\x. c))`,
16354   SIMP_TAC[GSYM BORSUK_SEPARATION_THEOREM_GEN] THEN
16355   X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN EQ_TAC THENL
16356    [DISCH_TAC THEN
16357     MP_TAC(ISPEC `(:real^N) DIFF s` COMPONENTS_EQ_SING) THEN
16358     MP_TAC(ISPEC `(:real^N) DIFF s` COBOUNDED_IMP_UNBOUNDED) THEN
16359     ASM_CASES_TAC `(:real^N) DIFF s = {}` THEN
16360     ASM_SIMP_TAC[COMPACT_IMP_BOUNDED; SET_RULE `UNIV DIFF (UNIV DIFF s) = s`;
16361                  BOUNDED_EMPTY; FORALL_IN_INSERT; NOT_IN_EMPTY];
16362
16363     REWRITE_TAC[components; FORALL_IN_GSPEC; IN_DIFF; IN_UNIV] THEN
16364     DISCH_TAC THEN REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENT_EQ] THEN
16365     REWRITE_TAC[IN_DIFF; IN_UNIV] THEN REPEAT STRIP_TAC THEN
16366     MATCH_MP_TAC COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT THEN
16367     ASM_SIMP_TAC[COMPACT_IMP_BOUNDED;
16368                  SET_RULE `UNIV DIFF (UNIV DIFF s) = s`]]);;
16369
16370 let HOMOTOPY_EQUIVALENT_SEPARATION = prove
16371  (`!s t. compact s /\ compact t /\ s homotopy_equivalent t
16372          ==> (connected((:real^N) DIFF s) <=> connected((:real^N) DIFF t))`,
16373   let special = prove
16374    (`!s:real^1->bool.
16375           bounded s /\ connected((:real^1) DIFF s) ==> s = {}`,
16376     REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1] THEN REPEAT STRIP_TAC THEN
16377     FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_OPEN_INTERVAL) THEN
16378     REWRITE_TAC[LEFT_IMP_EXISTS_THM; EXTENSION; NOT_IN_EMPTY] THEN
16379     MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN
16380     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IS_INTERVAL_1]) THEN
16381     DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `b:real^1`]) THEN
16382     REWRITE_TAC[IN_UNIV; IN_DIFF; SUBSET; IN_INTERVAL_1] THEN
16383     MESON_TAC[REAL_LT_REFL; REAL_LT_IMP_LE]) in
16384   REPEAT STRIP_TAC THEN
16385   SUBGOAL_THEN `1 <= dimindex(:N)` MP_TAC THENL
16386    [REWRITE_TAC[DIMINDEX_GE_1];
16387     REWRITE_TAC[ARITH_RULE `1 <= n <=> n = 1 \/ 2 <= n`] THEN
16388     REWRITE_TAC[GSYM DIMINDEX_1]] THEN
16389   STRIP_TAC THENL
16390    [ASSUME_TAC(GEOM_EQUAL_DIMENSION_RULE(ASSUME `dimindex(:N) = dimindex(:1)`)
16391        special) THEN
16392     EQ_TAC THEN DISCH_TAC THENL
16393      [FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`);
16394       FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`)] THEN
16395     ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN DISCH_TAC THEN
16396     UNDISCH_TAC `(s:real^N->bool) homotopy_equivalent (t:real^N->bool)` THEN
16397     ASM_REWRITE_TAC[HOMOTOPY_EQUIVALENT_EMPTY] THEN DISCH_TAC THEN
16398     ASM_REWRITE_TAC[CONNECTED_UNIV; DIFF_EMPTY];
16399     REPEAT STRIP_TAC THEN ASM_SIMP_TAC[BORSUK_SEPARATION_THEOREM] THEN
16400     MATCH_MP_TAC HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL THEN
16401     ASM_REWRITE_TAC[]]);;
16402
16403 let JORDAN_BROUWER_SEPARATION = prove
16404  (`!s a:real^N r.
16405         &0 < r /\ s homeomorphic sphere(a,r) ==> ~connected((:real^N) DIFF s)`,
16406   REPEAT GEN_TAC THEN STRIP_TAC THEN
16407   MP_TAC(ISPECL [`s:real^N->bool`; `sphere(a:real^N,r)`]
16408         HOMOTOPY_EQUIVALENT_SEPARATION) THEN
16409   ANTS_TAC THENL
16410    [ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS; COMPACT_SPHERE;
16411                   HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT];
16412     DISCH_THEN SUBST1_TAC] THEN
16413   DISCH_TAC THEN MP_TAC(ISPECL
16414    [`(:real^N) DIFF sphere(a,r)`;
16415     `ball(a:real^N,r)`] CONNECTED_INTER_FRONTIER) THEN
16416   ASM_SIMP_TAC[FRONTIER_BALL; NOT_IMP] THEN REPEAT CONJ_TAC THENL
16417    [REWRITE_TAC[GSYM CBALL_DIFF_BALL] THEN MATCH_MP_TAC(SET_RULE
16418      `~(b = {})
16419       ==> ~((UNIV DIFF (c DIFF b)) INTER b = {})`) THEN
16420     ASM_SIMP_TAC[BALL_EQ_EMPTY; REAL_NOT_LE];
16421     MATCH_MP_TAC(SET_RULE
16422      `~(s UNION t = UNIV) ==> ~(UNIV DIFF t DIFF s = {})`) THEN
16423     REWRITE_TAC[BALL_UNION_SPHERE] THEN
16424     MESON_TAC[BOUNDED_CBALL; NOT_BOUNDED_UNIV];
16425     SET_TAC[]]);;
16426
16427 let JORDAN_BROUWER_FRONTIER = prove
16428  (`!s t a:real^N r.
16429      2 <= dimindex(:N) /\
16430      s homeomorphic sphere(a,r) /\ t IN components((:real^N) DIFF s)
16431      ==> frontier t = s`,
16432   let lemma = prove
16433    (`!s a r. 2 <= dimindex(:N) /\ &0 < r /\ s PSUBSET sphere(a,r)
16434              ==> connected((:real^N) DIFF s)`,
16435     REWRITE_TAC[PSUBSET_ALT; SUBSET; IN_SPHERE; GSYM REAL_LE_ANTISYM] THEN
16436     REPEAT STRIP_TAC THEN
16437     SUBGOAL_THEN
16438      `(:real^N) DIFF s =
16439       {x:real^N | dist(a,x) <= r /\ ~(x IN s)} UNION
16440       {x:real^N | r <= dist(a,x) /\ ~(x IN s)}`
16441     SUBST1_TAC THENL
16442      [SET_TAC[REAL_LE_TOTAL]; MATCH_MP_TAC CONNECTED_UNION] THEN
16443     REPEAT CONJ_TAC THENL
16444      [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
16445       EXISTS_TAC `ball(a:real^N,r)` THEN
16446       ASM_SIMP_TAC[CONNECTED_BALL; CLOSURE_BALL; SUBSET; IN_BALL; IN_CBALL;
16447                    IN_ELIM_THM] THEN
16448       ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_NOT_LE];
16449       MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
16450       EXISTS_TAC `(:real^N) DIFF cball(a,r)` THEN
16451       REWRITE_TAC[CLOSURE_COMPLEMENT; SUBSET; IN_DIFF; IN_UNIV;
16452                   IN_BALL; IN_CBALL; IN_ELIM_THM; INTERIOR_CBALL] THEN
16453       CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_NOT_LE]] THEN
16454       MATCH_MP_TAC CONNECTED_OPEN_DIFF_CBALL THEN
16455       ASM_REWRITE_TAC[SUBSET_UNIV; CONNECTED_UNIV; OPEN_UNIV];
16456       ASM SET_TAC[]]) in
16457   MAP_EVERY X_GEN_TAC
16458    [`s:real^N->bool`; `c:real^N->bool`; `a:real^N`; `r:real`] THEN
16459   ASM_CASES_TAC `r < &0` THENL
16460    [ASM_SIMP_TAC[SPHERE_EMPTY; HOMEOMORPHIC_EMPTY; IMP_CONJ; DIFF_EMPTY] THEN
16461     SIMP_TAC[snd(EQ_IMP_RULE(SPEC_ALL COMPONENTS_EQ_SING));
16462              UNIV_NOT_EMPTY; CONNECTED_UNIV; IN_SING; FRONTIER_UNIV];
16463     ALL_TAC] THEN
16464   ASM_CASES_TAC `r = &0` THENL
16465    [ASM_SIMP_TAC[HOMEOMORPHIC_FINITE_STRONG; SPHERE_SING; FINITE_SING] THEN
16466     SIMP_TAC[CARD_CLAUSES; FINITE_EMPTY; GSYM HAS_SIZE; NOT_IN_EMPTY] THEN
16467     REWRITE_TAC[HAS_SIZE_CLAUSES; UNWIND_THM2; NOT_IN_EMPTY; IMP_CONJ] THEN
16468     SIMP_TAC[LEFT_IMP_EXISTS_THM; CONNECTED_PUNCTURED_UNIVERSE; IN_SING;
16469              snd(EQ_IMP_RULE(SPEC_ALL COMPONENTS_EQ_SING)); FRONTIER_SING;
16470              SET_RULE `UNIV DIFF s = {} <=> s = UNIV`; FRONTIER_COMPLEMENT;
16471              MESON[BOUNDED_SING; NOT_BOUNDED_UNIV] `~((:real^N) = {a})`];
16472     ALL_TAC] THEN
16473   SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
16474   REPEAT STRIP_TAC THEN MATCH_MP_TAC FRONTIER_MINIMAL_SEPARATING_CLOSED THEN
16475   ASM_REWRITE_TAC[] THEN
16476   FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN
16477   SIMP_TAC[COMPACT_SPHERE; COMPACT_IMP_CLOSED] THEN DISCH_TAC THEN
16478   CONJ_TAC THENL [ASM_MESON_TAC[JORDAN_BROUWER_SEPARATION]; ALL_TAC] THEN
16479   REPEAT STRIP_TAC THEN
16480   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
16481   REWRITE_TAC[HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN
16482   MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN
16483   STRIP_TAC THEN
16484   MP_TAC(ISPECL [`t:real^N->bool`; `IMAGE (f:real^N->real^N) t`]
16485         HOMOTOPY_EQUIVALENT_SEPARATION) THEN
16486   ANTS_TAC THENL
16487    [MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
16488      [ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET; PSUBSET];
16489       DISCH_TAC THEN
16490       SUBGOAL_THEN `t homeomorphic (IMAGE (f:real^N->real^N) t)` MP_TAC THENL
16491        [REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC
16492          [`f:real^N->real^N`; `g:real^N->real^N`] THEN
16493         ASM_REWRITE_TAC[HOMEOMORPHISM] THEN REPEAT CONJ_TAC THEN
16494         TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
16495           (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))) THEN ASM SET_TAC[];
16496         ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS;
16497                       HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT]]];
16498       DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC lemma THEN
16499       MAP_EVERY EXISTS_TAC [`a:real^N`; `r:real`] THEN ASM SET_TAC[]]);;
16500
16501 let JORDAN_BROUWER_NONSEPARATION = prove
16502  (`!s t a:real^N r.
16503         2 <= dimindex(:N) /\
16504         s homeomorphic sphere(a,r) /\ t PSUBSET s
16505         ==> connected((:real^N) DIFF t)`,
16506   REPEAT STRIP_TAC THEN
16507   SUBGOAL_THEN
16508    `!c. c IN components((:real^N) DIFF s)
16509         ==> connected(c UNION (s DIFF t))`
16510   ASSUME_TAC THENL
16511    [REPEAT STRIP_TAC THEN
16512     MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN
16513     EXISTS_TAC `c:real^N->bool` THEN
16514     CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN
16515     CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[UNION_SUBSET; CLOSURE_SUBSET]] THEN
16516     SUBGOAL_THEN `s:real^N->bool = frontier c` SUBST1_TAC THENL
16517      [ASM_MESON_TAC[JORDAN_BROUWER_FRONTIER]; ALL_TAC] THEN
16518     REWRITE_TAC[frontier] THEN SET_TAC[];
16519     ALL_TAC] THEN
16520   SUBGOAL_THEN
16521     `~(components((:real^N) DIFF s) = {})`
16522   ASSUME_TAC THENL
16523    [REWRITE_TAC[COMPONENTS_EQ_EMPTY; SET_RULE
16524      `UNIV DIFF s = {} <=> s = UNIV`] THEN
16525     ASM_MESON_TAC[NOT_BOUNDED_UNIV; COMPACT_EQ_BOUNDED_CLOSED;
16526                   HOMEOMORPHIC_COMPACTNESS; COMPACT_SPHERE];
16527     ALL_TAC] THEN
16528   SUBGOAL_THEN
16529    `(:real^N) DIFF t =
16530     UNIONS {c UNION (s DIFF t) | c | c IN components((:real^N) DIFF s)}`
16531   SUBST1_TAC THENL
16532    [MP_TAC(ISPEC `(:real^N) DIFF s` UNIONS_COMPONENTS) THEN
16533     REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[];
16534     MATCH_MP_TAC CONNECTED_UNIONS THEN
16535     ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN
16536     REWRITE_TAC[INTERS_GSPEC] THEN ASM SET_TAC[]]);;
16537
16538 let JORDAN_BROUWER_ACCESSIBILITY = prove
16539  (`!s c a:real^N r v x.
16540         2 <= dimindex(:N) /\
16541         s homeomorphic sphere(a,r) /\
16542         c IN components((:real^N) DIFF s) /\ x IN c /\
16543         open_in (subtopology euclidean s) v /\ ~(v = {})
16544         ==> ?g. arc g /\
16545                 IMAGE g (interval[vec 0,vec 1] DELETE (vec 1)) SUBSET c /\
16546                 pathstart g = x /\
16547                 pathfinish g IN v`,
16548   REPEAT STRIP_TAC THEN
16549   FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN
16550   REWRITE_TAC[COMPACT_SPHERE] THEN
16551   REWRITE_TAC[closed; COMPACT_EQ_BOUNDED_CLOSED] THEN STRIP_TAC THEN
16552   MATCH_MP_TAC DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED THEN
16553   ASM_REWRITE_TAC[] THEN
16554   ASM_MESON_TAC[JORDAN_BROUWER_FRONTIER; OPEN_COMPONENTS;
16555                 IN_COMPONENTS_CONNECTED]);;
16556
16557 (* ------------------------------------------------------------------------- *)
16558 (* Invariance of domain and corollaries.                                     *)
16559 (* ------------------------------------------------------------------------- *)
16560
16561 let INVARIANCE_OF_DOMAIN = prove
16562  (`!f:real^N->real^N s.
16563         f continuous_on s /\ open s /\
16564         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
16565         ==> open(IMAGE f s)`,
16566   let lemma = prove
16567    (`!f:real^N->real^N a r.
16568           f continuous_on cball(a,r) /\ &0 < r /\
16569           (!x y. x IN cball(a,r) /\ y IN cball(a,r) /\ f x = f y ==> x = y)
16570           ==> open(IMAGE f (ball(a,r)))`,
16571     REPEAT STRIP_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL
16572      [MP_TAC(ISPECL [`(:real^N)`; `(:real^1)`] ISOMETRIES_SUBSPACES) THEN
16573       ASM_SIMP_TAC[SUBSPACE_UNIV; DIM_UNIV; DIMINDEX_1;
16574                    LEFT_IMP_EXISTS_THM] THEN
16575       MAP_EVERY X_GEN_TAC [`h:real^N->real^1`; `k:real^1->real^N`] THEN
16576       REWRITE_TAC[IN_UNIV] THEN STRIP_TAC THEN
16577       MP_TAC(ISPECL [`(h:real^N->real^1) o f o (k:real^1->real^N)`;
16578                      `IMAGE (h:real^N->real^1) (cball(a,r))`]
16579           INJECTIVE_EQ_1D_OPEN_MAP_UNIV) THEN
16580       MATCH_MP_TAC(TAUT
16581        `p /\ q /\ r /\ (s ==> t)
16582         ==> (p /\ q ==> (r <=> s)) ==> t`) THEN
16583       REPEAT CONJ_TAC THENL
16584        [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN
16585         ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; GSYM IMAGE_o] THEN
16586         ASM_REWRITE_TAC[o_DEF; IMAGE_ID];
16587         REWRITE_TAC[IS_INTERVAL_CONNECTED_1] THEN
16588         MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
16589         ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; CONNECTED_CBALL];
16590         ASM_SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM;
16591                      FORALL_IN_IMAGE; o_DEF] THEN
16592         ASM SET_TAC[];
16593         DISCH_THEN(MP_TAC o SPEC `IMAGE (h:real^N->real^1) (ball(a,r))`) THEN
16594         ASM_SIMP_TAC[IMAGE_SUBSET; BALL_SUBSET_CBALL; GSYM IMAGE_o] THEN
16595         ANTS_TAC THENL
16596          [MP_TAC(ISPECL [`a:real^N`; `r:real`] OPEN_BALL); ALL_TAC] THEN
16597         MATCH_MP_TAC EQ_IMP THENL
16598          [CONV_TAC SYM_CONV;
16599           REWRITE_TAC[GSYM o_ASSOC] THEN ONCE_REWRITE_TAC[IMAGE_o] THEN
16600           ASM_REWRITE_TAC[o_DEF; ETA_AX]] THEN
16601         MATCH_MP_TAC OPEN_BIJECTIVE_LINEAR_IMAGE_EQ THEN
16602         ASM_MESON_TAC[]];
16603        FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE
16604         `~(n = 1) ==> 1 <= n ==> 2 <= n`)) THEN
16605        REWRITE_TAC[DIMINDEX_GE_1] THEN DISCH_TAC] THEN
16606     REPEAT STRIP_TAC THEN
16607     MP_TAC(ISPECL [`IMAGE (f:real^N->real^N) (sphere(a,r))`;
16608                    `a:real^N`; `r:real`]
16609           JORDAN_BROUWER_SEPARATION) THEN
16610     ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
16611      [ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
16612       MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN EXISTS_TAC `f:real^N->real^N` THEN
16613       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET; SPHERE_SUBSET_CBALL;
16614                     COMPACT_SPHERE];
16615       DISCH_TAC] THEN
16616     MP_TAC(ISPEC `(:real^N) DIFF IMAGE f (sphere(a:real^N,r))`
16617       COBOUNDED_HAS_BOUNDED_COMPONENT) THEN
16618     ASM_REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN
16619     ANTS_TAC THENL
16620      [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET; SPHERE_SUBSET_CBALL;
16621         COMPACT_SPHERE; COMPACT_CONTINUOUS_IMAGE; COMPACT_IMP_BOUNDED];
16622       DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC)] THEN
16623     SUBGOAL_THEN
16624      `IMAGE (f:real^N->real^N) (ball(a,r)) = c`
16625     SUBST1_TAC THENL
16626      [ALL_TAC;
16627       FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
16628           OPEN_COMPONENTS)) THEN
16629       REWRITE_TAC[GSYM closed] THEN
16630       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET; SPHERE_SUBSET_CBALL;
16631         COMPACT_SPHERE; COMPACT_CONTINUOUS_IMAGE; COMPACT_IMP_CLOSED]] THEN
16632     MATCH_MP_TAC(SET_RULE
16633      `~(c = {}) /\ (~(c INTER t = {}) ==> t SUBSET c) /\ c SUBSET t
16634       ==> t = c`) THEN
16635     REPEAT STRIP_TAC THENL
16636      [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY];
16637       FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ]
16638           COMPONENTS_MAXIMAL)) THEN
16639       ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
16640        [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN
16641         REWRITE_TAC[CONNECTED_BALL] THEN
16642         ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; BALL_SUBSET_CBALL];
16643         REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN
16644         MP_TAC(ISPECL [`a:real^N`; `r:real`] SPHERE_SUBSET_CBALL) THEN
16645         ASM SET_TAC[]];
16646       FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN
16647       FIRST_ASSUM(MP_TAC o SPEC `(:real^N) DIFF IMAGE f (cball(a:real^N,r))` o
16648         MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COMPONENTS_MAXIMAL)) THEN
16649       SIMP_TAC[SET_RULE `UNIV DIFF t SUBSET UNIV DIFF s <=> s SUBSET t`;
16650                IMAGE_SUBSET; SPHERE_SUBSET_CBALL] THEN
16651       MATCH_MP_TAC(TAUT `p /\ ~r /\ (~q ==> s) ==> (p /\ q ==> r) ==> s`) THEN
16652       REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
16653        [MATCH_MP_TAC(INST_TYPE [`:N`,`:M`]
16654           CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT) THEN
16655         EXISTS_TAC `cball(a:real^N,r)` THEN
16656         ASM_REWRITE_TAC[CONVEX_CBALL; COMPACT_CBALL] THEN
16657         ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN
16658         MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN
16659         EXISTS_TAC `f:real^N->real^N` THEN ASM_REWRITE_TAC[COMPACT_CBALL];
16660         DISCH_THEN(MP_TAC o
16661           MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET)) THEN
16662         ASM_REWRITE_TAC[] THEN MATCH_MP_TAC COBOUNDED_IMP_UNBOUNDED THEN
16663         REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN
16664         ASM_MESON_TAC[COMPACT_IMP_BOUNDED; COMPACT_CONTINUOUS_IMAGE;
16665                       COMPACT_CBALL];
16666         REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN ASM SET_TAC[]]]) in
16667   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[OPEN_SUBOPEN] THEN
16668   REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN
16669   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN
16670   DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN
16671   ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
16672   X_GEN_TAC `r:real` THEN STRIP_TAC THEN
16673   EXISTS_TAC `IMAGE (f:real^N->real^N) (ball(a,r))` THEN
16674   REPEAT CONJ_TAC THENL
16675    [MATCH_MP_TAC lemma THEN ASM_MESON_TAC[SUBSET; CONTINUOUS_ON_SUBSET];
16676     ASM_SIMP_TAC[FUN_IN_IMAGE; CENTRE_IN_BALL];
16677     MATCH_MP_TAC IMAGE_SUBSET THEN
16678     ASM_MESON_TAC[BALL_SUBSET_CBALL; SUBSET_TRANS]]);;
16679
16680 let INVARIANCE_OF_DOMAIN_SUBSPACES = prove
16681  (`!f:real^M->real^N u v s.
16682         subspace u /\ subspace v /\ dim v <= dim u /\
16683         f continuous_on s /\ IMAGE f s SUBSET v /\
16684         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
16685         open_in (subtopology euclidean u) s
16686         ==> open_in (subtopology euclidean v) (IMAGE f s)`,
16687   let lemma0 = prove
16688    (`!f:real^M->real^M s u.
16689           subspace s /\ dim s = dimindex(:N) /\
16690           f continuous_on u /\ IMAGE f u SUBSET s /\
16691           (!x y. x IN u /\ y IN u /\ f x = f y ==> x = y) /\
16692           open_in (subtopology euclidean s) u
16693           ==> open_in (subtopology euclidean s) (IMAGE f u)`,
16694     REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(:real^N)`; `s:real^M->bool`]
16695       HOMEOMORPHIC_SUBSPACES) THEN
16696     ASM_REWRITE_TAC[DIM_UNIV; SUBSPACE_UNIV] THEN
16697     REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN
16698     MAP_EVERY X_GEN_TAC [`h:real^N->real^M`; `k:real^M->real^N`] THEN
16699     STRIP_TAC THEN MP_TAC(ISPECL
16700      [`(k:real^M->real^N) o f o (h:real^N->real^M)`;
16701       `IMAGE (k:real^M->real^N) u`] INVARIANCE_OF_DOMAIN) THEN
16702     REWRITE_TAC[GSYM IMAGE_o; o_THM] THEN
16703     SUBGOAL_THEN
16704      `!t. open t <=>
16705           open_in (subtopology euclidean (IMAGE (k:real^M->real^N) s)) t`
16706      (fun th -> REWRITE_TAC[th])
16707     THENL [ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN]; ALL_TAC] THEN
16708     ANTS_TAC THENL
16709      [REPEAT CONJ_TAC THENL
16710        [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN
16711         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
16712             CONTINUOUS_ON_SUBSET)) THEN
16713         FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
16714         REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
16715         MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
16716         MAP_EVERY EXISTS_TAC [`h:real^N->real^M`; `s:real^M->bool`] THEN
16717         ASM_REWRITE_TAC[homeomorphism];
16718         REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
16719         FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
16720         ASM_SIMP_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN
16721         FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]];
16722       ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
16723       SUBGOAL_THEN
16724        `IMAGE f u =
16725         IMAGE (h:real^N->real^M) (IMAGE ((k o f o h) o (k:real^M->real^N)) u)`
16726       SUBST1_TAC THENL
16727        [REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC(SET_RULE
16728          `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN
16729         REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN
16730         ASM_SIMP_TAC[SUBSET; o_THM] THEN ASM SET_TAC[];
16731         MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
16732         MAP_EVERY EXISTS_TAC [`k:real^M->real^N`; `(:real^N)`] THEN
16733         ASM_REWRITE_TAC[homeomorphism]]]) in
16734   let lemma1 = prove
16735    (`!f:real^N->real^N s u.
16736           subspace s /\ f continuous_on u /\ IMAGE f u SUBSET s /\
16737           (!x y. x IN u /\ y IN u /\ f x = f y ==> x = y) /\
16738           open_in (subtopology euclidean s) u
16739           ==> open_in (subtopology euclidean s) (IMAGE f u)`,
16740     REWRITE_TAC[INJECTIVE_ON_ALT] THEN REPEAT STRIP_TAC THEN
16741     FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
16742     ABBREV_TAC `s' = {y:real^N | !x. x IN s ==> orthogonal x y}` THEN
16743     SUBGOAL_THEN `subspace(s':real^N->bool)` ASSUME_TAC THENL
16744       [EXPAND_TAC "s'" THEN REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTORS];
16745        FIRST_ASSUM(ASSUME_TAC o MATCH_MP SUBSPACE_IMP_NONEMPTY)] THEN
16746     ABBREV_TAC `g:real^(N,N)finite_sum->real^(N,N)finite_sum =
16747                   \z. pastecart (f(fstcart z)) (sndcart z)` THEN
16748     SUBGOAL_THEN
16749      `g continuous_on ((u:real^N->bool) PCROSS s') /\
16750       IMAGE g (u PCROSS s') SUBSET (s:real^N->bool) PCROSS (s':real^N->bool) /\
16751       (!w z. w IN u PCROSS s' /\ z IN u PCROSS s' ==> (g w = g z <=> w = z))`
16752     STRIP_ASSUME_TAC THENL
16753      [EXPAND_TAC "g" THEN REPEAT CONJ_TAC THENL
16754        [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN
16755         SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN
16756         GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
16757         MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
16758         SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART;
16759                  IMAGE_FSTCART_PCROSS] THEN
16760         COND_CASES_TAC THEN ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY];
16761         REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN
16762         SIMP_TAC[PASTECART_IN_PCROSS; SNDCART_PASTECART;
16763                  FSTCART_PASTECART] THEN
16764         ASM SET_TAC[];
16765         EXPAND_TAC "g" THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
16766         REWRITE_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART;
16767                     SNDCART_PASTECART] THEN
16768         ASM_SIMP_TAC[PASTECART_INJ]];
16769       ALL_TAC] THEN
16770     SUBGOAL_THEN
16771      `open_in (subtopology euclidean (s PCROSS s'))
16772               (IMAGE (g:real^(N,N)finite_sum->real^(N,N)finite_sum)
16773                      (u PCROSS s'))`
16774     MP_TAC THENL
16775      [MATCH_MP_TAC lemma0 THEN
16776       ASM_SIMP_TAC[SUBSPACE_PCROSS; OPEN_IN_PCROSS_EQ; OPEN_IN_REFL] THEN
16777       CONJ_TAC THENL [ASM_SIMP_TAC[DIM_PCROSS]; ASM_MESON_TAC[]] THEN
16778       MP_TAC(ISPECL [`s:real^N->bool`; `(:real^N)`]
16779         DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS) THEN
16780       ASM_REWRITE_TAC[SUBSET_UNIV; SUBSPACE_UNIV; IN_UNIV; DIM_UNIV] THEN
16781       ARITH_TAC;
16782       SUBGOAL_THEN
16783        `IMAGE (g:real^(N,N)finite_sum->real^(N,N)finite_sum) (u PCROSS s') =
16784         IMAGE f u PCROSS s'`
16785       SUBST1_TAC THENL
16786        [EXPAND_TAC "g" THEN
16787         REWRITE_TAC[EXTENSION; EXISTS_PASTECART; PASTECART_IN_PCROSS;
16788                     IN_IMAGE; FORALL_PASTECART; PASTECART_IN_PCROSS;
16789                     FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_INJ] THEN
16790         ASM SET_TAC[];
16791         ASM_SIMP_TAC[OPEN_IN_PCROSS_EQ; IMAGE_EQ_EMPTY] THEN
16792         STRIP_TAC THEN ASM_SIMP_TAC[IMAGE_CLAUSES; OPEN_IN_EMPTY]]]) in
16793   REWRITE_TAC[INJECTIVE_ON_ALT] THEN REPEAT STRIP_TAC THEN
16794   FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
16795   MP_TAC(ISPECL [`u:real^M->bool`; `dim(v:real^N->bool)`]
16796     CHOOSE_SUBSPACE_OF_SUBSPACE) THEN ASM_SIMP_TAC[SPAN_OF_SUBSPACE] THEN
16797   DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN
16798   MP_TAC(ISPECL [`v:real^N->bool`; `v:real^M->bool`]
16799         HOMEOMORPHIC_SUBSPACES) THEN
16800   ASM_REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN
16801   MAP_EVERY X_GEN_TAC [`h:real^N->real^M`; `k:real^M->real^N`] THEN
16802   STRIP_TAC THEN
16803   SUBGOAL_THEN
16804    `IMAGE (f:real^M->real^N) s =
16805     IMAGE (k:real^M->real^N) (IMAGE ((h:real^N->real^M) o f) s)`
16806   SUBST1_TAC THENL
16807    [REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC(SET_RULE
16808      `(!x. x IN u ==> f x = g x) ==> IMAGE f u = IMAGE g u`) THEN
16809     RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN
16810     ASM_SIMP_TAC[SUBSET; o_THM] THEN ASM SET_TAC[];
16811     MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN
16812     MAP_EVERY EXISTS_TAC [`h:real^N->real^M`; `v:real^M->bool`] THEN
16813     ASM_REWRITE_TAC[homeomorphism] THEN
16814     MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `u:real^M->bool` THEN
16815     ASM_REWRITE_TAC[IMAGE_o] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
16816     REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC lemma1 THEN
16817     ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN
16818     CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
16819     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
16820     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
16821           CONTINUOUS_ON_SUBSET)) THEN
16822     ASM SET_TAC[]]);;
16823
16824 let INVARIANCE_OF_DIMENSION_SUBSPACES = prove
16825  (`!f:real^M->real^N u v s.
16826       subspace u /\ subspace v /\
16827       ~(s = {}) /\ open_in (subtopology euclidean u) s /\
16828       f continuous_on s /\ IMAGE f s SUBSET v /\
16829       (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
16830       ==> dim u <= dim v`,
16831   REWRITE_TAC[GSYM NOT_LT] THEN REPEAT STRIP_TAC THEN
16832   MP_TAC(ISPECL [`u:real^M->bool`; `dim(v:real^N->bool)`]
16833     CHOOSE_SUBSPACE_OF_SUBSPACE) THEN
16834   ASM_SIMP_TAC[SPAN_OF_SUBSPACE; LE_LT] THEN
16835   DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN
16836   MP_TAC(ISPECL [`v:real^N->bool`; `t:real^M->bool`]
16837         HOMEOMORPHIC_SUBSPACES) THEN
16838   FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
16839   ASM_REWRITE_TAC[homeomorphic; homeomorphism; NOT_EXISTS_THM] THEN
16840   MAP_EVERY X_GEN_TAC [`h:real^N->real^M`; `k:real^M->real^N`] THEN
16841   STRIP_TAC THEN MP_TAC(ISPECL
16842    [`(h:real^N->real^M) o (f:real^M->real^N)`; `u:real^M->bool`;
16843     `u:real^M->bool`; `s:real^M->bool`]
16844         INVARIANCE_OF_DOMAIN_SUBSPACES) THEN
16845   ASM_REWRITE_TAC[LE_LT; NOT_IMP] THEN REPEAT CONJ_TAC THENL
16846    [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN
16847     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
16848     REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
16849     REWRITE_TAC[o_THM] THEN ASM SET_TAC[];
16850     ALL_TAC] THEN
16851   SUBGOAL_THEN `IMAGE ((h:real^N->real^M) o (f:real^M->real^N)) s SUBSET t`
16852   ASSUME_TAC THENL [REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; ALL_TAC] THEN
16853   ABBREV_TAC `w = IMAGE ((h:real^N->real^M) o (f:real^M->real^N)) s` THEN
16854   DISCH_TAC THEN UNDISCH_TAC `dim(t:real^M->bool) < dim(u:real^M->bool)` THEN
16855   REWRITE_TAC[NOT_LT] THEN MP_TAC(ISPECL
16856    [`w:real^M->bool`; `u:real^M->bool`] DIM_OPEN_IN) THEN
16857   ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
16858    [ASM_MESON_TAC[IMAGE_EQ_EMPTY]; DISCH_THEN(SUBST1_TAC o SYM)] THEN
16859   ASM_SIMP_TAC[DIM_SUBSET]);;
16860
16861 let INVARIANCE_OF_DOMAIN_AFFINE_SETS = prove
16862  (`!f:real^M->real^N u v s.
16863         affine u /\ affine v /\ aff_dim v <= aff_dim u /\
16864         f continuous_on s /\ IMAGE f s SUBSET v /\
16865         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
16866         open_in (subtopology euclidean u) s
16867         ==> open_in (subtopology euclidean v) (IMAGE f s)`,
16868   REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN
16869   ASM_REWRITE_TAC[IMAGE_CLAUSES; OPEN_IN_EMPTY; INJECTIVE_ON_ALT] THEN
16870   REPEAT STRIP_TAC THEN
16871   SUBGOAL_THEN `?a:real^M b:real^N. a IN s /\ a IN u /\ b IN v`
16872   STRIP_ASSUME_TAC THENL
16873    [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
16874     ASM SET_TAC[];
16875     ALL_TAC] THEN
16876   MP_TAC(ISPECL
16877    [`(\x. --b + x) o (f:real^M->real^N) o (\x. a + x)`;
16878     `IMAGE (\x:real^M. --a + x) u`; `IMAGE (\x:real^N. --b + x) v`;
16879     `IMAGE (\x:real^M. --a + x) s`] INVARIANCE_OF_DOMAIN_SUBSPACES) THEN
16880   REWRITE_TAC[IMAGE_o; INJECTIVE_ON_ALT; OPEN_IN_TRANSLATION_EQ] THEN
16881   SIMP_TAC[IMP_CONJ; GSYM INT_OF_NUM_LE; GSYM AFF_DIM_DIM_SUBSPACE] THEN
16882   ASM_REWRITE_TAC[AFF_DIM_TRANSLATION_EQ; RIGHT_FORALL_IMP_THM] THEN
16883   SIMP_TAC[FORALL_IN_IMAGE; o_THM; GSYM IMAGE_o; IMP_IMP; GSYM CONJ_ASSOC] THEN
16884   ANTS_TAC THENL
16885    [ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
16886      [CONJ_TAC THEN MATCH_MP_TAC AFFINE_IMP_SUBSPACE THEN
16887       ASM_REWRITE_TAC[AFFINE_TRANSLATION_EQ] THEN REWRITE_TAC[IN_IMAGE;
16888         VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN
16889       ASM_MESON_TAC[];
16890       REPEAT CONJ_TAC THENL
16891        [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
16892            SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);
16893         REWRITE_TAC[GSYM o_ASSOC] THEN REWRITE_TAC[IMAGE_o] THEN
16894         MATCH_MP_TAC IMAGE_SUBSET;
16895         REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]]];
16896     ALL_TAC] THEN
16897   ASM_SIMP_TAC[VECTOR_ARITH `a + --a + x:real^N = x`; GSYM IMAGE_o; o_DEF;
16898                IMAGE_ID; ETA_AX]);;
16899
16900 let INVARIANCE_OF_DIMENSION_AFFINE_SETS = prove
16901  (`!f:real^M->real^N u v s.
16902       affine u /\ affine v /\
16903       ~(s = {}) /\ open_in (subtopology euclidean u) s /\
16904       f continuous_on s /\ IMAGE f s SUBSET v /\
16905       (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
16906       ==> aff_dim u <= aff_dim v`,
16907   REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN
16908   ASM_REWRITE_TAC[IMAGE_CLAUSES; OPEN_IN_EMPTY; INJECTIVE_ON_ALT] THEN
16909   REPEAT STRIP_TAC THEN
16910   SUBGOAL_THEN `?a:real^M b:real^N. a IN s /\ a IN u /\ b IN v`
16911   STRIP_ASSUME_TAC THENL
16912    [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
16913     ASM SET_TAC[];
16914     ALL_TAC] THEN
16915   MP_TAC(ISPECL
16916    [`(\x. --b + x) o (f:real^M->real^N) o (\x. a + x)`;
16917     `IMAGE (\x:real^M. --a + x) u`; `IMAGE (\x:real^N. --b + x) v`;
16918     `IMAGE (\x:real^M. --a + x) s`] INVARIANCE_OF_DIMENSION_SUBSPACES) THEN
16919   REWRITE_TAC[IMAGE_o; INJECTIVE_ON_ALT; OPEN_IN_TRANSLATION_EQ] THEN
16920   SIMP_TAC[IMP_CONJ; GSYM INT_OF_NUM_LE; GSYM AFF_DIM_DIM_SUBSPACE] THEN
16921   ASM_REWRITE_TAC[AFF_DIM_TRANSLATION_EQ; RIGHT_FORALL_IMP_THM] THEN
16922   SIMP_TAC[FORALL_IN_IMAGE; o_THM; GSYM IMAGE_o; IMP_IMP; GSYM CONJ_ASSOC] THEN
16923   DISCH_THEN MATCH_MP_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
16924    [CONJ_TAC THEN MATCH_MP_TAC AFFINE_IMP_SUBSPACE THEN
16925     ASM_REWRITE_TAC[AFFINE_TRANSLATION_EQ] THEN REWRITE_TAC[IN_IMAGE;
16926       VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN
16927     ASM_MESON_TAC[];
16928     ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN REPEAT CONJ_TAC THENL
16929      [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
16930          SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);
16931       REWRITE_TAC[GSYM o_ASSOC] THEN REWRITE_TAC[IMAGE_o] THEN
16932       MATCH_MP_TAC IMAGE_SUBSET;
16933       REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]]] THEN
16934   ASM_SIMP_TAC[VECTOR_ARITH `a + --a + x:real^N = x`; GSYM IMAGE_o; o_DEF;
16935                IMAGE_ID; ETA_AX]);;
16936
16937 let INVARIANCE_OF_DIMENSION = prove
16938  (`!f:real^M->real^N s.
16939         f continuous_on s /\ open s /\ ~(s = {}) /\
16940         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
16941         ==> dimindex(:M) <= dimindex(:N)`,
16942   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM DIM_UNIV] THEN
16943   MATCH_MP_TAC INVARIANCE_OF_DIMENSION_SUBSPACES THEN
16944   MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `s:real^M->bool`] THEN
16945   ASM_REWRITE_TAC[SUBSPACE_UNIV; SUBSET_UNIV; SUBTOPOLOGY_UNIV;
16946                   GSYM OPEN_IN]);;
16947
16948 let CONTINUOUS_INJECTIVE_IMAGE_SUBSPACE_DIM_LE = prove
16949  (`!f:real^M->real^N s t.
16950         subspace s /\ subspace t /\
16951         f continuous_on s /\ IMAGE f s SUBSET t /\
16952         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
16953         ==> dim(s) <= dim(t)`,
16954   REPEAT STRIP_TAC THEN MATCH_MP_TAC INVARIANCE_OF_DIMENSION_SUBSPACES THEN
16955   MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `s:real^M->bool`] THEN
16956   ASM_REWRITE_TAC[OPEN_IN_REFL] THEN ASM_SIMP_TAC[SUBSPACE_IMP_NONEMPTY]);;
16957
16958 let INVARIANCE_OF_DIMENSION_CONVEX_DOMAIN = prove
16959  (`!f:real^M->real^N s t.
16960
16961         convex s /\ f continuous_on s /\ IMAGE f s SUBSET affine hull t /\
16962         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
16963         ==> aff_dim(s) <= aff_dim(t)`,
16964   REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN
16965   ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_GE] THEN
16966   MP_TAC(ISPECL
16967    [`f:real^M->real^N`; `affine hull s:real^M->bool`;
16968     `affine hull t:real^N->bool`; `relative_interior s:real^M->bool`]
16969         INVARIANCE_OF_DIMENSION_AFFINE_SETS) THEN
16970   ASM_REWRITE_TAC[AFFINE_AFFINE_HULL; AFF_DIM_AFFINE_HULL;
16971                   OPEN_IN_RELATIVE_INTERIOR] THEN
16972   DISCH_THEN MATCH_MP_TAC THEN
16973   CONJ_TAC THENL [ASM_MESON_TAC[RELATIVE_INTERIOR_EQ_EMPTY]; ALL_TAC] THEN
16974   ASSUME_TAC(ISPEC `s:real^M->bool` RELATIVE_INTERIOR_SUBSET) THEN
16975   CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]);;
16976
16977 let HOMEOMORPHIC_CONVEX_SETS = prove
16978  (`!s:real^M->bool t:real^N->bool.
16979         convex s /\ convex t /\ s homeomorphic t ==> aff_dim s = aff_dim t`,
16980   REPEAT STRIP_TAC THEN
16981   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN
16982   REWRITE_TAC[LEFT_IMP_EXISTS_THM; GSYM INT_LE_ANTISYM; homeomorphism] THEN
16983   MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
16984   REPEAT STRIP_TAC THEN
16985   MATCH_MP_TAC INVARIANCE_OF_DIMENSION_CONVEX_DOMAIN THENL
16986    [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^N->real^M`] THEN
16987   ASM_REWRITE_TAC[HULL_SUBSET] THEN ASM SET_TAC[]);;
16988
16989 let HOMEOMORPHIC_CONVEX_COMPACT_SETS_EQ = prove
16990  (`!s:real^M->bool t:real^N->bool.
16991         convex s /\ compact s /\ convex t /\ compact t
16992         ==> (s homeomorphic t <=> aff_dim s = aff_dim t)`,
16993   MESON_TAC[HOMEOMORPHIC_CONVEX_SETS; HOMEOMORPHIC_CONVEX_COMPACT_SETS]);;
16994
16995 let INVARIANCE_OF_DOMAIN_GEN = prove
16996  (`!f:real^M->real^N s.
16997         dimindex(:N) <= dimindex(:M) /\ f continuous_on s /\ open s /\
16998         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
16999         ==> open(IMAGE f s)`,
17000   REPEAT STRIP_TAC THEN MP_TAC(ISPECL
17001    [`f:real^M->real^N`; `(:real^M)`; `(:real^N)`; `s:real^M->bool`]
17002    INVARIANCE_OF_DOMAIN_SUBSPACES) THEN
17003   ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; SUBSPACE_UNIV;
17004                   DIM_UNIV; SUBSET_UNIV]);;
17005
17006 let INJECTIVE_INTO_1D_IMP_OPEN_MAP_UNIV = prove
17007  (`!f:real^N->real^1 s t.
17008         f continuous_on s /\
17009         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
17010         open t /\ t SUBSET s
17011         ==> open (IMAGE f t)`,
17012   REPEAT STRIP_TAC THEN
17013   MATCH_MP_TAC INVARIANCE_OF_DOMAIN_GEN THEN
17014   ASM_REWRITE_TAC[DIMINDEX_1; DIMINDEX_GE_1] THEN CONJ_TAC THENL
17015    [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]);;
17016
17017 let CONTINUOUS_ON_INVERSE_OPEN = prove
17018  (`!f:real^M->real^N g s.
17019         dimindex(:N) <= dimindex(:M) /\
17020         f continuous_on s /\ open s /\
17021         (!x. x IN s ==> g(f x) = x)
17022         ==> g continuous_on IMAGE f s`,
17023   REPEAT STRIP_TAC THEN
17024   REWRITE_TAC[CONTINUOUS_OPEN_IN_PREIMAGE_EQ] THEN
17025   X_GEN_TAC `t:real^M->bool` THEN DISCH_TAC THEN
17026   SUBGOAL_THEN
17027    `{x | x IN IMAGE f s /\ g x IN t} = IMAGE (f:real^M->real^N) (s INTER t)`
17028   SUBST1_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC OPEN_OPEN_IN_TRANS] THEN
17029   REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
17030   CONJ_TAC THEN MATCH_MP_TAC INVARIANCE_OF_DOMAIN_GEN THEN
17031   ASM_SIMP_TAC[OPEN_INTER; IN_INTER] THEN
17032   ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]);;
17033
17034 let CONTINUOUS_ON_INVERSE_INTO_1D = prove
17035  (`!f:real^N->real^1 g s t.
17036         f continuous_on s /\
17037         (path_connected s \/ compact s \/ open s) /\
17038         IMAGE f s = t /\ (!x. x IN s ==> g(f x) = x)
17039         ==> g continuous_on t`,
17040   REPEAT STRIP_TAC THENL
17041    [REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_INVERSE_OPEN_MAP THEN
17042     MAP_EVERY EXISTS_TAC [`f:real^N->real^1`; `s:real^N->bool`] THEN
17043     ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
17044     FIRST_ASSUM(SUBST1_TAC o SYM) THEN
17045     MATCH_MP_TAC INJECTIVE_INTO_1D_IMP_OPEN_MAP THEN ASM SET_TAC[];
17046     ASM_MESON_TAC[CONTINUOUS_ON_INVERSE];
17047     FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
17048     MATCH_MP_TAC CONTINUOUS_ON_INVERSE_OPEN THEN
17049     ASM_REWRITE_TAC[DIMINDEX_1; DIMINDEX_GE_1]]);;
17050
17051 let REAL_CONTINUOUS_ON_INVERSE = prove
17052  (`!f g s. f real_continuous_on s /\
17053            (is_realinterval s \/ real_compact s \/ real_open s) /\
17054            (!x. x IN s ==> g(f x) = x)
17055            ==> g real_continuous_on (IMAGE f s)`,
17056   REPEAT GEN_TAC THEN
17057   REWRITE_TAC[REAL_CONTINUOUS_ON; real_compact; REAL_OPEN;
17058               IS_REALINTERVAL_IS_INTERVAL] THEN
17059   DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_INVERSE_INTO_1D THEN
17060   MAP_EVERY EXISTS_TAC [`lift o f o drop`; `IMAGE lift s`] THEN
17061   ASM_REWRITE_TAC[GSYM IS_INTERVAL_PATH_CONNECTED_1] THEN
17062   ASM_SIMP_TAC[FORALL_IN_IMAGE; o_DEF; LIFT_DROP; GSYM IMAGE_o]);;
17063
17064 let REAL_CONTINUOUS_ON_INVERSE_ALT = prove
17065  (`!f g s t. f real_continuous_on s /\
17066              (is_realinterval s \/ real_compact s \/ real_open s) /\
17067              IMAGE f s = t /\ (!x. x IN s ==> g(f x) = x)
17068            ==> g real_continuous_on t`,
17069   MESON_TAC[REAL_CONTINUOUS_ON_INVERSE]);;
17070
17071 let INVARIANCE_OF_DOMAIN_HOMEOMORPHISM = prove
17072  (`!f:real^M->real^N s.
17073         dimindex(:N) <= dimindex(:M) /\ f continuous_on s /\ open s /\
17074         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
17075         ==> ?g. homeomorphism (s,IMAGE f s) (f,g)`,
17076   REPEAT STRIP_TAC THEN
17077   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN
17078   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN
17079   DISCH_TAC THEN ASM_REWRITE_TAC[homeomorphism] THEN
17080   ASM_SIMP_TAC[CONTINUOUS_ON_INVERSE_OPEN] THEN ASM SET_TAC[]);;
17081
17082 let INVARIANCE_OF_DOMAIN_HOMEOMORPHIC = prove
17083  (`!f:real^M->real^N s.
17084         dimindex(:N) <= dimindex(:M) /\ f continuous_on s /\ open s /\
17085         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
17086         ==> s homeomorphic (IMAGE f s)`,
17087   REPEAT GEN_TAC THEN
17088   DISCH_THEN(MP_TAC o MATCH_MP INVARIANCE_OF_DOMAIN_HOMEOMORPHISM) THEN
17089   REWRITE_TAC[homeomorphic] THEN MESON_TAC[]);;
17090
17091 let HOMEOMORPHIC_INTERVALS_EQ = prove
17092  (`(!a b:real^M c d:real^N.
17093         interval[a,b] homeomorphic interval[c,d] <=>
17094         aff_dim(interval[a,b]) = aff_dim(interval[c,d])) /\
17095    (!a b:real^M c d:real^N.
17096         interval[a,b] homeomorphic interval(c,d) <=>
17097         interval[a,b] = {} /\ interval(c,d) = {}) /\
17098    (!a b:real^M c d:real^N.
17099         interval(a,b) homeomorphic interval[c,d] <=>
17100         interval(a,b) = {} /\ interval[c,d] = {}) /\
17101    (!a b:real^M c d:real^N.
17102         interval(a,b) homeomorphic interval(c,d) <=>
17103         interval(a,b) = {} /\ interval(c,d) = {} \/
17104         ~(interval(a,b) = {}) /\ ~(interval(c,d) = {}) /\
17105         dimindex(:M) = dimindex(:N))`,
17106   SIMP_TAC[HOMEOMORPHIC_CONVEX_COMPACT_SETS_EQ; CONVEX_INTERVAL;
17107            COMPACT_INTERVAL] THEN
17108   REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN
17109   ASM_REWRITE_TAC[HOMEOMORPHIC_EMPTY] THENL
17110    [FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN
17111     REWRITE_TAC[COMPACT_INTERVAL_EQ] THEN ASM_MESON_TAC[HOMEOMORPHIC_EMPTY];
17112     FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN
17113     REWRITE_TAC[COMPACT_INTERVAL_EQ] THEN ASM_MESON_TAC[HOMEOMORPHIC_EMPTY];
17114     MATCH_MP_TAC(TAUT
17115      `(p <=> q) /\ (~p /\ ~q ==> r) ==> p /\ q \/ ~p /\ ~q /\ r`) THEN
17116     CONJ_TAC THENL [ASM_MESON_TAC[HOMEOMORPHIC_EMPTY]; STRIP_TAC] THEN
17117     REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN
17118     MATCH_MP_TAC INVARIANCE_OF_DIMENSION THEN
17119     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THENL
17120      [ALL_TAC; GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM]] THEN
17121     MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN
17122     REWRITE_TAC[homeomorphism] THEN STRIP_TAC THENL
17123      [EXISTS_TAC `interval(a:real^M,b)`;
17124       EXISTS_TAC `interval(c:real^N,d)`] THEN
17125     ASM_REWRITE_TAC[OPEN_INTERVAL] THEN ASM SET_TAC[];
17126     TRANS_TAC HOMEOMORPHIC_TRANS
17127      `IMAGE ((\x. lambda i. x$i):real^M->real^N)
17128             (interval(a,b))` THEN
17129     CONJ_TAC THENL
17130      [MATCH_MP_TAC INVARIANCE_OF_DOMAIN_HOMEOMORPHIC THEN
17131       REPEAT CONJ_TAC THENL
17132        [ASM_MESON_TAC[LE_REFL];
17133         MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN
17134         SIMP_TAC[linear; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
17135                  LAMBDA_BETA; CART_EQ];
17136         REWRITE_TAC[OPEN_INTERVAL];
17137         SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN ASM_MESON_TAC[]];
17138       ALL_TAC] THEN
17139     SUBGOAL_THEN
17140      `IMAGE ((\x. lambda i. x$i):real^M->real^N)
17141             (interval(a,b)) =
17142             interval((lambda i. a$i),(lambda i. b$i))`
17143     SUBST1_TAC THENL
17144      [MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN
17145       SIMP_TAC[IN_INTERVAL; LAMBDA_BETA] THEN
17146       CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
17147       X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN
17148       EXISTS_TAC `(lambda i. (y:real^N)$i):real^M` THEN
17149       SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
17150       FIRST_ASSUM(SUBST1_TAC o SYM) THEN   SIMP_TAC[CART_EQ; LAMBDA_BETA];
17151       MATCH_MP_TAC HOMEOMORPHIC_OPEN_INTERVALS THEN
17152       GEN_REWRITE_TAC I [TAUT `(p <=> q) <=> (~p <=> ~q)`] THEN
17153       SIMP_TAC[INTERVAL_NE_EMPTY; LAMBDA_BETA] THEN
17154       REPEAT(FIRST_X_ASSUM(MP_TAC o
17155         GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY])) THEN
17156       ASM_MESON_TAC[]]]);;
17157
17158 let CONTINUOUS_IMAGE_SUBSET_INTERIOR = prove
17159  (`!f:real^M->real^N s.
17160         f continuous_on s /\ dimindex(:N) <= dimindex(:M) /\
17161         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
17162         ==> IMAGE f (interior s) SUBSET interior(IMAGE f s)`,
17163   REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_MAXIMAL THEN
17164   SIMP_TAC[IMAGE_SUBSET; INTERIOR_SUBSET] THEN
17165   ASM_CASES_TAC `interior s:real^M->bool = {}` THENL
17166    [ASM_REWRITE_TAC[INTERIOR_EMPTY; OPEN_EMPTY; IMAGE_CLAUSES];
17167     MATCH_MP_TAC INVARIANCE_OF_DOMAIN_GEN] THEN
17168   ASM_REWRITE_TAC[OPEN_INTERIOR] THEN
17169   ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET; SUBSET]);;
17170
17171 let HOMEOMORPHIC_INTERIORS_SAME_DIMENSION = prove
17172  (`!s:real^M->bool t:real^N->bool.
17173         dimindex(:M) = dimindex(:N) /\ s homeomorphic t
17174         ==> (interior s) homeomorphic (interior t)`,
17175   REPEAT STRIP_TAC THEN
17176   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
17177   REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
17178   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN
17179   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN
17180   STRIP_TAC THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] INTERIOR_SUBSET] THEN
17181   REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN
17182   REPEAT CONJ_TAC THENL
17183    [SUBGOAL_THEN `t = IMAGE (f:real^M->real^N) s` SUBST1_TAC THENL
17184      [ASM SET_TAC[];
17185       MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_INTERIOR THEN
17186       ASM_MESON_TAC[LE_REFL]];
17187     SUBGOAL_THEN `s = IMAGE (g:real^N->real^M) t` SUBST1_TAC THENL
17188      [ASM SET_TAC[];
17189       MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_INTERIOR THEN
17190       ASM_MESON_TAC[LE_REFL]];
17191     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET];
17192     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET]]);;
17193
17194 let HOMEOMORPHIC_INTERIORS = prove
17195  (`!s:real^M->bool t:real^N->bool.
17196         s homeomorphic t /\ (interior s = {} <=> interior t = {})
17197         ==> (interior s) homeomorphic (interior t)`,
17198   REPEAT GEN_TAC THEN
17199   ASM_CASES_TAC `interior t:real^N->bool = {}` THEN
17200   ASM_SIMP_TAC[HOMEOMORPHIC_EMPTY] THEN STRIP_TAC THEN
17201   MATCH_MP_TAC HOMEOMORPHIC_INTERIORS_SAME_DIMENSION THEN
17202   ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM
17203    (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
17204   REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN
17205   MATCH_MP_TAC INVARIANCE_OF_DIMENSION THENL
17206    [MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `interior s:real^M->bool`];
17207     MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `interior t:real^N->bool`]] THEN
17208   ASM_REWRITE_TAC[OPEN_INTERIOR] THEN
17209   ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET; SUBSET]);;
17210
17211 let HOMEOMORPHIC_FRONTIERS_SAME_DIMENSION = prove
17212  (`!s:real^M->bool t:real^N->bool.
17213         dimindex(:M) = dimindex(:N) /\
17214         s homeomorphic t /\ closed s /\ closed t
17215         ==> (frontier s) homeomorphic (frontier t)`,
17216   REPEAT STRIP_TAC THEN
17217   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
17218   REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
17219   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN
17220   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN
17221   ASM_SIMP_TAC[REWRITE_RULE[SUBSET] FRONTIER_SUBSET_CLOSED] THEN
17222   STRIP_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
17223    [ALL_TAC; ASM_MESON_TAC[FRONTIER_SUBSET_CLOSED; CONTINUOUS_ON_SUBSET]] THEN
17224   ASM_SIMP_TAC[frontier; CLOSURE_CLOSED] THEN
17225   SUBGOAL_THEN
17226    `(!x:real^M. x IN interior s ==> f x IN interior t) /\
17227     (!y:real^N. y IN interior t ==> g y IN interior s)`
17228   MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
17229   REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN
17230   CONJ_TAC THENL
17231    [SUBGOAL_THEN `t = IMAGE (f:real^M->real^N) s` SUBST1_TAC THENL
17232      [ASM SET_TAC[];
17233       MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_INTERIOR THEN
17234       ASM_MESON_TAC[LE_REFL]];
17235     SUBGOAL_THEN `s = IMAGE (g:real^N->real^M) t` SUBST1_TAC THENL
17236      [ASM SET_TAC[];
17237       MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_INTERIOR THEN
17238       ASM_MESON_TAC[LE_REFL]]]);;
17239
17240 let HOMEOMORPHIC_FRONTIERS = prove
17241  (`!s:real^M->bool t:real^N->bool.
17242         s homeomorphic t /\ closed s /\ closed t /\
17243         (interior s = {} <=> interior t = {})
17244         ==> (frontier s) homeomorphic (frontier t)`,
17245   REPEAT GEN_TAC THEN
17246   ASM_CASES_TAC `interior t:real^N->bool = {}` THENL
17247    [ASM_SIMP_TAC[frontier; CLOSURE_CLOSED; DIFF_EMPTY]; STRIP_TAC] THEN
17248   MATCH_MP_TAC HOMEOMORPHIC_FRONTIERS_SAME_DIMENSION THEN
17249   ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM
17250    (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
17251   REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN
17252   MATCH_MP_TAC INVARIANCE_OF_DIMENSION THENL
17253    [MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `interior s:real^M->bool`];
17254     MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `interior t:real^N->bool`]] THEN
17255   ASM_REWRITE_TAC[OPEN_INTERIOR] THEN
17256   ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET; SUBSET]);;
17257
17258 let CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR = prove
17259  (`!f:real^M->real^N s t.
17260         f continuous_on s /\ IMAGE f s SUBSET t /\ aff_dim t <= aff_dim s /\
17261         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)
17262         ==> IMAGE f (relative_interior s) SUBSET relative_interior(IMAGE f s)`,
17263   REPEAT STRIP_TAC THEN MATCH_MP_TAC RELATIVE_INTERIOR_MAXIMAL THEN
17264   SIMP_TAC[IMAGE_SUBSET; RELATIVE_INTERIOR_SUBSET] THEN
17265   MATCH_MP_TAC INVARIANCE_OF_DOMAIN_AFFINE_SETS THEN
17266   EXISTS_TAC `affine hull s:real^M->bool` THEN
17267   ASM_REWRITE_TAC[AFFINE_AFFINE_HULL; AFF_DIM_AFFINE_HULL] THEN
17268   REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR] THEN CONJ_TAC THENL
17269    [ASM_MESON_TAC[AFF_DIM_SUBSET; INT_LE_TRANS]; ALL_TAC] THEN
17270   ASSUME_TAC(ISPEC `s:real^M->bool` RELATIVE_INTERIOR_SUBSET) THEN
17271   REPEAT CONJ_TAC THENL
17272    [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC; ASM SET_TAC[]] THEN
17273   MATCH_MP_TAC SUBSET_TRANS THEN
17274   EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN
17275   SIMP_TAC[IMAGE_SUBSET; RELATIVE_INTERIOR_SUBSET; HULL_SUBSET]);;
17276
17277 let HOMEOMORPHIC_RELATIVE_INTERIORS_SAME_DIMENSION = prove
17278  (`!s:real^M->bool t:real^N->bool.
17279         aff_dim s = aff_dim t /\ s homeomorphic t
17280         ==> (relative_interior s) homeomorphic (relative_interior t)`,
17281   REPEAT STRIP_TAC THEN
17282   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
17283   REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
17284   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN
17285   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN
17286   STRIP_TAC THEN
17287   ASM_SIMP_TAC[REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET] THEN
17288   REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN
17289   REPEAT CONJ_TAC THENL
17290    [SUBGOAL_THEN `t = IMAGE (f:real^M->real^N) s` SUBST1_TAC THENL
17291      [ASM SET_TAC[];
17292       MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR THEN
17293       EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN
17294       ASM SET_TAC[]];
17295     SUBGOAL_THEN `s = IMAGE (g:real^N->real^M) t` SUBST1_TAC THENL
17296      [ASM SET_TAC[];
17297       MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR THEN
17298       EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN
17299       ASM SET_TAC[]];
17300     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; RELATIVE_INTERIOR_SUBSET];
17301     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; RELATIVE_INTERIOR_SUBSET]]);;
17302
17303 let HOMEOMORPHIC_RELATIVE_INTERIORS = prove
17304  (`!s:real^M->bool t:real^N->bool.
17305         s homeomorphic t /\
17306         (relative_interior s = {} <=> relative_interior t = {})
17307         ==> (relative_interior s) homeomorphic (relative_interior t)`,
17308   REPEAT GEN_TAC THEN
17309   ASM_CASES_TAC `relative_interior t:real^N->bool = {}` THEN
17310   ASM_SIMP_TAC[HOMEOMORPHIC_EMPTY] THEN STRIP_TAC THEN
17311   MATCH_MP_TAC HOMEOMORPHIC_RELATIVE_INTERIORS_SAME_DIMENSION THEN
17312   ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM
17313    (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
17314   ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN
17315   REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN CONJ_TAC THEN
17316   MATCH_MP_TAC INVARIANCE_OF_DIMENSION_AFFINE_SETS THENL
17317    [MAP_EVERY EXISTS_TAC
17318      [`f:real^M->real^N`; `relative_interior s:real^M->bool`];
17319     MAP_EVERY EXISTS_TAC
17320      [`g:real^N->real^M`; `relative_interior t:real^N->bool`]] THEN
17321   ASM_REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR; AFFINE_AFFINE_HULL] THEN
17322   (REPEAT CONJ_TAC THENL
17323     [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; RELATIVE_INTERIOR_SUBSET];
17324      ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; HULL_SUBSET; SET_RULE
17325       `(!x. x IN s ==> f x IN t) /\ s' SUBSET s /\ t SUBSET t'
17326        ==> IMAGE f s' SUBSET t'`];
17327      ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET]]));;
17328
17329 let HOMEOMORPHIC_RELATIVE_BOUNDARIES_SAME_DIMENSION = prove
17330  (`!s:real^M->bool t:real^N->bool.
17331         aff_dim s = aff_dim t /\ s homeomorphic t
17332         ==> (s DIFF relative_interior s) homeomorphic
17333             (t DIFF relative_interior t)`,
17334   REPEAT STRIP_TAC THEN
17335   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
17336   REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN
17337   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN
17338   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN
17339   STRIP_TAC THEN ASM_SIMP_TAC[IN_DIFF] THEN
17340   ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
17341    [ALL_TAC; ASM_MESON_TAC[SUBSET_DIFF; CONTINUOUS_ON_SUBSET]] THEN
17342   SUBGOAL_THEN
17343    `(!x:real^M. x IN relative_interior s ==> f x IN relative_interior t) /\
17344     (!y:real^N. y IN relative_interior t ==> g y IN relative_interior s)`
17345   MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
17346   REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN
17347   CONJ_TAC THENL
17348    [SUBGOAL_THEN `t = IMAGE (f:real^M->real^N) s` SUBST1_TAC THENL
17349      [ASM SET_TAC[];
17350       MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR THEN
17351       EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN
17352       ASM SET_TAC[]];
17353     SUBGOAL_THEN `s = IMAGE (g:real^N->real^M) t` SUBST1_TAC THENL
17354      [ASM SET_TAC[];
17355       MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR THEN
17356       EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN
17357       ASM SET_TAC[]]]);;
17358
17359 let HOMEOMORPHIC_RELATIVE_BOUNDARIES = prove
17360  (`!s:real^M->bool t:real^N->bool.
17361         s homeomorphic t /\
17362         (relative_interior s = {} <=> relative_interior t = {})
17363         ==> (s DIFF relative_interior s) homeomorphic
17364             (t DIFF relative_interior t)`,
17365   REPEAT GEN_TAC THEN
17366   ASM_CASES_TAC `relative_interior t:real^N->bool = {}` THEN
17367   ASM_SIMP_TAC[DIFF_EMPTY] THEN STRIP_TAC THEN
17368   MATCH_MP_TAC HOMEOMORPHIC_RELATIVE_BOUNDARIES_SAME_DIMENSION THEN
17369   ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM
17370    (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN
17371   ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN
17372   REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN CONJ_TAC THEN
17373   MATCH_MP_TAC INVARIANCE_OF_DIMENSION_AFFINE_SETS THENL
17374    [MAP_EVERY EXISTS_TAC
17375      [`f:real^M->real^N`; `relative_interior s:real^M->bool`];
17376     MAP_EVERY EXISTS_TAC
17377      [`g:real^N->real^M`; `relative_interior t:real^N->bool`]] THEN
17378   ASM_REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR; AFFINE_AFFINE_HULL] THEN
17379   (REPEAT CONJ_TAC THENL
17380     [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; RELATIVE_INTERIOR_SUBSET];
17381      ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; HULL_SUBSET; SET_RULE
17382       `(!x. x IN s ==> f x IN t) /\ s' SUBSET s /\ t SUBSET t'
17383        ==> IMAGE f s' SUBSET t'`];
17384      ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET]]));;
17385
17386 let UNIFORMLY_CONTINUOUS_HOMEOMORPHISM_UNIV_TRIVIAL = prove
17387  (`!f g s:real^N->bool.
17388         homeomorphism (s,(:real^N)) (f,g) /\ f uniformly_continuous_on s
17389         ==> s = (:real^N)`,
17390   REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphism; IN_UNIV] THEN
17391   ASM_CASES_TAC `s:real^N->bool = {}` THEN
17392   ASM_REWRITE_TAC[NOT_IN_EMPTY] THENL [SET_TAC[]; STRIP_TAC] THEN
17393   MP_TAC(ISPEC `s:real^N->bool` CLOPEN) THEN ASM_REWRITE_TAC[] THEN
17394   DISCH_THEN(SUBST1_TAC o SYM) THEN CONJ_TAC THENL
17395    [REWRITE_TAC[GSYM COMPLETE_EQ_CLOSED; complete] THEN
17396     X_GEN_TAC `x:num->real^N` THEN STRIP_TAC THEN
17397     SUBGOAL_THEN `cauchy ((f:real^N->real^N) o x)` MP_TAC THENL
17398      [ASM_MESON_TAC[UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS]; ALL_TAC] THEN
17399     REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN
17400     DISCH_THEN(X_CHOOSE_TAC `l:real^N`) THEN
17401     EXISTS_TAC `(g:real^N->real^N) l` THEN
17402     CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
17403     MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN
17404     EXISTS_TAC `(g:real^N->real^N) o (f:real^N->real^N) o (x:num->real^N)` THEN
17405     REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL
17406      [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM SET_TAC[];
17407       MATCH_MP_TAC LIM_CONTINUOUS_FUNCTION THEN ASM_SIMP_TAC[GSYM o_DEF] THEN
17408       ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV]];
17409     FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN
17410     MATCH_MP_TAC INVARIANCE_OF_DOMAIN THEN
17411     ASM_REWRITE_TAC[OPEN_UNIV] THEN ASM SET_TAC[]]);;
17412
17413 let INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET_GEN = prove
17414  (`!f:real^M->real^N u s t.
17415         f continuous_on s /\ IMAGE f s SUBSET t /\
17416         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
17417         bounded u /\ convex u /\ affine t /\ aff_dim t < aff_dim u /\
17418         open_in (subtopology euclidean (relative_frontier u)) s
17419         ==> open_in (subtopology euclidean t) (IMAGE f s)`,
17420   REPEAT GEN_TAC THEN
17421   ASM_CASES_TAC `relative_frontier u:real^M->bool = {}` THEN
17422   ASM_SIMP_TAC[OPEN_IN_SUBTOPOLOGY_EMPTY; IMAGE_CLAUSES; OPEN_IN_EMPTY] THEN
17423   STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN
17424   SUBGOAL_THEN
17425    `?b c:real^M. b IN relative_frontier u /\ c IN relative_frontier u /\
17426                  ~(b = c)`
17427   STRIP_ASSUME_TAC THENL
17428    [MATCH_MP_TAC(SET_RULE
17429      `~(s = {} \/ ?x. s = {x}) ==> ?a b. a IN s /\ b IN s /\ ~(a = b)`) THEN
17430     ASM_MESON_TAC[RELATIVE_FRONTIER_NOT_SING];
17431     ALL_TAC] THEN
17432   MP_TAC(ISPECL [`(:real^M)`; `aff_dim(u:real^M->bool) - &1`]
17433         CHOOSE_AFFINE_SUBSET) THEN
17434   REWRITE_TAC[SUBSET_UNIV; AFFINE_UNIV] THEN ANTS_TAC THENL
17435    [MATCH_MP_TAC(INT_ARITH
17436      `&0:int <= t /\ t <= n ==> --a <= t - a /\ t - &1 <= n`) THEN
17437     REWRITE_TAC[AFF_DIM_LE_UNIV; AFF_DIM_UNIV; AFF_DIM_POS_LE] THEN
17438     ASM_MESON_TAC[RELATIVE_FRONTIER_EMPTY; NOT_IN_EMPTY];
17439     DISCH_THEN(X_CHOOSE_THEN `af:real^M->bool` STRIP_ASSUME_TAC)] THEN
17440   MP_TAC(ISPECL [`u:real^M->bool`; `af:real^M->bool`]
17441         HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN) THEN
17442   ASM_REWRITE_TAC[INT_ARITH `x - a + a:int = x`] THEN
17443   DISCH_THEN(fun th ->
17444     MP_TAC(SPEC `c:real^M` th) THEN MP_TAC(SPEC `b:real^M` th)) THEN
17445   ASM_REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN
17446   MAP_EVERY X_GEN_TAC [`g:real^M->real^M`; `h:real^M->real^M`] THEN
17447   REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
17448   MAP_EVERY X_GEN_TAC [`j:real^M->real^M`; `k:real^M->real^M`] THEN
17449   STRIP_TAC THEN
17450   MP_TAC(ISPECL
17451    [`(f:real^M->real^N) o (k:real^M->real^M)`;
17452     `(af:real^M->bool)`;
17453     `t:real^N->bool`; `IMAGE (j:real^M->real^M) (s DELETE c)`]
17454    INVARIANCE_OF_DOMAIN_AFFINE_SETS) THEN
17455   MP_TAC(ISPECL
17456    [`(f:real^M->real^N) o (h:real^M->real^M)`;
17457     `(af:real^M->bool)`;
17458     `t:real^N->bool`; `IMAGE (g:real^M->real^M) (s DELETE b)`]
17459    INVARIANCE_OF_DOMAIN_AFFINE_SETS) THEN
17460   ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN
17461   ASM_REWRITE_TAC[IMP_IMP; INT_ARITH `x:int <= y - &1 <=> x < y`] THEN
17462   MATCH_MP_TAC(TAUT
17463    `(p1 /\ p2) /\ (q1 /\ q2 ==> r) ==> (p1 ==> q1) /\ (p2 ==> q2) ==> r`) THEN
17464   REPEAT CONJ_TAC THENL
17465    [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
17466     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
17467         CONTINUOUS_ON_SUBSET)) THEN
17468     ASM SET_TAC[];
17469     REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
17470     RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_DELETE]) THEN
17471     ASM_SIMP_TAC[o_THM; IN_DELETE; IMP_CONJ] THEN ASM_MESON_TAC[];
17472     MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN MAP_EVERY EXISTS_TAC
17473      [`h:real^M->real^M`; `relative_frontier u DELETE (b:real^M)`] THEN
17474     ASM_SIMP_TAC[homeomorphism; DOT_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
17475     ASM_REWRITE_TAC[IN_ELIM_THM; OPEN_IN_OPEN] THEN
17476     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
17477     MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[];
17478     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
17479     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
17480         CONTINUOUS_ON_SUBSET)) THEN
17481     ASM SET_TAC[];
17482     REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[];
17483     RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_DELETE]) THEN
17484     ASM_SIMP_TAC[o_THM; IN_DELETE; IMP_CONJ] THEN ASM_MESON_TAC[];
17485     MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN MAP_EVERY EXISTS_TAC
17486      [`k:real^M->real^M`; `relative_frontier u DELETE (c:real^M)`] THEN
17487     ASM_SIMP_TAC[homeomorphism; DOT_BASIS; DIMINDEX_GE_1; LE_REFL] THEN
17488     ASM_REWRITE_TAC[IN_ELIM_THM; OPEN_IN_OPEN] THEN
17489     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN
17490     MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[];
17491     DISCH_THEN(MP_TAC o MATCH_MP OPEN_IN_UNION) THEN
17492     MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
17493     MATCH_MP_TAC EQ_TRANS THEN
17494     EXISTS_TAC `IMAGE (f:real^M->real^N)
17495                       ((s DELETE b) UNION (s DELETE c))` THEN
17496     CONJ_TAC THENL
17497      [REWRITE_TAC[IMAGE_UNION] THEN BINOP_TAC; ASM SET_TAC[]] THEN
17498     REWRITE_TAC[IMAGE_o] THEN AP_TERM_TAC THEN ASM SET_TAC[]]);;
17499
17500 let INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET = prove
17501  (`!f:real^M->real^N a r s t.
17502         f continuous_on s /\ IMAGE f s SUBSET t /\
17503         (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\
17504         ~(r = &0) /\ affine t /\ aff_dim t < &(dimindex(:M)) /\
17505         open_in (subtopology euclidean (sphere(a,r))) s
17506         ==> open_in (subtopology euclidean t) (IMAGE f s)`,
17507   REPEAT GEN_TAC THEN ASM_CASES_TAC `sphere(a:real^M,r) = {}` THEN
17508   ASM_SIMP_TAC[OPEN_IN_SUBTOPOLOGY_EMPTY; OPEN_IN_EMPTY; IMAGE_CLAUSES] THEN
17509   RULE_ASSUM_TAC(REWRITE_RULE[SPHERE_EQ_EMPTY; REAL_NOT_LT]) THEN
17510   STRIP_TAC THEN
17511   MP_TAC(ISPECL [`f:real^M->real^N`; `cball(a:real^M,r)`;
17512                  `s:real^M->bool`; `t:real^N->bool`]
17513         INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET_GEN) THEN
17514   ASM_REWRITE_TAC[AFF_DIM_CBALL; RELATIVE_FRONTIER_CBALL;
17515                   BOUNDED_CBALL; CONVEX_CBALL] THEN
17516   COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);;
17517
17518 let NO_EMBEDDING_SPHERE_LOWDIM = prove
17519  (`!f:real^M->real^N a r.
17520         &0 < r /\
17521         f continuous_on sphere(a,r) /\
17522         (!x y. x IN sphere(a,r) /\ y IN sphere(a,r) /\ f x = f y ==> x = y)
17523         ==> dimindex(:M) <= dimindex(:N)`,
17524   REWRITE_TAC[GSYM NOT_LT] THEN REPEAT STRIP_TAC THEN
17525   MP_TAC(ISPEC `IMAGE (f:real^M->real^N) (sphere(a:real^M,r))`
17526         COMPACT_OPEN) THEN
17527   ASM_SIMP_TAC[COMPACT_CONTINUOUS_IMAGE; IMAGE_EQ_EMPTY;
17528                COMPACT_SPHERE; SPHERE_EQ_EMPTY;
17529                REAL_ARITH `&0 < r ==> ~(r < &0)`] THEN
17530   ONCE_REWRITE_TAC[OPEN_IN] THEN
17531   ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN
17532   MATCH_MP_TAC INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET THEN
17533   MAP_EVERY EXISTS_TAC [`a:real^M`; `r:real`] THEN
17534   ASM_REWRITE_TAC[AFFINE_UNIV; SUBSET_UNIV; AFF_DIM_UNIV;
17535                   OPEN_IN_REFL; INT_OF_NUM_LT] THEN
17536   ASM_REAL_ARITH_TAC);;
17537
17538 (* ------------------------------------------------------------------------- *)
17539 (* Dimension-based conditions for various homeomorphisms.                    *)
17540 (* ------------------------------------------------------------------------- *)
17541
17542 let HOMEOMORPHIC_SUBSPACES_EQ = prove
17543  (`!s:real^M->bool t:real^N->bool.
17544         subspace s /\ subspace t ==> (s homeomorphic t <=> dim s = dim t)`,
17545   REPEAT STRIP_TAC THEN EQ_TAC THENL
17546    [ALL_TAC; ASM_MESON_TAC[HOMEOMORPHIC_SUBSPACES]] THEN
17547   REWRITE_TAC[homeomorphic; HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN
17548   MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
17549   STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN
17550   MATCH_MP_TAC CONTINUOUS_INJECTIVE_IMAGE_SUBSPACE_DIM_LE THEN
17551   ASM_MESON_TAC[]);;
17552
17553 let HOMEOMORPHIC_AFFINE_SETS_EQ = prove
17554  (`!s:real^M->bool t:real^N->bool.
17555         affine s /\ affine t ==> (s homeomorphic t <=> aff_dim s = aff_dim t)`,
17556   REPEAT GEN_TAC THEN
17557   ASM_CASES_TAC `t:real^N->bool = {}` THEN
17558   ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; HOMEOMORPHIC_EMPTY] THEN
17559   POP_ASSUM MP_TAC THEN
17560   GEN_REWRITE_TAC (funpow 3 RAND_CONV) [EQ_SYM_EQ] THEN
17561   ASM_CASES_TAC `s:real^M->bool = {}` THEN
17562   ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; HOMEOMORPHIC_EMPTY] THEN
17563   POP_ASSUM MP_TAC THEN REWRITE_TAC
17564    [GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM; RIGHT_IMP_FORALL_THM] THEN
17565   MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^N`] THEN
17566   GEOM_ORIGIN_TAC `a:real^M` THEN GEOM_ORIGIN_TAC `b:real^N` THEN
17567   SIMP_TAC[AFFINE_EQ_SUBSPACE; HOMEOMORPHIC_SUBSPACES_EQ; AFF_DIM_DIM_0;
17568            HULL_INC; INT_OF_NUM_EQ] THEN
17569   MESON_TAC[]);;
17570
17571 let HOMEOMORPHIC_HYPERPLANES_EQ = prove
17572  (`!a:real^M b c:real^N d.
17573         ~(a = vec 0) /\ ~(c = vec 0)
17574         ==> ({x | a dot x = b} homeomorphic {x | c dot x = d} <=>
17575              dimindex(:M) = dimindex(:N))`,
17576   SIMP_TAC[HOMEOMORPHIC_AFFINE_SETS_EQ; AFFINE_HYPERPLANE] THEN
17577   SIMP_TAC[AFF_DIM_HYPERPLANE; INT_OF_NUM_EQ;
17578           INT_ARITH `x - &1:int = y - &1 <=> x = y`]);;
17579
17580 let HOMEOMORPHIC_UNIV_UNIV = prove
17581  (`(:real^M) homeomorphic (:real^N) <=> dimindex(:M) = dimindex(:N)`,
17582   SIMP_TAC[HOMEOMORPHIC_SUBSPACES_EQ; DIM_UNIV; SUBSPACE_UNIV]);;
17583
17584 let HOMEOMORPHIC_CBALLS_EQ = prove
17585  (`!a:real^M b:real^N r s.
17586         cball(a,r) homeomorphic cball(b,s) <=>
17587         r < &0 /\ s < &0 \/ r = &0 /\ s = &0 \/
17588         &0 < r /\ &0 < s /\ dimindex(:M) = dimindex(:N)`,
17589   let lemma =
17590     let d = `dimindex(:M) = dimindex(:N)`
17591     and t = `?a:real^M b:real^N. ~(cball(a,r) homeomorphic cball(b,s))` in
17592     DISCH d (DISCH t (GEOM_EQUAL_DIMENSION_RULE (ASSUME d) (ASSUME t))) in
17593   REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THENL
17594    [ASM_SIMP_TAC[CBALL_EMPTY; HOMEOMORPHIC_EMPTY; CBALL_EQ_EMPTY] THEN
17595     EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
17596     ALL_TAC] THEN
17597   ASM_CASES_TAC `r = &0` THEN ASM_REWRITE_TAC[REAL_LT_REFL] THENL
17598    [ASM_SIMP_TAC[CBALL_TRIVIAL; FINITE_SING; HOMEOMORPHIC_FINITE_STRONG] THEN
17599     REWRITE_TAC[FINITE_CBALL] THEN
17600     ASM_CASES_TAC `s < &0` THEN
17601     ASM_SIMP_TAC[CBALL_EMPTY; CARD_CLAUSES; FINITE_EMPTY;
17602                  NOT_IN_EMPTY; ARITH; REAL_LT_IMP_NE] THEN
17603     ASM_CASES_TAC `s = &0` THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN
17604     ASM_SIMP_TAC[CBALL_TRIVIAL; CARD_CLAUSES; FINITE_EMPTY; NOT_IN_EMPTY;
17605                  REAL_LE_REFL; ARITH];
17606     ALL_TAC] THEN
17607   SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
17608   ASM_CASES_TAC `s <= &0` THEN
17609   ASM_SIMP_TAC[HOMEOMORPHIC_FINITE_STRONG; FINITE_CBALL] THENL
17610    [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
17611   SUBGOAL_THEN `&0 < s` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
17612   ASM_REWRITE_TAC[] THEN EQ_TAC THENL
17613    [REWRITE_TAC[homeomorphic; HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN
17614     MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
17615     STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN
17616     MATCH_MP_TAC INVARIANCE_OF_DIMENSION THENL
17617      [MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `ball(a:real^M,r)`] THEN
17618       MP_TAC(ISPECL [`a:real^M`; `r:real`] BALL_SUBSET_CBALL);
17619       MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `ball(b:real^N,s)`] THEN
17620       MP_TAC(ISPECL [`b:real^N`; `s:real`] BALL_SUBSET_CBALL)] THEN
17621     ASM_REWRITE_TAC[BALL_EQ_EMPTY; OPEN_BALL; REAL_NOT_LE] THEN
17622     ASM_MESON_TAC[SUBSET; CONTINUOUS_ON_SUBSET];
17623     DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN
17624     GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN
17625     REWRITE_TAC[NOT_EXISTS_THM] THEN ASM_SIMP_TAC[HOMEOMORPHIC_CBALLS]]);;
17626
17627 let HOMEOMORPHIC_BALLS_EQ = prove
17628  (`!a:real^M b:real^N r s.
17629         ball(a,r) homeomorphic ball(b,s) <=>
17630         r <= &0 /\ s <= &0 \/
17631         &0 < r /\ &0 < s /\ dimindex(:M) = dimindex(:N)`,
17632   let lemma =
17633     let d = `dimindex(:M) = dimindex(:N)`
17634     and t = `?a:real^M b:real^N. ~(ball(a,r) homeomorphic ball(b,s))` in
17635     DISCH d (DISCH t (GEOM_EQUAL_DIMENSION_RULE (ASSUME d) (ASSUME t))) in
17636   REPEAT GEN_TAC THEN ASM_CASES_TAC `r <= &0` THENL
17637    [ASM_SIMP_TAC[BALL_EMPTY; HOMEOMORPHIC_EMPTY; BALL_EQ_EMPTY] THEN
17638     EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
17639     ALL_TAC] THEN
17640   ASM_CASES_TAC `s <= &0` THENL
17641    [ASM_SIMP_TAC[BALL_EMPTY; HOMEOMORPHIC_EMPTY; BALL_EQ_EMPTY] THEN
17642     ASM_REAL_ARITH_TAC;
17643     ALL_TAC] THEN
17644   ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN
17645   ASM_REWRITE_TAC[] THEN EQ_TAC THENL
17646    [REWRITE_TAC[homeomorphic; HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN
17647     MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN
17648     STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN
17649     MATCH_MP_TAC INVARIANCE_OF_DIMENSION THENL
17650      [MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `ball(a:real^M,r)`];
17651       MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `ball(b:real^N,s)`]] THEN
17652     ASM_REWRITE_TAC[BALL_EQ_EMPTY; OPEN_BALL; REAL_NOT_LE] THEN
17653     ASM SET_TAC[];
17654     DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN
17655     GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN
17656     REWRITE_TAC[NOT_EXISTS_THM] THEN ASM_SIMP_TAC[HOMEOMORPHIC_BALLS]]);;
17657
17658 let SIMPLY_CONNECTED_SPHERE_EQ = prove
17659  (`!a:real^N r.
17660         simply_connected(sphere(a,r)) <=> 3 <= dimindex(:N) \/ r <= &0`,
17661   let hslemma = prove
17662    (`!a:real^M r b:real^N s.
17663         dimindex(:M) = dimindex(:N)
17664         ==> &0 < r /\ &0 < s  ==> (sphere(a,r) homeomorphic sphere(b,s))`,
17665     REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th ->
17666       let t = `?a:real^M b:real^N. ~(sphere(a,r) homeomorphic sphere(b,s))` in
17667       MP_TAC(DISCH t (GEOM_EQUAL_DIMENSION_RULE th (ASSUME t)))) THEN
17668     ASM_SIMP_TAC[HOMEOMORPHIC_SPHERES] THEN MESON_TAC[]) in
17669   REPEAT GEN_TAC THEN
17670   ASM_CASES_TAC `r < &0` THEN
17671   ASM_SIMP_TAC[SPHERE_EMPTY; REAL_LT_IMP_LE; SIMPLY_CONNECTED_EMPTY] THEN
17672   ASM_CASES_TAC `r = &0` THEN
17673   ASM_SIMP_TAC[SPHERE_SING; REAL_LE_REFL; CONVEX_IMP_SIMPLY_CONNECTED;
17674                CONVEX_SING] THEN
17675   ASM_REWRITE_TAC[REAL_LE_LT] THEN
17676   EQ_TAC THEN REWRITE_TAC[SIMPLY_CONNECTED_SPHERE] THEN
17677   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
17678   REWRITE_TAC[ARITH_RULE `~(3 <= n) <=> (1 <= n ==> n = 1 \/ n = 2)`] THEN
17679   REWRITE_TAC[DIMINDEX_GE_1] THEN STRIP_TAC THENL
17680    [DISCH_THEN(MP_TAC o MATCH_MP SIMPLY_CONNECTED_IMP_CONNECTED) THEN
17681     ASM_REWRITE_TAC[CONNECTED_SPHERE_EQ; ARITH] THEN ASM_REAL_ARITH_TAC;
17682     RULE_ASSUM_TAC(REWRITE_RULE[GSYM DIMINDEX_2]) THEN
17683     FIRST_ASSUM(MP_TAC o ISPECL [`a:real^N`; `r:real`; `vec 0:real^2`;
17684           `&1:real`] o MATCH_MP hslemma) THEN
17685     ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN
17686     DISCH_THEN(SUBST1_TAC o MATCH_MP HOMEOMORPHIC_SIMPLY_CONNECTED_EQ) THEN
17687     REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_CIRCLEMAP] THEN
17688     REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\x:real^2. x`) THEN
17689     REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID; SUBSET_REFL] THEN
17690     REWRITE_TAC[GSYM contractible; CONTRACTIBLE_SPHERE] THEN
17691     CONV_TAC REAL_RAT_REDUCE_CONV]);;
17692
17693 let NOT_SIMPLY_CONNECTED_CIRCLE = prove
17694  (`!a:real^2 r. &0 < r ==> ~simply_connected(sphere(a,r))`,
17695   REWRITE_TAC[SIMPLY_CONNECTED_SPHERE_EQ; DIMINDEX_2; ARITH] THEN
17696   REAL_ARITH_TAC);;
17697
17698 (* ------------------------------------------------------------------------- *)
17699 (* The power, squaring and exponential functions as covering maps.           *)
17700 (* ------------------------------------------------------------------------- *)
17701
17702 let COVERING_SPACE_POW_PUNCTURED_PLANE = prove
17703  (`!n. 0 < n
17704        ==> covering_space ((:complex) DIFF {Cx(&0)},(\z. z pow n))
17705                           ((:complex) DIFF {Cx (&0)})`,
17706   let lemma = prove
17707    (`!n. 0 < n
17708          ==> ?e. &0 < e /\
17709                  !w z. norm(w - z) < e * norm(z)
17710                        ==> (w pow n = z pow n <=> w = z)`,
17711     REPEAT STRIP_TAC THEN
17712     FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE
17713      `0 < n ==> n = 1 \/ 2 <= n`)) THEN
17714     ASM_SIMP_TAC[COMPLEX_POW_1] THENL [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN
17715     EXISTS_TAC `&2 * sin(pi / &n)` THEN CONJ_TAC THENL
17716      [REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`] THEN
17717       MATCH_MP_TAC SIN_POS_PI THEN
17718       ASM_SIMP_TAC[REAL_LT_DIV; PI_POS; REAL_OF_NUM_LT] THEN
17719       REWRITE_TAC[REAL_ARITH `x / y < x <=> &0 < x * (&1 - inv y)`] THEN
17720       MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[PI_POS; REAL_SUB_LT] THEN
17721       MATCH_MP_TAC REAL_INV_LT_1 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN
17722       ASM_ARITH_TAC;
17723       ALL_TAC] THEN
17724     REPEAT GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THENL
17725      [ASM_REWRITE_TAC[COMPLEX_NORM_0; COMPLEX_SUB_RZERO] THEN
17726       CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[] THEN
17727       SIMP_TAC[NORM_ARITH `norm(w) < x * &0 <=> F`];
17728       ALL_TAC] THEN
17729     ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; COMPLEX_NORM_NZ] THEN
17730     ASM_SIMP_TAC[COMPLEX_POW_EQ_0; COMPLEX_FIELD
17731      `~(z = Cx(&0)) ==> (w = z <=> w / z = Cx(&1))`] THEN
17732     REWRITE_TAC[GSYM COMPLEX_NORM_DIV; GSYM COMPLEX_POW_DIV] THEN
17733     ASM_SIMP_TAC[COMPLEX_FIELD
17734      `~(z = Cx(&0)) ==> (w - z) / z = w / z - Cx(&1)`] THEN
17735     ASM_CASES_TAC `w / z = Cx(&0)` THENL
17736      [ASM_REWRITE_TAC[COMPLEX_SUB_LZERO; NORM_NEG; COMPLEX_NORM_CX] THEN
17737       ASM_SIMP_TAC[COMPLEX_POW_ZERO; LE_1];
17738       UNDISCH_TAC `~(w / z = Cx(&0))` THEN
17739       UNDISCH_THEN `~(z = Cx(&0))` (K ALL_TAC) THEN
17740       REPEAT(POP_ASSUM MP_TAC) THEN
17741       SPEC_TAC(`w / z:complex`,`z:complex`) THEN REPEAT STRIP_TAC] THEN
17742     EQ_TAC THEN SIMP_TAC[COMPLEX_POW_ONE] THEN DISCH_TAC THEN
17743     UNDISCH_TAC `norm(z - Cx(&1)) < &2 * sin (pi / &n)` THEN
17744     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LT] THEN
17745     DISCH_TAC THEN MP_TAC(SPEC `n:num` COMPLEX_ROOTS_UNITY) THEN
17746     ASM_SIMP_TAC[LE_1; EXTENSION; IN_ELIM_THM] THEN
17747     DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN
17748     DISCH_THEN(X_CHOOSE_THEN `j:num` MP_TAC) THEN
17749     REWRITE_TAC[COMPLEX_RING `t * p * ii * q = ii * (t * p * q)`] THEN
17750     REWRITE_TAC[GSYM CX_MUL] THEN ASM_CASES_TAC `j = 0` THENL
17751      [ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_MUL_RZERO; CEXP_0;
17752                       COMPLEX_MUL_RZERO];
17753       STRIP_TAC THEN ASM_REWRITE_TAC[DIST_CEXP_II_1]] THEN
17754     MATCH_MP_TAC(REAL_ARITH `x <= y ==> &2 * x <= &2 * abs y`) THEN
17755     REWRITE_TAC[REAL_ARITH `(&2 * x) / &2 = x`] THEN
17756     ASM_CASES_TAC `&j / &n <= &1 / &2` THENL
17757      [ALL_TAC;
17758       SUBGOAL_THEN `sin(pi * &j / &n) = sin(pi * &(n - j) / &n)`
17759       SUBST1_TAC THENL
17760        [ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; LT_IMP_LE; REAL_OF_NUM_LT;
17761            REAL_FIELD `&0 < n ==> pi * (n - j) / n = pi - pi * j / n`] THEN
17762         REWRITE_TAC[SIN_SUB; COS_PI; SIN_PI] THEN REAL_ARITH_TAC;
17763         ALL_TAC]] THEN
17764     MATCH_MP_TAC SIN_MONO_LE THEN
17765     REWRITE_TAC[REAL_ARITH `--(pi / &2) = pi * --(&1 / &2)`; real_div] THEN
17766     SIMP_TAC[REAL_LE_LMUL_EQ; PI_POS] THEN
17767     ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; REAL_MUL_LINV; REAL_LT_IMP_NZ;
17768                  REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; REAL_OF_NUM_LT; LE_1;
17769                  ARITH_RULE `j < n ==> 1 <= n - j`; REAL_OF_NUM_LE;
17770                  REAL_ARITH `&0 <= x ==> --(&1 / &2) <= x`;
17771                  REAL_POS; REAL_LE_INV_EQ] THEN
17772     ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; LT_IMP_LE] THEN
17773     REWRITE_TAC[REAL_ARITH `n - j <= inv(&2) * n <=> inv(&2) * n <= j`] THEN
17774     ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_LE_RDIV_EQ;
17775                  REAL_OF_NUM_LT] THEN
17776     ASM_REAL_ARITH_TAC) in
17777   REPEAT STRIP_TAC THEN
17778   SIMP_TAC[covering_space; CONTINUOUS_ON_COMPLEX_POW; CONTINUOUS_ON_ID] THEN
17779   SIMP_TAC[OPEN_IN_OPEN_EQ; OPEN_DIFF; OPEN_UNIV; CLOSED_SING] THEN
17780   MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
17781    [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DIFF; IN_UNIV; IN_SING] THEN
17782     ASM_MESON_TAC[COMPLEX_POW_EQ_0; EXISTS_COMPLEX_ROOT; LE_1];
17783     DISCH_THEN(fun th -> GEN_REWRITE_TAC
17784         (BINDER_CONV o LAND_CONV o RAND_CONV) [GSYM th])] THEN
17785   REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; IN_DIFF; IN_SING] THEN
17786   SIMP_TAC[SUBSET_UNIV; SET_RULE `s SUBSET UNIV DIFF {a} <=> ~(a IN s)`] THEN
17787   X_GEN_TAC `z:complex` THEN DISCH_TAC THEN
17788   MP_TAC(SPEC `n:num` lemma) THEN ASM_REWRITE_TAC[] THEN
17789   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
17790   ABBREV_TAC `d = (min (&1 / &2) (e / &4)) * norm(z:complex)` THEN
17791   SUBGOAL_THEN `&0 < d` ASSUME_TAC THENL
17792    [EXPAND_TAC "d" THEN MATCH_MP_TAC REAL_LT_MUL THEN
17793     ASM_REWRITE_TAC[COMPLEX_NORM_NZ] THEN ASM_REAL_ARITH_TAC;
17794     ALL_TAC] THEN
17795   SUBGOAL_THEN
17796    `!w x y. w pow n = z pow n /\ x IN ball(w,d) /\ y IN ball(w,d)
17797             ==> (x pow n = y pow n <=> x = y)`
17798   ASSUME_TAC THENL
17799    [REWRITE_TAC[IN_BALL] THEN REPEAT STRIP_TAC THEN
17800     FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
17801     SUBGOAL_THEN `norm(z pow n) = norm(w pow n)` MP_TAC THENL
17802      [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]] THEN
17803     DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
17804      (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN
17805     ASM_SIMP_TAC[LE_1; NORM_POS_LE] THEN
17806     ASM_CASES_TAC `w = Cx(&0)` THENL
17807      [ASM_MESON_TAC[COMPLEX_NORM_ZERO]; DISCH_THEN SUBST_ALL_TAC] THEN
17808     MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&2 * d` THEN CONJ_TAC THENL
17809      [MAP_EVERY UNDISCH_TAC
17810        [`dist(w:complex,x) < d`; `dist(w:complex,y) < d`] THEN
17811       CONV_TAC NORM_ARITH;
17812       ALL_TAC] THEN
17813     EXPAND_TAC "d" THEN MATCH_MP_TAC REAL_LE_TRANS THEN
17814     EXISTS_TAC `&2 * e / &4 * norm(w:complex)` THEN CONJ_TAC THENL
17815      [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN
17816       MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN
17817       REAL_ARITH_TAC;
17818       ALL_TAC] THEN
17819     ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_ARITH
17820      `&2 * e / &4 * x <= e * y <=> e * x <= e * &2 * y`] THEN
17821     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH
17822      `dist(z,y) < d ==> d <= &1 / &2 * norm(z)
17823                         ==> norm(z) <= &2 * norm y`)) THEN
17824     EXPAND_TAC "d" THEN MATCH_MP_TAC REAL_LE_RMUL THEN
17825     REWRITE_TAC[NORM_POS_LE] THEN REAL_ARITH_TAC;
17826     ALL_TAC] THEN
17827   EXISTS_TAC `IMAGE (\w. w pow n) (ball(z,d))` THEN REPEAT CONJ_TAC THENL
17828    [REWRITE_TAC[IN_IMAGE] THEN ASM_MESON_TAC[CENTRE_IN_BALL];
17829     MATCH_MP_TAC INVARIANCE_OF_DOMAIN THEN
17830     SIMP_TAC[OPEN_BALL; CONTINUOUS_ON_COMPLEX_POW; CONTINUOUS_ON_ID] THEN
17831     ASM_MESON_TAC[];
17832     REWRITE_TAC[SET_RULE
17833      `~(z IN IMAGE f s) <=> (!x. x IN s ==> ~(f x = z))`] THEN
17834     X_GEN_TAC `w:complex` THEN
17835     ASM_SIMP_TAC[IN_BALL; COMPLEX_POW_EQ_0; LE_1] THEN
17836     ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
17837     SIMP_TAC[GSYM COMPLEX_VEC_0; DIST_0] THEN DISCH_TAC THEN
17838     EXPAND_TAC "d" THEN
17839     REWRITE_TAC[REAL_ARITH `~(z < e * z) <=> &0 <= z * (&1 - e)`] THEN
17840     MATCH_MP_TAC REAL_LE_MUL THEN CONV_TAC NORM_ARITH;
17841     ALL_TAC] THEN
17842   SUBGOAL_THEN
17843    `!z'. z' pow n = z pow n
17844          ==> IMAGE (\w. w pow n) (ball(z',d)) =
17845              IMAGE (\w. w pow n) (ball(z,d))`
17846   ASSUME_TAC THENL
17847    [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_BALL] THEN
17848     X_GEN_TAC `w:complex` THEN DISCH_TAC THEN
17849     ASM_CASES_TAC `w = Cx(&0)` THENL
17850      [ASM_MESON_TAC[COMPLEX_POW_EQ_0; LE_1]; ALL_TAC] THEN
17851     X_GEN_TAC `x:complex` THEN  EQ_TAC THEN
17852     DISCH_THEN(X_CHOOSE_THEN `y:complex` STRIP_ASSUME_TAC) THENL
17853      [EXISTS_TAC `z / w * y:complex`;
17854       EXISTS_TAC `w / z * y:complex`] THEN
17855     ASM_SIMP_TAC[COMPLEX_POW_MUL; COMPLEX_POW_DIV; COMPLEX_DIV_REFL;
17856                  COMPLEX_POW_EQ_0; LE_1; COMPLEX_MUL_LID; dist] THEN
17857     ASM_SIMP_TAC[COMPLEX_FIELD
17858      `~(w = Cx(&0)) ==> z - z / w * y = z / w * (w - y)`] THEN
17859     REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV] THEN
17860     (SUBGOAL_THEN `norm(z pow n) = norm(w pow n)` MP_TAC THENL
17861      [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]]) THEN
17862     DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
17863      (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN
17864     ASM_SIMP_TAC[LE_1; NORM_POS_LE; REAL_DIV_REFL; COMPLEX_NORM_ZERO] THEN
17865     ASM_REWRITE_TAC[REAL_MUL_LID; GSYM dist];
17866     ALL_TAC] THEN
17867   EXISTS_TAC `{ ball(z',d) | z' pow n = z pow n}` THEN
17868   REWRITE_TAC[FORALL_IN_GSPEC] THEN REPEAT CONJ_TAC THENL
17869    [REWRITE_TAC[UNIONS_GSPEC; EXTENSION; IN_ELIM_THM] THEN
17870     X_GEN_TAC `x:complex` THEN EQ_TAC THENL
17871      [DISCH_THEN(X_CHOOSE_THEN `w:complex` STRIP_ASSUME_TAC) THEN
17872       CONJ_TAC THENL
17873        [DISCH_TAC THEN UNDISCH_TAC `x IN ball(w:complex,d)` THEN
17874         ASM_REWRITE_TAC[IN_BALL; GSYM COMPLEX_VEC_0; DIST_0] THEN
17875         SUBGOAL_THEN `norm(w pow n) = norm(z pow n)` MP_TAC THENL
17876          [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]] THEN
17877         DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
17878          (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN
17879         ASM_SIMP_TAC[LE_1; NORM_POS_LE; REAL_NOT_LT] THEN DISCH_TAC THEN
17880         EXPAND_TAC "d" THEN REWRITE_TAC[REAL_ARITH
17881          `e * z <= z <=> &0 <= z * (&1 - e)`] THEN
17882         MATCH_MP_TAC REAL_LE_MUL THEN CONV_TAC NORM_ARITH;
17883         SUBGOAL_THEN `IMAGE (\w. w pow n) (ball(z,d)) =
17884                   IMAGE (\w. w pow n) (ball(w,d))`
17885         SUBST1_TAC THENL [ASM_MESON_TAC[]; ASM SET_TAC[]]];
17886       STRIP_TAC THEN
17887       FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_IMAGE]) THEN
17888       REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:complex` THEN
17889       REWRITE_TAC[IN_BALL] THEN STRIP_TAC THEN
17890       ASM_CASES_TAC `y = Cx(&0)` THENL
17891        [ASM_MESON_TAC[COMPLEX_POW_EQ_0; LE_1]; ALL_TAC] THEN
17892       EXISTS_TAC `x / y * z:complex` THEN
17893       REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV] THEN
17894       ASM_SIMP_TAC[COMPLEX_POW_MUL; COMPLEX_POW_DIV; COMPLEX_DIV_REFL;
17895                    COMPLEX_POW_EQ_0; LE_1; COMPLEX_MUL_LID; dist] THEN
17896       ASM_SIMP_TAC[COMPLEX_FIELD
17897        `~(y = Cx(&0)) ==> x / y * z - x = x / y * (z - y)`] THEN
17898       REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV] THEN
17899       SUBGOAL_THEN `norm(y pow n) = norm(x pow n)` MP_TAC THENL
17900        [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]] THEN
17901       REWRITE_TAC[COMPLEX_POW_MUL; COMPLEX_POW_DIV] THEN
17902       DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
17903        (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN
17904       ASM_SIMP_TAC[LE_1; NORM_POS_LE; REAL_DIV_REFL; COMPLEX_NORM_ZERO] THEN
17905       ASM_REWRITE_TAC[REAL_MUL_LID; GSYM dist]];
17906     X_GEN_TAC `w:complex` THEN DISCH_TAC THEN
17907     REWRITE_TAC[OPEN_BALL; IN_BALL; REAL_NOT_LT; dist; COMPLEX_SUB_RZERO] THEN
17908     SUBGOAL_THEN `norm(w pow n) = norm(z pow n)` MP_TAC THENL
17909      [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]] THEN
17910     DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
17911      (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN
17912     ASM_SIMP_TAC[LE_1; NORM_POS_LE] THEN DISCH_THEN SUBST1_TAC THEN
17913     EXPAND_TAC "d" THEN
17914     REWRITE_TAC[REAL_ARITH `e * z <= z <=> &0 <= z * (&1 - e)`] THEN
17915     MATCH_MP_TAC REAL_LE_MUL THEN CONV_TAC NORM_ARITH;
17916     REWRITE_TAC[pairwise; IMP_CONJ; FORALL_IN_GSPEC; RIGHT_FORALL_IMP_THM] THEN
17917     X_GEN_TAC `u:complex` THEN DISCH_TAC THEN
17918     X_GEN_TAC `v:complex` THEN DISCH_TAC THEN
17919     ASM_CASES_TAC `v:complex = u` THEN ASM_REWRITE_TAC[] THEN
17920     DISCH_THEN(K ALL_TAC) THEN
17921     REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s /\ x IN t ==> F`] THEN
17922     X_GEN_TAC `x:complex` THEN REWRITE_TAC[IN_BALL] THEN
17923     DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH
17924      `dist(u,x) < d /\ dist(v,x) < d ==> dist(u,v) < &2 * d`)) THEN
17925     REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
17926     EXISTS_TAC `e * norm(z:complex)` THEN CONJ_TAC THENL
17927      [EXPAND_TAC "d" THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN
17928       MATCH_MP_TAC REAL_LE_RMUL THEN
17929       REWRITE_TAC[NORM_POS_LE] THEN ASM_REAL_ARITH_TAC;
17930       ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN REWRITE_TAC[dist]] THEN
17931     SUBGOAL_THEN `norm(z pow n) = norm(v pow n)` MP_TAC THENL
17932      [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]] THEN
17933     DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT]
17934      (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN
17935     ASM_SIMP_TAC[LE_1; NORM_POS_LE] THEN ASM_MESON_TAC[];
17936     X_GEN_TAC `w:complex` THEN DISCH_TAC THEN
17937     SUBGOAL_THEN `IMAGE (\w. w pow n) (ball(z,d)) =
17938                   IMAGE (\w. w pow n) (ball(w,d))`
17939     SUBST1_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
17940     MATCH_MP_TAC INVARIANCE_OF_DOMAIN_HOMEOMORPHISM THEN
17941     SIMP_TAC[LE_REFL; OPEN_BALL; CONTINUOUS_ON_COMPLEX_POW;
17942              CONTINUOUS_ON_ID] THEN
17943     ASM_MESON_TAC[]]);;
17944
17945 let COVERING_SPACE_SQUARE_PUNCTURED_PLANE = prove
17946  (`covering_space ((:complex) DIFF {Cx(&0)},(\z. z pow 2))
17947                   ((:complex) DIFF {Cx (&0)})`,
17948   SIMP_TAC[COVERING_SPACE_POW_PUNCTURED_PLANE; ARITH]);;
17949
17950 let COVERING_SPACE_CEXP_PUNCTURED_PLANE = prove
17951  (`covering_space((:complex),cexp) ((:complex) DIFF {Cx(&0)})`,
17952   SIMP_TAC[covering_space; IN_UNIV; CONTINUOUS_ON_CEXP; IN_DIFF; IN_SING] THEN
17953   CONJ_TAC THENL [SET_TAC[CEXP_CLOG; CEXP_NZ]; ALL_TAC] THEN
17954   SIMP_TAC[OPEN_IN_OPEN_EQ; OPEN_DIFF; OPEN_UNIV; CLOSED_SING] THEN
17955   SIMP_TAC[SUBSET_UNIV; SET_RULE `s SUBSET UNIV DIFF {a} <=> ~(a IN s)`] THEN
17956   X_GEN_TAC `z:complex` THEN DISCH_TAC THEN
17957   EXISTS_TAC `IMAGE cexp (ball(clog z,&1))` THEN
17958   REWRITE_TAC[SET_RULE `~(z IN IMAGE f s) <=> !x. x IN s ==> ~(f x = z)`] THEN
17959   REWRITE_TAC[CEXP_NZ] THEN CONJ_TAC THENL
17960    [REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `clog z` THEN
17961     ASM_SIMP_TAC[CEXP_CLOG; CENTRE_IN_BALL; REAL_LT_01];
17962     ALL_TAC] THEN
17963   SUBGOAL_THEN
17964    `!x y. x IN cball(clog z,&1) /\ y IN cball(clog z,&1) /\ cexp x = cexp y
17965           ==> x = y`
17966   ASSUME_TAC THENL
17967    [REWRITE_TAC[IN_CBALL] THEN REPEAT STRIP_TAC THEN
17968     MATCH_MP_TAC COMPLEX_EQ_CEXP THEN ASM_REWRITE_TAC[] THEN
17969     MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `norm(x - y:complex)` THEN
17970     REWRITE_TAC[GSYM IM_SUB; COMPLEX_NORM_GE_RE_IM] THEN
17971     MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&2` THEN CONJ_TAC THENL
17972      [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC NORM_ARITH;
17973       MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC];
17974     ALL_TAC] THEN
17975   CONJ_TAC THENL
17976    [MATCH_MP_TAC INVARIANCE_OF_DOMAIN THEN
17977     REWRITE_TAC[OPEN_BALL; CONTINUOUS_ON_CEXP] THEN
17978     ASM_MESON_TAC[SUBSET; BALL_SUBSET_CBALL];
17979     ALL_TAC] THEN
17980   MP_TAC(ISPECL [`cball(clog z,&1)`; `cexp`;
17981                  `IMAGE cexp (cball(clog z,&1))`] HOMEOMORPHISM_COMPACT) THEN
17982   ASM_REWRITE_TAC[COMPACT_CBALL; CONTINUOUS_ON_CEXP] THEN
17983   REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE] THEN
17984   X_GEN_TAC `l:complex->complex` THEN STRIP_TAC THEN
17985   EXISTS_TAC `{ IMAGE (\x. x + Cx (&2 * n * pi) * ii)
17986                       (ball(clog z,&1))
17987                 | integer n}` THEN
17988   SIMP_TAC[FORALL_IN_GSPEC; OPEN_BALL;
17989            ONCE_REWRITE_RULE[VECTOR_ADD_SYM] OPEN_TRANSLATION] THEN
17990   REPEAT CONJ_TAC THENL
17991    [REWRITE_TAC[UNIONS_GSPEC; IN_IMAGE; CEXP_EQ] THEN SET_TAC[];
17992     REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
17993     REWRITE_TAC[FORALL_IN_GSPEC] THEN
17994     X_GEN_TAC `m:real` THEN DISCH_TAC THEN
17995     X_GEN_TAC `n:real` THEN DISCH_TAC THEN
17996     ASM_CASES_TAC `m:real = n` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
17997     REWRITE_TAC[IN_BALL; dist; SET_RULE
17998      `DISJOINT (IMAGE f s) (IMAGE g s) <=>
17999       !x y. x IN s /\ y IN s ==> ~(f x = g y)`] THEN
18000     REPEAT GEN_TAC THEN MATCH_MP_TAC(NORM_ARITH
18001      `&2 <= norm(m - n)
18002       ==> norm(c - x) < &1 /\ norm(c - y) < &1 ==> ~(x + m = y + n)`) THEN
18003     REWRITE_TAC[GSYM COMPLEX_SUB_RDISTRIB; COMPLEX_NORM_MUL] THEN
18004     REWRITE_TAC[COMPLEX_NORM_II; GSYM CX_SUB; COMPLEX_NORM_CX] THEN
18005     REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN
18006     REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM; REAL_ABS_PI; REAL_MUL_RID] THEN
18007     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 * &1 * pi` THEN
18008     CONJ_TAC THENL [MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; ALL_TAC] THEN
18009     MATCH_MP_TAC REAL_LE_LMUL THEN
18010     SIMP_TAC[REAL_LE_RMUL_EQ; PI_POS; REAL_POS] THEN
18011     MATCH_MP_TAC REAL_ABS_INTEGER_LEMMA THEN
18012     ASM_SIMP_TAC[REAL_SUB_0; INTEGER_CLOSED];
18013     X_GEN_TAC `n:real` THEN DISCH_TAC THEN
18014     EXISTS_TAC `(\x. x + Cx(&2 * n * pi) * ii) o (l:complex->complex)` THEN
18015     ASM_REWRITE_TAC[CONTINUOUS_ON_CEXP; o_THM; IMAGE_o; FORALL_IN_IMAGE] THEN
18016     RULE_ASSUM_TAC(REWRITE_RULE[INJECTIVE_ON_ALT]) THEN
18017     ASM_SIMP_TAC[CEXP_ADD; CEXP_INTEGER_2PI; COMPLEX_MUL_RID;
18018                  REWRITE_RULE[SUBSET] BALL_SUBSET_CBALL] THEN
18019     REPEAT CONJ_TAC THENL
18020      [MATCH_MP_TAC(SET_RULE
18021        `(!x. e(f x) = e x) ==> IMAGE e (IMAGE f s) = IMAGE e s`) THEN
18022       ASM_SIMP_TAC[CEXP_ADD; CEXP_INTEGER_2PI; COMPLEX_MUL_RID];
18023       MATCH_MP_TAC(SET_RULE
18024        `(!x. x IN s ==> l(e x) = x)
18025         ==> IMAGE t (IMAGE l (IMAGE e s)) = IMAGE t s`) THEN
18026       ASM_SIMP_TAC[REWRITE_RULE[SUBSET] BALL_SUBSET_CBALL];
18027       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
18028       SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID;
18029                CONTINUOUS_ON_CONST] THEN
18030       ASM_MESON_TAC[BALL_SUBSET_CBALL; IMAGE_SUBSET;
18031                     CONTINUOUS_ON_SUBSET]]]);;
18032
18033 (* ------------------------------------------------------------------------- *)
18034 (* Hence the Borsukian results about mappings into circle.                   *)
18035 (* ------------------------------------------------------------------------- *)
18036
18037 let INESSENTIAL_EQ_CONTINUOUS_LOGARITHM = prove
18038  (`!f:real^N->complex s.
18039       (?a. homotopic_with (\h. T) (s,(:complex) DIFF {Cx(&0)}) f (\t. a)) <=>
18040       (?g. g continuous_on s /\ (!x. x IN s ==> f x = cexp(g x)))`,
18041   REPEAT GEN_TAC THEN EQ_TAC THENL
18042    [DISCH_THEN(CHOOSE_THEN
18043      (MP_TAC o CONJ COVERING_SPACE_CEXP_PUNCTURED_PLANE)) THEN
18044     DISCH_THEN(MP_TAC o MATCH_MP COVERING_SPACE_LIFT_INESSENTIAL_FUNCTION) THEN
18045     REWRITE_TAC[SUBSET_UNIV] THEN MESON_TAC[];
18046     DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN
18047     SUBGOAL_THEN
18048      `?a. homotopic_with (\h. T) (s,(:complex) DIFF {Cx(&0)})
18049               (cexp o g) (\x:real^N. a)`
18050     MP_TAC THENL
18051      [MATCH_MP_TAC NULLHOMOTOPIC_THROUGH_CONTRACTIBLE THEN
18052       EXISTS_TAC `(:complex)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN
18053       ASM_SIMP_TAC[STARLIKE_IMP_CONTRACTIBLE; STARLIKE_UNIV] THEN
18054       REWRITE_TAC[CONTINUOUS_ON_CEXP; SUBSET; FORALL_IN_IMAGE] THEN
18055       REWRITE_TAC[IN_UNIV; IN_DIFF; IN_SING; CEXP_NZ];
18056       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:complex` THEN
18057       MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN
18058       ASM_SIMP_TAC[o_THM]]]);;
18059
18060 let INESSENTIAL_IMP_CONTINUOUS_LOGARITHM_CIRCLE = prove
18061  (`!f:real^N->complex s.
18062         (?a. homotopic_with (\h. T) (s,sphere(vec 0,&1)) f (\t. a))
18063         ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = cexp(g x)`,
18064   REPEAT GEN_TAC THEN
18065   SIMP_TAC[sphere; GSYM INESSENTIAL_EQ_CONTINUOUS_LOGARITHM] THEN
18066   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:complex` THEN
18067   REWRITE_TAC[homotopic_with] THEN MATCH_MP_TAC MONO_EXISTS THEN
18068   REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
18069   FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
18070     (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN
18071   SIMP_TAC[SUBSET; DIST_0; FORALL_IN_GSPEC; IN_UNIV; IN_DIFF; IN_SING] THEN
18072   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
18073   SIMP_TAC[COMPLEX_NORM_CX] THEN REAL_ARITH_TAC);;
18074
18075 let INESSENTIAL_EQ_CONTINUOUS_LOGARITHM_CIRCLE = prove
18076  (`!f:real^N->complex s.
18077         (?a. homotopic_with (\h. T) (s,sphere(vec 0,&1)) f (\t. a)) <=>
18078         (?g. (Cx o g) continuous_on s /\
18079              !x. x IN s ==> f x = cexp(ii * Cx(g x)))`,
18080   REPEAT GEN_TAC THEN EQ_TAC THENL
18081    [DISCH_TAC THEN FIRST_ASSUM(MP_TAC o
18082       MATCH_MP INESSENTIAL_IMP_CONTINUOUS_LOGARITHM_CIRCLE) THEN
18083     DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN
18084     EXISTS_TAC `Im o (g:real^N->complex)` THEN CONJ_TAC THENL
18085      [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
18086       ASM_REWRITE_TAC[CONTINUOUS_ON_CX_IM];
18087       FIRST_X_ASSUM(CHOOSE_THEN (MP_TAC o CONJUNCT1 o
18088         MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET)) THEN
18089       ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; NORM_CEXP] THEN
18090       REWRITE_TAC[EULER; o_THM; RE_MUL_II; IM_MUL_II] THEN
18091       SIMP_TAC[RE_CX; IM_CX; REAL_NEG_0; REAL_EXP_0]];
18092     DISCH_THEN(X_CHOOSE_THEN `g:real^N->real` STRIP_ASSUME_TAC) THEN
18093     SUBGOAL_THEN
18094      `?a. homotopic_with (\h. T) (s,sphere(vec 0,&1))
18095               ((cexp o (\z. ii * z)) o (Cx o g)) (\x:real^N. a)`
18096     MP_TAC THENL
18097      [MATCH_MP_TAC NULLHOMOTOPIC_THROUGH_CONTRACTIBLE THEN
18098       EXISTS_TAC `{z | Im z = &0}` THEN ASM_REWRITE_TAC[] THEN
18099       ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; CONTINUOUS_ON_CEXP; CONJ_ASSOC;
18100                    CONTINUOUS_ON_COMPLEX_LMUL; CONTINUOUS_ON_ID] THEN
18101       CONJ_TAC THENL
18102        [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_SPHERE_0;
18103                     o_THM; IM_CX] THEN
18104         SIMP_TAC[NORM_CEXP; RE_MUL_II; REAL_EXP_0; REAL_NEG_0];
18105         MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN
18106         MATCH_MP_TAC CONVEX_IMP_STARLIKE THEN CONJ_TAC THENL
18107          [REWRITE_TAC[IM_DEF; CONVEX_STANDARD_HYPERPLANE];
18108           REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN
18109           MESON_TAC[IM_CX]]];
18110       MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:complex` THEN
18111       MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN
18112       ASM_SIMP_TAC[o_THM]]]);;
18113
18114 let HOMOTOPIC_CIRCLEMAPS_DIV,HOMOTOPIC_CIRCLEMAPS_DIV_1 = (CONJ_PAIR o prove)
18115  (`(!f g:real^N->real^2 s.
18116     homotopic_with (\x. T) (s,sphere(vec 0,&1)) f g <=>
18117     f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0,&1) /\
18118     g continuous_on s /\ IMAGE g s SUBSET sphere(vec 0,&1) /\
18119     ?c. homotopic_with (\x. T) (s,sphere(vec 0,&1)) (\x. f x / g x) (\x. c)) /\
18120    (!f g:real^N->real^2 s.
18121     homotopic_with (\x. T) (s,sphere(vec 0,&1)) f g <=>
18122     f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0,&1) /\
18123     g continuous_on s /\ IMAGE g s SUBSET sphere(vec 0,&1) /\
18124     homotopic_with (\x. T) (s,sphere(vec 0,&1)) (\x. f x / g x) (\x. Cx(&1)))`,
18125   let lemma = prove
18126    (`!f g h:real^N->real^2 s.
18127           homotopic_with (\x. T) (s,sphere(vec 0,&1)) f g
18128           ==> h continuous_on s /\ (!x. x IN s ==> h(x) IN sphere(vec 0,&1))
18129                ==> homotopic_with (\x. T) (s,sphere(vec 0,&1))
18130                                           (\x. f x * h x) (\x. g x * h x)`,
18131     REWRITE_TAC[IN_SPHERE_0] THEN REPEAT STRIP_TAC THEN
18132     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN
18133     ASM_SIMP_TAC[HOMOTOPIC_WITH; LEFT_IMP_EXISTS_THM] THEN
18134     REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; FORALL_IN_PCROSS] THEN
18135     X_GEN_TAC `k:real^((1,N)finite_sum)->real^2` THEN STRIP_TAC THEN
18136     EXISTS_TAC `\z. (k:real^(1,N)finite_sum->real^2) z * h(sndcart z)` THEN
18137     ASM_SIMP_TAC[COMPLEX_NORM_MUL; SNDCART_PASTECART; REAL_MUL_LID] THEN
18138     ASM_REWRITE_TAC[SNDCART_PASTECART] THEN
18139     MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN
18140     ASM_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
18141     SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; IMAGE_SNDCART_PCROSS] THEN
18142     ASM_REWRITE_TAC[UNIT_INTERVAL_NONEMPTY]) in
18143   REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC
18144    (TAUT `(q <=> r) /\ (p <=> r) ==> (p <=> q) /\ (p <=> r)`) THEN
18145   CONJ_TAC THENL
18146    [REPEAT(MATCH_MP_TAC(TAUT `(p ==> (q <=> r)) ==> (p /\ q <=> p /\ r)`) THEN
18147            DISCH_TAC) THEN
18148     EQ_TAC THENL
18149      [ALL_TAC; DISCH_TAC THEN EXISTS_TAC `Cx(&1)` THEN ASM_MESON_TAC[]] THEN
18150     REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:complex` THEN
18151     DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET th) THEN
18152         MP_TAC th) THEN
18153     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN
18154     REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN
18155     ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN
18156     MP_TAC(ISPECL [`vec 0:real^2`; `&1`] PATH_CONNECTED_SPHERE) THEN
18157     REWRITE_TAC[DIMINDEX_2; LE_REFL; PATH_CONNECTED_IFF_PATH_COMPONENT] THEN
18158     DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL
18159      [ASM SET_TAC[]; REWRITE_TAC[IN_SPHERE_0; COMPLEX_NORM_CX; REAL_ABS_NUM]];
18160     EQ_TAC THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP lemma) THENL
18161      [FIRST_ASSUM(STRIP_ASSUME_TAC o
18162          MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN
18163       FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
18164       DISCH_THEN(MP_TAC o SPEC `\x. inv((g:real^N->complex) x)`);
18165       DISCH_THEN(MP_TAC o SPEC `g:real^N->complex`)] THEN
18166     RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0]) THEN
18167     ASM_SIMP_TAC[IN_SPHERE_0; COMPLEX_NORM_INV; REAL_INV_1] THEN
18168     ASM_SIMP_TAC[GSYM COMPLEX_NORM_ZERO; REAL_OF_NUM_EQ; ARITH_EQ;
18169                  CONTINUOUS_ON_COMPLEX_INV] THEN
18170     ASM_REWRITE_TAC[SUBSET; IN_SPHERE_0; FORALL_IN_IMAGE] THEN
18171     MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT]
18172      HOMOTOPIC_WITH_EQ) THEN
18173     ASM_SIMP_TAC[COMPLEX_DIV_RMUL; COMPLEX_MUL_LID; COMPLEX_MUL_RINV;
18174                  GSYM complex_div; COMPLEX_DIV_REFL;
18175                  GSYM COMPLEX_NORM_ZERO; REAL_OF_NUM_EQ; ARITH_EQ]]);;
18176
18177 (* ------------------------------------------------------------------------- *)
18178 (* In particular, complex logs exist on various "well-behaved" sets.         *)
18179 (* ------------------------------------------------------------------------- *)
18180
18181 let CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE = prove
18182  (`!f:real^N->complex s.
18183         f continuous_on s /\ contractible s /\
18184         (!x. x IN s ==> ~(f x = Cx(&0)))
18185         ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = cexp(g x)`,
18186   REPEAT STRIP_TAC THEN
18187   REWRITE_TAC[GSYM INESSENTIAL_EQ_CONTINUOUS_LOGARITHM] THEN
18188   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NULLHOMOTOPIC_FROM_CONTRACTIBLE THEN
18189   ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);;
18190
18191 let CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED = prove
18192  (`!f:real^N->complex s.
18193         f continuous_on s /\ simply_connected s /\ locally path_connected s /\
18194         (!x. x IN s ==> ~(f x = Cx(&0)))
18195         ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = cexp(g x)`,
18196   REPEAT STRIP_TAC THEN MP_TAC
18197   (ISPECL [`f:real^N->complex`; `s:real^N->bool`]
18198     (MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT)
18199         COVERING_SPACE_CEXP_PUNCTURED_PLANE)) THEN
18200   ASM_REWRITE_TAC[IN_UNIV] THEN ASM SET_TAC[]);;
18201
18202 let CONTINUOUS_LOGARITHM_ON_CBALL = prove
18203  (`!f:real^N->complex a r.
18204         f continuous_on cball(a,r) /\
18205         (!z. z IN cball(a,r) ==> ~(f z = Cx(&0)))
18206         ==> ?h. h continuous_on cball(a,r) /\
18207                 !z. z IN cball(a,r) ==> f z = cexp(h z)`,
18208   REPEAT STRIP_TAC THEN
18209   ASM_CASES_TAC `cball(a:real^N,r) = {}` THEN
18210   ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY; NOT_IN_EMPTY] THEN
18211   MATCH_MP_TAC CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE THEN
18212   ASM_REWRITE_TAC[] THEN
18213   MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN
18214   MATCH_MP_TAC CONVEX_IMP_STARLIKE THEN
18215   ASM_REWRITE_TAC[CONVEX_CBALL]);;
18216
18217 let CONTINUOUS_LOGARITHM_ON_BALL = prove
18218  (`!f:real^N->complex a r.
18219         f continuous_on ball(a,r) /\
18220         (!x. x IN ball(a,r) ==> ~(f x = Cx(&0)))
18221         ==> ?h. h continuous_on ball(a,r) /\
18222                 !x. x IN ball(a,r) ==> f x = cexp(h x)`,
18223   REPEAT STRIP_TAC THEN
18224   ASM_CASES_TAC `ball(a:real^N,r) = {}` THEN
18225   ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY; NOT_IN_EMPTY] THEN
18226   MATCH_MP_TAC CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE THEN
18227   ASM_REWRITE_TAC[] THEN
18228   MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN
18229   MATCH_MP_TAC CONVEX_IMP_STARLIKE THEN
18230   ASM_REWRITE_TAC[CONVEX_BALL]);;
18231
18232 let CONTINUOUS_SQRT_ON_CONTRACTIBLE = prove
18233  (`!f:real^N->complex s.
18234         f continuous_on s /\ contractible s /\
18235         (!x. x IN s ==> ~(f x = Cx(&0)))
18236         ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = (g x) pow 2`,
18237   REPEAT GEN_TAC THEN DISCH_TAC THEN
18238   FIRST_ASSUM(MP_TAC o MATCH_MP CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE) THEN
18239   DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN
18240   EXISTS_TAC `\z:real^N. cexp(g z / Cx(&2))` THEN
18241   ASM_SIMP_TAC[GSYM CEXP_N; COMPLEX_RING `Cx(&2) * z / Cx(&2) = z`] THEN
18242   GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
18243   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
18244   REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN
18245   MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN
18246   ASM_SIMP_TAC[CONTINUOUS_ON_CONST] THEN
18247   CONV_TAC COMPLEX_RING);;
18248
18249 let CONTINUOUS_SQRT_ON_SIMPLY_CONNECTED = prove
18250  (`!f:real^N->complex s.
18251         f continuous_on s /\ simply_connected s /\ locally path_connected s /\
18252         (!x. x IN s ==> ~(f x = Cx(&0)))
18253         ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = (g x) pow 2`,
18254   REPEAT GEN_TAC THEN DISCH_TAC THEN
18255   FIRST_ASSUM(MP_TAC o MATCH_MP CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED) THEN
18256   DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN
18257   EXISTS_TAC `\z:real^N. cexp(g z / Cx(&2))` THEN
18258   ASM_SIMP_TAC[GSYM CEXP_N; COMPLEX_RING `Cx(&2) * z / Cx(&2) = z`] THEN
18259   GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
18260   MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
18261   REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN
18262   MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN
18263   ASM_SIMP_TAC[CONTINUOUS_ON_CONST] THEN
18264   CONV_TAC COMPLEX_RING);;
18265
18266 (* ------------------------------------------------------------------------- *)
18267 (* Analogously, holomorphic logarithms and square roots.                     *)
18268 (* ------------------------------------------------------------------------- *)
18269
18270 let CONTRACTIBLE_IMP_HOLOMORPHIC_LOG,SIMPLY_CONNECTED_IMP_HOLOMORPHIC_LOG =
18271  (CONJ_PAIR o prove)
18272  (`(!s:complex->bool.
18273       contractible s
18274       ==> !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0)))
18275               ==> ?g. g holomorphic_on s /\ !z. z IN s ==> f z = cexp(g z)) /\
18276    (!s:complex->bool.
18277       simply_connected s /\ locally path_connected s
18278       ==> !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0)))
18279               ==> ?g. g holomorphic_on s /\ !z. z IN s ==> f z = cexp(g z))`,
18280   REPEAT STRIP_TAC THENL
18281    [MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`]
18282         CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE);
18283     MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`]
18284         CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED)] THEN
18285   ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN
18286  (MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN
18287   STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
18288   UNDISCH_TAC `f holomorphic_on s` THEN
18289   REWRITE_TAC[holomorphic_on] THEN MATCH_MP_TAC MONO_FORALL THEN
18290   X_GEN_TAC `z:complex` THEN ASM_CASES_TAC `(z:complex) IN s` THEN
18291   ASM_REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN] THEN
18292   DISCH_THEN(X_CHOOSE_THEN `f':complex` MP_TAC) THEN
18293   DISCH_THEN(MP_TAC o
18294    ISPECL [`\x. (cexp(g x) - cexp(g z)) / (x - z)`; `&1`] o
18295    MATCH_MP (REWRITE_RULE [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`]
18296     LIM_TRANSFORM_WITHIN)) THEN
18297   ASM_SIMP_TAC[REAL_LT_01] THEN
18298   DISCH_THEN(MP_TAC o
18299     SPECL [`\x:complex. if g x = g z then cexp(g z)
18300                         else (cexp(g x) - cexp(g z)) / (g x - g z)`;
18301            `cexp(g(z:complex))`] o
18302     MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_COMPLEX_DIV)) THEN
18303   REWRITE_TAC[CEXP_NZ] THEN ANTS_TAC THENL
18304    [SUBGOAL_THEN
18305      `(\x. if g x = g z then cexp(g z)
18306            else (cexp(g x) - cexp(g(z:complex))) / (g x - g z)) =
18307       (\y. if y = g z then cexp(g z) else (cexp y - cexp(g z)) / (y - g z)) o g`
18308     SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN
18309     MATCH_MP_TAC LIM_COMPOSE_AT THEN
18310     EXISTS_TAC `(g:complex->complex) z` THEN REPEAT CONJ_TAC THENL
18311      [ASM_MESON_TAC[CONTINUOUS_ON];
18312       REWRITE_TAC[EVENTUALLY_TRUE];
18313       ONCE_REWRITE_TAC[LIM_AT_ZERO] THEN
18314       SIMP_TAC[COMPLEX_VEC_0; COMPLEX_ADD_SUB; COMPLEX_EQ_ADD_LCANCEL_0] THEN
18315       MP_TAC(SPEC `cexp(g(z:complex))` (MATCH_MP LIM_COMPLEX_LMUL
18316        LIM_CEXP_MINUS_1)) THEN REWRITE_TAC[COMPLEX_MUL_RID] THEN
18317       MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN
18318       SIMP_TAC[EVENTUALLY_AT; GSYM DIST_NZ; CEXP_ADD] THEN
18319       EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN
18320       SIMPLE_COMPLEX_ARITH_TAC];
18321     DISCH_THEN(fun th ->
18322         EXISTS_TAC `f' / cexp(g(z:complex))` THEN MP_TAC th) THEN
18323     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ]
18324         LIM_TRANSFORM_EVENTUALLY) THEN
18325     FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I
18326      [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN
18327     DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN
18328     REWRITE_TAC[CONTINUOUS_WITHIN; tendsto] THEN
18329     DISCH_THEN(MP_TAC o SPEC `&2 * pi`) THEN
18330     REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN
18331     MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN
18332     X_GEN_TAC `w:complex` THEN REWRITE_TAC[dist] THEN DISCH_TAC THEN
18333     COND_CASES_TAC THENL
18334      [ASM_REWRITE_TAC[COMPLEX_SUB_REFL; complex_div; COMPLEX_MUL_LZERO];
18335       ASM_CASES_TAC `w:complex = z` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
18336       SUBGOAL_THEN `~(cexp(g(w:complex)) = cexp(g z))` MP_TAC THENL
18337        [UNDISCH_TAC `~((g:complex->complex) w = g z)` THEN
18338         REWRITE_TAC[CONTRAPOS_THM] THEN
18339         MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] COMPLEX_EQ_CEXP) THEN
18340         FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT]
18341          REAL_LET_TRANS)) THEN
18342         REWRITE_TAC[GSYM IM_SUB; COMPLEX_NORM_GE_RE_IM];
18343         REPEAT(FIRST_X_ASSUM(MP_TAC o check(is_neg o concl))) THEN
18344         CONV_TAC COMPLEX_FIELD]]]));;
18345
18346 let CONTRACTIBLE_IMP_HOLOMORPHIC_SQRT,SIMPLY_CONNECTED_IMP_HOLOMORPHIC_SQRT =
18347  (CONJ_PAIR o prove)
18348  (`(!s:complex->bool.
18349       contractible s
18350       ==> !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0)))
18351               ==> ?g. g holomorphic_on s /\  !z. z IN s ==> f z = g z pow 2) /\
18352    (!s:complex->bool.
18353       simply_connected s /\ locally path_connected s
18354       ==> !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0)))
18355               ==> ?g. g holomorphic_on s /\  !z. z IN s ==> f z = g z pow 2)`,
18356   CONJ_TAC THEN GEN_TAC THENL
18357    [DISCH_THEN(ASSUME_TAC o MATCH_MP CONTRACTIBLE_IMP_HOLOMORPHIC_LOG);
18358     DISCH_THEN(ASSUME_TAC o
18359       MATCH_MP SIMPLY_CONNECTED_IMP_HOLOMORPHIC_LOG)] THEN
18360   REPEAT STRIP_TAC THEN
18361   FIRST_X_ASSUM(MP_TAC o SPEC `f:complex->complex`) THEN ASM_SIMP_TAC[] THEN
18362   DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN
18363   EXISTS_TAC `\z:complex. cexp(g z / Cx(&2))` THEN
18364   ASM_SIMP_TAC[GSYM CEXP_N; COMPLEX_RING `Cx(&2) * z / Cx(&2) = z`] THEN
18365   GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
18366   MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN
18367   REWRITE_TAC[HOLOMORPHIC_ON_CEXP] THEN
18368   MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN
18369   ASM_SIMP_TAC[HOLOMORPHIC_ON_CONST] THEN
18370   CONV_TAC COMPLEX_RING);;
18371
18372 (* ------------------------------------------------------------------------- *)
18373 (* Related theorems about holomorphic inverse cosines.                       *)
18374 (* ------------------------------------------------------------------------- *)
18375
18376 let CONTRACTIBLE_IMP_HOLOMORPHIC_ACS = prove
18377  (`!f s. f holomorphic_on s /\ contractible s /\
18378          (!z. z IN s ==> ~(f z = Cx(&1)) /\ ~(f z = --Cx(&1)))
18379          ==> ?g. g holomorphic_on s /\ !z. z IN s ==> f z = ccos(g z)`,
18380    REPEAT STRIP_TAC THEN
18381    FIRST_ASSUM(MP_TAC o SPEC `\z:complex. Cx(&1) - f(z) pow 2` o
18382      MATCH_MP CONTRACTIBLE_IMP_HOLOMORPHIC_SQRT) THEN
18383    ASM_SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_POW;
18384                 COMPLEX_RING `~(Cx(&1) - z pow 2 = Cx(&0)) <=>
18385                               ~(z = Cx(&1)) /\ ~(z = --Cx(&1))`] THEN
18386    REWRITE_TAC[COMPLEX_RING
18387     `Cx(&1) - w pow 2 = z pow 2 <=>
18388      (w + ii * z) * (w - ii * z) = Cx(&1)`] THEN
18389    DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN
18390    FIRST_ASSUM(MP_TAC o SPEC `\z:complex. f(z) + ii * g(z)` o
18391        MATCH_MP CONTRACTIBLE_IMP_HOLOMORPHIC_LOG) THEN
18392    ASM_SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_CONST;
18393      COMPLEX_RING `(a + b) * (a - b) = Cx(&1) ==> ~(a + b = Cx(&0))`] THEN
18394    DISCH_THEN(X_CHOOSE_THEN `h:complex->complex` STRIP_ASSUME_TAC) THEN
18395    EXISTS_TAC `\z:complex. --ii * h(z)` THEN
18396    ASM_SIMP_TAC[HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_CONST; ccos] THEN
18397    X_GEN_TAC `z:complex` THEN
18398    DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`)) THEN
18399    ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
18400    FIRST_X_ASSUM(MP_TAC o MATCH_MP (COMPLEX_FIELD
18401     `a * b = Cx(&1) ==> b = inv a`)) THEN
18402    ASM_SIMP_TAC[GSYM CEXP_NEG] THEN
18403    FIRST_X_ASSUM(ASSUME_TAC o SYM) THEN DISCH_THEN(ASSUME_TAC o SYM) THEN
18404    ASM_REWRITE_TAC[COMPLEX_RING `ii * --ii * z = z`;
18405                    COMPLEX_RING `--ii * --ii * z = --z`] THEN
18406    CONV_TAC COMPLEX_RING);;
18407
18408 let CONTRACTIBLE_IMP_HOLOMORPHIC_ACS_BOUNDED = prove
18409  (`!f s a.
18410         f holomorphic_on s /\ contractible s /\ a IN s /\
18411         (!z. z IN s ==> ~(f z = Cx(&1)) /\ ~(f z = --Cx(&1)))
18412         ==> ?g. g holomorphic_on s /\ norm(g a) <= pi + norm(f a) /\
18413                 !z. z IN s ==> f z = ccos(g z)`,
18414   let lemma = prove
18415     (`!w. ?v. ccos(v) = w /\ norm(v) <= pi + norm(w)`,
18416      GEN_TAC THEN EXISTS_TAC `cacs w` THEN ABBREV_TAC `v = cacs w` THEN
18417      MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL
18418       [ASM_MESON_TAC[CCOS_CACS]; DISCH_THEN(SUBST1_TAC o SYM)] THEN
18419      SIMP_TAC[NORM_LE_SQUARE; PI_POS_LE; NORM_POS_LE; REAL_LE_ADD] THEN
18420      MATCH_MP_TAC(REAL_ARITH
18421       `&0 <= b * c /\ a <= b pow 2 + c pow 2 ==> a <= (b + c) pow 2`) THEN
18422      SIMP_TAC[REAL_LE_MUL; PI_POS_LE; NORM_POS_LE] THEN
18423      REWRITE_TAC[COMPLEX_SQNORM; GSYM NORM_POW_2; NORM_CCOS_POW_2] THEN
18424      MATCH_MP_TAC REAL_LE_ADD2 THEN REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN
18425      EXPAND_TAC "v" THEN REWRITE_TAC[REAL_ABS_PI; RE_CACS_BOUND] THEN
18426      MATCH_MP_TAC(REAL_ARITH
18427       `&0 <= c /\ x <= (d / &2) pow 2 ==> x <= c + d pow 2 / &4`) THEN
18428      REWRITE_TAC[REAL_LE_POW_2; GSYM REAL_LE_SQUARE_ABS; REAL_LE_ABS_SINH]) in
18429   REPEAT STRIP_TAC THEN
18430   MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`]
18431         CONTRACTIBLE_IMP_HOLOMORPHIC_ACS) THEN
18432   ASM_REWRITE_TAC[] THEN
18433   DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN
18434   MP_TAC(SPEC `(f:complex->complex) a` lemma) THEN
18435   DISCH_THEN(X_CHOOSE_THEN `b:complex` STRIP_ASSUME_TAC) THEN
18436   SUBGOAL_THEN `ccos b = ccos(g(a:complex))` MP_TAC THENL
18437    [ASM_MESON_TAC[]; REWRITE_TAC[CCOS_EQ]] THEN
18438   DISCH_THEN(X_CHOOSE_THEN `n:real` (STRIP_ASSUME_TAC o GSYM)) THENL
18439    [EXISTS_TAC `\z:complex. g z + Cx(&2 * n * pi)`;
18440     EXISTS_TAC `\z:complex. --(g z) + Cx(&2 * n * pi)`] THEN
18441   ASM_SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_NEG;
18442                HOLOMORPHIC_ON_CONST] THEN
18443   CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[CCOS_EQ] THEN
18444   ASM_MESON_TAC[]);;
18445
18446 (* ------------------------------------------------------------------------- *)
18447 (* Another interesting equivalent of an inessential mapping into C-{0}       *)
18448 (* ------------------------------------------------------------------------- *)
18449
18450 let INESSENTIAL_EQ_EXTENSIBLE = prove
18451  (`!f s.
18452    closed s
18453    ==> ((?a. homotopic_with (\h. T) (s,(:complex) DIFF {Cx(&0)}) f (\t. a)) <=>
18454         (?g. g continuous_on (:real^N) /\
18455              (!x. x IN s ==> g x = f x) /\ (!x. ~(g x = Cx(&0)))))`,
18456   REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL
18457    [DISCH_THEN(X_CHOOSE_TAC `a:complex`) THEN
18458     ASM_CASES_TAC `s:real^N->bool = {}` THENL
18459      [EXISTS_TAC `\x:real^N. Cx(&1)` THEN
18460       ASM_REWRITE_TAC[CONTINUOUS_ON_CONST; NOT_IN_EMPTY] THEN
18461       CONV_TAC COMPLEX_RING;
18462       ALL_TAC] THEN
18463     FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN
18464     FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN
18465     FIRST_ASSUM(MP_TAC o
18466       SPECL [`(:real^N)`; `(:complex) DIFF {Cx(&0)}`] o
18467       MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ_ALT]
18468         (REWRITE_RULE[CONJ_ASSOC] BORSUK_HOMOTOPY_EXTENSION)) o
18469       GEN_REWRITE_RULE I [HOMOTOPIC_WITH_SYM]) THEN
18470     ASM_SIMP_TAC[CLOSED_UNIV; CONTINUOUS_ON_CONST; OPEN_DIFF; CLOSED_SING;
18471                  OPEN_UNIV; RETRACT_OF_REFL] THEN
18472     ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN
18473     ASM SET_TAC[];
18474     DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN
18475     REWRITE_TAC[INESSENTIAL_EQ_CONTINUOUS_LOGARITHM] THEN
18476     MP_TAC(ISPECL [`vec 0:real^N`; `&1`] HOMEOMORPHIC_BALL_UNIV) THEN
18477     REWRITE_TAC[REAL_LT_01; homeomorphic; LEFT_IMP_EXISTS_THM] THEN
18478     MAP_EVERY X_GEN_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN
18479     REWRITE_TAC[homeomorphism; IN_UNIV] THEN STRIP_TAC THEN
18480     MP_TAC(ISPECL [`(g:real^N->complex) o (h:real^N->real^N)`;
18481                    `vec 0:real^N`; `&1`] CONTINUOUS_LOGARITHM_ON_BALL) THEN
18482     ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; o_THM] THEN
18483     DISCH_THEN(X_CHOOSE_THEN `j:real^N->complex` STRIP_ASSUME_TAC) THEN
18484     EXISTS_TAC `(j:real^N->complex) o (k:real^N->real^N)` THEN
18485     ASM_SIMP_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN
18486     MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN
18487     FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ]
18488       CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]]);;
18489
18490 (* ------------------------------------------------------------------------- *)
18491 (* Unicoherence.                                                             *)
18492 (* ------------------------------------------------------------------------- *)
18493
18494 let INESSENTIAL_IMP_UNICOHERENT = prove
18495  (`!u:real^N->bool.
18496         (!f. f continuous_on u /\ IMAGE f u SUBSET sphere(vec 0,&1)
18497              ==> ?a. homotopic_with (\h. T)
18498                        (u,(:complex) DIFF {Cx (&0)}) f (\t. a))
18499         ==> !s t. connected s /\ connected t /\ s UNION t = u /\
18500                   closed_in (subtopology euclidean u) s /\
18501                   closed_in (subtopology euclidean u) t
18502                   ==> connected (s INTER t)`,
18503   REWRITE_TAC[sphere; DIST_0; INESSENTIAL_EQ_CONTINUOUS_LOGARITHM] THEN
18504   REPEAT STRIP_TAC THEN SIMP_TAC[CONNECTED_CLOSED_IN_EQ; NOT_EXISTS_THM] THEN
18505   MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `w:real^N->bool`] THEN STRIP_TAC THEN
18506   SUBGOAL_THEN
18507    `closed_in (subtopology euclidean u) (v:real^N->bool) /\
18508     closed_in (subtopology euclidean u) (w:real^N->bool)`
18509   STRIP_ASSUME_TAC THENL
18510    [ASM_MESON_TAC[CLOSED_IN_INTER; CLOSED_IN_TRANS]; ALL_TAC] THEN
18511   MP_TAC(ISPECL
18512    [`v:real^N->bool`; `w:real^N->bool`; `u:real^N->bool`;
18513     `vec 0:real^1`; `vec 1:real^1`] URYSOHN_LOCAL) THEN
18514   ASM_REWRITE_TAC[] THEN
18515   DISCH_THEN(X_CHOOSE_THEN `q:real^N->real^1` STRIP_ASSUME_TAC) THEN
18516   SUBGOAL_THEN
18517    `?g:real^N->real^2.
18518         g continuous_on u /\ IMAGE g u SUBSET {x | norm x = &1} /\
18519         (!x. x IN s ==> g(x) = cexp(Cx pi * ii * Cx(drop(q x)))) /\
18520         (!x. x IN t ==> g(x) = inv(cexp(Cx pi * ii * Cx(drop(q x)))))`
18521   (DESTRUCT_TAC "@g. cont circle s t") THENL
18522    [EXISTS_TAC
18523      `\x. if (x:real^N) IN s then cexp(Cx pi * ii * Cx(drop(q x)))
18524           else inv(cexp(Cx pi * ii * Cx(drop(q x))))` THEN
18525     SUBGOAL_THEN
18526      `!x:real^N.
18527         x IN s INTER t
18528         ==> cexp(Cx pi * ii * Cx(drop(q x))) =
18529             inv(cexp(Cx pi * ii * Cx(drop (q x))))`
18530     ASSUME_TAC THENL
18531      [SUBST1_TAC(SYM(ASSUME `v UNION w:real^N->bool = s INTER t`)) THEN
18532       REWRITE_TAC[IN_UNION] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN
18533       REWRITE_TAC[DROP_VEC; COMPLEX_MUL_RZERO; CEXP_0; COMPLEX_INV_1] THEN
18534       REWRITE_TAC[COMPLEX_MUL_RID; EULER] THEN
18535       REWRITE_TAC[RE_MUL_CX; IM_MUL_CX; RE_MUL_II; IM_MUL_II] THEN
18536       REWRITE_TAC[RE_II; IM_II; REAL_MUL_RZERO; REAL_MUL_RID] THEN
18537       REWRITE_TAC[REAL_EXP_0; COMPLEX_MUL_LID; COS_PI; SIN_PI] THEN
18538       REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN
18539       CONV_TAC COMPLEX_RING;
18540       ALL_TAC] THEN
18541     SIMP_TAC[] THEN REPEAT CONJ_TAC THENL
18542      [EXPAND_TAC "u" THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
18543       ASM_REWRITE_TAC[SET_RULE
18544        `P /\ ~P \/ x IN t /\ x IN s <=> x IN s INTER t`] THEN
18545       CONJ_TAC THENL
18546        [ALL_TAC;
18547         MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_INV THEN REWRITE_TAC[CEXP_NZ]] THEN
18548       GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN
18549       MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
18550       REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN
18551       REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN
18552       MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN
18553       REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
18554       MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN
18555       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION];
18556       REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN
18557       REPEAT STRIP_TAC THEN COND_CASES_TAC THEN
18558       REWRITE_TAC[COMPLEX_NORM_INV; NORM_CEXP] THEN
18559       REWRITE_TAC[RE_MUL_CX; RE_MUL_II; IM_CX] THEN
18560       REWRITE_TAC[REAL_MUL_RZERO; REAL_NEG_0; REAL_EXP_0; REAL_INV_1];
18561       GEN_TAC THEN DISCH_TAC THEN COND_CASES_TAC THEN
18562       ASM_REWRITE_TAC[] THEN ASM SET_TAC[]];
18563      FIRST_X_ASSUM(MP_TAC o SPEC `g:real^N->complex`) THEN
18564      ASM_REWRITE_TAC[] THEN
18565      DISCH_THEN(X_CHOOSE_THEN `h:real^N->complex` STRIP_ASSUME_TAC)] THEN
18566   SUBGOAL_THEN
18567    `(?n. integer n /\
18568          !x:real^N. x IN s
18569                     ==> h(x) - Cx pi * ii * Cx (drop (q x)) =
18570                         Cx(&2 * n * pi) * ii) /\
18571     (?n. integer n /\
18572          !x:real^N. x IN t
18573                     ==> h(x) + Cx pi * ii * Cx (drop (q x)) =
18574                         Cx(&2 * n * pi) * ii)`
18575   (CONJUNCTS_THEN2
18576     (X_CHOOSE_THEN `m:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))
18577     (X_CHOOSE_THEN `n:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)))
18578   THENL
18579    [CONJ_TAC THEN MATCH_MP_TAC(MESON[]
18580      `(?x. x IN s) /\
18581       (!x. x IN s ==> ?n. P n /\ f x = k n) /\
18582       (?a. !x. x IN s ==> f x = a)
18583       ==> (?n. P n /\ !x. x IN s ==> f x = k n)`) THEN
18584     (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN
18585     MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN
18586    (CONJ_TAC THENL
18587      [REWRITE_TAC[COMPLEX_RING `a + b:complex = c <=> a = --b + c`;
18588                   COMPLEX_RING `a - b:complex = c <=> a = b + c`] THEN
18589       REWRITE_TAC[GSYM CEXP_EQ; CEXP_NEG] THEN ASM SET_TAC[];
18590       ALL_TAC] THEN
18591     DISCH_THEN(LABEL_TAC "*") THEN
18592     MATCH_MP_TAC CONTINUOUS_DISCRETE_RANGE_CONSTANT THEN
18593     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
18594      [(MATCH_MP_TAC CONTINUOUS_ON_ADD ORELSE
18595        MATCH_MP_TAC CONTINUOUS_ON_SUB) THEN
18596       CONJ_TAC THENL
18597        [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; ALL_TAC] THEN
18598       REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN
18599       MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN
18600       REWRITE_TAC[CONTINUOUS_ON_CONST] THEN
18601       MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN
18602       ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION];
18603       X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `&2 * pi` THEN
18604       REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN
18605       X_GEN_TAC `y:real^N` THEN
18606       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
18607       REMOVE_THEN "*" (fun th ->
18608        MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN
18609       ASM_REWRITE_TAC[] THEN STRIP_TAC THEN STRIP_TAC THEN
18610       ASM_REWRITE_TAC[] THEN
18611       REWRITE_TAC[COMPLEX_EQ_MUL_RCANCEL; II_NZ; GSYM COMPLEX_SUB_RDISTRIB;
18612             COMPLEX_NORM_MUL; CX_INJ; COMPLEX_NORM_II; REAL_MUL_RID] THEN
18613       REWRITE_TAC[GSYM CX_SUB; COMPLEX_NORM_CX] THEN
18614       REWRITE_TAC[REAL_EQ_MUL_LCANCEL; GSYM REAL_SUB_LDISTRIB] THEN
18615       REWRITE_TAC[GSYM REAL_SUB_RDISTRIB; REAL_ABS_MUL] THEN
18616       REWRITE_TAC[REAL_EQ_MUL_RCANCEL; PI_NZ; REAL_ABS_PI] THEN
18617       REWRITE_TAC[REAL_ABS_NUM; REAL_OF_NUM_EQ; ARITH_EQ] THEN
18618       DISCH_TAC THEN REWRITE_TAC[REAL_ARITH
18619        `&2 * p <= &2 * a * p <=> &0 <= &2 * p * (a - &1)`] THEN
18620       MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN
18621       MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[PI_POS_LE; REAL_SUB_LE] THEN
18622       MATCH_MP_TAC REAL_ABS_INTEGER_LEMMA THEN
18623       ASM_SIMP_TAC[INTEGER_CLOSED; REAL_SUB_0]]);
18624       ALL_TAC] THEN
18625   GEN_REWRITE_TAC I [TAUT `p ==> q ==> F <=> ~(p /\ q)`] THEN
18626   DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE
18627    `(!x. x IN s ==> P x) /\ (!x. x IN t ==> Q x)
18628     ==> ~(v = {}) /\ ~(w = {}) /\ v UNION w SUBSET s INTER t
18629          ==> ~(!y z. y IN v /\ z IN w ==> ~(P y /\ Q y /\ P z /\ Q z))`)) THEN
18630   ANTS_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[]] THEN
18631   REPEAT GEN_TAC THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (COMPLEX_RING
18632    `y + p = n /\ y - p = m /\ z + q = n /\ z - q = m ==> q:complex = p`)) THEN
18633   REWRITE_TAC[DROP_VEC; COMPLEX_MUL_RZERO; COMPLEX_ENTIRE; CX_INJ] THEN
18634   REWRITE_TAC[PI_NZ; II_NZ; REAL_OF_NUM_EQ; ARITH_EQ]);;
18635
18636 let CONTRACTIBLE_IMP_UNICOHERENT = prove
18637  (`!u:real^N->bool.
18638         contractible u
18639         ==> !s t. connected s /\ connected t /\ s UNION t = u /\
18640                   closed_in (subtopology euclidean u) s /\
18641                   closed_in (subtopology euclidean u) t
18642                   ==> connected (s INTER t)`,
18643   GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC INESSENTIAL_IMP_UNICOHERENT THEN
18644   REPEAT STRIP_TAC THEN MATCH_MP_TAC NULLHOMOTOPIC_FROM_CONTRACTIBLE THEN
18645   ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
18646    (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN
18647   REWRITE_TAC[SUBSET; IN_SPHERE_0; IN_DIFF; IN_UNIV; IN_SING] THEN
18648   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN
18649   SIMP_TAC[COMPLEX_NORM_0] THEN REAL_ARITH_TAC);;
18650
18651 let CONVEX_IMP_UNICOHERENT = prove
18652  (`!u:real^N->bool.
18653         convex u
18654         ==> !s t. connected s /\ connected t /\ s UNION t = u /\
18655                   closed_in (subtopology euclidean u) s /\
18656                   closed_in (subtopology euclidean u) t
18657                   ==> connected (s INTER t)`,
18658   GEN_TAC THEN DISCH_TAC THEN
18659   ASM_CASES_TAC `u:real^N->bool = {}` THEN
18660   ASM_SIMP_TAC[EMPTY_UNION; INTER_EMPTY; CONNECTED_EMPTY] THEN
18661   MATCH_MP_TAC CONTRACTIBLE_IMP_UNICOHERENT THEN
18662   ASM_SIMP_TAC[CONVEX_IMP_STARLIKE; STARLIKE_IMP_CONTRACTIBLE]);;
18663
18664 let UNICOHERENT_UNIV = prove
18665  (`!s t. closed s /\ closed t /\ connected s /\ connected t /\
18666          s UNION t = (:real^N)
18667          ==> connected(s INTER t)`,
18668   MP_TAC(ISPEC `(:real^N)` CONVEX_IMP_UNICOHERENT) THEN
18669   REWRITE_TAC[CONVEX_UNIV; SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN
18670   REWRITE_TAC[CONJ_ACI]);;
18671
18672 (* ------------------------------------------------------------------------- *)
18673 (* Another simple case where sphere maps are nullhomotopic.                  *)
18674 (* ------------------------------------------------------------------------- *)
18675
18676 let INESSENTIAL_SPHEREMAP_2 = prove
18677  (`!f:real^M->real^N a r b s.
18678         2 < dimindex(:M) /\ dimindex(:N) = 2 /\
18679         f continuous_on sphere(a,r) /\
18680         IMAGE f (sphere(a,r)) SUBSET (sphere(b,s))
18681         ==> ?c. homotopic_with (\z. T) (sphere(a,r),sphere(b,s)) f (\x. c)`,
18682   let lemma = prove
18683    (`!f:real^N->real^2 a r.
18684           2 < dimindex(:N) /\
18685           f continuous_on sphere(a,r) /\
18686           IMAGE f (sphere(a,r)) SUBSET (sphere(vec 0,&1))
18687           ==> ?c. homotopic_with (\z. T) (sphere(a,r),sphere(vec 0,&1))
18688                                  f (\x. c)`,
18689     REPEAT STRIP_TAC THEN
18690     REWRITE_TAC[INESSENTIAL_EQ_CONTINUOUS_LOGARITHM_CIRCLE] THEN
18691     MP_TAC(ISPECL [`f:real^N->real^2`; `sphere(a:real^N,r)`]
18692           CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED) THEN
18693     ASM_SIMP_TAC[SIMPLY_CONNECTED_SPHERE_EQ; LOCALLY_PATH_CONNECTED_SPHERE] THEN
18694     ANTS_TAC THENL
18695      [ASM_REWRITE_TAC[ARITH_RULE `3 <= n <=> 2 < n`] THEN FIRST_X_ASSUM
18696        (MATCH_MP_TAC o MATCH_MP (SET_RULE
18697           `IMAGE f s SUBSET t ==> (!x. P x ==> ~(x IN t))
18698           ==> !x. x IN s ==> ~P(f x)`)) THEN
18699       SIMP_TAC[COMPLEX_NORM_0; IN_SPHERE_0] THEN REAL_ARITH_TAC;
18700       DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^2` STRIP_ASSUME_TAC) THEN
18701       EXISTS_TAC `Im o (g:real^N->real^2)` THEN CONJ_TAC THENL
18702        [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN
18703         ASM_REWRITE_TAC[CONTINUOUS_ON_CX_IM];
18704         X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
18705         ASM_SIMP_TAC[] THEN AP_TERM_TAC THEN
18706         REWRITE_TAC[o_DEF; COMPLEX_EQ; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX] THEN
18707         FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
18708         REWRITE_TAC[FORALL_IN_IMAGE] THEN
18709         DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
18710         ASM_SIMP_TAC[IN_SPHERE_0; NORM_CEXP; REAL_EXP_EQ_1] THEN
18711         REAL_ARITH_TAC]])
18712   and hslemma = prove
18713    (`!a:real^M r b:real^N s.
18714         dimindex(:M) = dimindex(:N) /\ &0 < r /\ &0 < s
18715         ==> (sphere(a,r) homeomorphic sphere(b,s))`,
18716     REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th ->
18717       let t = `?a:real^M b:real^N. ~(sphere(a,r) homeomorphic sphere(b,s))` in
18718       MP_TAC(DISCH t (GEOM_EQUAL_DIMENSION_RULE th (ASSUME t)))) THEN
18719     ASM_SIMP_TAC[HOMEOMORPHIC_SPHERES] THEN MESON_TAC[]) in
18720   REPEAT STRIP_TAC THEN ASM_CASES_TAC `s <= &0` THEN
18721   ASM_SIMP_TAC[NULLHOMOTOPIC_INTO_CONTRACTIBLE; CONTRACTIBLE_SPHERE] THEN
18722   RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN
18723   SUBGOAL_THEN
18724    `(sphere(b:real^N,s)) homeomorphic (sphere(vec 0:real^2,&1))`
18725   MP_TAC THENL
18726    [ASM_SIMP_TAC[hslemma; REAL_LT_01; DIMINDEX_2];
18727     REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM]] THEN
18728   MAP_EVERY X_GEN_TAC [`h:real^N->real^2`; `k:real^2->real^N`] THEN
18729   REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN
18730   MP_TAC(ISPECL
18731    [`(h:real^N->real^2) o (f:real^M->real^N)`;
18732     `a:real^M`; `r:real`] lemma) THEN
18733   ASM_REWRITE_TAC[IMAGE_o] THEN ANTS_TAC THENL
18734    [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE; ASM SET_TAC[]] THEN
18735     ASM_MESON_TAC[CONTINUOUS_ON_SUBSET];
18736     DISCH_THEN(X_CHOOSE_THEN `c:real^2` (fun th ->
18737       EXISTS_TAC `(k:real^2->real^N) c` THEN MP_TAC th)) THEN
18738     DISCH_THEN(MP_TAC o ISPEC `k:real^2->real^N` o MATCH_MP
18739      (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN
18740     DISCH_THEN(MP_TAC o SPEC `sphere(b:real^N,s)`) THEN
18741     ASM_REWRITE_TAC[SUBSET_REFL] THEN
18742     MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN
18743     REWRITE_TAC[o_DEF] THEN ASM SET_TAC[]]);;
18744
18745 (* ------------------------------------------------------------------------- *)
18746 (* Janiszewski's theorem.                                                    *)
18747 (* ------------------------------------------------------------------------- *)
18748
18749 let JANISZEWSKI = prove
18750  (`!s t a b:real^2.
18751         compact s /\ closed t /\ connected(s INTER t) /\
18752         connected_component ((:real^2) DIFF s) a b /\
18753         connected_component ((:real^2) DIFF t) a b
18754         ==> connected_component ((:real^2) DIFF (s UNION t)) a b`,
18755   let lemma = prove
18756    (`!s t a b:real^2.
18757           compact s /\ compact t /\ connected(s INTER t) /\
18758           connected_component ((:real^2) DIFF s) a b /\
18759           connected_component ((:real^2) DIFF t) a b
18760           ==> connected_component ((:real^2) DIFF (s UNION t)) a b`,
18761     REPEAT GEN_TAC THEN
18762     REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
18763     DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN
18764     FIRST_X_ASSUM(CONJUNCTS_THEN(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN)) THEN
18765     REWRITE_TAC[IN_DIFF; IN_UNIV] THEN STRIP_TAC THEN STRIP_TAC THEN
18766     ASM_SIMP_TAC[GSYM BORSUK_MAPS_HOMOTOPIC_IN_CONNECTED_COMPONENT_EQ;
18767                  DIMINDEX_2; LE_REFL; COMPACT_UNION; IN_UNION] THEN
18768     ONCE_REWRITE_TAC[HOMOTOPIC_CIRCLEMAPS_DIV] THEN
18769     REWRITE_TAC[INESSENTIAL_EQ_CONTINUOUS_LOGARITHM_CIRCLE] THEN
18770     ASM_SIMP_TAC[BORSUK_MAP_INTO_SPHERE; CONTINUOUS_ON_BORSUK_MAP;
18771                  IN_UNION] THEN
18772     DISCH_THEN(CONJUNCTS_THEN2
18773      (X_CHOOSE_THEN `g:real^2->real` STRIP_ASSUME_TAC)
18774      (X_CHOOSE_THEN `h:real^2->real` STRIP_ASSUME_TAC)) THEN
18775     SUBGOAL_THEN
18776      `closed_in (subtopology euclidean (s UNION t)) s /\
18777       closed_in (subtopology euclidean (s UNION t)) (t:real^2->bool)`
18778     STRIP_ASSUME_TAC THENL
18779      [REWRITE_TAC[CLOSED_IN_CLOSED] THEN CONJ_TAC THENL
18780        [EXISTS_TAC `s:real^2->bool`; EXISTS_TAC `t:real^2->bool`] THEN
18781       ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM SET_TAC[];
18782       ALL_TAC] THEN
18783     ASM_CASES_TAC `s INTER t:real^2->bool = {}` THENL
18784      [EXISTS_TAC `(\x. if x IN s then g x else h x):real^2->real` THEN
18785       CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN
18786       REWRITE_TAC[o_DEF; COND_RAND] THEN
18787       MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
18788       ASM_REWRITE_TAC[GSYM o_DEF] THEN ASM SET_TAC[];
18789       ALL_TAC] THEN
18790     MP_TAC(ISPECL
18791      [`\x:real^2. lift(g x) - lift(h x)`; `s INTER t:real^2->bool`]
18792      CONTINUOUS_DISCRETE_RANGE_CONSTANT) THEN
18793     ASM_REWRITE_TAC[] THEN ANTS_TAC THENL
18794      [CONJ_TAC THENL
18795        [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN
18796         REWRITE_TAC[GSYM CONTINUOUS_ON_CX_LIFT] THEN
18797         REWRITE_TAC[GSYM o_DEF] THEN
18798         ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET];
18799         REWRITE_TAC[o_DEF]] THEN
18800       X_GEN_TAC `x:real^2` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN
18801       EXISTS_TAC `&2 * pi` THEN
18802       REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN
18803       X_GEN_TAC `y:real^2` THEN
18804       DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
18805       ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN
18806       REWRITE_TAC[GSYM LIFT_SUB; LIFT_EQ; NORM_LIFT] THEN DISCH_TAC THEN
18807       ONCE_REWRITE_TAC[REAL_RING `a - b:real = c - d <=> a - c = b - d`] THEN
18808       REWRITE_TAC[GSYM CX_INJ] THEN
18809       MATCH_MP_TAC(COMPLEX_RING `ii * w = ii * z ==> w = z`) THEN
18810       MATCH_MP_TAC COMPLEX_EQ_CEXP THEN CONJ_TAC THENL
18811        [REWRITE_TAC[IM_MUL_II; RE_CX] THEN ASM_REAL_ARITH_TAC;
18812         REWRITE_TAC[CX_SUB; COMPLEX_SUB_LDISTRIB; CEXP_SUB] THEN
18813         ASM_MESON_TAC[]];
18814       REWRITE_TAC[EXISTS_LIFT; GSYM LIFT_SUB; LIFT_EQ; IN_INTER] THEN
18815       REWRITE_TAC[REAL_EQ_SUB_RADD; LEFT_IMP_EXISTS_THM] THEN
18816       X_GEN_TAC `z:real` THEN DISCH_TAC THEN
18817       EXISTS_TAC `(\x. if x IN s then g x else z + h x):real^2->real` THEN
18818       CONJ_TAC THENL
18819        [REWRITE_TAC[o_DEF; COND_RAND] THEN
18820         MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN
18821         ASM_SIMP_TAC[TAUT `~(p /\ ~p)`; CX_ADD; GSYM o_DEF] THEN
18822         REWRITE_TAC[o_DEF; CX_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN
18823         ASM_REWRITE_TAC[CONTINUOUS_ON_CONST; GSYM o_DEF];
18824         X_GEN_TAC `x:real^2` THEN REWRITE_TAC[] THEN
18825         COND_CASES_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN
18826         ASM_SIMP_TAC[] THEN DISCH_TAC THEN
18827         SUBGOAL_THEN
18828          `?w:real^2. cexp(ii * Cx(h w)) = cexp (ii * Cx(z + h w))`
18829          (CHOOSE_THEN MP_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN
18830         REWRITE_TAC[CX_ADD; COMPLEX_ADD_LDISTRIB; CEXP_ADD] THEN
18831         REWRITE_TAC[COMPLEX_FIELD `a = b * a <=> a = Cx(&0) \/ b = Cx(&1)`;
18832                     CEXP_NZ]]]) in
18833   REPEAT STRIP_TAC THEN
18834   SUBGOAL_THEN
18835    `?c:real^2->bool.
18836        compact c /\ connected c /\ a IN c /\ b IN c /\ c INTER t = {}`
18837   STRIP_ASSUME_TAC THENL
18838    [SUBGOAL_THEN `path_component((:real^2) DIFF t) a b` MP_TAC THENL
18839      [ASM_MESON_TAC[OPEN_PATH_CONNECTED_COMPONENT; closed; COMPACT_IMP_CLOSED];
18840       REWRITE_TAC[path_component; SET_RULE
18841         `s SUBSET UNIV DIFF t <=> s INTER t = {}`]] THEN
18842     DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^2` STRIP_ASSUME_TAC) THEN
18843     EXISTS_TAC `path_image(g:real^1->real^2)` THEN
18844     ASM_SIMP_TAC[CONNECTED_PATH_IMAGE; COMPACT_PATH_IMAGE] THEN
18845     ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE];
18846     ALL_TAC] THEN
18847   MP_TAC(ISPECL [`c UNION s:real^2->bool`; `vec 0:real^2`]
18848         BOUNDED_SUBSET_BALL) THEN
18849   ASM_SIMP_TAC[BOUNDED_UNION; COMPACT_IMP_BOUNDED; LEFT_IMP_EXISTS_THM] THEN
18850   X_GEN_TAC `r:real` THEN STRIP_TAC THEN
18851   MP_TAC(ISPECL [`s:real^2->bool`;
18852                  `(t INTER cball(vec 0,r)) UNION sphere(vec 0:real^2,r)`;
18853                  `a:real^2`; `b:real^2`] lemma) THEN
18854   ASM_SIMP_TAC[COMPACT_UNION; CLOSED_INTER_COMPACT;
18855                COMPACT_SPHERE; COMPACT_CBALL] THEN
18856   ANTS_TAC THENL
18857    [CONJ_TAC THENL
18858      [UNDISCH_TAC `connected(s INTER t:real^2->bool)` THEN
18859       MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC;
18860       REWRITE_TAC[connected_component] THEN EXISTS_TAC `c:real^2->bool`] THEN
18861     MP_TAC(ISPECL [`vec 0:real^2`; `r:real`] CBALL_DIFF_SPHERE) THEN
18862     ASM SET_TAC[];
18863     REWRITE_TAC[connected_component] THEN MATCH_MP_TAC MONO_EXISTS THEN
18864     X_GEN_TAC `u:real^2->bool` THEN
18865     SIMP_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN
18866     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
18867     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
18868     MP_TAC(ISPECL
18869      [`u:real^2->bool`; `cball(vec 0:real^2,r)`] CONNECTED_INTER_FRONTIER) THEN
18870     ASM_REWRITE_TAC[FRONTIER_CBALL] THEN
18871     MP_TAC(ISPECL [`vec 0:real^2`; `r:real`] BALL_SUBSET_CBALL) THEN
18872     ASM SET_TAC[]]);;
18873
18874 let JANISZEWSKI_GEN = prove
18875  (`!s t a b:real^N.
18876         dimindex(:N) <= 2 /\
18877         compact s /\ closed t /\ connected(s INTER t) /\
18878         connected_component ((:real^N) DIFF s) a b /\
18879         connected_component ((:real^N) DIFF t) a b
18880         ==> connected_component ((:real^N) DIFF (s UNION t)) a b`,
18881   REPEAT GEN_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL
18882    [ASM_SIMP_TAC[CONNECTED_COMPONENT_1_GEN] THEN SET_TAC[];
18883     ASM_SIMP_TAC[ARITH_RULE `1 <= n /\ ~(n = 1) ==> (n <= 2 <=> n = 2)`;
18884                  DIMINDEX_GE_1] THEN
18885     ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[GSYM DIMINDEX_2] THEN
18886     DISCH_THEN(fun th ->
18887      MATCH_ACCEPT_TAC(GEOM_EQUAL_DIMENSION_RULE th JANISZEWSKI))]);;