Library/analysis.ml

   1 (* ========================================================================= *)
   2 (* Elementary real analysis, with some supporting HOL88 compatibility stuff. *)
   3 (* ========================================================================= *)
   4
   5 let dest_neg_imp tm =
   6   try dest_imp tm with Failure _ ->
   7   try (dest_neg tm,mk_const("F",[]))
   8   with Failure _ -> failwith "dest_neg_imp";;
   9
  10 (* ------------------------------------------------------------------------- *)
  11 (* The quantifier movement conversions.                                      *)
  12 (* ------------------------------------------------------------------------- *)
  13
  14 let (CONV_OF_RCONV: conv -> conv) =
  15   let rec get_bv tm =
  16     if is_abs tm then bndvar tm
  17     else if is_comb tm then try get_bv (rand tm)
  18             with Failure _ -> get_bv (rator tm)
  19     else failwith "" in
  20   fun conv tm ->
  21   let v = get_bv tm in
  22   let th1 = conv tm in
  23   let th2 = ONCE_DEPTH_CONV (GEN_ALPHA_CONV v) (rhs(concl th1)) in
  24   TRANS th1 th2;;
  25
  26 let (CONV_OF_THM: thm -> conv) =
  27   CONV_OF_RCONV o REWR_CONV;;
  28
  29 let (X_FUN_EQ_CONV:term->conv) =
  30   fun v -> (REWR_CONV FUN_EQ_THM) THENC GEN_ALPHA_CONV v;;
  31
  32 let (FUN_EQ_CONV:conv) =
  33   fun tm ->
  34     let vars = frees tm in
  35     let op,[ty1;ty2] = dest_type(type_of (lhs tm)) in
  36     if op = "fun"
  37        then let varnm =
  38                 if (is_vartype ty1) then "x" else
  39                    hd(explode(fst(dest_type ty1))) in
  40             let x = variant vars (mk_var(varnm,ty1)) in
  41             X_FUN_EQ_CONV x tm
  42        else failwith "FUN_EQ_CONV";;
  43
  44 let (SINGLE_DEPTH_CONV:conv->conv) =
  45   let rec SINGLE_DEPTH_CONV conv tm =
  46     try conv tm with Failure _ ->
  47     (SUB_CONV (SINGLE_DEPTH_CONV conv) THENC (TRY_CONV conv)) tm in
  48   SINGLE_DEPTH_CONV;;
  49
  50 let (OLD_SKOLEM_CONV:conv) =
  51   SINGLE_DEPTH_CONV (REWR_CONV SKOLEM_THM);;
  52
  53 let (X_SKOLEM_CONV:term->conv) =
  54   fun v -> OLD_SKOLEM_CONV THENC GEN_ALPHA_CONV v;;
  55
  56 let EXISTS_UNIQUE_CONV tm =
  57   let v = bndvar(rand tm) in
  58   let th1 = REWR_CONV EXISTS_UNIQUE_THM tm in
  59   let tm1 = rhs(concl th1) in
  60   let vars = frees tm1 in
  61   let v = variant vars v in
  62   let v' = variant (v::vars) v in
  63   let th2 =
  64    (LAND_CONV(GEN_ALPHA_CONV v) THENC
  65     RAND_CONV(BINDER_CONV(GEN_ALPHA_CONV v') THENC
  66               GEN_ALPHA_CONV v)) tm1 in
  67   TRANS th1 th2;;
  68
  69 let NOT_FORALL_CONV = CONV_OF_THM NOT_FORALL_THM;;
  70
  71 let NOT_EXISTS_CONV = CONV_OF_THM NOT_EXISTS_THM;;
  72
  73 let RIGHT_IMP_EXISTS_CONV = CONV_OF_THM RIGHT_IMP_EXISTS_THM;;
  74
  75 let FORALL_IMP_CONV = CONV_OF_RCONV
  76   (REWR_CONV TRIV_FORALL_IMP_THM ORELSEC
  77    REWR_CONV RIGHT_FORALL_IMP_THM ORELSEC
  78    REWR_CONV LEFT_FORALL_IMP_THM);;
  79
  80 let EXISTS_AND_CONV = CONV_OF_RCONV
  81   (REWR_CONV TRIV_EXISTS_AND_THM ORELSEC
  82    REWR_CONV LEFT_EXISTS_AND_THM ORELSEC
  83    REWR_CONV RIGHT_EXISTS_AND_THM);;
  84
  85 let LEFT_IMP_EXISTS_CONV = CONV_OF_THM LEFT_IMP_EXISTS_THM;;
  86
  87 let LEFT_AND_EXISTS_CONV tm =
  88   let v = bndvar(rand(rand(rator tm))) in
  89   (REWR_CONV LEFT_AND_EXISTS_THM THENC TRY_CONV (GEN_ALPHA_CONV v)) tm;;
  90
  91 let RIGHT_AND_EXISTS_CONV =
  92   CONV_OF_THM RIGHT_AND_EXISTS_THM;;
  93
  94 let AND_FORALL_CONV = CONV_OF_THM AND_FORALL_THM;;
  95
  96 (* ------------------------------------------------------------------------- *)
  97 (* The slew of named tautologies.                                            *)
  98 (* ------------------------------------------------------------------------- *)
  99
 100 let F_IMP = TAUT `!t. ~t ==> t ==> F`;;
 101
 102 let LEFT_AND_OVER_OR = TAUT
 103   `!t1 t2 t3. t1 /\ (t2 \/ t3) <=> t1 /\ t2 \/ t1 /\ t3`;;
 104
 105 let RIGHT_AND_OVER_OR = TAUT
 106   `!t1 t2 t3. (t2 \/ t3) /\ t1 <=> t2 /\ t1 \/ t3 /\ t1`;;
 107
 108 (* ------------------------------------------------------------------------- *)
 109 (* Something trivial and useless.                                            *)
 110 (* ------------------------------------------------------------------------- *)
 111
 112 let INST_TY_TERM(substl,insttyl) th = INST substl (INST_TYPE insttyl th);;
 113
 114 (* ------------------------------------------------------------------------- *)
 115 (* Derived rules.                                                            *)
 116 (* ------------------------------------------------------------------------- *)
 117
 118 let NOT_MP thi th =
 119   try MP thi th with Failure _ ->
 120   try let t = dest_neg (concl thi) in
 121       MP(MP (SPEC t F_IMP) thi) th
 122   with Failure _ -> failwith "NOT_MP";;
 123
 124 (* ------------------------------------------------------------------------- *)
 125 (* Creating half abstractions.                                               *)
 126 (* ------------------------------------------------------------------------- *)
 127
 128 let MK_ABS qth =
 129   try let ov = bndvar(rand(concl qth)) in
 130       let bv,rth = SPEC_VAR qth in
 131       let sth = ABS bv rth in
 132       let cnv = ALPHA_CONV ov in
 133       CONV_RULE(BINOP_CONV cnv) sth
 134   with Failure _ -> failwith "MK_ABS";;
 135
 136 let HALF_MK_ABS th =
 137   try let th1 = MK_ABS th in
 138       CONV_RULE(LAND_CONV ETA_CONV) th1
 139   with Failure _ -> failwith "HALF_MK_ABS";;
 140
 141 (* ------------------------------------------------------------------------- *)
 142 (* Old substitution primitive, now a (not very efficient) derived rule.      *)
 143 (* ------------------------------------------------------------------------- *)
 144
 145 let SUBST thl pat th =
 146   let eqs,vs = unzip thl in
 147   let gvs = map (genvar o type_of) vs in
 148   let gpat = subst (zip gvs vs) pat in
 149   let ls,rs = unzip (map (dest_eq o concl) eqs) in
 150   let ths = map (ASSUME o mk_eq) (zip gvs rs) in
 151   let th1 = ASSUME gpat in
 152   let th2 = SUBS ths th1 in
 153   let th3 = itlist DISCH (map concl ths) (DISCH gpat th2) in
 154   let th4 = INST (zip ls gvs) th3 in
 155   MP (rev_itlist (C MP) eqs th4) th;;
 156
 157 (* ------------------------------------------------------------------------- *)
 158 (* Various theorems have different names.                                    *)
 159 (* ------------------------------------------------------------------------- *)
 160
 161 prioritize_num();;
 162
 163 let LESS_EQUAL_ANTISYM = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL LE_ANTISYM)));;
 164 let NOT_LESS_0 = GEN_ALL(EQF_ELIM(SPEC_ALL(CONJUNCT1 LT)));;
 165 let LESS_LEMMA1 = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL(CONJUNCT2 LT))));;
 166 let LESS_SUC_REFL = ARITH_RULE `!n. n < SUC n`;;
 167 let LESS_EQ_SUC_REFL = ARITH_RULE `!n. n <= SUC n`;;
 168 let LESS_EQUAL_ADD = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL LE_EXISTS)));;
 169 let LESS_EQ_IMP_LESS_SUC = GEN_ALL(snd(EQ_IMP_RULE(SPEC_ALL LT_SUC_LE)));;
 170 let LESS_MONO_ADD = GEN_ALL(snd(EQ_IMP_RULE(SPEC_ALL LT_ADD_RCANCEL)));;
 171 let LESS_SUC = ARITH_RULE `!m n. m < n ==> m < (SUC n)`;;
 172 let LESS_ADD_1 = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL
 173   (REWRITE_RULE[ADD1] LT_EXISTS))));;
 174 let SUC_SUB1 = ARITH_RULE `!m. SUC m - 1 = m`;;
 175 let LESS_ADD_SUC = ARITH_RULE `!m n. m < m + SUC n`;;
 176 let OR_LESS = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL LE_SUC_LT)));;
 177 let NOT_SUC_LESS_EQ = ARITH_RULE `!n m. ~(SUC n <= m) <=> m <= n`;;
 178 let LESS_LESS_CASES = ARITH_RULE `!m n. (m = n) \/ m < n \/ n < m`;;
 179 let SUB_SUB = prove
 180  (`!b c. c <= b ==> (!a. a - (b - c) = (a + c) - b)`,
 181   REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN ARITH_TAC);;
 182 let LESS_CASES_IMP = ARITH_RULE `!m n. ~(m < n) /\ ~(m = n) ==> n < m`;;
 183 let SUB_LESS_EQ = ARITH_RULE `!n m. (n - m) <= n`;;
 184 let SUB_EQ_EQ_0 = ARITH_RULE `!m n. (m - n = m) <=> (m = 0) \/ (n = 0)`;;
 185 let SUB_LEFT_LESS_EQ =
 186   ARITH_RULE `!m n p. m <= (n - p) <=> (m + p) <= n \/ m <= 0`;;
 187 let SUB_LEFT_GREATER_EQ = ARITH_RULE `!m n p. m >= (n - p) <=> (m + p) >= n`;;
 188 let LESS_0_CASES = ARITH_RULE `!m. (0 = m) \/ 0 < m`;;
 189 let LESS_OR = ARITH_RULE `!m n. m < n ==> (SUC m) <= n`;;
 190 let SUB_OLD = prove(`(!m. 0 - m = 0) /\
 191                  (!m n. (SUC m) - n = (if m < n then 0 else SUC(m - n)))`,
 192                 REPEAT STRIP_TAC THEN TRY COND_CASES_TAC THEN
 193                 ASM_REWRITE_TAC[] THEN TRY (POP_ASSUM MP_TAC) THEN
 194                 ARITH_TAC);;
 195
 196 (*============================================================================*)
 197 (* Various useful tactics, conversions etc.                                   *)
 198 (*============================================================================*)
 199
 200 (*----------------------------------------------------------------------------*)
 201 (* SYM_CANON_CONV - Canonicalizes single application of symmetric operator    *)
 202 (* Rewrites `so as to make fn true`, e.g. fn = $<< or fn = curry$= `1` o fst  *)
 203 (*----------------------------------------------------------------------------*)
 204
 205 let SYM_CANON_CONV sym fn =
 206   REWR_CONV sym o
 207   check (not o fn o ((snd o dest_comb) F_F I) o dest_comb);;
 208
 209 (*----------------------------------------------------------------------------*)
 210 (* IMP_SUBST_TAC - Implicational substitution for deepest matchable term      *)
 211 (*----------------------------------------------------------------------------*)
 212
 213 let (IMP_SUBST_TAC:thm_tactic) =
 214   fun th (asl,w) ->
 215     let tms = find_terms (can (PART_MATCH (lhs o snd o dest_imp) th)) w in
 216     let tm1 = hd (sort free_in tms) in
 217     let th1 = PART_MATCH (lhs o snd o dest_imp) th tm1 in
 218     let (a,(l,r)) = (I F_F dest_eq) (dest_imp (concl th1)) in
 219     let gv = genvar (type_of l) in
 220     let pat = subst[gv,l] w in
 221     null_meta,
 222     [(asl,a); (asl,subst[(r,gv)] pat)],
 223     fun i [t1;t2] -> SUBST[(SYM(MP th1 t1),gv)] pat t2;;
 224
 225 (*---------------------------------------------------------------*)
 226 (* EXT_CONV `!x. f x = g x` = |- (!x. f x = g x) = (f = g)       *)
 227 (*---------------------------------------------------------------*)
 228
 229 let EXT_CONV =  SYM o uncurry X_FUN_EQ_CONV o
 230       (I F_F (mk_eq o (rator F_F rator) o dest_eq)) o dest_forall;;
 231
 232 (*----------------------------------------------------------------------------*)
 233 (* EQUAL_TAC - Strip down to unequal core (usually too enthusiastic)          *)
 234 (*----------------------------------------------------------------------------*)
 235
 236 let EQUAL_TAC = REPEAT(FIRST [AP_TERM_TAC; AP_THM_TAC; ABS_TAC]);;
 237
 238 (*----------------------------------------------------------------------------*)
 239 (* X_BETA_CONV `v` `tm[v]` = |- tm[v] = (\v. tm[v]) v                         *)
 240 (*----------------------------------------------------------------------------*)
 241
 242 let X_BETA_CONV v tm =
 243   SYM(BETA_CONV(mk_comb(mk_abs(v,tm),v)));;
 244
 245 (*----------------------------------------------------------------------------*)
 246 (* EXACT_CONV - Rewrite with theorem matching exactly one in a list           *)
 247 (*----------------------------------------------------------------------------*)
 248
 249 let EXACT_CONV =
 250   ONCE_DEPTH_CONV o FIRST_CONV o
 251   map (fun t -> K t o check((=)(lhs(concl t))));;
 252
 253 (*----------------------------------------------------------------------------*)
 254 (* Rather ad-hoc higher-order fiddling conversion                             *)
 255 (* |- (\x. f t1[x] ... tn[x]) = (\x. f ((\x. t1[x]) x) ... ((\x. tn[x]) x))   *)
 256 (*----------------------------------------------------------------------------*)
 257
 258 let HABS_CONV tm =
 259   let v,bod = dest_abs tm in
 260   let hop,pl = strip_comb bod in
 261   let eql = rev(map (X_BETA_CONV v) pl) in
 262   ABS v (itlist (C(curry MK_COMB)) eql (REFL hop));;
 263
 264 (*----------------------------------------------------------------------------*)
 265 (* Expand an abbreviation                                                     *)
 266 (*----------------------------------------------------------------------------*)
 267
 268 let EXPAND_TAC s = FIRST_ASSUM(SUBST1_TAC o SYM o
 269   check((=) s o fst o dest_var o rhs o concl)) THEN BETA_TAC;;
 270
 271 (* ------------------------------------------------------------------------- *)
 272 (* Set up the reals.                                                         *)
 273 (* ------------------------------------------------------------------------- *)
 274
 275 prioritize_real();;
 276
 277 let real_le = prove
 278  (`!x y. x <= y <=> ~(y < x)`,
 279   REWRITE_TAC[REAL_NOT_LT]);;
 280
 281 (* ------------------------------------------------------------------------- *)
 282 (* Link a few theorems.                                                      *)
 283 (* ------------------------------------------------------------------------- *)
 284
 285 let REAL_10 = REAL_ARITH `~(&1 = &0)`;;
 286
 287 let REAL_LDISTRIB = REAL_ADD_LDISTRIB;;
 288
 289 let  REAL_LT_IADD = REAL_ARITH `!x y z. y < z ==> x + y < x + z`;;
 290
 291 (*----------------------------------------------------------------------------*)
 292 (* Prove lots of boring field theorems                                        *)
 293 (*----------------------------------------------------------------------------*)
 294
 295 let REAL_MUL_RID = prove(
 296   `!x. x * &1 = x`,
 297   GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
 298   MATCH_ACCEPT_TAC REAL_MUL_LID);;
 299
 300 let REAL_MUL_RINV = prove(
 301   `!x. ~(x = &0) ==> (x * (inv x) = &1)`,
 302   GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
 303   MATCH_ACCEPT_TAC REAL_MUL_LINV);;
 304
 305 let REAL_RDISTRIB = prove(
 306   `!x y z. (x + y) * z = (x * z) + (y * z)`,
 307   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
 308   MATCH_ACCEPT_TAC REAL_LDISTRIB);;
 309
 310 let REAL_EQ_LADD = prove(
 311   `!x y z. (x + y = x + z) <=> (y = z)`,
 312   REPEAT GEN_TAC THEN EQ_TAC THENL
 313    [DISCH_THEN(MP_TAC o AP_TERM `(+) (-- x)`) THEN
 314     REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_LID];
 315     DISCH_THEN SUBST1_TAC THEN REFL_TAC]);;
 316
 317 let REAL_EQ_RADD = prove(
 318   `!x y z. (x + z = y + z) <=> (x = y)`,
 319   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
 320   MATCH_ACCEPT_TAC REAL_EQ_LADD);;
 321
 322 let REAL_ADD_LID_UNIQ = prove(
 323   `!x y. (x + y = y) <=> (x = &0)`,
 324   REPEAT GEN_TAC THEN
 325   GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_ADD_LID]
 326   THEN MATCH_ACCEPT_TAC REAL_EQ_RADD);;
 327
 328 let REAL_ADD_RID_UNIQ = prove(
 329   `!x y. (x + y = x) <=> (y = &0)`,
 330   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
 331   MATCH_ACCEPT_TAC REAL_ADD_LID_UNIQ);;
 332
 333 let REAL_LNEG_UNIQ = prove(
 334   `!x y. (x + y = &0) <=> (x = --y)`,
 335   REPEAT GEN_TAC THEN SUBST1_TAC (SYM(SPEC `y:real` REAL_ADD_LINV)) THEN
 336   MATCH_ACCEPT_TAC REAL_EQ_RADD);;
 337
 338 let REAL_RNEG_UNIQ = prove(
 339   `!x y. (x + y = &0) <=> (y = --x)`,
 340   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
 341   MATCH_ACCEPT_TAC REAL_LNEG_UNIQ);;
 342
 343 let REAL_NEG_ADD = prove(
 344   `!x y. --(x + y) = (--x) + (--y)`,
 345   REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN
 346   REWRITE_TAC[GSYM REAL_LNEG_UNIQ] THEN
 347   ONCE_REWRITE_TAC[AC REAL_ADD_AC
 348     `(a + b) + (c + d) = (a + c) + (b + d)`] THEN
 349   REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]);;
 350
 351 let REAL_MUL_LZERO = prove(
 352   `!x. &0 * x = &0`,
 353   GEN_TAC THEN SUBST1_TAC(SYM(SPECL [`&0 * x`; `&0 * x`] REAL_ADD_LID_UNIQ))
 354   THEN REWRITE_TAC[GSYM REAL_RDISTRIB; REAL_ADD_LID]);;
 355
 356 let REAL_MUL_RZERO = prove(
 357   `!x. x * &0 = &0`,
 358   GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
 359   MATCH_ACCEPT_TAC REAL_MUL_LZERO);;
 360
 361 let REAL_NEG_LMUL = prove(
 362   `!x y. --(x * y) = (--x) * y`,
 363   REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN
 364   REWRITE_TAC[GSYM REAL_LNEG_UNIQ; GSYM REAL_RDISTRIB;
 365               REAL_ADD_LINV; REAL_MUL_LZERO]);;
 366
 367 let REAL_NEG_RMUL = prove(
 368   `!x y. --(x * y) = x * (--y)`,
 369   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
 370   MATCH_ACCEPT_TAC REAL_NEG_LMUL);;
 371
 372 let REAL_NEGNEG = prove(
 373   `!x. --(--x) = x`,
 374   GEN_TAC THEN CONV_TAC SYM_CONV THEN
 375   REWRITE_TAC[GSYM REAL_LNEG_UNIQ; REAL_ADD_RINV]);;
 376
 377 let REAL_NEG_MUL2 = prove(
 378   `!x y. (--x) * (--y) = x * y`,
 379   REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL; REAL_NEGNEG]);;
 380
 381 let REAL_LT_LADD = prove(
 382   `!x y z. (x + y) < (x + z) <=> y < z`,
 383   REPEAT GEN_TAC THEN EQ_TAC THENL
 384    [DISCH_THEN(MP_TAC o SPEC `--x` o MATCH_MP REAL_LT_IADD) THEN
 385     REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_LID];
 386     MATCH_ACCEPT_TAC REAL_LT_IADD]);;
 387
 388 let REAL_LT_RADD = prove(
 389   `!x y z. (x + z) < (y + z) <=> x < y`,
 390   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
 391   MATCH_ACCEPT_TAC REAL_LT_LADD);;
 392
 393 let REAL_NOT_LT = prove(
 394   `!x y. ~(x < y) <=> y <= x`,
 395   REPEAT GEN_TAC THEN REWRITE_TAC[real_le]);;
 396
 397 let REAL_LT_ANTISYM = prove(
 398   `!x y. ~(x < y /\ y < x)`,
 399   REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_TRANS) THEN
 400   REWRITE_TAC[REAL_LT_REFL]);;
 401
 402 let REAL_LT_GT = prove(
 403   `!x y. x < y ==> ~(y < x)`,
 404   REPEAT GEN_TAC THEN
 405   DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o CONJ th)) THEN
 406   REWRITE_TAC[REAL_LT_ANTISYM]);;
 407
 408 let REAL_NOT_LE = prove(
 409   `!x y. ~(x <= y) <=> y < x`,
 410   REPEAT GEN_TAC THEN REWRITE_TAC[real_le]);;
 411
 412 let REAL_LE_TOTAL = prove(
 413   `!x y. x <= y \/ y <= x`,
 414   REPEAT GEN_TAC THEN
 415   REWRITE_TAC[real_le; GSYM DE_MORGAN_THM; REAL_LT_ANTISYM]);;
 416
 417 let REAL_LE_REFL = prove(
 418   `!x. x <= x`,
 419   GEN_TAC THEN REWRITE_TAC[real_le; REAL_LT_REFL]);;
 420
 421 let REAL_LE_LT = prove(
 422   `!x y. x <= y <=> x < y \/ (x = y)`,
 423   REPEAT GEN_TAC THEN REWRITE_TAC[real_le] THEN EQ_TAC THENL
 424    [REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
 425      (SPECL [`x:real`; `y:real`] REAL_LT_TOTAL) THEN ASM_REWRITE_TAC[];
 426     DISCH_THEN(DISJ_CASES_THEN2
 427      ((then_) (MATCH_MP_TAC REAL_LT_GT) o ACCEPT_TAC) SUBST1_TAC) THEN
 428     MATCH_ACCEPT_TAC REAL_LT_REFL]);;
 429
 430 let REAL_LT_LE = prove(
 431   `!x y. x < y <=> x <= y /\ ~(x = y)`,
 432   let lemma = TAUT `~(a /\ ~a)` in
 433   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT; RIGHT_AND_OVER_OR; lemma]
 434   THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
 435   POP_ASSUM MP_TAC THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN
 436   DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_LT_REFL]);;
 437
 438 let REAL_LT_IMP_LE = prove(
 439   `!x y. x < y ==> x <= y`,
 440   REPEAT GEN_TAC THEN DISCH_TAC THEN
 441   ASM_REWRITE_TAC[REAL_LE_LT]);;
 442
 443 let REAL_LTE_TRANS = prove(
 444   `!x y z. x < y /\ y <= z ==> x < z`,
 445   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT; LEFT_AND_OVER_OR] THEN
 446   DISCH_THEN(DISJ_CASES_THEN2 (ACCEPT_TAC o MATCH_MP REAL_LT_TRANS)
 447     (CONJUNCTS_THEN2 MP_TAC SUBST1_TAC)) THEN REWRITE_TAC[]);;
 448
 449 let REAL_LE_TRANS = prove(
 450   `!x y z. x <= y /\ y <= z ==> x <= z`,
 451   REPEAT GEN_TAC THEN
 452   GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_LE_LT] THEN
 453   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (DISJ_CASES_THEN2 ASSUME_TAC SUBST1_TAC))
 454   THEN REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o C CONJ (ASSUME `y < z`)) THEN
 455   DISCH_THEN(ACCEPT_TAC o MATCH_MP REAL_LT_IMP_LE o MATCH_MP REAL_LET_TRANS));;
 456
 457 let REAL_NEG_LT0 = prove(
 458   `!x. (--x) < &0 <=> &0 < x`,
 459   GEN_TAC THEN SUBST1_TAC(SYM(SPECL [`--x`; `&0`; `x:real`] REAL_LT_RADD)) THEN
 460   REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]);;
 461
 462 let REAL_NEG_GT0 = prove(
 463   `!x. &0 < (--x) <=> x < &0`,
 464   GEN_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LT0; REAL_NEGNEG]);;
 465
 466 let REAL_NEG_LE0 = prove(
 467   `!x. (--x) <= &0 <=> &0 <= x`,
 468   GEN_TAC THEN REWRITE_TAC[real_le] THEN
 469   REWRITE_TAC[REAL_NEG_GT0]);;
 470
 471 let REAL_NEG_GE0 = prove(
 472   `!x. &0 <= (--x) <=> x <= &0`,
 473   GEN_TAC THEN REWRITE_TAC[real_le] THEN
 474   REWRITE_TAC[REAL_NEG_LT0]);;
 475
 476 let REAL_LT_NEGTOTAL = prove(
 477   `!x. (x = &0) \/ (&0 < x) \/ (&0 < --x)`,
 478   GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
 479    (SPECL [`x:real`; `&0`] REAL_LT_TOTAL) THEN
 480   ASM_REWRITE_TAC[SYM(REWRITE_RULE[REAL_NEGNEG] (SPEC `--x` REAL_NEG_LT0))]);;
 481
 482 let REAL_LE_NEGTOTAL = prove(
 483   `!x. &0 <= x \/ &0 <= --x`,
 484   GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN
 485   REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPEC `x:real` REAL_LT_NEGTOTAL) THEN
 486   ASM_REWRITE_TAC[]);;
 487
 488 let REAL_LE_MUL = prove(
 489   `!x y. &0 <= x /\ &0 <= y ==> &0 <= (x * y)`,
 490   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN
 491   MAP_EVERY ASM_CASES_TAC [`&0 = x`; `&0 = y`] THEN
 492   ASM_REWRITE_TAC[] THEN TRY(FIRST_ASSUM(SUBST1_TAC o SYM)) THEN
 493   REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO] THEN
 494   DISCH_TAC THEN DISJ1_TAC THEN MATCH_MP_TAC REAL_LT_MUL THEN
 495   ASM_REWRITE_TAC[]);;
 496
 497 let REAL_LE_SQUARE = prove(
 498   `!x. &0 <= x * x`,
 499   GEN_TAC THEN DISJ_CASES_TAC (SPEC `x:real` REAL_LE_NEGTOTAL) THEN
 500   POP_ASSUM(MP_TAC o MATCH_MP REAL_LE_MUL o W CONJ) THEN
 501   REWRITE_TAC[GSYM REAL_NEG_RMUL; GSYM REAL_NEG_LMUL; REAL_NEGNEG]);;
 502
 503 let REAL_LT_01 = prove(
 504   `&0 < &1`,
 505   REWRITE_TAC[REAL_LT_LE; REAL_LE_01] THEN
 506   CONV_TAC(RAND_CONV SYM_CONV) THEN
 507   REWRITE_TAC[REAL_10]);;
 508
 509 let REAL_LE_LADD = prove(
 510   `!x y z. (x + y) <= (x + z) <=> y <= z`,
 511   REPEAT GEN_TAC THEN REWRITE_TAC[real_le] THEN
 512   AP_TERM_TAC THEN MATCH_ACCEPT_TAC REAL_LT_LADD);;
 513
 514 let REAL_LE_RADD = prove(
 515   `!x y z. (x + z) <= (y + z) <=> x <= y`,
 516   REPEAT GEN_TAC THEN REWRITE_TAC[real_le] THEN
 517   AP_TERM_TAC THEN MATCH_ACCEPT_TAC REAL_LT_RADD);;
 518
 519 let REAL_LT_ADD2 = prove(
 520   `!w x y z. w < x /\ y < z ==> (w + y) < (x + z)`,
 521   REPEAT GEN_TAC THEN DISCH_TAC THEN
 522   MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `w + z` THEN
 523   ASM_REWRITE_TAC[REAL_LT_LADD; REAL_LT_RADD]);;
 524
 525 let REAL_LT_ADD = prove(
 526   `!x y. &0 < x /\ &0 < y ==> &0 < (x + y)`,
 527   REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_ADD2) THEN
 528   REWRITE_TAC[REAL_ADD_LID]);;
 529
 530 let REAL_LT_ADDNEG = prove(
 531   `!x y z. y < (x + (--z)) <=> (y + z) < x`,
 532   REPEAT GEN_TAC THEN
 533   SUBST1_TAC(SYM(SPECL [`y:real`; `x + (--z)`; `z:real`] REAL_LT_RADD)) THEN
 534   REWRITE_TAC[GSYM REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_RID]);;
 535
 536 let REAL_LT_ADDNEG2 = prove(
 537   `!x y z. (x + (--y)) < z <=> x < (z + y)`,
 538   REPEAT GEN_TAC THEN
 539   SUBST1_TAC(SYM(SPECL [`x + (-- y)`; `z:real`; `y:real`] REAL_LT_RADD)) THEN
 540   REWRITE_TAC[GSYM REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_RID]);;
 541
 542 let REAL_LT_ADD1 = prove(
 543   `!x y. x <= y ==> x < (y + &1)`,
 544   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN
 545   DISCH_THEN DISJ_CASES_TAC THENL
 546    [POP_ASSUM(MP_TAC o MATCH_MP REAL_LT_ADD2 o C CONJ REAL_LT_01) THEN
 547     REWRITE_TAC[REAL_ADD_RID];
 548     POP_ASSUM SUBST1_TAC THEN
 549     GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_RID] THEN
 550     REWRITE_TAC[REAL_LT_LADD; REAL_LT_01]]);;
 551
 552 let REAL_SUB_ADD = prove(
 553   `!x y. (x - y) + y = x`,
 554   REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; GSYM REAL_ADD_ASSOC;
 555     REAL_ADD_LINV; REAL_ADD_RID]);;
 556
 557 let REAL_SUB_ADD2 = prove(
 558   `!x y. y + (x - y) = x`,
 559   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
 560   MATCH_ACCEPT_TAC REAL_SUB_ADD);;
 561
 562 let REAL_SUB_REFL = prove(
 563   `!x. x - x = &0`,
 564   GEN_TAC THEN REWRITE_TAC[real_sub; REAL_ADD_RINV]);;
 565
 566 let REAL_SUB_0 = prove(
 567   `!x y. (x - y = &0) <=> (x = y)`,
 568   REPEAT GEN_TAC THEN EQ_TAC THENL
 569    [DISCH_THEN(MP_TAC o C AP_THM `y:real` o AP_TERM `(+)`) THEN
 570     REWRITE_TAC[REAL_SUB_ADD; REAL_ADD_LID];
 571     DISCH_THEN SUBST1_TAC THEN MATCH_ACCEPT_TAC REAL_SUB_REFL]);;
 572
 573 let REAL_LE_DOUBLE = prove(
 574   `!x. &0 <= x + x <=> &0 <= x`,
 575   GEN_TAC THEN EQ_TAC THENL
 576    [CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[REAL_NOT_LE] THEN
 577     DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_ADD2 o W CONJ);
 578     DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_ADD2 o W CONJ)] THEN
 579   REWRITE_TAC[REAL_ADD_LID]);;
 580
 581 let REAL_LE_NEGL = prove(
 582   `!x. (--x <= x) <=> (&0 <= x)`,
 583   GEN_TAC THEN SUBST1_TAC (SYM(SPECL [`x:real`; `--x`; `x:real`] REAL_LE_LADD))
 584   THEN REWRITE_TAC[REAL_ADD_RINV; REAL_LE_DOUBLE]);;
 585
 586 let REAL_LE_NEGR = prove(
 587   `!x. (x <= --x) <=> (x <= &0)`,
 588   GEN_TAC THEN SUBST1_TAC(SYM(SPEC `x:real` REAL_NEGNEG)) THEN
 589   GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_NEGNEG] THEN
 590   REWRITE_TAC[REAL_LE_NEGL] THEN REWRITE_TAC[REAL_NEG_GE0] THEN
 591   REWRITE_TAC[REAL_NEGNEG]);;
 592
 593 let REAL_NEG_EQ0 = prove(
 594   `!x. (--x = &0) <=> (x = &0)`,
 595   GEN_TAC THEN EQ_TAC THENL
 596    [DISCH_THEN(MP_TAC o AP_TERM `(+) x`);
 597     DISCH_THEN(MP_TAC o AP_TERM `(+) (--x)`)] THEN
 598   REWRITE_TAC[REAL_ADD_RINV; REAL_ADD_LINV; REAL_ADD_RID] THEN
 599   DISCH_THEN SUBST1_TAC THEN REFL_TAC);;
 600
 601 let REAL_NEG_0 = prove(
 602   `--(&0) = &0`,
 603   REWRITE_TAC[REAL_NEG_EQ0]);;
 604
 605 let REAL_NEG_SUB = prove(
 606   `!x y. --(x - y) = y - x`,
 607   REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; REAL_NEG_ADD; REAL_NEGNEG] THEN
 608   MATCH_ACCEPT_TAC REAL_ADD_SYM);;
 609
 610 let REAL_SUB_LT = prove(
 611   `!x y. &0 < x - y <=> y < x`,
 612   REPEAT GEN_TAC THEN
 613   SUBST1_TAC(SYM(SPECL [`&0`; `x - y`; `y:real`] REAL_LT_RADD)) THEN
 614   REWRITE_TAC[REAL_SUB_ADD; REAL_ADD_LID]);;
 615
 616 let REAL_SUB_LE = prove(
 617   `!x y. &0 <= (x - y) <=> y <= x`,
 618   REPEAT GEN_TAC THEN
 619   SUBST1_TAC(SYM(SPECL [`&0`; `x - y`; `y:real`] REAL_LE_RADD)) THEN
 620   REWRITE_TAC[REAL_SUB_ADD; REAL_ADD_LID]);;
 621
 622 let REAL_EQ_LMUL = prove(
 623   `!x y z. (x * y = x * z) <=> (x = &0) \/ (y = z)`,
 624   REPEAT GEN_TAC THEN EQ_TAC THENL
 625    [DISCH_THEN(MP_TAC o AP_TERM `(*) (inv x)`) THEN
 626     ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[] THEN
 627     POP_ASSUM(fun th -> REWRITE_TAC
 628       [REAL_MUL_ASSOC; MATCH_MP REAL_MUL_LINV th]) THEN
 629     REWRITE_TAC[REAL_MUL_LID];
 630     DISCH_THEN(DISJ_CASES_THEN SUBST1_TAC) THEN
 631     REWRITE_TAC[REAL_MUL_LZERO]]);;
 632
 633 let REAL_EQ_RMUL = prove(
 634   `!x y z. (x * z = y * z) <=> (z = &0) \/ (x = y)`,
 635   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
 636   MATCH_ACCEPT_TAC REAL_EQ_LMUL);;
 637
 638 let REAL_SUB_LDISTRIB = prove(
 639   `!x y z. x * (y - z) = (x * y) - (x * z)`,
 640   REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; REAL_LDISTRIB; REAL_NEG_RMUL]);;
 641
 642 let REAL_SUB_RDISTRIB = prove(
 643   `!x y z. (x - y) * z = (x * z) - (y * z)`,
 644   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
 645   MATCH_ACCEPT_TAC REAL_SUB_LDISTRIB);;
 646
 647 let REAL_NEG_EQ = prove(
 648   `!x y. (--x = y) <=> (x = --y)`,
 649   REPEAT GEN_TAC THEN EQ_TAC THENL
 650    [DISCH_THEN(SUBST1_TAC o SYM); DISCH_THEN SUBST1_TAC] THEN
 651   REWRITE_TAC[REAL_NEGNEG]);;
 652
 653 let REAL_NEG_MINUS1 = prove(
 654   `!x. --x = (--(&1)) * x`,
 655   GEN_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL] THEN
 656   REWRITE_TAC[REAL_MUL_LID]);;
 657
 658 let REAL_INV_NZ = prove(
 659   `!x. ~(x = &0) ==> ~(inv x = &0)`,
 660   GEN_TAC THEN DISCH_TAC THEN
 661   DISCH_THEN(MP_TAC o C AP_THM `x:real` o AP_TERM `(*)`) THEN
 662   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN
 663   REWRITE_TAC[REAL_MUL_LZERO; REAL_10]);;
 664
 665 let REAL_INVINV = prove(
 666   `!x. ~(x = &0) ==> (inv (inv x) = x)`,
 667   GEN_TAC THEN DISCH_TAC THEN
 668   FIRST_ASSUM(MP_TAC o MATCH_MP REAL_MUL_RINV) THEN
 669   ASM_CASES_TAC `inv x = &0` THEN
 670   ASM_REWRITE_TAC[REAL_MUL_RZERO; GSYM REAL_10] THEN
 671   MP_TAC(SPECL [`inv(inv x)`; `x:real`; `inv x`] REAL_EQ_RMUL)
 672   THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
 673   DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN
 674   FIRST_ASSUM ACCEPT_TAC);;
 675
 676 let REAL_LT_IMP_NE = prove(
 677   `!x y. x < y ==> ~(x = y)`,
 678   REPEAT GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN
 679   REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN
 680   REWRITE_TAC[REAL_LT_REFL]);;
 681
 682 let REAL_INV_POS = prove(
 683   `!x. &0 < x ==> &0 < inv x`,
 684   GEN_TAC THEN DISCH_TAC THEN REPEAT_TCL DISJ_CASES_THEN
 685    MP_TAC (SPECL [`inv x`; `&0`] REAL_LT_TOTAL) THENL
 686    [POP_ASSUM(ASSUME_TAC o MATCH_MP REAL_INV_NZ o
 687               GSYM o MATCH_MP REAL_LT_IMP_NE) THEN ASM_REWRITE_TAC[];
 688     ONCE_REWRITE_TAC[GSYM REAL_NEG_GT0] THEN
 689     DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_MUL o C CONJ (ASSUME `&0 < x`)) THEN
 690     REWRITE_TAC[GSYM REAL_NEG_LMUL] THEN
 691     POP_ASSUM(fun th -> REWRITE_TAC
 692      [MATCH_MP REAL_MUL_LINV (GSYM (MATCH_MP REAL_LT_IMP_NE th))]) THEN
 693     REWRITE_TAC[REAL_NEG_GT0] THEN DISCH_THEN(MP_TAC o CONJ REAL_LT_01) THEN
 694     REWRITE_TAC[REAL_LT_ANTISYM];
 695     REWRITE_TAC[]]);;
 696
 697 let REAL_LT_LMUL_0 = prove(
 698   `!x y. &0 < x ==> (&0 < (x * y) <=> &0 < y)`,
 699   REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL
 700    [FIRST_ASSUM(fun th ->
 701       DISCH_THEN(MP_TAC o CONJ (MATCH_MP REAL_INV_POS th))) THEN
 702     DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_MUL) THEN
 703     REWRITE_TAC[REAL_MUL_ASSOC] THEN
 704     FIRST_ASSUM(fun th -> REWRITE_TAC
 705       [MATCH_MP REAL_MUL_LINV (GSYM (MATCH_MP REAL_LT_IMP_NE th))]) THEN
 706     REWRITE_TAC[REAL_MUL_LID];
 707     DISCH_TAC THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[]]);;
 708
 709 let REAL_LT_RMUL_0 = prove(
 710   `!x y. &0 < y ==> (&0 < (x * y) <=> &0 < x)`,
 711   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
 712   MATCH_ACCEPT_TAC REAL_LT_LMUL_0);;
 713
 714 let REAL_LT_LMUL_EQ = prove(
 715   `!x y z. &0 < x ==> ((x * y) < (x * z) <=> y < z)`,
 716   REPEAT GEN_TAC THEN DISCH_TAC THEN
 717   ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
 718   REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN
 719   POP_ASSUM MP_TAC THEN MATCH_ACCEPT_TAC REAL_LT_LMUL_0);;
 720
 721 let REAL_LT_RMUL_EQ = prove(
 722   `!x y z. &0 < z ==> ((x * z) < (y * z) <=> x < y)`,
 723   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
 724   MATCH_ACCEPT_TAC REAL_LT_LMUL_EQ);;
 725
 726 let REAL_LT_RMUL_IMP = prove(
 727   `!x y z. x < y /\ &0 < z ==> (x * z) < (y * z)`,
 728   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
 729   POP_ASSUM(fun th -> REWRITE_TAC[GEN_ALL(MATCH_MP REAL_LT_RMUL_EQ th)]));;
 730
 731 let REAL_LT_LMUL_IMP = prove(
 732   `!x y z. y < z  /\ &0 < x ==> (x * y) < (x * z)`,
 733   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
 734   POP_ASSUM(fun th -> REWRITE_TAC[GEN_ALL(MATCH_MP REAL_LT_LMUL_EQ th)]));;
 735
 736 let REAL_LINV_UNIQ = prove(
 737   `!x y. (x * y = &1) ==> (x = inv y)`,
 738   REPEAT GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN
 739   ASM_REWRITE_TAC[REAL_MUL_LZERO; GSYM REAL_10] THEN
 740   DISCH_THEN(MP_TAC o AP_TERM `(*) (inv x)`) THEN
 741   REWRITE_TAC[REAL_MUL_ASSOC] THEN
 742   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN
 743   REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RID] THEN
 744   DISCH_THEN SUBST1_TAC THEN CONV_TAC SYM_CONV THEN
 745   POP_ASSUM MP_TAC THEN MATCH_ACCEPT_TAC REAL_INVINV);;
 746
 747 let REAL_RINV_UNIQ = prove(
 748   `!x y. (x * y = &1) ==> (y = inv x)`,
 749   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
 750   MATCH_ACCEPT_TAC REAL_LINV_UNIQ);;
 751
 752 let REAL_NEG_INV = prove(
 753   `!x. ~(x = &0) ==> (--(inv x) = inv(--x))`,
 754   GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LINV_UNIQ THEN
 755   REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN
 756   POP_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN
 757   REWRITE_TAC[REAL_NEGNEG]);;
 758
 759 let REAL_INV_1OVER = prove(
 760   `!x. inv x = &1 / x`,
 761   GEN_TAC THEN REWRITE_TAC[real_div; REAL_MUL_LID]);;
 762
 763 (*----------------------------------------------------------------------------*)
 764 (* Prove homomorphisms for the inclusion map                                  *)
 765 (*----------------------------------------------------------------------------*)
 766
 767 let REAL = prove(
 768   `!n. &(SUC n) = &n + &1`,
 769   REWRITE_TAC[ADD1; REAL_OF_NUM_ADD]);;
 770
 771 let REAL_POS = prove(
 772   `!n. &0 <= &n`,
 773   INDUCT_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN
 774   MATCH_MP_TAC REAL_LE_TRANS THEN
 775   EXISTS_TAC `&n` THEN ASM_REWRITE_TAC[REAL] THEN
 776   REWRITE_TAC[REAL_LE_ADDR; REAL_LE_01]);;
 777
 778 let REAL_LE = prove(
 779   `!m n. &m <= &n <=> m <= n`,
 780   REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC
 781    [REAL; REAL_LE_RADD; LE_0; LE_SUC; REAL_LE_REFL] THEN
 782   REWRITE_TAC[GSYM NOT_LT; LT_0] THENL
 783    [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&n` THEN
 784     ASM_REWRITE_TAC[LE_0; REAL_LE_ADDR; REAL_LE_01];
 785     DISCH_THEN(MP_TAC o C CONJ (SPEC `m:num` REAL_POS)) THEN
 786     DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_TRANS) THEN
 787     REWRITE_TAC[REAL_NOT_LE; REAL_LT_ADDR; REAL_LT_01]]);;
 788
 789 let REAL_LT = prove(
 790   `!m n. &m < &n <=> m < n`,
 791   REPEAT GEN_TAC THEN MATCH_ACCEPT_TAC ((REWRITE_RULE[] o AP_TERM `(~)` o
 792     REWRITE_RULE[GSYM NOT_LT; GSYM REAL_NOT_LT]) (SPEC_ALL REAL_LE)));;
 793
 794 let REAL_INJ = prove(
 795   `!m n. (&m = &n) <=> (m = n)`,
 796   let th = prove(`(m = n) <=> m:num <= n /\ n <= m`,
 797                  EQ_TAC THENL
 798                   [DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[LE_REFL];
 799                    MATCH_ACCEPT_TAC LESS_EQUAL_ANTISYM]) in
 800   REPEAT GEN_TAC THEN REWRITE_TAC[th; GSYM REAL_LE_ANTISYM; REAL_LE]);;
 801
 802 let REAL_ADD = prove(
 803   `!m n. &m + &n = &(m + n)`,
 804   INDUCT_TAC THEN REWRITE_TAC[REAL; ADD; REAL_ADD_LID] THEN
 805   RULE_ASSUM_TAC GSYM THEN GEN_TAC THEN ASM_REWRITE_TAC[] THEN
 806   REWRITE_TAC[REAL_ADD_AC]);;
 807
 808 let REAL_MUL = prove(
 809   `!m n. &m * &n = &(m * n)`,
 810   INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; MULT_CLAUSES; REAL;
 811     GSYM REAL_ADD; REAL_RDISTRIB] THEN
 812   FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM th]) THEN
 813   REWRITE_TAC[REAL_MUL_LID]);;
 814
 815 (*----------------------------------------------------------------------------*)
 816 (* Now more theorems                                                          *)
 817 (*----------------------------------------------------------------------------*)
 818
 819 let REAL_INV1 = prove(
 820   `inv(&1) = &1`,
 821   CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_LINV_UNIQ THEN
 822   REWRITE_TAC[REAL_MUL_LID]);;
 823
 824 let REAL_DIV_LZERO = prove(
 825   `!x. &0 / x = &0`,
 826   REPEAT GEN_TAC THEN REWRITE_TAC[real_div; REAL_MUL_LZERO]);;
 827
 828 let REAL_LT_NZ = prove(
 829   `!n. ~(&n = &0) <=> (&0 < &n)`,
 830   GEN_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN
 831   CONV_TAC(RAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN
 832   ASM_CASES_TAC `&n = &0` THEN ASM_REWRITE_TAC[REAL_LE_REFL; REAL_POS]);;
 833
 834 let REAL_NZ_IMP_LT = prove(
 835   `!n. ~(n = 0) ==> &0 < &n`,
 836   GEN_TAC THEN REWRITE_TAC[GSYM REAL_INJ; REAL_LT_NZ]);;
 837
 838 let REAL_LT_RDIV_0 = prove(
 839   `!y z. &0 < z ==> (&0 < (y / z) <=> &0 < y)`,
 840   REPEAT GEN_TAC THEN DISCH_TAC THEN
 841   REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LT_RMUL_0 THEN
 842   MATCH_MP_TAC REAL_INV_POS THEN POP_ASSUM ACCEPT_TAC);;
 843
 844 let REAL_LT_RDIV = prove(
 845   `!x y z. &0 < z ==> ((x / z) < (y / z) <=> x < y)`,
 846   REPEAT GEN_TAC THEN DISCH_TAC THEN
 847   REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LT_RMUL_EQ THEN
 848   MATCH_MP_TAC REAL_INV_POS THEN POP_ASSUM ACCEPT_TAC);;
 849
 850 let REAL_LT_FRACTION_0 = prove(
 851   `!n d. ~(n = 0) ==> (&0 < (d / &n) <=> &0 < d)`,
 852   REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LT_RDIV_0 THEN
 853   ASM_REWRITE_TAC[GSYM REAL_LT_NZ; REAL_INJ]);;
 854
 855 let REAL_LT_MULTIPLE = prove(
 856   `!n d. 1 < n ==> (d < (&n * d) <=> &0 < d)`,
 857   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN INDUCT_TAC THENL
 858    [REWRITE_TAC[num_CONV `1`; NOT_LESS_0];
 859     POP_ASSUM MP_TAC THEN ASM_CASES_TAC `1 < n` THEN
 860     ASM_REWRITE_TAC[] THENL
 861      [DISCH_TAC THEN GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN
 862       REWRITE_TAC[REAL; REAL_LDISTRIB; REAL_MUL_RID; REAL_LT_ADDL] THEN
 863       MATCH_MP_TAC REAL_LT_RMUL_0 THEN REWRITE_TAC[REAL_LT] THEN
 864       MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `1` THEN
 865       ASM_REWRITE_TAC[] THEN REWRITE_TAC[num_CONV `1`; LT_0];
 866       GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LESS_LEMMA1) THEN
 867       ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
 868       REWRITE_TAC[REAL; REAL_LDISTRIB; REAL_MUL_RID] THEN
 869       REWRITE_TAC[REAL_LT_ADDL]]]);;
 870
 871 let REAL_LT_FRACTION = prove(
 872   `!n d. (1 < n) ==> ((d / &n) < d <=> &0 < d)`,
 873   REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN
 874   ASM_REWRITE_TAC[NOT_LESS_0] THEN DISCH_TAC THEN
 875   UNDISCH_TAC `1 < n` THEN
 876   FIRST_ASSUM(fun th -> let th1 = REWRITE_RULE[GSYM REAL_INJ] th in
 877     MAP_EVERY ASSUME_TAC [th1; REWRITE_RULE[REAL_LT_NZ] th1]) THEN
 878   FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV)
 879                      [GSYM(MATCH_MP REAL_LT_RMUL_EQ th)]) THEN
 880   REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN
 881   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN
 882   REWRITE_TAC[REAL_MUL_RID] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
 883   MATCH_ACCEPT_TAC REAL_LT_MULTIPLE);;
 884
 885 let REAL_LT_HALF1 = prove(
 886   `!d. &0 < (d / &2) <=> &0 < d`,
 887   GEN_TAC THEN MATCH_MP_TAC REAL_LT_FRACTION_0 THEN
 888   REWRITE_TAC[num_CONV `2`; NOT_SUC]);;
 889
 890 let REAL_LT_HALF2 = prove(
 891   `!d. (d / &2) < d <=> &0 < d`,
 892   GEN_TAC THEN MATCH_MP_TAC REAL_LT_FRACTION THEN
 893   CONV_TAC(RAND_CONV num_CONV) THEN
 894   REWRITE_TAC[LESS_SUC_REFL]);;
 895
 896 let REAL_DOUBLE = prove(
 897   `!x. x + x = &2 * x`,
 898   GEN_TAC THEN REWRITE_TAC[num_CONV `2`; REAL] THEN
 899   REWRITE_TAC[REAL_RDISTRIB; REAL_MUL_LID]);;
 900
 901 let REAL_HALF_DOUBLE = prove(
 902   `!x. (x / &2) + (x / &2) = x`,
 903   GEN_TAC THEN REWRITE_TAC[REAL_DOUBLE] THEN
 904   MATCH_MP_TAC REAL_DIV_LMUL THEN REWRITE_TAC[REAL_INJ] THEN
 905   REWRITE_TAC[num_CONV `2`; NOT_SUC]);;
 906
 907 let REAL_SUB_SUB = prove(
 908   `!x y. (x - y) - x = --y`,
 909   REPEAT GEN_TAC THEN REWRITE_TAC[real_sub] THEN
 910   ONCE_REWRITE_TAC[AC REAL_ADD_AC
 911     `(a + b) + c = (c + a) + b`] THEN
 912   REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]);;
 913
 914 let REAL_LT_ADD_SUB = prove(
 915   `!x y z. (x + y) < z <=> x < (z - y)`,
 916   REPEAT GEN_TAC THEN
 917   SUBST1_TAC(SYM(SPECL [`x:real`; `z - y`; `y:real`] REAL_LT_RADD)) THEN
 918   REWRITE_TAC[REAL_SUB_ADD]);;
 919
 920 let REAL_LT_SUB_RADD = prove(
 921   `!x y z. (x - y) < z <=> x < z + y`,
 922   REPEAT GEN_TAC THEN
 923   SUBST1_TAC(SYM(SPECL [`x - y`; `z:real`; `y:real`] REAL_LT_RADD)) THEN
 924   REWRITE_TAC[REAL_SUB_ADD]);;
 925
 926 let REAL_LT_SUB_LADD = prove(
 927   `!x y z. x < (y - z) <=> (x + z) < y`,
 928   REPEAT GEN_TAC THEN
 929   SUBST1_TAC(SYM(SPECL [`x + z`; `y:real`; `--z`] REAL_LT_RADD)) THEN
 930   REWRITE_TAC[real_sub; GSYM REAL_ADD_ASSOC; REAL_ADD_RINV; REAL_ADD_RID]);;
 931
 932 let REAL_LE_SUB_LADD = prove(
 933   `!x y z. x <= (y - z) <=> (x + z) <= y`,
 934   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT; REAL_LT_SUB_RADD]);;
 935
 936 let REAL_LE_SUB_RADD = prove(
 937   `!x y z. (x - y) <= z <=> x <= z + y`,
 938   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT; REAL_LT_SUB_LADD]);;
 939
 940 let REAL_LT_NEG = prove(
 941   `!x y. --x < --y <=> y < x`,
 942   REPEAT GEN_TAC THEN
 943   SUBST1_TAC(SYM(SPECL[`--x`; `--y`; `x + y`] REAL_LT_RADD)) THEN
 944   REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_LID] THEN
 945   ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
 946   REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_RINV; REAL_ADD_LID]);;
 947
 948 let REAL_LE_NEG = prove(
 949   `!x y. --x <= --y <=> y <= x`,
 950   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN
 951   REWRITE_TAC[REAL_LT_NEG]);;
 952
 953 let REAL_SUB_LZERO = prove(
 954   `!x. &0 - x = --x`,
 955   GEN_TAC THEN REWRITE_TAC[real_sub; REAL_ADD_LID]);;
 956
 957 let REAL_SUB_RZERO = prove(
 958   `!x. x - &0 = x`,
 959   GEN_TAC THEN REWRITE_TAC[real_sub; REAL_NEG_0; REAL_ADD_RID]);;
 960
 961 let REAL_LTE_ADD2 = prove(
 962   `!w x y z. w < x /\ y <= z ==> (w + y) < (x + z)`,
 963   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN
 964   ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
 965   MATCH_ACCEPT_TAC REAL_LET_ADD2);;
 966
 967 let REAL_LTE_ADD = prove(
 968   `!x y. &0 < x /\ &0 <= y ==> &0 < (x + y)`,
 969   REPEAT GEN_TAC THEN DISCH_TAC THEN
 970   SUBST1_TAC(SYM(SPEC `&0` REAL_ADD_LID)) THEN
 971   MATCH_MP_TAC REAL_LTE_ADD2 THEN
 972   ASM_REWRITE_TAC[]);;
 973
 974 let REAL_LT_MUL2_ALT = prove(
 975   `!x1 x2 y1 y2. &0 <= x1 /\ &0 <= y1 /\ x1 < x2 /\ y1 < y2 ==>
 976         (x1 * y1) < (x2 * y2)`,
 977   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
 978   REWRITE_TAC[REAL_SUB_RZERO] THEN
 979   SUBGOAL_THEN `!a b c d.
 980     (a * b) - (c * d) = ((a * b) - (a * d)) + ((a * d) - (c * d))`
 981   MP_TAC THENL
 982    [REPEAT GEN_TAC THEN REWRITE_TAC[real_sub] THEN
 983     ONCE_REWRITE_TAC[AC REAL_ADD_AC
 984       `(a + b) + (c + d) = (b + c) + (a + d)`] THEN
 985     REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID];
 986     DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th]) THEN
 987     REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN
 988     DISCH_THEN STRIP_ASSUME_TAC THEN
 989     MATCH_MP_TAC REAL_LTE_ADD THEN CONJ_TAC THENL
 990      [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN
 991       MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x1:real` THEN
 992       ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
 993       ASM_REWRITE_TAC[];
 994       MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN
 995       MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]]);;
 996
 997 let REAL_SUB_LNEG = prove(
 998   `!x y. (--x) - y = --(x + y)`,
 999   REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; REAL_NEG_ADD]);;
1000
1001 let REAL_SUB_RNEG = prove(
1002   `!x y. x - (--y) = x + y`,
1003   REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; REAL_NEGNEG]);;
1004
1005 let REAL_SUB_NEG2 = prove(
1006   `!x y. (--x) - (--y) = y - x`,
1007   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_SUB_LNEG] THEN
1008   REWRITE_TAC[real_sub; REAL_NEG_ADD; REAL_NEGNEG] THEN
1009   MATCH_ACCEPT_TAC REAL_ADD_SYM);;
1010
1011 let REAL_SUB_TRIANGLE = prove(
1012   `!a b c. (a - b) + (b - c) = a - c`,
1013   REPEAT GEN_TAC THEN REWRITE_TAC[real_sub] THEN
1014   ONCE_REWRITE_TAC[AC REAL_ADD_AC
1015     `(a + b) + (c + d) = (b + c) + (a + d)`] THEN
1016   REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]);;
1017
1018 let REAL_INV_MUL_WEAK = prove(
1019   `!x y. ~(x = &0) /\ ~(y = &0) ==>
1020              (inv(x * y) = inv(x) * inv(y))`,
1021   REWRITE_TAC[REAL_INV_MUL]);;
1022
1023 let REAL_LE_LMUL_LOCAL = prove(
1024   `!x y z. &0 < x ==> ((x * y) <= (x * z) <=> y <= z)`,
1025   REPEAT GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN
1026   AP_TERM_TAC THEN MATCH_MP_TAC REAL_LT_LMUL_EQ THEN ASM_REWRITE_TAC[]);;
1027
1028 let REAL_LE_RMUL_EQ = prove(
1029   `!x y z. &0 < z ==> ((x * z) <= (y * z) <=> x <= y)`,
1030    REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
1031    MATCH_ACCEPT_TAC REAL_LE_LMUL_LOCAL);;
1032
1033 let REAL_SUB_INV2 = prove(
1034   `!x y. ~(x = &0) /\ ~(y = &0) ==>
1035                 (inv(x) - inv(y) = (y - x) / (x * y))`,
1036   REPEAT GEN_TAC THEN DISCH_THEN STRIP_ASSUME_TAC THEN
1037   REWRITE_TAC[real_div; REAL_SUB_RDISTRIB] THEN
1038   SUBGOAL_THEN `inv(x * y) = inv(x) * inv(y)` SUBST1_TAC THENL
1039    [MATCH_MP_TAC REAL_INV_MUL_WEAK THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
1040   REWRITE_TAC[REAL_MUL_ASSOC] THEN
1041   EVERY_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_RINV th]) THEN
1042   REWRITE_TAC[REAL_MUL_LID] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
1043   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN
1044   EVERY_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN
1045   REWRITE_TAC[REAL_MUL_LID]);;
1046
1047 let REAL_SUB_SUB2 = prove(
1048   `!x y. x - (x - y) = y`,
1049   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_NEGNEG] THEN
1050   AP_TERM_TAC THEN REWRITE_TAC[REAL_NEG_SUB; REAL_SUB_SUB]);;
1051
1052 let REAL_MEAN = prove(
1053   `!x y. x < y ==> ?z. x < z /\ z < y`,
1054   REPEAT GEN_TAC THEN
1055   DISCH_THEN(MP_TAC o MATCH_MP REAL_DOWN o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT])
1056   THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
1057   EXISTS_TAC `x + d` THEN ASM_REWRITE_TAC[REAL_LT_ADDR] THEN
1058   ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
1059   ASM_REWRITE_TAC[GSYM REAL_LT_SUB_LADD]);;
1060
1061 let REAL_EQ_LMUL2 = prove(
1062   `!x y z. ~(x = &0) ==> ((y = z) <=> (x * y = x * z))`,
1063   REPEAT GEN_TAC THEN DISCH_TAC THEN
1064   MP_TAC(SPECL [`x:real`; `y:real`; `z:real`] REAL_EQ_LMUL) THEN
1065   ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST_ALL_TAC THEN REFL_TAC);;
1066
1067 let REAL_LE_MUL2V = prove(
1068   `!x1 x2 y1 y2.
1069     (& 0) <= x1 /\ (& 0) <= y1 /\ x1 <= x2 /\ y1 <= y2 ==>
1070     (x1 * y1) <= (x2 * y2)`,
1071   REPEAT GEN_TAC THEN
1072   SUBST1_TAC(SPECL [`x1:real`; `x2:real`] REAL_LE_LT) THEN
1073   ASM_CASES_TAC `x1:real = x2` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THENL
1074    [UNDISCH_TAC `&0 <= x2` THEN
1075     DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL
1076      [FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP REAL_LE_LMUL_LOCAL th]);
1077       SUBST1_TAC(SYM(ASSUME `&0 = x2`)) THEN
1078       REWRITE_TAC[REAL_MUL_LZERO; REAL_LE_REFL]]; ALL_TAC] THEN
1079   UNDISCH_TAC `y1 <= y2` THEN
1080   DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL
1081    [MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_LT_MUL2_ALT THEN
1082     ASM_REWRITE_TAC[];
1083     ASM_REWRITE_TAC[]] THEN
1084   UNDISCH_TAC `&0 <= y1` THEN ASM_REWRITE_TAC[] THEN
1085   DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL
1086    [FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP REAL_LE_RMUL_EQ th]) THEN
1087     MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[];
1088     SUBST1_TAC(SYM(ASSUME `&0 = y2`)) THEN
1089     REWRITE_TAC[REAL_MUL_RZERO; REAL_LE_REFL]]);;
1090
1091 let REAL_LE_LDIV = prove(
1092   `!x y z. &0 < x /\ y <= (z * x) ==> (y / x) <= z`,
1093   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1094   MATCH_MP_TAC(TAUT `(a = b) ==> a ==> b`) THEN
1095   SUBGOAL_THEN `y = (y / x) * x` MP_TAC THENL
1096    [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN
1097     CONV_TAC(RAND_CONV SYM_CONV) THEN
1098     MATCH_MP_TAC REAL_LT_IMP_NE THEN POP_ASSUM ACCEPT_TAC;
1099     DISCH_THEN(fun t -> GEN_REWRITE_TAC (funpow 2 LAND_CONV) [t])
1100     THEN MATCH_MP_TAC REAL_LE_RMUL_EQ THEN POP_ASSUM ACCEPT_TAC]);;
1101
1102 let REAL_LE_RDIV = prove(
1103   `!x y z. &0 < x /\ (y * x) <= z ==> y <= (z / x)`,
1104   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1105   MATCH_MP_TAC EQ_IMP THEN
1106   SUBGOAL_THEN `z = (z / x) * x` MP_TAC THENL
1107    [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN
1108     CONV_TAC(RAND_CONV SYM_CONV) THEN
1109     MATCH_MP_TAC REAL_LT_IMP_NE THEN POP_ASSUM ACCEPT_TAC;
1110     DISCH_THEN(fun t -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [t])
1111     THEN MATCH_MP_TAC REAL_LE_RMUL_EQ THEN POP_ASSUM ACCEPT_TAC]);;
1112
1113 let REAL_LT_1 = prove(
1114   `!x y. &0 <= x /\ x < y ==> (x / y) < &1`,
1115   REPEAT GEN_TAC THEN DISCH_TAC THEN
1116   SUBGOAL_THEN `(x / y) < &1 <=> ((x / y) * y) < (&1 * y)` SUBST1_TAC THENL
1117    [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_LT_RMUL_EQ THEN
1118     MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x:real` THEN
1119     ASM_REWRITE_TAC[];
1120     SUBGOAL_THEN `(x / y) * y = x` SUBST1_TAC THENL
1121      [MATCH_MP_TAC REAL_DIV_RMUL THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
1122       MATCH_MP_TAC REAL_LT_IMP_NE THEN MATCH_MP_TAC REAL_LET_TRANS THEN
1123       EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[];
1124       ASM_REWRITE_TAC[REAL_MUL_LID]]]);;
1125
1126 let REAL_LE_LMUL_IMP = prove(
1127   `!x y z. &0 <= x /\ y <= z ==> (x * y) <= (x * z)`,
1128   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
1129   DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL
1130    [FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP REAL_LE_LMUL_LOCAL th]);
1131     FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_MUL_LZERO] THEN
1132     MATCH_ACCEPT_TAC REAL_LE_REFL]);;
1133
1134 let REAL_LE_RMUL_IMP = prove(
1135   `!x y z. &0 <= x /\ y <= z ==> (y * x) <= (z * x)`,
1136   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_LE_LMUL_IMP);;
1137
1138 let REAL_INV_LT1 = prove(
1139   `!x. &0 < x /\ x < &1 ==> &1 < inv(x)`,
1140   GEN_TAC THEN STRIP_TAC THEN
1141   FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_INV_POS) THEN
1142   GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN
1143   PURE_REWRITE_TAC[REAL_NOT_LT] THEN REWRITE_TAC[REAL_LE_LT] THEN
1144   DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL
1145    [DISCH_TAC THEN
1146     MP_TAC(SPECL [`inv(x)`; `&1`; `x:real`; `&1`] REAL_LT_MUL2_ALT) THEN
1147     ASM_REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL
1148      [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[];
1149       MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[];
1150       DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_NE) THEN
1151       REWRITE_TAC[REAL_MUL_LID] THEN MATCH_MP_TAC REAL_MUL_LINV THEN
1152       DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `&0 < &0` THEN
1153       REWRITE_TAC[REAL_LT_REFL]];
1154     DISCH_THEN(MP_TAC o AP_TERM `inv`) THEN REWRITE_TAC[REAL_INV1] THEN
1155     SUBGOAL_THEN `inv(inv x) = x` SUBST1_TAC THENL
1156      [MATCH_MP_TAC REAL_INVINV THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
1157       MATCH_MP_TAC REAL_LT_IMP_NE THEN FIRST_ASSUM ACCEPT_TAC;
1158       DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `&1 < &1` THEN
1159       REWRITE_TAC[REAL_LT_REFL]]]);;
1160
1161 let REAL_POS_NZ = prove(
1162   `!x. &0 < x ==> ~(x = &0)`,
1163   GEN_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP REAL_LT_IMP_NE) THEN
1164   CONV_TAC(RAND_CONV SYM_CONV) THEN POP_ASSUM ACCEPT_TAC);;
1165
1166 let REAL_EQ_RMUL_IMP = prove(
1167   `!x y z. ~(z = &0) /\ (x * z = y * z) ==> (x = y)`,
1168   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
1169   ASM_REWRITE_TAC[REAL_EQ_RMUL]);;
1170
1171 let REAL_EQ_LMUL_IMP = prove(
1172   `!x y z. ~(x = &0) /\ (x * y = x * z) ==> (y = z)`,
1173   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_EQ_RMUL_IMP);;
1174
1175 let REAL_FACT_NZ = prove(
1176   `!n. ~(&(FACT n) = &0)`,
1177   GEN_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN
1178   REWRITE_TAC[REAL_LT; FACT_LT]);;
1179
1180 let REAL_POSSQ = prove(
1181   `!x. &0 < (x * x) <=> ~(x = &0)`,
1182   GEN_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LE] THEN AP_TERM_TAC THEN EQ_TAC THENL
1183    [DISCH_THEN(MP_TAC o C CONJ (SPEC `x:real` REAL_LE_SQUARE)) THEN
1184     REWRITE_TAC[REAL_LE_ANTISYM; REAL_ENTIRE];
1185     DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_LE_REFL]]);;
1186
1187 let REAL_SUMSQ = prove(
1188   `!x y. ((x * x) + (y * y) = &0) <=> (x = &0) /\ (y = &0)`,
1189   REPEAT GEN_TAC THEN EQ_TAC THENL
1190    [CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[DE_MORGAN_THM] THEN
1191     DISCH_THEN DISJ_CASES_TAC THEN MATCH_MP_TAC REAL_POS_NZ THENL
1192      [MATCH_MP_TAC REAL_LTE_ADD; MATCH_MP_TAC REAL_LET_ADD] THEN
1193     ASM_REWRITE_TAC[REAL_POSSQ; REAL_LE_SQUARE];
1194     DISCH_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID]]);;
1195
1196 let REAL_EQ_NEG = prove(
1197   `!x y. (--x = --y) <=> (x = y)`,
1198   REPEAT GEN_TAC THEN
1199   REWRITE_TAC[GSYM REAL_LE_ANTISYM; REAL_LE_NEG] THEN
1200   MATCH_ACCEPT_TAC CONJ_SYM);;
1201
1202 let REAL_DIV_MUL2 = prove(
1203   `!x z. ~(x = &0) /\ ~(z = &0) ==> !y. y / z = (x * y) / (x * z)`,
1204   REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN
1205   REWRITE_TAC[real_div] THEN IMP_SUBST_TAC REAL_INV_MUL_WEAK THEN
1206   ASM_REWRITE_TAC[] THEN
1207   ONCE_REWRITE_TAC[AC REAL_MUL_AC
1208     `(a * b) * (c * d) = (c * a) * (b * d)`] THEN
1209   IMP_SUBST_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[] THEN
1210   REWRITE_TAC[REAL_MUL_LID]);;
1211
1212 let REAL_MIDDLE1 = prove(
1213   `!a b. a <= b ==> a <= (a + b) / &2`,
1214   REPEAT GEN_TAC THEN DISCH_TAC THEN
1215   MATCH_MP_TAC REAL_LE_RDIV THEN
1216   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
1217   REWRITE_TAC[GSYM REAL_DOUBLE] THEN
1218   ASM_REWRITE_TAC[GSYM REAL_DOUBLE; REAL_LE_LADD] THEN
1219   REWRITE_TAC[num_CONV `2`; REAL_LT; LT_0]);;
1220
1221 let REAL_MIDDLE2 = prove(
1222   `!a b. a <= b ==> ((a + b) / &2) <= b`,
1223   REPEAT GEN_TAC THEN DISCH_TAC THEN
1224   MATCH_MP_TAC REAL_LE_LDIV THEN
1225   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
1226   REWRITE_TAC[GSYM REAL_DOUBLE] THEN
1227   ASM_REWRITE_TAC[GSYM REAL_DOUBLE; REAL_LE_RADD] THEN
1228   REWRITE_TAC[num_CONV `2`; REAL_LT; LT_0]);;
1229
1230 (*----------------------------------------------------------------------------*)
1231 (* Define usual norm (absolute distance) on the real line                     *)
1232 (*----------------------------------------------------------------------------*)
1233
1234 let ABS_ZERO = prove(
1235   `!x. (abs(x) = &0) <=> (x = &0)`,
1236   GEN_TAC THEN REWRITE_TAC[real_abs] THEN
1237   COND_CASES_TAC THEN REWRITE_TAC[REAL_NEG_EQ0]);;
1238
1239 let ABS_0 = prove(
1240   `abs(&0) = &0`,
1241   REWRITE_TAC[ABS_ZERO]);;
1242
1243 let ABS_1 = prove(
1244   `abs(&1) = &1`,
1245   REWRITE_TAC[real_abs; REAL_LE; LE_0]);;
1246
1247 let ABS_NEG = prove(
1248   `!x. abs(--x) = abs(x)`,
1249   GEN_TAC THEN REWRITE_TAC[real_abs; REAL_NEGNEG; REAL_NEG_GE0] THEN
1250   REPEAT COND_CASES_TAC THEN REWRITE_TAC[] THENL
1251    [MP_TAC(CONJ (ASSUME `&0 <= x`) (ASSUME `x <= &0`)) THEN
1252     REWRITE_TAC[REAL_LE_ANTISYM] THEN
1253     DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_NEG_0];
1254     RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN
1255     W(MP_TAC o end_itlist CONJ o map snd o fst) THEN
1256     REWRITE_TAC[REAL_LT_ANTISYM]]);;
1257
1258 let ABS_TRIANGLE = prove(
1259   `!x y. abs(x + y) <= abs(x) + abs(y)`,
1260   REPEAT GEN_TAC THEN REWRITE_TAC[real_abs] THEN
1261   REPEAT COND_CASES_TAC THEN
1262   REWRITE_TAC[REAL_NEG_ADD; REAL_LE_REFL; REAL_LE_LADD; REAL_LE_RADD] THEN
1263   ASM_REWRITE_TAC[GSYM REAL_NEG_ADD; REAL_LE_NEGL; REAL_LE_NEGR] THEN
1264   RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN
1265   TRY(MATCH_MP_TAC REAL_LT_IMP_LE) THEN TRY(FIRST_ASSUM ACCEPT_TAC) THEN
1266   TRY(UNDISCH_TAC `(x + y) < &0`) THEN SUBST1_TAC(SYM(SPEC `&0` REAL_ADD_LID))
1267   THEN REWRITE_TAC[REAL_NOT_LT] THEN
1268   MAP_FIRST MATCH_MP_TAC [REAL_LT_ADD2; REAL_LE_ADD2] THEN
1269   ASM_REWRITE_TAC[]);;
1270
1271 let ABS_POS = prove(
1272   `!x. &0 <= abs(x)`,
1273   GEN_TAC THEN ASM_CASES_TAC `&0 <= x` THENL
1274    [ALL_TAC;
1275     MP_TAC(SPEC `x:real` REAL_LE_NEGTOTAL) THEN ASM_REWRITE_TAC[] THEN
1276     DISCH_TAC] THEN
1277   ASM_REWRITE_TAC[real_abs]);;
1278
1279 let ABS_MUL = prove(
1280   `!x y. abs(x * y) = abs(x) * abs(y)`,
1281   REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 <= x` THENL
1282    [ALL_TAC;
1283     MP_TAC(SPEC `x:real` REAL_LE_NEGTOTAL) THEN ASM_REWRITE_TAC[] THEN
1284     POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN
1285     GEN_REWRITE_TAC LAND_CONV [GSYM ABS_NEG] THEN
1286     GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM ABS_NEG]
1287     THEN REWRITE_TAC[REAL_NEG_LMUL]] THEN
1288   (ASM_CASES_TAC `&0 <= y` THENL
1289     [ALL_TAC;
1290      MP_TAC(SPEC `y:real` REAL_LE_NEGTOTAL) THEN ASM_REWRITE_TAC[] THEN
1291      POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN
1292      GEN_REWRITE_TAC LAND_CONV [GSYM ABS_NEG] THEN
1293      GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM ABS_NEG] THEN
1294      REWRITE_TAC[REAL_NEG_RMUL]]) THEN
1295   ASSUM_LIST(ASSUME_TAC o MATCH_MP REAL_LE_MUL o end_itlist CONJ o rev) THEN
1296   ASM_REWRITE_TAC[real_abs]);;
1297
1298 let ABS_LT_MUL2 = prove(
1299   `!w x y z. abs(w) < y /\ abs(x) < z ==> abs(w * x) < (y * z)`,
1300   REPEAT GEN_TAC THEN DISCH_TAC THEN
1301   REWRITE_TAC[ABS_MUL] THEN MATCH_MP_TAC REAL_LT_MUL2_ALT THEN
1302   ASM_REWRITE_TAC[ABS_POS]);;
1303
1304 let ABS_SUB = prove(
1305   `!x y. abs(x - y) = abs(y - x)`,
1306   REPEAT GEN_TAC THEN
1307   GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_NEG_SUB] THEN
1308   REWRITE_TAC[ABS_NEG]);;
1309
1310 let ABS_NZ = prove(
1311   `!x. ~(x = &0) <=> &0 < abs(x)`,
1312   GEN_TAC THEN EQ_TAC THENL
1313    [ONCE_REWRITE_TAC[GSYM ABS_ZERO] THEN
1314     REWRITE_TAC[TAUT `~a ==> b <=> b \/ a`] THEN
1315     CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN
1316     REWRITE_TAC[GSYM REAL_LE_LT; ABS_POS];
1317     CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN
1318     DISCH_THEN SUBST1_TAC THEN
1319     REWRITE_TAC[real_abs; REAL_LT_REFL; REAL_LE_REFL]]);;
1320
1321 let ABS_INV = prove(
1322   `!x. ~(x = &0) ==> (abs(inv x) = inv(abs(x)))`,
1323   GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LINV_UNIQ THEN
1324   REWRITE_TAC[GSYM ABS_MUL] THEN
1325   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN
1326   REWRITE_TAC[real_abs; REAL_LE] THEN
1327   REWRITE_TAC[num_CONV `1`; GSYM NOT_LT; NOT_LESS_0]);;
1328
1329 let ABS_ABS = prove(
1330   `!x. abs(abs(x)) = abs(x)`,
1331   GEN_TAC THEN
1332   GEN_REWRITE_TAC LAND_CONV [real_abs] THEN
1333   REWRITE_TAC[ABS_POS]);;
1334
1335 let ABS_LE = prove(
1336   `!x. x <= abs(x)`,
1337   GEN_TAC THEN REWRITE_TAC[real_abs] THEN
1338   COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN
1339   REWRITE_TAC[REAL_LE_NEGR] THEN
1340   MATCH_MP_TAC REAL_LT_IMP_LE THEN
1341   POP_ASSUM MP_TAC THEN REWRITE_TAC[REAL_NOT_LE]);;
1342
1343 let ABS_REFL = prove(
1344   `!x. (abs(x) = x) <=> &0 <= x`,
1345   GEN_TAC THEN REWRITE_TAC[real_abs] THEN
1346   ASM_CASES_TAC `&0 <= x` THEN ASM_REWRITE_TAC[] THEN
1347   CONV_TAC(RAND_CONV SYM_CONV) THEN
1348   ONCE_REWRITE_TAC[GSYM REAL_RNEG_UNIQ] THEN
1349   REWRITE_TAC[REAL_DOUBLE; REAL_ENTIRE; REAL_INJ] THEN
1350   REWRITE_TAC[num_CONV `2`; NOT_SUC] THEN
1351   DISCH_THEN SUBST_ALL_TAC THEN POP_ASSUM MP_TAC THEN
1352   REWRITE_TAC[REAL_LE_REFL]);;
1353
1354 let ABS_N = prove(
1355   `!n. abs(&n) = &n`,
1356   GEN_TAC THEN REWRITE_TAC[ABS_REFL; REAL_LE; LE_0]);;
1357
1358 let ABS_BETWEEN = prove(
1359   `!x y d. &0 < d /\ ((x - d) < y) /\ (y < (x + d)) <=> abs(y - x) < d`,
1360   REPEAT GEN_TAC THEN REWRITE_TAC[real_abs] THEN
1361   REWRITE_TAC[REAL_SUB_LE] THEN REWRITE_TAC[REAL_NEG_SUB] THEN
1362   COND_CASES_TAC THEN REWRITE_TAC[REAL_LT_SUB_RADD] THEN
1363   GEN_REWRITE_TAC (funpow 2 RAND_CONV) [REAL_ADD_SYM] THEN
1364   EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THENL
1365    [SUBGOAL_THEN `x < (x + d)` MP_TAC THENL
1366      [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `y:real` THEN
1367       ASM_REWRITE_TAC[]; ALL_TAC] THEN
1368     REWRITE_TAC[REAL_LT_ADDR] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
1369     MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `y:real` THEN
1370     ASM_REWRITE_TAC[REAL_LT_ADDR];
1371     RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN
1372     SUBGOAL_THEN `y < (y + d)` MP_TAC THENL
1373      [MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `x:real` THEN
1374       ASM_REWRITE_TAC[]; ALL_TAC] THEN
1375     REWRITE_TAC[REAL_LT_ADDR] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
1376     MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `x:real` THEN
1377     ASM_REWRITE_TAC[REAL_LT_ADDR]]);;
1378
1379 let ABS_BOUND = prove(
1380   `!x y d. abs(x - y) < d ==> y < (x + d)`,
1381   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[ABS_SUB] THEN
1382   ONCE_REWRITE_TAC[GSYM ABS_BETWEEN] THEN
1383   DISCH_TAC THEN ASM_REWRITE_TAC[]);;
1384
1385 let ABS_STILLNZ = prove(
1386   `!x y. abs(x - y) < abs(y) ==> ~(x = &0)`,
1387   REPEAT GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN
1388   REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN
1389   REWRITE_TAC[REAL_SUB_LZERO; ABS_NEG; REAL_LT_REFL]);;
1390
1391 let ABS_CASES = prove(
1392   `!x. (x = &0) \/ &0 < abs(x)`,
1393   GEN_TAC THEN REWRITE_TAC[GSYM ABS_NZ] THEN
1394   BOOL_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[]);;
1395
1396 let ABS_BETWEEN1 = prove(
1397   `!x y z. x < z /\ (abs(y - x)) < (z - x) ==> y < z`,
1398   REPEAT GEN_TAC THEN
1399   DISJ_CASES_TAC (SPECL [`x:real`; `y:real`] REAL_LET_TOTAL) THENL
1400    [ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN
1401     REWRITE_TAC[real_sub; REAL_LT_RADD] THEN
1402     DISCH_THEN(ACCEPT_TAC o CONJUNCT2);
1403     DISCH_TAC THEN MATCH_MP_TAC REAL_LT_TRANS THEN
1404     EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]]);;
1405
1406 let ABS_SIGN = prove(
1407   `!x y. abs(x - y) < y ==> &0 < x`,
1408   REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP ABS_BOUND) THEN
1409   REWRITE_TAC[REAL_LT_ADDL]);;
1410
1411 let ABS_SIGN2 = prove(
1412   `!x y. abs(x - y) < --y ==> x < &0`,
1413   REPEAT GEN_TAC THEN DISCH_TAC THEN
1414   MP_TAC(SPECL [`--x`; `--y`] ABS_SIGN) THEN
1415   REWRITE_TAC[REAL_SUB_NEG2] THEN
1416   ONCE_REWRITE_TAC[ABS_SUB] THEN
1417   DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP th)) THEN
1418   REWRITE_TAC[GSYM REAL_NEG_LT0; REAL_NEGNEG]);;
1419
1420 let ABS_DIV = prove(
1421   `!y. ~(y = &0) ==> !x. abs(x / y) = abs(x) / abs(y)`,
1422   GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[real_div] THEN
1423   REWRITE_TAC[ABS_MUL] THEN
1424   POP_ASSUM(fun th -> REWRITE_TAC[MATCH_MP ABS_INV th]));;
1425
1426 let ABS_CIRCLE = prove(
1427   `!x y h. abs(h) < (abs(y) - abs(x)) ==> abs(x + h) < abs(y)`,
1428   REPEAT GEN_TAC THEN DISCH_TAC THEN
1429   MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(x) + abs(h)` THEN
1430   REWRITE_TAC[ABS_TRIANGLE] THEN
1431   POP_ASSUM(MP_TAC o CONJ (SPEC `abs(x)` REAL_LE_REFL)) THEN
1432   DISCH_THEN(MP_TAC o MATCH_MP REAL_LET_ADD2) THEN
1433   REWRITE_TAC[REAL_SUB_ADD2]);;
1434
1435 let REAL_SUB_ABS = prove(
1436   `!x y. (abs(x) - abs(y)) <= abs(x - y)`,
1437   REPEAT GEN_TAC THEN
1438   MATCH_MP_TAC REAL_LE_TRANS THEN
1439   EXISTS_TAC `(abs(x - y) + abs(y)) - abs(y)` THEN CONJ_TAC THENL
1440    [ONCE_REWRITE_TAC[real_sub] THEN REWRITE_TAC[REAL_LE_RADD] THEN
1441     SUBST1_TAC(SYM(SPECL [`x:real`; `y:real`] REAL_SUB_ADD)) THEN
1442     GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_SUB_ADD] THEN
1443     MATCH_ACCEPT_TAC ABS_TRIANGLE;
1444     ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
1445     REWRITE_TAC[REAL_ADD_SUB; REAL_LE_REFL]]);;
1446
1447 let ABS_SUB_ABS = prove(
1448   `!x y. abs(abs(x) - abs(y)) <= abs(x - y)`,
1449   REPEAT GEN_TAC THEN
1450   GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [real_abs] THEN
1451   COND_CASES_TAC THEN REWRITE_TAC[REAL_SUB_ABS] THEN
1452   REWRITE_TAC[REAL_NEG_SUB] THEN
1453   ONCE_REWRITE_TAC[ABS_SUB] THEN
1454   REWRITE_TAC[REAL_SUB_ABS]);;
1455
1456 let ABS_BETWEEN2 = prove(
1457   `!x0 x y0 y. x0 < y0 /\ abs(x - x0) < (y0 - x0) / &2 /\
1458                           abs(y - y0) < (y0 - x0) / &2
1459         ==> x < y`,
1460   REPEAT GEN_TAC THEN STRIP_TAC THEN
1461   SUBGOAL_THEN `x < y0 /\ x0 < y` STRIP_ASSUME_TAC THENL
1462    [CONJ_TAC THENL
1463      [MP_TAC(SPECL [`x0:real`; `x:real`; `y0 - x0`] ABS_BOUND) THEN
1464       REWRITE_TAC[REAL_SUB_ADD2] THEN DISCH_THEN MATCH_MP_TAC THEN
1465       ONCE_REWRITE_TAC[ABS_SUB] THEN
1466       MATCH_MP_TAC REAL_LT_TRANS THEN
1467       EXISTS_TAC `(y0 - x0) / &2` THEN ASM_REWRITE_TAC[REAL_LT_HALF2] THEN
1468       ASM_REWRITE_TAC[REAL_SUB_LT];
1469       GEN_REWRITE_TAC I [TAUT `a = ~ ~a`] THEN
1470       PURE_REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN
1471       MP_TAC(AC REAL_ADD_AC
1472        `(y0 + --x0) + (x0 + --y) = (--x0 + x0) + (y0 + --y)`) THEN
1473       REWRITE_TAC[GSYM real_sub; REAL_ADD_LINV; REAL_ADD_LID] THEN
1474       DISCH_TAC THEN
1475       MP_TAC(SPECL [`y0 - x0`; `x0 - y`] REAL_LE_ADDR) THEN
1476       ASM_REWRITE_TAC[REAL_SUB_LE] THEN DISCH_TAC THEN
1477       SUBGOAL_THEN `~(y0 <= y)` ASSUME_TAC THENL
1478        [REWRITE_TAC[REAL_NOT_LE] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
1479         MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `y0 - x0` THEN
1480         ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[REAL_SUB_LT]; ALL_TAC] THEN
1481       UNDISCH_TAC `abs(y - y0) < (y0 - x0) / &2` THEN
1482       ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN
1483       REWRITE_TAC[REAL_NEG_SUB] THEN DISCH_TAC THEN
1484       SUBGOAL_THEN `(y0 - x0) < (y0 - x0) / &2` MP_TAC THENL
1485        [MATCH_MP_TAC REAL_LET_TRANS THEN
1486         EXISTS_TAC `y0 - y` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
1487       REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
1488       REWRITE_TAC[REAL_LT_HALF2] THEN ASM_REWRITE_TAC[REAL_SUB_LT]];
1489     ALL_TAC] THEN
1490   GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN
1491   PURE_REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN
1492   SUBGOAL_THEN `abs(x0 - y) < (y0 - x0) / &2` ASSUME_TAC THENL
1493    [REWRITE_TAC[real_abs; REAL_SUB_LE] THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LT] THEN
1494     REWRITE_TAC[REAL_NEG_SUB] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
1495     EXISTS_TAC `x - x0` THEN REWRITE_TAC[real_sub; REAL_LE_RADD] THEN
1496     ASM_REWRITE_TAC[GSYM real_sub] THEN
1497     MATCH_MP_TAC REAL_LET_TRANS THEN
1498     EXISTS_TAC `abs(x - x0)` THEN ASM_REWRITE_TAC[ABS_LE]; ALL_TAC] THEN
1499   SUBGOAL_THEN `abs(y0 - x0) < ((y0 - x0) / &2) + ((y0 - x0) / &2)`
1500   MP_TAC THENL
1501    [ALL_TAC;
1502     REWRITE_TAC[REAL_HALF_DOUBLE; REAL_NOT_LT; ABS_LE]] THEN
1503   MATCH_MP_TAC REAL_LET_TRANS THEN
1504   EXISTS_TAC `abs(y0 - y) + abs(y - x0)` THEN CONJ_TAC THENL
1505    [ALL_TAC;
1506     MATCH_MP_TAC REAL_LT_ADD2 THEN ONCE_REWRITE_TAC[ABS_SUB] THEN
1507     ASM_REWRITE_TAC[]] THEN
1508   SUBGOAL_THEN `y0 - x0 = (y0 - y) + (y - x0)` SUBST1_TAC THEN
1509   REWRITE_TAC[ABS_TRIANGLE] THEN
1510   REWRITE_TAC[real_sub] THEN
1511   ONCE_REWRITE_TAC[AC REAL_ADD_AC
1512     `(a + b) + (c + d) = (b + c) + (a + d)`] THEN
1513   REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]);;
1514
1515 let ABS_BOUNDS = prove(
1516   `!x k. abs(x) <= k <=> --k <= x /\ x <= k`,
1517   REPEAT GEN_TAC THEN
1518   GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM REAL_LE_NEG] THEN
1519   REWRITE_TAC[REAL_NEGNEG] THEN REWRITE_TAC[real_abs] THEN
1520   COND_CASES_TAC THENL
1521    [REWRITE_TAC[TAUT `(a <=> b /\ a) <=> a ==> b`] THEN
1522     DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
1523     EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[REAL_LE_NEGL];
1524     REWRITE_TAC[TAUT `(a <=> a /\ b) <=> a ==> b`] THEN
1525     DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
1526     EXISTS_TAC `--x` THEN ASM_REWRITE_TAC[] THEN
1527     REWRITE_TAC[REAL_LE_NEGR] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
1528     ASM_REWRITE_TAC[GSYM REAL_NOT_LE]]);;
1529
1530 (*----------------------------------------------------------------------------*)
1531 (* Define integer powers                                                      *)
1532 (*----------------------------------------------------------------------------*)
1533
1534 let pow = real_pow;;
1535
1536 let POW_0 = prove(
1537   `!n. &0 pow (SUC n) = &0`,
1538   INDUCT_TAC THEN REWRITE_TAC[pow; REAL_MUL_LZERO]);;
1539
1540 let POW_NZ = prove(
1541   `!c n. ~(c = &0) ==> ~(c pow n = &0)`,
1542   REPEAT GEN_TAC THEN DISCH_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN
1543   INDUCT_TAC THEN ASM_REWRITE_TAC[pow; REAL_10; REAL_ENTIRE]);;
1544
1545 let POW_INV = prove(
1546   `!c n. ~(c = &0) ==> (inv(c pow n) = (inv c) pow n)`,
1547   GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
1548   DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[pow; REAL_INV1] THEN
1549   MP_TAC(SPECL [`c:real`; `c pow n`] REAL_INV_MUL_WEAK) THEN
1550   ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `~(c pow n = &0)` ASSUME_TAC THENL
1551    [MATCH_MP_TAC POW_NZ THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
1552   ASM_REWRITE_TAC[]);;
1553
1554 let POW_ABS = prove(
1555   `!c n. abs(c) pow n = abs(c pow n)`,
1556   GEN_TAC THEN INDUCT_TAC THEN
1557   ASM_REWRITE_TAC[pow; ABS_1; ABS_MUL]);;
1558
1559 let POW_PLUS1 = prove(
1560   `!e n. &0 < e ==> (&1 + (&n * e)) <= (&1 + e) pow n`,
1561   GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
1562   DISCH_TAC THEN INDUCT_TAC THEN
1563   REWRITE_TAC[pow; REAL_MUL_LZERO; REAL_ADD_RID; REAL_LE_REFL] THEN
1564   MATCH_MP_TAC REAL_LE_TRANS THEN
1565   EXISTS_TAC `(&1 + e) * (&1 + (&n * e))` THEN CONJ_TAC THENL
1566    [REWRITE_TAC[REAL_RDISTRIB; REAL; REAL_MUL_LID] THEN
1567     REWRITE_TAC[REAL_LDISTRIB;REAL_MUL_RID; REAL_ADD_ASSOC; REAL_LE_ADDR] THEN
1568     ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
1569     REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
1570     MATCH_MP_TAC REAL_LE_MUL THEN
1571     REWRITE_TAC[REAL_LE_SQUARE; REAL_LE; LE_0];
1572     SUBGOAL_THEN `&0 < (&1 + e)`
1573       (fun th -> ASM_REWRITE_TAC[MATCH_MP REAL_LE_LMUL_LOCAL th]) THEN
1574     GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_LID] THEN
1575     MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_REWRITE_TAC[] THEN
1576     REWRITE_TAC[REAL_LT] THEN REWRITE_TAC[num_CONV `1`; LT_0]]);;
1577
1578 let POW_ADD = prove(
1579   `!c m n. c pow (m + n) = (c pow m) * (c pow n)`,
1580   GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
1581   ASM_REWRITE_TAC[pow; ADD_CLAUSES; REAL_MUL_RID] THEN
1582   REWRITE_TAC[REAL_MUL_AC]);;
1583
1584 let POW_1 = prove(
1585   `!x. x pow 1 = x`,
1586   GEN_TAC THEN REWRITE_TAC[num_CONV `1`] THEN
1587   REWRITE_TAC[pow; REAL_MUL_RID]);;
1588
1589 let POW_2 = prove(
1590   `!x. x pow 2 = x * x`,
1591   GEN_TAC THEN REWRITE_TAC[num_CONV `2`] THEN
1592   REWRITE_TAC[pow; POW_1]);;
1593
1594 let POW_POS = prove(
1595   `!x n. &0 <= x ==> &0 <= (x pow n)`,
1596   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
1597   GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN
1598   REWRITE_TAC[pow; REAL_LE_01] THEN
1599   MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]);;
1600
1601 let POW_LE = prove(
1602   `!n x y. &0 <= x /\ x <= y ==> (x pow n) <= (y pow n)`,
1603   INDUCT_TAC THEN REWRITE_TAC[pow; REAL_LE_REFL] THEN
1604   REPEAT GEN_TAC THEN STRIP_TAC THEN
1605   MATCH_MP_TAC REAL_LE_MUL2V THEN ASM_REWRITE_TAC[] THEN
1606   ASM_MESON_TAC[POW_POS]);;
1607
1608 let POW_M1 = prove(
1609   `!n. abs((--(&1)) pow n) = &1`,
1610   INDUCT_TAC THEN REWRITE_TAC[pow; ABS_NEG; ABS_1] THEN
1611   ASM_REWRITE_TAC[ABS_MUL; ABS_NEG; ABS_1; REAL_MUL_LID]);;
1612
1613 let POW_MUL = prove(
1614   `!n x y. (x * y) pow n = (x pow n) * (y pow n)`,
1615   INDUCT_TAC THEN REWRITE_TAC[pow; REAL_MUL_LID] THEN
1616   REPEAT GEN_TAC THEN ASM_REWRITE_TAC[] THEN
1617   REWRITE_TAC[REAL_MUL_AC]);;
1618
1619 let REAL_LE_SQUARE_POW = prove(
1620   `!x. &0 <= x pow 2`,
1621   GEN_TAC THEN REWRITE_TAC[POW_2; REAL_LE_SQUARE]);;
1622
1623 let ABS_POW2 = prove(
1624   `!x. abs(x pow 2) = x pow 2`,
1625   GEN_TAC THEN REWRITE_TAC[ABS_REFL; REAL_LE_SQUARE_POW]);;
1626
1627 let REAL_LE1_POW2 = prove(
1628   `!x. &1 <= x ==> &1 <= (x pow 2)`,
1629   GEN_TAC THEN REWRITE_TAC[POW_2] THEN DISCH_TAC THEN
1630   GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN
1631   MATCH_MP_TAC REAL_LE_MUL2V THEN ASM_REWRITE_TAC[REAL_LE_01]);;
1632
1633 let REAL_LT1_POW2 = prove(
1634   `!x. &1 < x ==> &1 < (x pow 2)`,
1635   GEN_TAC THEN REWRITE_TAC[POW_2] THEN DISCH_TAC THEN
1636   GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN
1637   MATCH_MP_TAC REAL_LT_MUL2_ALT THEN ASM_REWRITE_TAC[REAL_LE_01]);;
1638
1639 let POW_POS_LT = prove(
1640   `!x n. &0 < x ==> &0 < (x pow (SUC n))`,
1641   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN
1642   DISCH_TAC THEN CONJ_TAC THENL
1643    [MATCH_MP_TAC POW_POS THEN ASM_REWRITE_TAC[];
1644     CONV_TAC(RAND_CONV SYM_CONV) THEN
1645     MATCH_MP_TAC POW_NZ THEN
1646     CONV_TAC(RAND_CONV SYM_CONV) THEN ASM_REWRITE_TAC[]]);;
1647
1648 let POW_2_LE1 = prove(
1649   `!n. &1 <= &2 pow n`,
1650   INDUCT_TAC THEN REWRITE_TAC[pow; REAL_LE_REFL] THEN
1651   GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN
1652   MATCH_MP_TAC REAL_LE_MUL2V THEN ASM_REWRITE_TAC[REAL_LE] THEN
1653   REWRITE_TAC[LE_0; num_CONV `2`; LESS_EQ_SUC_REFL]);;
1654
1655 let POW_2_LT = prove(
1656   `!n. &n < &2 pow n`,
1657   INDUCT_TAC THEN REWRITE_TAC[pow; REAL_LT_01] THEN
1658   REWRITE_TAC[ADD1; GSYM REAL_ADD; GSYM REAL_DOUBLE] THEN
1659   MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_REWRITE_TAC[POW_2_LE1]);;
1660
1661 let POW_MINUS1 = prove(
1662   `!n. (--(&1)) pow (2 * n) = &1`,
1663   INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES; pow] THEN
1664   REWRITE_TAC[num_CONV `2`; num_CONV `1`; ADD_CLAUSES] THEN
1665   REWRITE_TAC[pow] THEN
1666   REWRITE_TAC[SYM(num_CONV `2`); SYM(num_CONV `1`)] THEN
1667   ASM_REWRITE_TAC[] THEN
1668   REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN
1669   REWRITE_TAC[REAL_MUL_LID; REAL_NEGNEG]);;
1670
1671 (*----------------------------------------------------------------------------*)
1672 (* Derive the supremum property for an arbitrary bounded nonempty set         *)
1673 (*----------------------------------------------------------------------------*)
1674
1675 let REAL_SUP_EXISTS = prove(
1676   `!P. (?x. P x) /\ (?z. !x. P x ==> x < z) ==>
1677      (?s. !y. (?x. P x /\ y < x) <=> y < s)`,
1678   GEN_TAC THEN MP_TAC(SPEC `P:real->bool` REAL_COMPLETE) THEN
1679   MESON_TAC[REAL_LT_IMP_LE; REAL_LTE_TRANS; REAL_NOT_LT]);;
1680
1681 let sup_def = new_definition
1682  `sup s = @a. (!x. x IN s ==> x <= a) /\
1683               (!b. (!x. x IN s ==> x <= b) ==> a <= b)`;;
1684
1685 let sup = prove
1686  (`sup P = @s. !y. (?x. P x /\ y < x) <=> y < s`,
1687   REWRITE_TAC[sup_def; IN] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN
1688   ASM_MESON_TAC[REAL_LTE_TRANS; REAL_NOT_LT; REAL_LE_REFL]);;
1689
1690 let REAL_SUP = prove(
1691   `!P. (?x. P x) /\ (?z. !x. P x ==> x < z) ==>
1692           (!y. (?x. P x /\ y < x) <=> y < sup P)`,
1693   GEN_TAC THEN DISCH_THEN(MP_TAC o SELECT_RULE o MATCH_MP REAL_SUP_EXISTS)
1694   THEN REWRITE_TAC[GSYM sup]);;
1695
1696 let REAL_SUP_UBOUND = prove(
1697   `!P. (?x. P x) /\ (?z. !x. P x ==> x < z) ==>
1698           (!y. P y ==> y <= sup P)`,
1699   GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `sup P` o MATCH_MP REAL_SUP) THEN
1700   REWRITE_TAC[REAL_LT_REFL] THEN
1701   DISCH_THEN(ASSUME_TAC o CONV_RULE NOT_EXISTS_CONV) THEN
1702   X_GEN_TAC `x:real` THEN RULE_ASSUM_TAC(SPEC `x:real`) THEN
1703   DISCH_THEN (SUBST_ALL_TAC o EQT_INTRO) THEN POP_ASSUM MP_TAC THEN
1704   REWRITE_TAC[REAL_NOT_LT]);;
1705
1706 let SETOK_LE_LT = prove(
1707   `!P. (?x. P x) /\ (?z. !x. P x ==> x <= z) <=>
1708        (?x. P x) /\ (?z. !x. P x ==> x < z)`,
1709   GEN_TAC THEN AP_TERM_TAC THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `z:real`)
1710   THENL (map EXISTS_TAC [`z + &1`; `z:real`]) THEN GEN_TAC THEN
1711   DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
1712   REWRITE_TAC[REAL_LT_ADD1; REAL_LT_IMP_LE]);;
1713
1714 let REAL_SUP_LE = prove(
1715   `!P. (?x. P x) /\ (?z. !x. P x ==> x <= z) ==>
1716            (!y. (?x. P x /\ y < x) <=> y < sup P)`,
1717   GEN_TAC THEN REWRITE_TAC[SETOK_LE_LT; REAL_SUP]);;
1718
1719 let REAL_SUP_UBOUND_LE = prove(
1720   `!P. (?x. P x) /\ (?z. !x. P x ==> x <= z) ==>
1721           (!y. P y ==> y <= sup P)`,
1722   GEN_TAC THEN REWRITE_TAC[SETOK_LE_LT; REAL_SUP_UBOUND]);;
1723
1724 (*----------------------------------------------------------------------------*)
1725 (* Prove the Archimedean property                                             *)
1726 (*----------------------------------------------------------------------------*)
1727
1728 let REAL_ARCH_SIMPLE = prove
1729  (`!x. ?n. x <= &n`,
1730   let lemma = prove(`(!x. (?n. x = &n) ==> P x) <=> !n. P(&n)`,MESON_TAC[]) in
1731   MP_TAC(SPEC `\y. ?n. y = &n` REAL_COMPLETE) THEN REWRITE_TAC[lemma] THEN
1732   MESON_TAC[REAL_LE_SUB_LADD; REAL_OF_NUM_ADD; REAL_LE_TOTAL;
1733             REAL_ARITH `~(M <= M - &1)`]);;
1734
1735 let REAL_ARCH = prove(
1736   `!x. &0 < x ==> !y. ?n. y < &n * x`,
1737   GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN
1738   ONCE_REWRITE_TAC[TAUT `a <=> ~(~a)`] THEN
1739   CONV_TAC(ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN
1740   REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN
1741   MP_TAC(SPEC `\z. ?n. z = &n * x` REAL_SUP_LE) THEN BETA_TAC THEN
1742   W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o
1743        funpow 2 (fst o dest_imp) o snd)
1744   THENL [CONJ_TAC THENL
1745    [MAP_EVERY EXISTS_TAC [`&n * x`; `n:num`] THEN REFL_TAC;
1746     EXISTS_TAC `y:real` THEN GEN_TAC THEN
1747     DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN
1748   DISCH_TAC THEN
1749   FIRST_ASSUM(MP_TAC o SPEC `sup(\z. ?n. z = &n * x) - x`) THEN
1750   REWRITE_TAC[REAL_LT_SUB_RADD; REAL_LT_ADDR] THEN ASM_REWRITE_TAC[] THEN
1751   DISCH_THEN(X_CHOOSE_THEN `z:real` MP_TAC) THEN
1752   DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `n:num`) MP_TAC) THEN
1753   ASM_REWRITE_TAC[] THEN
1754   GEN_REWRITE_TAC (funpow 3 RAND_CONV) [GSYM REAL_MUL_LID] THEN
1755   REWRITE_TAC[GSYM REAL_RDISTRIB] THEN DISCH_TAC THEN
1756   FIRST_ASSUM(MP_TAC o SPEC `sup(\z. ?n. z = &n * x)`) THEN
1757   REWRITE_TAC[REAL_LT_REFL] THEN EXISTS_TAC `(&n + &1) * x` THEN
1758   ASM_REWRITE_TAC[] THEN EXISTS_TAC `n + 1` THEN
1759   REWRITE_TAC[REAL_ADD]);;
1760
1761 let REAL_ARCH_LEAST = prove(
1762   `!y. &0 < y ==> !x. &0 <= x ==>
1763                         ?n. (&n * y) <= x /\ x < (&(SUC n) * y)`,
1764   GEN_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP REAL_ARCH) THEN
1765   GEN_TAC THEN POP_ASSUM(ASSUME_TAC o SPEC `x:real`) THEN
1766   POP_ASSUM(X_CHOOSE_THEN `n:num` MP_TAC o
1767         ONCE_REWRITE_RULE[num_WOP]) THEN
1768   REWRITE_TAC[REAL_NOT_LT] THEN
1769   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o SPEC `PRE n`)) THEN
1770   DISCH_TAC THEN EXISTS_TAC `PRE n` THEN
1771   SUBGOAL_THEN `SUC(PRE n) = n` ASSUME_TAC THENL
1772    [DISJ_CASES_THEN2 SUBST_ALL_TAC (CHOOSE_THEN SUBST_ALL_TAC)
1773         (SPEC `n:num` num_CASES) THENL
1774      [UNDISCH_TAC `x < &0 * y` THEN
1775       ASM_REWRITE_TAC[REAL_MUL_LZERO; GSYM REAL_NOT_LE];
1776       REWRITE_TAC[PRE]];
1777     ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN
1778     FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[PRE; LESS_SUC_REFL]]);;
1779
1780 let REAL_POW_LBOUND = prove
1781  (`!x n. &0 <= x ==> &1 + &n * x <= (&1 + x) pow n`,
1782   GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN
1783   INDUCT_TAC THEN
1784   REWRITE_TAC[real_pow; REAL_MUL_LZERO; REAL_ADD_RID; REAL_LE_REFL] THEN
1785   REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN
1786   MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&1 + x) * (&1 + &n * x)` THEN
1787   ASM_SIMP_TAC[REAL_LE_LMUL; REAL_ARITH `&0 <= x ==> &0 <= &1 + x`] THEN
1788   ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_ARITH
1789    `&1 + (n + &1) * x <= (&1 + x) * (&1 + n * x) <=> &0 <= n * x * x`]);;
1790
1791 let REAL_ARCH_POW = prove
1792  (`!x y. &1 < x ==> ?n. y < x pow n`,
1793   REPEAT STRIP_TAC THEN
1794   MP_TAC(SPEC `x - &1` REAL_ARCH) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN
1795   DISCH_THEN(MP_TAC o SPEC `y:real`) THEN MATCH_MP_TAC MONO_EXISTS THEN
1796   X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN
1797   EXISTS_TAC `&1 + &n * (x - &1)` THEN
1798   ASM_SIMP_TAC[REAL_ARITH `x < y ==> x < &1 + y`] THEN
1799   ASM_MESON_TAC[REAL_POW_LBOUND; REAL_SUB_ADD2; REAL_ARITH
1800     `&1 < x ==> &0 <= x - &1`]);;
1801
1802 let REAL_ARCH_POW2 = prove
1803  (`!x. ?n. x < &2 pow n`,
1804   SIMP_TAC[REAL_ARCH_POW; REAL_OF_NUM_LT; ARITH]);;
1805
1806 (* ========================================================================= *)
1807 (* Finite sums. NB: sum(m,n) f = f(m) + f(m+1) + ... + f(m+n-1)              *)
1808 (* ========================================================================= *)
1809
1810 prioritize_real();;
1811
1812 make_overloadable "sum" `:A->(B->real)->real`;;
1813
1814 overload_interface("sum",`sum:(A->bool)->(A->real)->real`);;
1815 overload_interface("sum",`psum:(num#num)->(num->real)->real`);;
1816
1817 let sum_EXISTS = prove
1818  (`?sum. (!f n. sum(n,0) f = &0) /\
1819          (!f m n. sum(n,SUC m) f = sum(n,m) f + f(n + m))`,
1820   (CHOOSE_TAC o prove_recursive_functions_exist num_RECURSION)
1821     `(!f n. sm n 0 f = &0) /\
1822      (!f m n. sm  n (SUC m) f = sm n m f + f(n + m))` THEN
1823   EXISTS_TAC `\(n,m) f. (sm:num->num->(num->real)->real) n m f` THEN
1824   CONV_TAC(DEPTH_CONV GEN_BETA_CONV) THEN ASM_REWRITE_TAC[]);;
1825
1826 let sum_DEF = new_specification ["psum"] sum_EXISTS;;
1827
1828 let sum = prove
1829  (`(sum(n,0) f = &0) /\
1830    (sum(n,SUC m) f = sum(n,m) f + f(n + m))`,
1831   REWRITE_TAC[sum_DEF]);;
1832
1833 (* ------------------------------------------------------------------------- *)
1834 (* Relation to the standard notion.                                          *)
1835 (* ------------------------------------------------------------------------- *)
1836
1837 let PSUM_SUM = prove
1838  (`!f m n. sum(m,n) f = sum {i | m <= i /\ i < m + n} f`,
1839   GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[sum] THENL
1840    [SUBGOAL_THEN `{i | m <= i /\ i < m + 0} = {}`
1841      (fun th -> SIMP_TAC[th; SUM_CLAUSES]) THEN
1842     REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN ARITH_TAC;
1843     ALL_TAC] THEN
1844   SUBGOAL_THEN
1845     `FINITE {i | m <= i /\ i < m + n} /\
1846      {i | m <= i /\ i < m + SUC n} =
1847                 (m + n) INSERT {i | m <= i /\ i < m + n}`
1848     (fun th -> ASM_SIMP_TAC[th; SUM_CLAUSES; IN_ELIM_THM;
1849                             LT_REFL; REAL_ADD_AC]) THEN
1850   CONJ_TAC THENL
1851    [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `m..m+n` THEN
1852     REWRITE_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; IN_ELIM_THM];
1853     REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT]] THEN
1854   ARITH_TAC);;
1855
1856 let PSUM_SUM_NUMSEG = prove
1857  (`!f m n. ~(m = 0 /\ n = 0) ==> sum(m,n) f = sum(m..(m+n)-1) f`,
1858   REPEAT STRIP_TAC THEN REWRITE_TAC[PSUM_SUM] THEN
1859   AP_THM_TAC THEN AP_TERM_TAC THEN
1860   REWRITE_TAC[EXTENSION; IN_NUMSEG; IN_ELIM_THM] THEN
1861   POP_ASSUM MP_TAC THEN ARITH_TAC);;
1862
1863 (* ------------------------------------------------------------------------- *)
1864 (* Stuff about sums.                                                         *)
1865 (* ------------------------------------------------------------------------- *)
1866
1867 let SUM_TWO = prove
1868  (`!f n p. sum(0,n) f + sum(n,p) f = sum(0,n + p) f`,
1869   GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
1870   REWRITE_TAC[sum; REAL_ADD_RID; ADD_CLAUSES] THEN
1871   ASM_REWRITE_TAC[REAL_ADD_ASSOC]);;
1872
1873 let SUM_DIFF = prove
1874  (`!f m n. sum(m,n) f = sum(0,m + n) f - sum(0,m) f`,
1875   REPEAT GEN_TAC THEN REWRITE_TAC[REAL_EQ_SUB_LADD] THEN
1876   ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_ACCEPT_TAC SUM_TWO);;
1877
1878 let ABS_SUM = prove
1879  (`!f m n. abs(sum(m,n) f) <= sum(m,n) (\n. abs(f n))`,
1880   GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
1881   REWRITE_TAC[sum; REAL_ABS_0; REAL_LE_REFL] THEN BETA_TAC THEN
1882   MATCH_MP_TAC REAL_LE_TRANS THEN
1883   EXISTS_TAC `abs(sum(m,n) f) + abs(f(m + n))` THEN
1884   ASM_REWRITE_TAC[REAL_ABS_TRIANGLE; REAL_LE_RADD]);;
1885
1886 let SUM_LE = prove
1887  (`!f g m n. (!r. m <= r /\ r < n + m ==> f(r) <= g(r))
1888         ==> (sum(m,n) f <= sum(m,n) g)`,
1889   EVERY(replicate GEN_TAC 3) THEN
1890   INDUCT_TAC THEN REWRITE_TAC[sum; REAL_LE_REFL] THEN
1891   DISCH_TAC THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN
1892   FIRST_ASSUM MATCH_MP_TAC THENL
1893    [GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
1894     ASM_REWRITE_TAC[ADD_CLAUSES] THEN
1895     MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `(n:num) + m`;
1896     GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [ADD_SYM]] THEN
1897   ASM_REWRITE_TAC[ADD_CLAUSES; LE_ADD; LT]);;
1898
1899 let SUM_EQ = prove
1900  (`!f g m n. (!r. m <= r /\ r < (n + m) ==> (f(r) = g(r)))
1901         ==> (sum(m,n) f = sum(m,n) g)`,
1902   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
1903   CONJ_TAC THEN MATCH_MP_TAC SUM_LE THEN GEN_TAC THEN
1904   DISCH_THEN(fun th -> MATCH_MP_TAC REAL_EQ_IMP_LE THEN
1905     FIRST_ASSUM(SUBST1_TAC o C MATCH_MP th)) THEN REFL_TAC);;
1906
1907 let SUM_POS = prove
1908  (`!f. (!n. &0 <= f(n)) ==> !m n. &0 <= sum(m,n) f`,
1909   GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
1910   REWRITE_TAC[sum; REAL_LE_REFL] THEN
1911   MATCH_MP_TAC REAL_LE_ADD THEN ASM_REWRITE_TAC[]);;
1912
1913 let SUM_POS_GEN = prove
1914  (`!f m n.
1915      (!n. m <= n ==> &0 <= f(n))
1916      ==> &0 <= sum(m,n) f`,
1917   REPEAT STRIP_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN
1918   REWRITE_TAC[sum; REAL_LE_REFL] THEN
1919   MATCH_MP_TAC REAL_LE_ADD THEN
1920   ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN
1921   MATCH_ACCEPT_TAC LE_ADD);;
1922
1923 let SUM_ABS = prove
1924  (`!f m n. abs(sum(m,n) (\m. abs(f m))) = sum(m,n) (\m. abs(f m))`,
1925   GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[REAL_ABS_REFL] THEN
1926   SPEC_TAC(`m:num`,`m:num`) THEN MATCH_MP_TAC SUM_POS THEN BETA_TAC THEN
1927   REWRITE_TAC[REAL_ABS_POS]);;
1928
1929 let SUM_ABS_LE = prove
1930  (`!f m n. abs(sum(m,n) f) <= sum(m,n)(\n. abs(f n))`,
1931   GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
1932   REWRITE_TAC[sum; REAL_ABS_0; REAL_LE_REFL] THEN
1933   MATCH_MP_TAC REAL_LE_TRANS THEN
1934   EXISTS_TAC `abs(sum(m,n) f) + abs(f(m + n))` THEN
1935   REWRITE_TAC[REAL_ABS_TRIANGLE] THEN BETA_TAC THEN
1936   ASM_REWRITE_TAC[REAL_LE_RADD]);;
1937
1938 let SUM_ZERO = prove
1939  (`!f N. (!n. n >= N ==> (f(n) = &0)) ==>
1940          (!m n. m >= N ==> (sum(m,n) f = &0))`,
1941   REPEAT GEN_TAC THEN DISCH_TAC THEN
1942   MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN REWRITE_TAC[GE] THEN
1943   DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN
1944   SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[sum] THEN
1945   ASM_REWRITE_TAC[REAL_ADD_LID] THEN FIRST_ASSUM MATCH_MP_TAC THEN
1946   REWRITE_TAC[GE; GSYM ADD_ASSOC; LE_ADD]);;
1947
1948 let SUM_ADD = prove
1949  (`!f g m n. sum(m,n) (\n. f(n) + g(n)) = sum(m,n) f + sum(m,n) g`,
1950   EVERY(replicate GEN_TAC 3) THEN INDUCT_TAC THEN
1951   ASM_REWRITE_TAC[sum; REAL_ADD_LID; REAL_ADD_AC]);;
1952
1953 let SUM_CMUL = prove
1954  (`!f c m n. sum(m,n) (\n. c * f(n)) = c * sum(m,n) f`,
1955   EVERY(replicate GEN_TAC 3) THEN INDUCT_TAC THEN
1956   ASM_REWRITE_TAC[sum; REAL_MUL_RZERO] THEN BETA_TAC THEN
1957   REWRITE_TAC[REAL_ADD_LDISTRIB]);;
1958
1959 let SUM_NEG = prove
1960  (`!f n d. sum(n,d) (\n. --(f n)) = --(sum(n,d) f)`,
1961   GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
1962   ASM_REWRITE_TAC[sum; REAL_NEG_0] THEN
1963   BETA_TAC THEN REWRITE_TAC[REAL_NEG_ADD]);;
1964
1965 let SUM_SUB = prove
1966  (`!f g m n. sum(m,n)(\n. (f n) - (g n)) = sum(m,n) f - sum(m,n) g`,
1967   REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; GSYM SUM_NEG; GSYM SUM_ADD]);;
1968
1969 let SUM_SUBST = prove
1970  (`!f g m n. (!p. m <= p /\ p < (m + n) ==> (f p = g p))
1971         ==> (sum(m,n) f = sum(m,n) g)`,
1972   EVERY (replicate GEN_TAC 3) THEN INDUCT_TAC THEN REWRITE_TAC[sum] THEN
1973   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN BINOP_TAC THEN
1974   FIRST_ASSUM MATCH_MP_TAC THENL
1975    [GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
1976     ASM_REWRITE_TAC[ADD_CLAUSES; LT_SUC_LE] THEN
1977     MATCH_MP_TAC LT_IMP_LE THEN ASM_REWRITE_TAC[];
1978     REWRITE_TAC[LE_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
1979     REWRITE_TAC[LT_SUC_LE; LE_REFL; ADD_CLAUSES]]);;
1980
1981 let SUM_NSUB = prove
1982  (`!n f c. sum(0,n) f - (&n * c) = sum(0,n)(\p. f(p) - c)`,
1983   INDUCT_TAC THEN REWRITE_TAC[sum; REAL_MUL_LZERO; REAL_SUB_REFL] THEN
1984   REWRITE_TAC[ADD_CLAUSES; GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB] THEN
1985   REPEAT GEN_TAC THEN POP_ASSUM(fun th -> REWRITE_TAC[GSYM th]) THEN
1986   REWRITE_TAC[real_sub; REAL_NEG_ADD; REAL_MUL_LID; REAL_ADD_AC]);;
1987
1988 let SUM_BOUND = prove
1989  (`!f K m n. (!p. m <= p /\ p < (m + n) ==> (f(p) <= K))
1990         ==> (sum(m,n) f <= (&n * K))`,
1991   EVERY (replicate GEN_TAC 3) THEN INDUCT_TAC THEN
1992   REWRITE_TAC[sum; REAL_MUL_LZERO; REAL_LE_REFL] THEN
1993   DISCH_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB] THEN
1994   MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL
1995    [FIRST_ASSUM MATCH_MP_TAC THEN GEN_TAC THEN DISCH_TAC THEN
1996     FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
1997     REWRITE_TAC[ADD_CLAUSES; LT_SUC_LE; LE_REFL] THEN
1998     MATCH_MP_TAC LT_IMP_LE THEN ASM_REWRITE_TAC[];
1999     REWRITE_TAC[REAL_MUL_LID] THEN FIRST_ASSUM MATCH_MP_TAC THEN
2000     REWRITE_TAC[ADD_CLAUSES; LE_ADD; LT_SUC_LE; LE_REFL]]);;
2001
2002 let SUM_GROUP = prove
2003  (`!n k f. sum(0,n)(\m. sum(m * k,k) f) = sum(0,n * k) f`,
2004   INDUCT_TAC THEN REWRITE_TAC[sum; MULT_CLAUSES] THEN
2005   REPEAT GEN_TAC THEN BETA_TAC THEN ASM_REWRITE_TAC[] THEN
2006   REWRITE_TAC[ADD_CLAUSES; SUM_TWO]);;
2007
2008 let SUM_1 = prove
2009  (`!f n. sum(n,1) f = f(n)`,
2010   REPEAT GEN_TAC THEN
2011   REWRITE_TAC[num_CONV `1`; sum; ADD_CLAUSES; REAL_ADD_LID]);;
2012
2013 let SUM_2 = prove
2014  (`!f n. sum(n,2) f = f(n) + f(n + 1)`,
2015   REPEAT GEN_TAC THEN CONV_TAC(REDEPTH_CONV num_CONV) THEN
2016   REWRITE_TAC[sum; ADD_CLAUSES; REAL_ADD_LID]);;
2017
2018 let SUM_OFFSET = prove
2019  (`!f n k. sum(0,n)(\m. f(m + k)) = sum(0,n + k) f - sum(0,k) f`,
2020   REPEAT GEN_TAC THEN
2021   GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN
2022   REWRITE_TAC[GSYM SUM_TWO; REAL_ADD_SUB] THEN
2023   SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[sum] THEN
2024   BETA_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN AP_TERM_TAC THEN
2025   AP_TERM_TAC THEN MATCH_ACCEPT_TAC ADD_SYM);;
2026
2027 let SUM_REINDEX = prove
2028  (`!f m k n. sum(m + k,n) f = sum(m,n)(\r. f(r + k))`,
2029   EVERY(replicate GEN_TAC 3) THEN INDUCT_TAC THEN REWRITE_TAC[sum] THEN
2030   ASM_REWRITE_TAC[REAL_EQ_ADD_LCANCEL] THEN REWRITE_TAC[ADD_AC]);;
2031
2032 let SUM_0 = prove
2033  (`!m n. sum(m,n)(\r. &0) = &0`,
2034   GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[sum] THEN
2035   BETA_TAC THEN ASM_REWRITE_TAC[REAL_ADD_LID]);;
2036
2037 let SUM_CANCEL = prove
2038  (`!f n d. sum(n,d) (\n. f(SUC n) - f(n)) = f(n + d) - f(n)`,
2039   GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
2040   ASM_REWRITE_TAC[sum; ADD_CLAUSES; REAL_SUB_REFL] THEN
2041   BETA_TAC THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
2042   REWRITE_TAC[real_sub; REAL_NEG_ADD; REAL_ADD_ASSOC] THEN
2043   AP_THM_TAC THEN AP_TERM_TAC THEN
2044   REWRITE_TAC[GSYM REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_RID]);;
2045
2046 let SUM_HORNER = prove
2047  (`!f n x. sum(0,SUC n)(\i. f(i) * x pow i) =
2048            f(0) + x * sum(0,n)(\i. f(SUC i) * x pow i)`,
2049   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUM_CMUL] THEN
2050   ONCE_REWRITE_TAC[REAL_ARITH `a * b * c = b * (a * c)`] THEN
2051   REWRITE_TAC[GSYM real_pow] THEN
2052   MP_TAC(GEN `f:num->real`
2053    (SPECL [`f:num->real`; `n:num`; `1`] SUM_OFFSET)) THEN
2054   REWRITE_TAC[GSYM ADD1] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN
2055   REWRITE_TAC[SUM_1] THEN REWRITE_TAC[real_pow; REAL_MUL_RID] THEN
2056   ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[REAL_SUB_ADD]);;
2057
2058 let SUM_CONST = prove
2059  (`!c n. sum(0,n) (\m. c) = &n * c`,
2060   GEN_TAC THEN INDUCT_TAC THEN
2061   ASM_REWRITE_TAC[sum; GSYM REAL_OF_NUM_SUC; REAL_MUL_LZERO] THEN
2062   REWRITE_TAC[REAL_ADD_RDISTRIB; REAL_MUL_LID]);;
2063
2064 let SUM_SPLIT = prove
2065  (`!f n p. sum(m,n) f + sum(m + n,p) f = sum(m,n + p) f`,
2066   REPEAT GEN_TAC THEN
2067   GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [SUM_DIFF] THEN
2068   GEN_REWRITE_TAC RAND_CONV [SUM_DIFF] THEN
2069   REWRITE_TAC[ADD_ASSOC] THEN
2070   GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM SUM_TWO] THEN
2071   REAL_ARITH_TAC);;
2072
2073 let SUM_SWAP = prove
2074  (`!f m1 n1 m2 n2.
2075         sum(m1,n1) (\a. sum(m2,n2) (\b. f a b)) =
2076         sum(m2,n2) (\b. sum(m1,n1) (\a. f a b))`,
2077   GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN
2078   REWRITE_TAC[sum; SUM_0] THEN ASM_REWRITE_TAC[SUM_ADD]);;
2079
2080 let SUM_EQ_0 = prove
2081  (`(!r. m <= r /\ r < m + n ==> (f(r) = &0)) ==> (sum(m,n) f = &0)`,
2082   REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
2083   EXISTS_TAC `sum(m,n) (\r. &0)` THEN
2084   CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUM_0]] THEN
2085   MATCH_MP_TAC SUM_EQ THEN ASM_REWRITE_TAC[] THEN
2086   ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[]);;
2087
2088 let SUM_MORETERMS_EQ = prove
2089  (`!m n p.
2090       n <= p /\ (!r. m + n <= r /\ r < m + p ==> (f(r) = &0))
2091       ==> (sum(m,p) f = sum(m,n) f)`,
2092   REPEAT STRIP_TAC THEN
2093   FIRST_ASSUM(SUBST1_TAC o GSYM o MATCH_MP SUB_ADD) THEN
2094   ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM SUM_SPLIT] THEN
2095   SUBGOAL_THEN `sum (m + n,p - n) f = &0`
2096    (fun th -> REWRITE_TAC[REAL_ADD_RID; th]) THEN MATCH_MP_TAC SUM_EQ_0 THEN
2097   REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
2098   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LTE_TRANS THEN
2099   EXISTS_TAC `(m + n) + p - n:num` THEN ASM_REWRITE_TAC[] THEN
2100   REWRITE_TAC[GSYM ADD_ASSOC; LE_ADD_LCANCEL] THEN MATCH_MP_TAC EQ_IMP_LE THEN
2101   ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_SIMP_TAC[SUB_ADD]);;
2102
2103 let SUM_DIFFERENCES_EQ = prove
2104  (`!m n p.
2105       n <= p /\ (!r. m + n <= r /\ r < m + p ==> (f(r) = g(r)))
2106       ==> (sum(m,p) f - sum(m,n) f = sum(m,p) g - sum(m,n) g)`,
2107   ONCE_REWRITE_TAC[REAL_ARITH `(a - b = c - d) <=> (a - c = b - d)`] THEN
2108   SIMP_TAC[GSYM SUM_SUB; SUM_MORETERMS_EQ; REAL_SUB_0]);;
2109
2110 (* ------------------------------------------------------------------------- *)
2111 (* A conversion to evaluate summations (not clear it belongs here...)        *)
2112 (* ------------------------------------------------------------------------- *)
2113
2114 let REAL_SUM_CONV =
2115   let sum_tm = `sum` in
2116   let pth = prove
2117    (`sum(0,1) f = f 0`,
2118     REWRITE_TAC[num_CONV `1`; sum; REAL_ADD_LID; ADD_CLAUSES]) in
2119   let conv0 = GEN_REWRITE_CONV I [CONJUNCT1 sum; pth]
2120   and conv1 = REWR_CONV(CONJUNCT2 sum) in
2121   let rec sum_conv tm =
2122     try conv0 tm
2123     with Failure _ ->
2124       (LAND_CONV(RAND_CONV num_CONV) THENC
2125        conv1 THENC LAND_CONV sum_conv) tm in
2126   fun tm ->
2127     let sn,bod = dest_comb tm in
2128     let s,ntm = dest_comb sn in
2129     let _,htm = dest_pair ntm in
2130     if s = sum_tm & is_numeral htm
2131     then sum_conv tm
2132     else failwith "REAL_SUM_CONV";;
2133
2134 let REAL_HORNER_SUM_CONV =
2135   let sum_tm = `sum` in
2136   let pth = prove
2137    (`sum(0,1) f = f 0`,
2138     REWRITE_TAC[num_CONV `1`; sum; REAL_ADD_LID; ADD_CLAUSES]) in
2139   let conv0 = GEN_REWRITE_CONV I [CONJUNCT1 sum; pth]
2140   and conv1 = REWR_CONV SUM_HORNER in
2141   let rec sum_conv tm =
2142     try conv0 tm
2143     with Failure _ ->
2144       (LAND_CONV(RAND_CONV num_CONV) THENC
2145        conv1 THENC RAND_CONV (RAND_CONV sum_conv)) tm in
2146   fun tm ->
2147     let sn,bod = dest_comb tm in
2148     let s,ntm = dest_comb sn in
2149     let _,htm = dest_pair ntm in
2150     if s = sum_tm & is_numeral htm
2151     then sum_conv tm
2152     else failwith "REAL_HORNER_SUM_CONV";;
2153
2154 (*============================================================================*)
2155 (* Topologies and metric spaces, including metric on real line                *)
2156 (*============================================================================*)
2157
2158 parse_as_infix("re_union",(15,"right"));;
2159 parse_as_infix("re_intersect",(17,"right"));;
2160 parse_as_infix("re_subset",(12,"right"));;
2161
2162 (*----------------------------------------------------------------------------*)
2163 (* Minimal amount of set notation is convenient                               *)
2164 (*----------------------------------------------------------------------------*)
2165
2166 let re_Union = new_definition(
2167   `re_Union S = \x:A. ?s. S s /\ s x`);;
2168
2169 let re_union = new_definition(
2170   `P re_union Q = \x:A. P x \/ Q x`);;
2171
2172 let re_intersect = new_definition
2173   `P re_intersect Q = \x:A. P x /\ Q x`;;
2174
2175 let re_null = new_definition(
2176   `re_null = \x:A. F`);;
2177
2178 let re_universe = new_definition(
2179   `re_universe = \x:A. T`);;
2180
2181 let re_subset = new_definition(
2182   `P re_subset Q <=> !x:A. P x ==> Q x`);;
2183
2184 let re_compl = new_definition(
2185   `re_compl S = \x:A. ~(S x)`);;
2186
2187 let SUBSETA_REFL = prove(
2188   `!S:A->bool. S re_subset S`,
2189   GEN_TAC THEN REWRITE_TAC[re_subset]);;
2190
2191 let COMPL_MEM = prove(
2192   `!S:A->bool. !x. S x <=> ~(re_compl S x)`,
2193   REPEAT GEN_TAC THEN REWRITE_TAC[re_compl] THEN
2194   BETA_TAC THEN REWRITE_TAC[]);;
2195
2196 let SUBSETA_ANTISYM = prove(
2197   `!P:A->bool. !Q. P re_subset Q /\ Q re_subset P <=> (P = Q)`,
2198   REPEAT GEN_TAC THEN REWRITE_TAC[re_subset] THEN
2199   CONV_TAC(ONCE_DEPTH_CONV AND_FORALL_CONV) THEN
2200   REWRITE_TAC[TAUT `(a ==> b) /\ (b ==> a) <=> (a <=> b)`] THEN
2201   CONV_TAC(RAND_CONV FUN_EQ_CONV) THEN REFL_TAC);;
2202
2203 let SUBSETA_TRANS = prove(
2204   `!P:A->bool. !Q R. P re_subset Q /\ Q re_subset R ==> P re_subset R`,
2205   REPEAT GEN_TAC THEN REWRITE_TAC[re_subset] THEN
2206   CONV_TAC(ONCE_DEPTH_CONV AND_FORALL_CONV) THEN
2207   DISCH_THEN(MATCH_ACCEPT_TAC o GEN `x:A` o end_itlist IMP_TRANS o
2208     CONJUNCTS o SPEC `x:A`));;
2209
2210 (*----------------------------------------------------------------------------*)
2211 (* Characterize an (A)topology                                                *)
2212 (*----------------------------------------------------------------------------*)
2213
2214 let istopology = new_definition(
2215   `!L:(A->bool)->bool. istopology L <=>
2216             L re_null /\
2217             L re_universe /\
2218      (!a b. L a /\ L b ==> L (a re_intersect b)) /\
2219        (!P. P re_subset L ==> L (re_Union P))`);;
2220
2221 let topology_tybij = new_type_definition "topology" ("topology","open")
2222  (prove(`?t:(A->bool)->bool. istopology t`,
2223         EXISTS_TAC `re_universe:(A->bool)->bool` THEN
2224         REWRITE_TAC[istopology; re_universe]));;
2225
2226 let TOPOLOGY = prove(
2227   `!L:(A)topology. open(L) re_null /\
2228                    open(L) re_universe /\
2229             (!x y. open(L) x /\ open(L) y ==> open(L) (x re_intersect y)) /\
2230               (!P. P re_subset (open L) ==> open(L) (re_Union P))`,
2231   GEN_TAC THEN REWRITE_TAC[GSYM istopology] THEN
2232   REWRITE_TAC[topology_tybij]);;
2233
2234 let TOPOLOGY_UNION = prove(
2235   `!L:(A)topology. !P. P re_subset (open L) ==> open(L) (re_Union P)`,
2236   REWRITE_TAC[TOPOLOGY]);;
2237
2238 (*----------------------------------------------------------------------------*)
2239 (* Characterize a neighbourhood of a point relative to a topology             *)
2240 (*----------------------------------------------------------------------------*)
2241
2242 let neigh = new_definition(
2243   `neigh(top)(N,(x:A)) = ?P. open(top) P /\ P re_subset N /\ P x`);;
2244
2245 (*----------------------------------------------------------------------------*)
2246 (* Prove various properties / characterizations of open sets                  *)
2247 (*----------------------------------------------------------------------------*)
2248
2249 let OPEN_OWN_NEIGH = prove(
2250   `!S top. !x:A. open(top) S /\ S x ==> neigh(top)(S,x)`,
2251   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[neigh] THEN
2252   EXISTS_TAC `S:A->bool` THEN ASM_REWRITE_TAC[SUBSETA_REFL]);;
2253
2254 let OPEN_UNOPEN = prove(
2255   `!S top. open(top) S <=>
2256            (re_Union (\P:A->bool. open(top) P /\ P re_subset S) = S)`,
2257   REPEAT GEN_TAC THEN EQ_TAC THENL
2258    [DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM SUBSETA_ANTISYM] THEN
2259     REWRITE_TAC[re_Union; re_subset] THEN
2260     BETA_TAC THEN CONJ_TAC THEN GEN_TAC THENL
2261      [DISCH_THEN(X_CHOOSE_THEN `s:A->bool` STRIP_ASSUME_TAC) THEN
2262       FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC;
2263       DISCH_TAC THEN EXISTS_TAC `S:A->bool` THEN ASM_REWRITE_TAC[]];
2264     DISCH_THEN(SUBST1_TAC o SYM) THEN
2265     MATCH_MP_TAC TOPOLOGY_UNION THEN
2266     REWRITE_TAC[re_subset] THEN BETA_TAC THEN
2267     GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]]);;
2268
2269 let OPEN_SUBOPEN = prove(
2270   `!S top. open(top) S <=>
2271            !x:A. S x ==> ?P. P x /\ open(top) P /\ P re_subset S`,
2272   REPEAT GEN_TAC THEN EQ_TAC THENL
2273    [DISCH_TAC THEN GEN_TAC THEN DISCH_TAC THEN
2274     EXISTS_TAC `S:A->bool` THEN ASM_REWRITE_TAC[SUBSETA_REFL];
2275     DISCH_TAC THEN C SUBGOAL_THEN SUBST1_TAC
2276      `S = re_Union (\P:A->bool. open(top) P /\ P re_subset S)` THENL
2277      [ONCE_REWRITE_TAC[GSYM SUBSETA_ANTISYM] THEN CONJ_TAC THENL
2278        [ONCE_REWRITE_TAC[re_subset] THEN REWRITE_TAC [re_Union] THEN
2279         BETA_TAC THEN GEN_TAC THEN
2280         DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
2281         DISCH_THEN(X_CHOOSE_TAC `P:A->bool`) THEN EXISTS_TAC `P:A->bool` THEN
2282         ASM_REWRITE_TAC[];
2283         REWRITE_TAC[re_subset; re_Union] THEN BETA_TAC THEN GEN_TAC THEN
2284         DISCH_THEN(CHOOSE_THEN STRIP_ASSUME_TAC) THEN
2285         FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC];
2286       MATCH_MP_TAC TOPOLOGY_UNION THEN ONCE_REWRITE_TAC[re_subset] THEN
2287       GEN_TAC THEN BETA_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]]]);;
2288
2289 let OPEN_NEIGH = prove(
2290   `!S top. open(top) S = !x:A. S x ==> ?N. neigh(top)(N,x) /\ N re_subset S`,
2291   REPEAT GEN_TAC THEN EQ_TAC THENL
2292    [DISCH_TAC THEN GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `S:A->bool` THEN
2293     REWRITE_TAC[SUBSETA_REFL; neigh] THEN
2294     EXISTS_TAC `S:A->bool` THEN ASM_REWRITE_TAC[SUBSETA_REFL];
2295     DISCH_TAC THEN ONCE_REWRITE_TAC[OPEN_SUBOPEN] THEN
2296     GEN_TAC THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
2297     DISCH_THEN(X_CHOOSE_THEN `N:A->bool` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC))
2298     THEN REWRITE_TAC[neigh] THEN
2299     DISCH_THEN(X_CHOOSE_THEN `P:A->bool` STRIP_ASSUME_TAC) THEN
2300     EXISTS_TAC `P:A->bool` THEN ASM_REWRITE_TAC[] THEN
2301     MATCH_MP_TAC SUBSETA_TRANS THEN EXISTS_TAC `N:A->bool` THEN
2302     ASM_REWRITE_TAC[]]);;
2303
2304 (*----------------------------------------------------------------------------*)
2305 (* Characterize closed sets in a topological space                            *)
2306 (*----------------------------------------------------------------------------*)
2307
2308 let closed = new_definition(
2309   `closed(L:(A)topology) S = open(L)(re_compl S)`);;
2310
2311 (*----------------------------------------------------------------------------*)
2312 (* Define limit point in topological space                                    *)
2313 (*----------------------------------------------------------------------------*)
2314
2315 let limpt = new_definition(
2316   `limpt(top) x S <=>
2317       !N:A->bool. neigh(top)(N,x) ==> ?y. ~(x = y) /\ S y /\ N y`);;
2318
2319 (*----------------------------------------------------------------------------*)
2320 (* Prove that a set is closed iff it contains all its limit points            *)
2321 (*----------------------------------------------------------------------------*)
2322
2323 let CLOSED_LIMPT = prove(
2324   `!top S. closed(top) S <=> (!x:A. limpt(top) x S ==> S x)`,
2325   REPEAT GEN_TAC THEN CONV_TAC(ONCE_DEPTH_CONV CONTRAPOS_CONV) THEN
2326   REWRITE_TAC[closed; limpt] THEN
2327   CONV_TAC(ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN
2328   FREEZE_THEN (fun th -> ONCE_REWRITE_TAC[th])
2329     (SPEC `S:A->bool` COMPL_MEM) THEN
2330   REWRITE_TAC[] THEN
2331   SPEC_TAC(`re_compl(S:A->bool)`,`S:A->bool`) THEN
2332   GEN_TAC THEN REWRITE_TAC[NOT_IMP] THEN
2333   CONV_TAC(ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN
2334   REWRITE_TAC[DE_MORGAN_THM] THEN
2335   REWRITE_TAC[OPEN_NEIGH; re_subset] THEN
2336   AP_TERM_TAC THEN ABS_TAC THEN
2337   ASM_CASES_TAC `(S:A->bool) x` THEN ASM_REWRITE_TAC[] THEN
2338   REWRITE_TAC[TAUT `a \/ b \/ ~c <=> c ==> a \/ b`] THEN
2339   EQUAL_TAC THEN
2340   REWRITE_TAC[TAUT `(a <=> b \/ a) <=> b ==> a`] THEN
2341   DISCH_THEN(SUBST1_TAC o SYM) THEN
2342   POP_ASSUM ACCEPT_TAC);;
2343
2344 (*----------------------------------------------------------------------------*)
2345 (* Characterize an (A)metric                                                  *)
2346 (*----------------------------------------------------------------------------*)
2347
2348 let ismet = new_definition(
2349   `ismet (m:A#A->real) <=> (!x y. (m(x,y) = &0) <=> (x = y)) /\
2350                            (!x y z. m(y,z) <= m(x,y) + m(x,z))`);;
2351
2352 let metric_tybij = new_type_definition "metric" ("metric","mdist")
2353       (prove(`?m:(A#A->real). ismet m`,
2354         EXISTS_TAC `\((x:A),(y:A)). if x = y then &0 else &1` THEN
2355         REWRITE_TAC[ismet] THEN
2356         CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN
2357         CONJ_TAC THEN REPEAT GEN_TAC THENL
2358          [BOOL_CASES_TAC `x:A = y` THEN REWRITE_TAC[REAL_10];
2359           REPEAT COND_CASES_TAC THEN
2360           ASM_REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID; REAL_LE_REFL; REAL_LE_01]
2361           THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_LID] THEN
2362           TRY(MATCH_MP_TAC REAL_LE_ADD2) THEN
2363           REWRITE_TAC[REAL_LE_01; REAL_LE_REFL] THEN
2364           FIRST_ASSUM(UNDISCH_TAC o check is_neg o concl) THEN
2365           EVERY_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[]]));;
2366
2367 (*----------------------------------------------------------------------------*)
2368 (* Derive the metric properties                                               *)
2369 (*----------------------------------------------------------------------------*)
2370
2371 let METRIC_ISMET = prove(
2372   `!m:(A)metric. ismet (mdist m)`,
2373   GEN_TAC THEN REWRITE_TAC[metric_tybij]);;
2374
2375 let METRIC_ZERO = prove(
2376   `!m:(A)metric. !x y. ((mdist m)(x,y) = &0) <=> (x = y)`,
2377   REPEAT GEN_TAC THEN ASSUME_TAC(SPEC `m:(A)metric` METRIC_ISMET) THEN
2378   RULE_ASSUM_TAC(REWRITE_RULE[ismet]) THEN ASM_REWRITE_TAC[]);;
2379
2380 let METRIC_SAME = prove(
2381   `!m:(A)metric. !x. (mdist m)(x,x) = &0`,
2382   REPEAT GEN_TAC THEN REWRITE_TAC[METRIC_ZERO]);;
2383
2384 let METRIC_POS = prove(
2385   `!m:(A)metric. !x y. &0 <= (mdist m)(x,y)`,
2386   REPEAT GEN_TAC THEN ASSUME_TAC(SPEC `m:(A)metric` METRIC_ISMET) THEN
2387   RULE_ASSUM_TAC(REWRITE_RULE[ismet]) THEN
2388   FIRST_ASSUM(MP_TAC o SPECL [`x:A`; `y:A`; `y:A`] o CONJUNCT2) THEN
2389   REWRITE_TAC[REWRITE_RULE[] (SPECL [`m:(A)metric`; `y:A`; `y:A`] METRIC_ZERO)]
2390   THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[REAL_NOT_LE] THEN
2391   DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_ADD2 o W CONJ) THEN
2392   REWRITE_TAC[REAL_ADD_LID]);;
2393
2394 let METRIC_SYM = prove(
2395   `!m:(A)metric. !x y. (mdist m)(x,y) = (mdist m)(y,x)`,
2396   REPEAT GEN_TAC THEN ASSUME_TAC(SPEC `m:(A)metric` METRIC_ISMET) THEN
2397   RULE_ASSUM_TAC(REWRITE_RULE[ismet]) THEN FIRST_ASSUM
2398    (MP_TAC o GENL [`y:A`; `z:A`] o SPECL [`z:A`; `y:A`; `z:A`] o CONJUNCT2)
2399   THEN REWRITE_TAC[METRIC_SAME; REAL_ADD_RID] THEN
2400   DISCH_TAC THEN ASM_REWRITE_TAC[GSYM REAL_LE_ANTISYM]);;
2401
2402 let METRIC_TRIANGLE = prove(
2403   `!m:(A)metric. !x y z. (mdist m)(x,z) <= (mdist m)(x,y) + (mdist m)(y,z)`,
2404   REPEAT GEN_TAC THEN ASSUME_TAC(SPEC `m:(A)metric` METRIC_ISMET) THEN
2405   RULE_ASSUM_TAC(REWRITE_RULE[ismet]) THEN
2406   GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [METRIC_SYM] THEN
2407   ASM_REWRITE_TAC[]);;
2408
2409 let METRIC_NZ = prove(
2410   `!m:(A)metric. !x y. ~(x = y) ==> &0 < (mdist m)(x,y)`,
2411   REPEAT GEN_TAC THEN
2412   SUBST1_TAC(SYM(SPECL [`m:(A)metric`; `x:A`; `y:A`] METRIC_ZERO)) THEN
2413   ONCE_REWRITE_TAC[TAUT `~a ==> b <=> b \/ a`] THEN
2414   CONV_TAC(RAND_CONV SYM_CONV) THEN
2415   REWRITE_TAC[GSYM REAL_LE_LT; METRIC_POS]);;
2416
2417 (*----------------------------------------------------------------------------*)
2418 (* Now define metric topology and prove equivalent definition of `open`       *)
2419 (*----------------------------------------------------------------------------*)
2420
2421 let mtop = new_definition(
2422   `!m:(A)metric. mtop m =
2423     topology(\S. !x. S x ==> ?e. &0 < e /\ (!y. (mdist m)(x,y) < e ==> S y))`);;
2424
2425 let mtop_istopology = prove(
2426   `!m:(A)metric. istopology
2427     (\S. !x. S x ==> ?e. &0 < e /\ (!y. (mdist m)(x,y) < e ==> S y))`,
2428   GEN_TAC THEN
2429   REWRITE_TAC[istopology; re_null; re_universe; re_Union;
2430               re_intersect; re_subset] THEN
2431   CONV_TAC(REDEPTH_CONV BETA_CONV) THEN
2432   REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
2433    [EXISTS_TAC `&1` THEN MATCH_ACCEPT_TAC REAL_LT_01;
2434         REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN
2435     DISCH_THEN(fun th -> POP_ASSUM(CONJUNCTS_THEN(MP_TAC o SPEC `x:A`))
2436                     THEN REWRITE_TAC[th]) THEN
2437     DISCH_THEN(X_CHOOSE_TAC `e1:real`) THEN
2438     DISCH_THEN(X_CHOOSE_TAC `e2:real`) THEN
2439     REPEAT_TCL DISJ_CASES_THEN MP_TAC
2440         (SPECL [`e1:real`; `e2:real`] REAL_LT_TOTAL) THENL
2441      [DISCH_THEN SUBST_ALL_TAC THEN EXISTS_TAC `e2:real` THEN
2442       ASM_REWRITE_TAC[] THEN GEN_TAC THEN
2443       DISCH_THEN(fun th -> EVERY_ASSUM(ASSUME_TAC o C MATCH_MP th o CONJUNCT2))
2444       THEN ASM_REWRITE_TAC[];
2445       DISCH_THEN((then_) (EXISTS_TAC `e1:real`) o MP_TAC);
2446       DISCH_THEN((then_) (EXISTS_TAC `e2:real`) o MP_TAC)] THEN
2447     ASM_REWRITE_TAC[] THEN
2448     DISCH_THEN(fun th2 -> GEN_TAC THEN DISCH_THEN(fun th1 ->
2449       ASSUME_TAC th1 THEN ASSUME_TAC (MATCH_MP REAL_LT_TRANS (CONJ th1 th2))))
2450     THEN CONJ_TAC THEN FIRST_ASSUM (MATCH_MP_TAC o CONJUNCT2)
2451     THEN FIRST_ASSUM ACCEPT_TAC;
2452     GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN
2453     DISCH_THEN(X_CHOOSE_THEN `y:A->bool`
2454      (fun th -> POP_ASSUM(X_CHOOSE_TAC `e:real` o C MATCH_MP (CONJUNCT2 th) o
2455                      C MATCH_MP (CONJUNCT1 th)) THEN ASSUME_TAC th)) THEN
2456     EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:A` THEN
2457     DISCH_THEN
2458       (fun th -> FIRST_ASSUM(ASSUME_TAC o C MATCH_MP th o CONJUNCT2)) THEN
2459     EXISTS_TAC `y:A->bool` THEN ASM_REWRITE_TAC[]]);;
2460
2461 let MTOP_OPEN = prove(
2462   `!m:(A)metric. open(mtop m) S <=>
2463       (!x. S x ==> ?e. &0 < e /\ (!y. (mdist m(x,y)) < e ==> S y))`,
2464   GEN_TAC THEN REWRITE_TAC[mtop] THEN
2465   REWRITE_TAC[REWRITE_RULE[topology_tybij] mtop_istopology] THEN
2466   BETA_TAC THEN REFL_TAC);;
2467
2468 (*----------------------------------------------------------------------------*)
2469 (* Define open ball in metric space + prove basic properties                  *)
2470 (*----------------------------------------------------------------------------*)
2471
2472 let ball = new_definition(
2473   `!m:(A)metric. !x e. ball(m)(x,e) = \y. (mdist m)(x,y) < e`);;
2474
2475 let BALL_OPEN = prove(
2476   `!m:(A)metric. !x e. &0 < e ==> open(mtop(m))(ball(m)(x,e))`,
2477   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[MTOP_OPEN] THEN
2478   X_GEN_TAC `z:A` THEN REWRITE_TAC[ball] THEN BETA_TAC THEN
2479   DISCH_THEN(ASSUME_TAC o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) THEN
2480   EXISTS_TAC `e - mdist(m:(A)metric)(x,z)` THEN ASM_REWRITE_TAC[] THEN
2481   X_GEN_TAC `y:A` THEN REWRITE_TAC[REAL_LT_SUB_LADD] THEN
2482   ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN DISCH_TAC THEN
2483   MATCH_MP_TAC REAL_LET_TRANS THEN
2484   EXISTS_TAC `mdist(m)((x:A),z) + mdist(m)(z,y)` THEN
2485   ASM_REWRITE_TAC[METRIC_TRIANGLE]);;
2486
2487 let BALL_NEIGH = prove(
2488   `!m:(A)metric. !x e. &0 < e ==> neigh(mtop(m))(ball(m)(x,e),x)`,
2489   REPEAT GEN_TAC THEN DISCH_TAC THEN
2490   REWRITE_TAC[neigh] THEN EXISTS_TAC `ball(m)((x:A),e)` THEN
2491   REWRITE_TAC[SUBSETA_REFL] THEN CONJ_TAC THENL
2492    [MATCH_MP_TAC BALL_OPEN;
2493     REWRITE_TAC[ball] THEN BETA_TAC THEN REWRITE_TAC[METRIC_SAME]] THEN
2494   POP_ASSUM ACCEPT_TAC);;
2495
2496 (*----------------------------------------------------------------------------*)
2497 (* Characterize limit point in a metric topology                              *)
2498 (*----------------------------------------------------------------------------*)
2499
2500 let MTOP_LIMPT = prove(
2501   `!m:(A)metric. !x S. limpt(mtop m) x S <=>
2502       !e. &0 < e ==> ?y. ~(x = y) /\ S y /\ (mdist m)(x,y) < e`,
2503   REPEAT GEN_TAC THEN REWRITE_TAC[limpt] THEN EQ_TAC THENL
2504    [DISCH_THEN((then_) (GEN_TAC THEN DISCH_TAC) o
2505       MP_TAC o SPEC `ball(m)((x:A),e)`) THEN
2506     FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP BALL_NEIGH th]) THEN
2507     REWRITE_TAC[ball] THEN BETA_TAC THEN DISCH_THEN ACCEPT_TAC;
2508     DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[neigh] THEN
2509     DISCH_THEN(X_CHOOSE_THEN `P:A->bool`
2510       (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN
2511     REWRITE_TAC[MTOP_OPEN] THEN
2512     DISCH_THEN(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN
2513     DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
2514     FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN
2515     DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
2516     DISCH_THEN(X_CHOOSE_THEN `y:A` STRIP_ASSUME_TAC) THEN
2517     DISCH_THEN(MP_TAC o SPEC `y:A`) THEN ASM_REWRITE_TAC[] THEN
2518     DISCH_TAC THEN EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[] THEN
2519     UNDISCH_TAC `(P:A->bool) re_subset N` THEN
2520     REWRITE_TAC[re_subset] THEN DISCH_THEN MATCH_MP_TAC THEN
2521     FIRST_ASSUM ACCEPT_TAC]);;
2522
2523 (*----------------------------------------------------------------------------*)
2524 (* Define the usual metric on the real line                                   *)
2525 (*----------------------------------------------------------------------------*)
2526
2527 let ISMET_R1 = prove(
2528   `ismet (\(x,y). abs(y - x))`,
2529   REWRITE_TAC[ismet] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN
2530   CONJ_TAC THEN REPEAT GEN_TAC THENL
2531    [REWRITE_TAC[ABS_ZERO; REAL_SUB_0] THEN
2532     CONV_TAC(RAND_CONV SYM_CONV) THEN REFL_TAC;
2533     SUBST1_TAC(SYM(SPECL [`x:real`; `y:real`] REAL_NEG_SUB)) THEN
2534     REWRITE_TAC[ABS_NEG] THEN SUBGOAL_THEN `z - y = (x - y) + (z - x)`
2535       (fun th -> SUBST1_TAC th THEN MATCH_ACCEPT_TAC ABS_TRIANGLE) THEN
2536     REWRITE_TAC[real_sub] THEN
2537     ONCE_REWRITE_TAC[AC REAL_ADD_AC
2538       `(a + b) + (c + d) = (d + a) + (c + b)`] THEN
2539     REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]]);;
2540
2541 let mr1 = new_definition(
2542   `mr1 = metric(\(x,y). abs(y - x))`);;
2543
2544 let MR1_DEF = prove(
2545   `!x y. (mdist mr1)(x,y) = abs(y - x)`,
2546   REPEAT GEN_TAC THEN REWRITE_TAC[mr1; REWRITE_RULE[metric_tybij] ISMET_R1]
2547   THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REFL_TAC);;
2548
2549 let MR1_ADD = prove(
2550   `!x d. (mdist mr1)(x,x+d) = abs(d)`,
2551   REPEAT GEN_TAC THEN REWRITE_TAC[MR1_DEF; REAL_ADD_SUB]);;
2552
2553 let MR1_SUB = prove(
2554   `!x d. (mdist mr1)(x,x-d) = abs(d)`,
2555   REPEAT GEN_TAC THEN REWRITE_TAC[MR1_DEF; REAL_SUB_SUB; ABS_NEG]);;
2556
2557 let MR1_ADD_LE = prove(
2558   `!x d. &0 <= d ==> ((mdist mr1)(x,x+d) = d)`,
2559   REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[MR1_ADD; real_abs]);;
2560
2561 let MR1_SUB_LE = prove(
2562   `!x d. &0 <= d ==> ((mdist mr1)(x,x-d) = d)`,
2563   REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[MR1_SUB; real_abs]);;
2564
2565 let MR1_ADD_LT = prove(
2566   `!x d. &0 < d ==> ((mdist mr1)(x,x+d) = d)`,
2567   REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN
2568   MATCH_ACCEPT_TAC MR1_ADD_LE);;
2569
2570 let MR1_SUB_LT = prove(
2571   `!x d. &0 < d ==> ((mdist mr1)(x,x-d) = d)`,
2572    REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN
2573   MATCH_ACCEPT_TAC MR1_SUB_LE);;
2574
2575 let MR1_BETWEEN1 = prove(
2576   `!x y z. x < z /\ (mdist mr1)(x,y) < (z - x) ==> y < z`,
2577   REPEAT GEN_TAC THEN REWRITE_TAC[MR1_DEF; ABS_BETWEEN1]);;
2578
2579 (*----------------------------------------------------------------------------*)
2580 (* Every real is a limit point of the real line                               *)
2581 (*----------------------------------------------------------------------------*)
2582
2583 let MR1_LIMPT = prove(
2584   `!x. limpt(mtop mr1) x re_universe`,
2585   GEN_TAC THEN REWRITE_TAC[MTOP_LIMPT; re_universe] THEN
2586   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
2587   EXISTS_TAC `x + (e / &2)` THEN
2588   REWRITE_TAC[MR1_ADD] THEN
2589   SUBGOAL_THEN `&0 <= (e / &2)` ASSUME_TAC THENL
2590    [MATCH_MP_TAC REAL_LT_IMP_LE THEN
2591     ASM_REWRITE_TAC[REAL_LT_HALF1]; ALL_TAC] THEN
2592   ASM_REWRITE_TAC[real_abs; REAL_LT_HALF2] THEN
2593   CONV_TAC(RAND_CONV SYM_CONV) THEN
2594   REWRITE_TAC[REAL_ADD_RID_UNIQ] THEN
2595   CONV_TAC(RAND_CONV SYM_CONV) THEN
2596   MATCH_MP_TAC REAL_LT_IMP_NE THEN
2597   ASM_REWRITE_TAC[REAL_LT_HALF1]);;
2598
2599 (*============================================================================*)
2600 (* Theory of Moore-Smith covergence nets, and special cases like sequences    *)
2601 (*============================================================================*)
2602
2603 parse_as_infix ("tends",(12,"right"));;
2604
2605 (*----------------------------------------------------------------------------*)
2606 (* Basic definitions: directed set, net, bounded net, pointwise limit         *)
2607 (*----------------------------------------------------------------------------*)
2608
2609 let dorder = new_definition(
2610   `dorder (g:A->A->bool) <=>
2611      !x y. g x x /\ g y y ==> ?z. g z z /\ (!w. g w z ==> g w x /\ g w y)`);;
2612
2613 let tends = new_definition
2614   `(s tends l)(top,g) <=>
2615       !N:A->bool. neigh(top)(N,l) ==>
2616             ?n:B. g n n /\ !m:B. g m n ==> N(s m)`;;
2617
2618 let bounded = new_definition(
2619   `bounded((m:(A)metric),(g:B->B->bool)) f <=>
2620       ?k x N. g N N /\ (!n. g n N ==> (mdist m)(f(n),x) < k)`);;
2621
2622 let tendsto = new_definition(
2623   `tendsto((m:(A)metric),x) y z <=>
2624       &0 < (mdist m)(x,y) /\ (mdist m)(x,y) <= (mdist m)(x,z)`);;
2625
2626 parse_as_infix("-->",(12,"right"));;
2627
2628 override_interface ("-->",`(tends)`);;
2629
2630 let DORDER_LEMMA = prove(
2631   `!g:A->A->bool.
2632       dorder g ==>
2633         !P Q. (?n. g n n /\ (!m. g m n ==> P m)) /\
2634               (?n. g n n /\ (!m. g m n ==> Q m))
2635                   ==> (?n. g n n /\ (!m. g m n ==> P m /\ Q m))`,
2636   GEN_TAC THEN REWRITE_TAC[dorder] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
2637   DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `N1:A` STRIP_ASSUME_TAC)
2638                              (X_CHOOSE_THEN `N2:A` STRIP_ASSUME_TAC)) THEN
2639   FIRST_ASSUM(MP_TAC o SPECL [`N1:A`; `N2:A`]) THEN
2640   REWRITE_TAC[ASSUME `(g:A->A->bool) N1 N1`;ASSUME `(g:A->A->bool) N2 N2`] THEN
2641   DISCH_THEN(X_CHOOSE_THEN `n:A` STRIP_ASSUME_TAC) THEN
2642   EXISTS_TAC `n:A` THEN ASM_REWRITE_TAC[] THEN
2643   X_GEN_TAC `m:A` THEN DISCH_TAC THEN
2644   CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
2645   FIRST_ASSUM(UNDISCH_TAC o
2646     check(is_conj o snd o dest_imp o snd o dest_forall) o concl) THEN
2647   DISCH_THEN(MP_TAC o SPEC `m:A`) THEN ASM_REWRITE_TAC[] THEN
2648   DISCH_TAC THEN ASM_REWRITE_TAC[]);;
2649
2650 (*----------------------------------------------------------------------------*)
2651 (* Following tactic is useful in the following proofs                         *)
2652 (*----------------------------------------------------------------------------*)
2653
2654 let DORDER_THEN tac th =
2655   let [t1;t2] = map (rand o rand o body o rand) (conjuncts(concl th)) in
2656   let dog = (rator o rator o rand o rator o body) t1 in
2657   let thl = map ((uncurry X_BETA_CONV) o (I F_F rand) o dest_abs) [t1;t2] in
2658   let th1 = CONV_RULE(EXACT_CONV thl) th in
2659   let th2 = MATCH_MP DORDER_LEMMA (ASSUME (list_mk_icomb "dorder" [dog])) in
2660   let th3 = MATCH_MP th2 th1 in
2661   let th4 = CONV_RULE(EXACT_CONV(map SYM thl)) th3 in
2662   tac th4;;
2663
2664 (*----------------------------------------------------------------------------*)
2665 (* Show that sequences and pointwise limits in a metric space are directed    *)
2666 (*----------------------------------------------------------------------------*)
2667
2668 let DORDER_NGE = prove(
2669   `dorder ((>=) :num->num->bool)`,
2670   REWRITE_TAC[dorder; GE; LE_REFL] THEN
2671   REPEAT GEN_TAC THEN
2672   DISJ_CASES_TAC(SPECL [`x:num`; `y:num`] LE_CASES) THENL
2673     [EXISTS_TAC `y:num`; EXISTS_TAC `x:num`] THEN
2674   GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
2675   MATCH_MP_TAC LE_TRANS THENL
2676     [EXISTS_TAC `y:num`; EXISTS_TAC `x:num`] THEN
2677   ASM_REWRITE_TAC[]);;
2678
2679 let DORDER_TENDSTO = prove(
2680   `!m:(A)metric. !x. dorder(tendsto(m,x))`,
2681   REPEAT GEN_TAC THEN REWRITE_TAC[dorder; tendsto] THEN
2682   MAP_EVERY X_GEN_TAC [`u:A`; `v:A`] THEN
2683   REWRITE_TAC[REAL_LE_REFL] THEN
2684   DISCH_THEN STRIP_ASSUME_TAC THEN ASM_REWRITE_TAC[] THEN
2685   DISJ_CASES_TAC(SPECL [`(mdist m)((x:A),v)`; `(mdist m)((x:A),u)`]
2686     REAL_LE_TOTAL)
2687   THENL [EXISTS_TAC `v:A`; EXISTS_TAC `u:A`] THEN ASM_REWRITE_TAC[] THEN
2688   GEN_TAC THEN DISCH_THEN STRIP_ASSUME_TAC THEN ASM_REWRITE_TAC[] THEN
2689   MATCH_MP_TAC REAL_LE_TRANS THEN FIRST_ASSUM (fun th ->
2690    (EXISTS_TAC o rand o concl) th THEN ASM_REWRITE_TAC[] THEN NO_TAC));;
2691
2692 (*----------------------------------------------------------------------------*)
2693 (* Simpler characterization of limit in a metric topology                     *)
2694 (*----------------------------------------------------------------------------*)
2695
2696 let MTOP_TENDS = prove(
2697   `!d g. !x:B->A. !x0. (x --> x0)(mtop(d),g) <=>
2698      !e. &0 < e ==> ?n. g n n /\ !m. g m n ==> mdist(d)(x(m),x0) < e`,
2699   REPEAT GEN_TAC THEN REWRITE_TAC[tends] THEN EQ_TAC THEN DISCH_TAC THENL
2700    [GEN_TAC THEN DISCH_TAC THEN
2701     FIRST_ASSUM(MP_TAC o SPEC `ball(d)((x0:A),e)`) THEN
2702     W(C SUBGOAL_THEN MP_TAC o funpow 2 (rand o rator) o snd) THENL
2703      [MATCH_MP_TAC BALL_NEIGH THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
2704     DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[ball] THEN
2705     BETA_TAC THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV)
2706      [METRIC_SYM] THEN REWRITE_TAC[];
2707     GEN_TAC THEN REWRITE_TAC[neigh] THEN
2708     DISCH_THEN(X_CHOOSE_THEN `P:A->bool` STRIP_ASSUME_TAC) THEN
2709     UNDISCH_TAC `open(mtop(d)) (P:A->bool)` THEN
2710     REWRITE_TAC[MTOP_OPEN] THEN DISCH_THEN(MP_TAC o SPEC `x0:A`) THEN
2711     ASM_REWRITE_TAC[] THEN
2712     DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
2713     FIRST_ASSUM(MP_TAC o SPEC `d:real`) THEN
2714     REWRITE_TAC[ASSUME `&0 < d`] THEN
2715     DISCH_THEN(X_CHOOSE_THEN `n:B` STRIP_ASSUME_TAC) THEN
2716     EXISTS_TAC `n:B` THEN ASM_REWRITE_TAC[] THEN
2717     GEN_TAC THEN DISCH_TAC THEN
2718     UNDISCH_TAC `(P:A->bool) re_subset N` THEN
2719     REWRITE_TAC[re_subset] THEN DISCH_TAC THEN
2720     REPEAT(FIRST_ASSUM MATCH_MP_TAC) THEN
2721     ONCE_REWRITE_TAC[METRIC_SYM] THEN
2722     FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC]);;
2723
2724 (*----------------------------------------------------------------------------*)
2725 (* Prove that a net in a metric topology cannot converge to different limits  *)
2726 (*----------------------------------------------------------------------------*)
2727
2728 let MTOP_TENDS_UNIQ = prove(
2729   `!g d. dorder (g:B->B->bool) ==>
2730       (x --> x0)(mtop(d),g) /\ (x --> x1)(mtop(d),g) ==> (x0:A = x1)`,
2731   REPEAT GEN_TAC THEN DISCH_TAC THEN
2732   REWRITE_TAC[MTOP_TENDS] THEN
2733   CONV_TAC(ONCE_DEPTH_CONV AND_FORALL_CONV) THEN
2734   REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN
2735   CONV_TAC CONTRAPOS_CONV THEN DISCH_TAC THEN
2736   CONV_TAC NOT_FORALL_CONV THEN
2737   EXISTS_TAC `mdist(d:(A)metric)(x0,x1) / &2` THEN
2738   W(C SUBGOAL_THEN ASSUME_TAC o rand o rator o rand o snd) THENL
2739    [REWRITE_TAC[REAL_LT_HALF1] THEN MATCH_MP_TAC METRIC_NZ THEN
2740     FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN
2741   ASM_REWRITE_TAC[] THEN DISCH_THEN(DORDER_THEN MP_TAC) THEN
2742   DISCH_THEN(X_CHOOSE_THEN `N:B` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
2743   DISCH_THEN(MP_TAC o SPEC `N:B`) THEN ASM_REWRITE_TAC[] THEN
2744   BETA_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_ADD2) THEN
2745   REWRITE_TAC[REAL_HALF_DOUBLE; REAL_NOT_LT] THEN
2746   GEN_REWRITE_TAC(RAND_CONV o LAND_CONV) [METRIC_SYM] THEN
2747   MATCH_ACCEPT_TAC METRIC_TRIANGLE);;
2748
2749 (*----------------------------------------------------------------------------*)
2750 (* Simpler characterization of limit of a sequence in a metric topology       *)
2751 (*----------------------------------------------------------------------------*)
2752
2753 let SEQ_TENDS = prove(
2754   `!d:(A)metric. !x x0. (x --> x0)(mtop(d), (>=) :num->num->bool) <=>
2755      !e. &0 < e ==> ?N. !n. n >= N ==> mdist(d)(x(n),x0) < e`,
2756   REPEAT GEN_TAC THEN REWRITE_TAC[MTOP_TENDS; GE; LE_REFL]);;
2757
2758 (*----------------------------------------------------------------------------*)
2759 (* And of limit of function between metric spaces                             *)
2760 (*----------------------------------------------------------------------------*)
2761
2762 let LIM_TENDS = prove(
2763   `!m1:(A)metric. !m2:(B)metric. !f x0 y0.
2764       limpt(mtop m1) x0 re_universe ==>
2765         ((f --> y0)(mtop(m2),tendsto(m1,x0)) <=>
2766           !e. &0 < e ==>
2767             ?d. &0 < d /\ !x. &0 < (mdist m1)(x,x0) /\ (mdist m1)(x,x0) <= d
2768                 ==> (mdist m2)(f(x),y0) < e)`,
2769   REPEAT GEN_TAC THEN DISCH_TAC THEN
2770   REWRITE_TAC[MTOP_TENDS; tendsto] THEN
2771   AP_TERM_TAC THEN ABS_TAC THEN
2772   ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN
2773   REWRITE_TAC[REAL_LE_REFL] THEN EQ_TAC THENL
2774    [DISCH_THEN(X_CHOOSE_THEN `z:A` STRIP_ASSUME_TAC) THEN
2775     EXISTS_TAC `(mdist m1)((x0:A),z)` THEN ASM_REWRITE_TAC[] THEN
2776     GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
2777     ASM_REWRITE_TAC[] THEN
2778     SUBST1_TAC(ISPECL [`m1:(A)metric`; `x0:A`; `x:A`] METRIC_SYM) THEN
2779     ASM_REWRITE_TAC[];
2780     DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
2781     UNDISCH_TAC `limpt(mtop m1) (x0:A) re_universe` THEN
2782     REWRITE_TAC[MTOP_LIMPT] THEN
2783     DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN
2784     REWRITE_TAC[re_universe] THEN
2785     DISCH_THEN(X_CHOOSE_THEN `y:A` STRIP_ASSUME_TAC) THEN
2786     EXISTS_TAC `y:A` THEN CONJ_TAC THENL
2787      [MATCH_MP_TAC METRIC_NZ THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
2788     X_GEN_TAC `x:A` THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
2789     ONCE_REWRITE_TAC[METRIC_SYM] THEN ASM_REWRITE_TAC[] THEN
2790     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(mdist m1)((x0:A),y)` THEN
2791     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
2792     FIRST_ASSUM ACCEPT_TAC]);;
2793
2794 (*----------------------------------------------------------------------------*)
2795 (* Similar, more conventional version, is also true at a limit point          *)
2796 (*----------------------------------------------------------------------------*)
2797
2798 let LIM_TENDS2 = prove(
2799   `!m1:(A)metric. !m2:(B)metric. !f x0 y0.
2800       limpt(mtop m1) x0 re_universe ==>
2801         ((f --> y0)(mtop(m2),tendsto(m1,x0)) <=>
2802           !e. &0 < e ==>
2803             ?d. &0 < d /\ !x. &0 < (mdist m1)(x,x0) /\ (mdist m1)(x,x0) < d ==>
2804               (mdist m2)(f(x),y0) < e)`,
2805   REPEAT GEN_TAC THEN DISCH_TAC THEN
2806   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LIM_TENDS th]) THEN
2807   AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN
2808   EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THENL
2809    [EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN
2810     GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
2811     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[];
2812     EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN
2813     GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
2814     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
2815     EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_LT_HALF2]]);;
2816
2817 (*----------------------------------------------------------------------------*)
2818 (* Simpler characterization of boundedness for the real line                  *)
2819 (*----------------------------------------------------------------------------*)
2820
2821 let MR1_BOUNDED = prove(
2822   `!(g:A->A->bool) f. bounded(mr1,g) f <=>
2823         ?k N. g N N /\ (!n. g n N ==> abs(f n) < k)`,
2824   REPEAT GEN_TAC THEN REWRITE_TAC[bounded; MR1_DEF] THEN
2825   GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ABS_CONV)
2826    [SWAP_EXISTS_THM] THEN
2827   ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
2828   AP_TERM_TAC THEN ABS_TAC THEN
2829   CONV_TAC(REDEPTH_CONV EXISTS_AND_CONV) THEN
2830   AP_TERM_TAC THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `k:real` MP_TAC) THENL
2831    [DISCH_THEN(X_CHOOSE_TAC `x:real`) THEN
2832     EXISTS_TAC `abs(x) + k` THEN GEN_TAC THEN DISCH_TAC THEN
2833     SUBST1_TAC(SYM(SPECL [`(f:A->real) n`; `x:real`] REAL_SUB_ADD)) THEN
2834     MATCH_MP_TAC REAL_LET_TRANS THEN
2835     EXISTS_TAC `abs((f:A->real) n - x) + abs(x)` THEN
2836     REWRITE_TAC[ABS_TRIANGLE] THEN
2837     GEN_REWRITE_TAC RAND_CONV [REAL_ADD_SYM] THEN
2838     REWRITE_TAC[REAL_LT_RADD] THEN
2839     ONCE_REWRITE_TAC[ABS_SUB] THEN
2840     FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC;
2841     DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`k:real`; `&0`] THEN
2842     ASM_REWRITE_TAC[REAL_SUB_LZERO; ABS_NEG]]);;
2843
2844 (*----------------------------------------------------------------------------*)
2845 (* Firstly, prove useful forms of null and bounded nets                       *)
2846 (*----------------------------------------------------------------------------*)
2847
2848 let NET_NULL = prove(
2849   `!g:A->A->bool. !x x0.
2850       (x --> x0)(mtop(mr1),g) <=> ((\n. x(n) - x0) --> &0)(mtop(mr1),g)`,
2851   REPEAT GEN_TAC THEN REWRITE_TAC[MTOP_TENDS] THEN BETA_TAC THEN
2852   REWRITE_TAC[MR1_DEF; REAL_SUB_LZERO] THEN EQUAL_TAC THEN
2853   REWRITE_TAC[REAL_NEG_SUB]);;
2854
2855 let NET_CONV_BOUNDED = prove(
2856   `!g:A->A->bool. !x x0.
2857       (x --> x0)(mtop(mr1),g) ==> bounded(mr1,g) x`,
2858   REPEAT GEN_TAC THEN REWRITE_TAC[MTOP_TENDS; bounded] THEN
2859   DISCH_THEN(MP_TAC o SPEC `&1`) THEN
2860   REWRITE_TAC[REAL_LT; num_CONV `1`; LT_0] THEN
2861   REWRITE_TAC[GSYM(num_CONV `1`)] THEN
2862   DISCH_THEN(X_CHOOSE_THEN `N:A` STRIP_ASSUME_TAC) THEN
2863   MAP_EVERY EXISTS_TAC [`&1`; `x0:real`; `N:A`] THEN
2864   ASM_REWRITE_TAC[]);;
2865
2866 let NET_CONV_NZ = prove(
2867   `!g:A->A->bool. !x x0.
2868       (x --> x0)(mtop(mr1),g) /\ ~(x0 = &0) ==>
2869         ?N. g N N /\ (!n. g n N ==> ~(x n = &0))`,
2870   REPEAT GEN_TAC THEN REWRITE_TAC[MTOP_TENDS; bounded] THEN
2871   DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `abs(x0)`) ASSUME_TAC) THEN
2872   ASM_REWRITE_TAC[GSYM ABS_NZ] THEN
2873   DISCH_THEN(X_CHOOSE_THEN `N:A` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
2874   DISCH_TAC THEN EXISTS_TAC `N:A` THEN ASM_REWRITE_TAC[] THEN
2875   GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN
2876   CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN
2877   DISCH_THEN SUBST1_TAC THEN
2878   REWRITE_TAC[MR1_DEF; REAL_SUB_RZERO; REAL_LT_REFL]);;
2879
2880 let NET_CONV_IBOUNDED = prove(
2881   `!g:A->A->bool. !x x0.
2882       (x --> x0)(mtop(mr1),g) /\ ~(x0 = &0) ==>
2883         bounded(mr1,g) (\n. inv(x n))`,
2884   REPEAT GEN_TAC THEN REWRITE_TAC[MTOP_TENDS; MR1_BOUNDED; MR1_DEF] THEN
2885   BETA_TAC THEN REWRITE_TAC[ABS_NZ] THEN
2886   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
2887   DISCH_THEN(MP_TAC o SPEC `abs(x0) / &2`) THEN
2888   ASM_REWRITE_TAC[REAL_LT_HALF1] THEN
2889   DISCH_THEN(X_CHOOSE_THEN `N:A` STRIP_ASSUME_TAC) THEN
2890   MAP_EVERY EXISTS_TAC [`&2 / abs(x0)`; `N:A`] THEN
2891   ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:A` THEN
2892   DISCH_THEN(ANTE_RES_THEN ASSUME_TAC) THEN
2893   SUBGOAL_THEN `(abs(x0) / & 2) < abs(x(n:A))` ASSUME_TAC THENL
2894    [SUBST1_TAC(SYM(SPECL [`abs(x0) / &2`; `abs(x0) / &2`; `abs(x(n:A))`]
2895       REAL_LT_LADD)) THEN
2896     REWRITE_TAC[REAL_HALF_DOUBLE] THEN
2897     MATCH_MP_TAC REAL_LET_TRANS THEN
2898     EXISTS_TAC `abs(x0 - x(n:A)) + abs(x(n))` THEN
2899     ASM_REWRITE_TAC[REAL_LT_RADD] THEN
2900     SUBST1_TAC(SYM(AP_TERM `abs`
2901       (SPECL [`x0:real`; `x(n:A):real`] REAL_SUB_ADD))) THEN
2902     MATCH_ACCEPT_TAC ABS_TRIANGLE; ALL_TAC] THEN
2903   SUBGOAL_THEN `&0 < abs(x(n:A))` ASSUME_TAC THENL
2904    [MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `abs(x0) / &2` THEN
2905     ASM_REWRITE_TAC[REAL_LT_HALF1]; ALL_TAC] THEN
2906   SUBGOAL_THEN `&2 / abs(x0) = inv(abs(x0) / &2)` SUBST1_TAC THENL
2907    [MATCH_MP_TAC REAL_RINV_UNIQ THEN REWRITE_TAC[real_div] THEN
2908     ONCE_REWRITE_TAC[AC REAL_MUL_AC
2909         `(a * b) * (c * d) = (d * a) * (b * c)`] THEN
2910     SUBGOAL_THEN `~(abs(x0) = &0) /\ ~(&2 = &0)`
2911       (fun th -> CONJUNCTS_THEN(SUBST1_TAC o MATCH_MP REAL_MUL_LINV) th
2912             THEN REWRITE_TAC[REAL_MUL_LID]) THEN
2913     CONJ_TAC THENL
2914      [ASM_REWRITE_TAC[ABS_NZ; ABS_ABS];
2915       REWRITE_TAC[REAL_INJ; num_CONV `2`; NOT_SUC]]; ALL_TAC] THEN
2916   SUBGOAL_THEN `~(x(n:A) = &0)` (SUBST1_TAC o MATCH_MP ABS_INV) THENL
2917    [ASM_REWRITE_TAC[ABS_NZ]; ALL_TAC] THEN
2918   MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_HALF1]);;
2919
2920 (*----------------------------------------------------------------------------*)
2921 (* Now combining theorems for null nets                                       *)
2922 (*----------------------------------------------------------------------------*)
2923
2924 let NET_NULL_ADD = prove(
2925   `!g:A->A->bool. dorder g ==>
2926         !x y. (x --> &0)(mtop(mr1),g) /\ (y --> &0)(mtop(mr1),g) ==>
2927                 ((\n. x(n) + y(n)) --> &0)(mtop(mr1),g)`,
2928   GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
2929   REWRITE_TAC[MTOP_TENDS; MR1_DEF; REAL_SUB_LZERO; ABS_NEG] THEN
2930   DISCH_THEN((then_) (X_GEN_TAC `e:real` THEN DISCH_TAC) o
2931     MP_TAC o end_itlist CONJ o map (SPEC `e / &2`) o CONJUNCTS) THEN
2932   ASM_REWRITE_TAC[REAL_LT_HALF1] THEN
2933   DISCH_THEN(DORDER_THEN (X_CHOOSE_THEN `N:A` STRIP_ASSUME_TAC)) THEN
2934   EXISTS_TAC `N:A` THEN ASM_REWRITE_TAC[] THEN
2935   GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN ASSUME_TAC) THEN
2936   BETA_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN
2937   EXISTS_TAC `abs(x(m:A)) + abs(y(m:A))` THEN
2938   REWRITE_TAC[ABS_TRIANGLE] THEN RULE_ASSUM_TAC BETA_RULE THEN
2939   GEN_REWRITE_TAC RAND_CONV [GSYM REAL_HALF_DOUBLE] THEN
2940   MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_REWRITE_TAC[]);;
2941
2942 let NET_NULL_MUL = prove(
2943   `!g:A->A->bool. dorder g ==>
2944       !x y. bounded(mr1,g) x /\ (y --> &0)(mtop(mr1),g) ==>
2945               ((\n. x(n) * y(n)) --> &0)(mtop(mr1),g)`,
2946   GEN_TAC THEN DISCH_TAC THEN
2947   REPEAT GEN_TAC THEN REWRITE_TAC[MR1_BOUNDED] THEN
2948   REWRITE_TAC[MTOP_TENDS; MR1_DEF; REAL_SUB_LZERO; ABS_NEG] THEN
2949   DISCH_THEN((then_) (X_GEN_TAC `e:real` THEN DISCH_TAC) o MP_TAC) THEN
2950   CONV_TAC(LAND_CONV LEFT_AND_EXISTS_CONV) THEN
2951   DISCH_THEN(X_CHOOSE_THEN `k:real` MP_TAC) THEN
2952   DISCH_THEN(ASSUME_TAC o uncurry CONJ o (I F_F SPEC `e / k`) o CONJ_PAIR) THEN
2953   SUBGOAL_THEN `&0 < k` ASSUME_TAC THENL
2954    [FIRST_ASSUM(X_CHOOSE_THEN `N:A`
2955       (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) o CONJUNCT1) THEN
2956     DISCH_THEN(MP_TAC o SPEC `N:A`) THEN ASM_REWRITE_TAC[] THEN
2957     DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN
2958     EXISTS_TAC `abs(x(N:A))` THEN ASM_REWRITE_TAC[ABS_POS]; ALL_TAC] THEN
2959   FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN
2960   SUBGOAL_THEN `&0 < e / k` ASSUME_TAC THENL
2961    [FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_LT_RDIV_0 th] THEN
2962     ASM_REWRITE_TAC[] THEN NO_TAC); ALL_TAC] THEN ASM_REWRITE_TAC[] THEN
2963   DISCH_THEN(DORDER_THEN(X_CHOOSE_THEN `N:A` STRIP_ASSUME_TAC)) THEN
2964   EXISTS_TAC `N:A` THEN ASM_REWRITE_TAC[] THEN
2965   GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN (ASSUME_TAC o BETA_RULE)) THEN
2966   SUBGOAL_THEN `e = k * (e / k)` SUBST1_TAC THENL
2967    [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_LMUL THEN
2968     DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `&0 < &0` THEN
2969     REWRITE_TAC[REAL_LT_REFL]; ALL_TAC] THEN BETA_TAC THEN
2970   REWRITE_TAC[ABS_MUL] THEN MATCH_MP_TAC REAL_LT_MUL2_ALT THEN
2971   ASM_REWRITE_TAC[ABS_POS]);;
2972
2973 let NET_NULL_CMUL = prove(
2974   `!g:A->A->bool. !k x.
2975       (x --> &0)(mtop(mr1),g) ==> ((\n. k * x(n)) --> &0)(mtop(mr1),g)`,
2976   REPEAT GEN_TAC THEN REWRITE_TAC[MTOP_TENDS; MR1_DEF] THEN
2977   BETA_TAC THEN REWRITE_TAC[REAL_SUB_LZERO; ABS_NEG] THEN
2978   DISCH_THEN((then_) (X_GEN_TAC `e:real` THEN DISCH_TAC) o MP_TAC) THEN
2979   ASM_CASES_TAC `k = &0` THENL
2980    [DISCH_THEN(MP_TAC o SPEC `&1`) THEN
2981     REWRITE_TAC[REAL_LT; num_CONV `1`; LESS_SUC_REFL] THEN
2982     DISCH_THEN(X_CHOOSE_THEN `N:A` STRIP_ASSUME_TAC) THEN
2983     EXISTS_TAC `N:A` THEN
2984     ASM_REWRITE_TAC[REAL_MUL_LZERO; real_abs; REAL_LE_REFL];
2985     DISCH_THEN(MP_TAC o SPEC `e / abs(k)`) THEN
2986     SUBGOAL_THEN `&0 < e / abs(k)` ASSUME_TAC THENL
2987      [REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LT_MUL THEN
2988       ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INV_POS THEN
2989       ASM_REWRITE_TAC[GSYM ABS_NZ]; ALL_TAC] THEN
2990     ASM_REWRITE_TAC[] THEN
2991     DISCH_THEN(X_CHOOSE_THEN `N:A` STRIP_ASSUME_TAC) THEN
2992     EXISTS_TAC `N:A` THEN ASM_REWRITE_TAC[] THEN
2993     GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN ASSUME_TAC) THEN
2994     SUBGOAL_THEN `e = abs(k) * (e / abs(k))` SUBST1_TAC THENL
2995      [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_LMUL THEN
2996       ASM_REWRITE_TAC[ABS_ZERO]; ALL_TAC] THEN
2997     REWRITE_TAC[ABS_MUL] THEN
2998     SUBGOAL_THEN `&0 < abs k` (fun th -> REWRITE_TAC[MATCH_MP REAL_LT_LMUL_EQ th])
2999     THEN ASM_REWRITE_TAC[GSYM ABS_NZ]]);;
3000
3001 (*----------------------------------------------------------------------------*)
3002 (* Now real arithmetic theorems for convergent nets                           *)
3003 (*----------------------------------------------------------------------------*)
3004
3005 let NET_ADD = prove(
3006   `!g:A->A->bool x x0 y y0.
3007         dorder g
3008         ==> (x --> x0)(mtop(mr1),g) /\ (y --> y0)(mtop(mr1),g)
3009             ==> ((\n. x(n) + y(n)) --> (x0 + y0))(mtop(mr1),g)`,
3010   REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
3011   ONCE_REWRITE_TAC[NET_NULL] THEN
3012   DISCH_THEN(fun th -> FIRST_ASSUM
3013     (MP_TAC o C MATCH_MP th o MATCH_MP NET_NULL_ADD))
3014   THEN MATCH_MP_TAC EQ_IMP THEN EQUAL_TAC THEN
3015   BETA_TAC THEN REWRITE_TAC[real_sub; REAL_NEG_ADD] THEN
3016   REWRITE_TAC[REAL_ADD_AC]);;
3017
3018 let NET_NEG = prove(
3019   `!g:A->A->bool x x0.
3020         dorder g
3021         ==> ((x --> x0)(mtop(mr1),g) <=>
3022             ((\n. --(x n)) --> --x0)(mtop(mr1),g))`,
3023   REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
3024   REWRITE_TAC[MTOP_TENDS; MR1_DEF] THEN BETA_TAC THEN
3025   REWRITE_TAC[REAL_SUB_NEG2] THEN
3026   GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ABS_SUB] THEN
3027   REFL_TAC);;
3028
3029 let NET_SUB = prove(
3030   `!g:A->A->bool x x0 y y0.
3031       dorder g
3032       ==> (x --> x0)(mtop(mr1),g) /\ (y --> y0)(mtop(mr1),g)
3033           ==> ((\n. x(n) - y(n)) --> (x0 - y0))(mtop(mr1),g)`,
3034   REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN
3035   REWRITE_TAC[real_sub] THEN
3036   CONV_TAC(EXACT_CONV[X_BETA_CONV `n:A` `--(y(n:A))`]) THEN
3037   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP NET_ADD) THEN
3038   ASM_REWRITE_TAC[] THEN
3039   FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[GSYM(MATCH_MP NET_NEG th)]) THEN
3040   ASM_REWRITE_TAC[]);;
3041
3042 let NET_MUL = prove(
3043   `!g:A->A->bool x y x0 y0.
3044         dorder g
3045         ==> (x --> x0)(mtop(mr1),g) /\ (y --> y0)(mtop(mr1),g)
3046             ==> ((\n. x(n) * y(n)) --> (x0 * y0))(mtop(mr1),g)`,
3047   REPEAT GEN_TAC THEN DISCH_TAC THEN
3048   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[NET_NULL] THEN
3049   DISCH_TAC THEN BETA_TAC THEN
3050   SUBGOAL_THEN `!a b c d. (a * b) - (c * d) = (a * (b - d)) + ((a - c) * d)`
3051   (fun th -> ONCE_REWRITE_TAC[th]) THENL
3052    [REPEAT GEN_TAC THEN
3053     REWRITE_TAC[real_sub; REAL_LDISTRIB; REAL_RDISTRIB; GSYM REAL_ADD_ASSOC]
3054     THEN AP_TERM_TAC THEN
3055     REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN
3056     REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_LID]; ALL_TAC] THEN
3057   CONV_TAC(EXACT_CONV[X_BETA_CONV `n:A` `x(n:A) * (y(n) - y0)`]) THEN
3058   CONV_TAC(EXACT_CONV[X_BETA_CONV `n:A` `(x(n:A) - x0) * y0`]) THEN
3059   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP NET_NULL_ADD) THEN
3060   GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN
3061   (CONV_TAC o EXACT_CONV o map (X_BETA_CONV `n:A`))
3062    [`y(n:A) - y0`; `x(n:A) - x0`] THEN
3063   CONJ_TAC THENL
3064    [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP NET_NULL_MUL) THEN
3065     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NET_CONV_BOUNDED THEN
3066     EXISTS_TAC `x0:real` THEN ONCE_REWRITE_TAC[NET_NULL] THEN
3067     ASM_REWRITE_TAC[];
3068     MATCH_MP_TAC NET_NULL_CMUL THEN ASM_REWRITE_TAC[]]);;
3069
3070 let NET_INV = prove(
3071   `!g:A->A->bool x x0.
3072         dorder g
3073         ==> (x --> x0)(mtop(mr1),g) /\ ~(x0 = &0)
3074             ==> ((\n. inv(x(n))) --> inv x0)(mtop(mr1),g)`,
3075   REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
3076   DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN
3077     MP_TAC(CONJ (MATCH_MP NET_CONV_IBOUNDED th)
3078                     (MATCH_MP NET_CONV_NZ th))) THEN
3079   REWRITE_TAC[MR1_BOUNDED] THEN
3080   CONV_TAC(ONCE_DEPTH_CONV LEFT_AND_EXISTS_CONV) THEN
3081   DISCH_THEN(X_CHOOSE_THEN `k:real` MP_TAC) THEN
3082   DISCH_THEN(DORDER_THEN MP_TAC) THEN BETA_TAC THEN
3083   DISCH_THEN(MP_TAC o C CONJ
3084    (ASSUME `(x --> x0)(mtop mr1,(g:A->A->bool))`)) THEN
3085   ONCE_REWRITE_TAC[NET_NULL] THEN
3086   REWRITE_TAC[MTOP_TENDS; MR1_DEF; REAL_SUB_LZERO; ABS_NEG] THEN BETA_TAC
3087   THEN DISCH_THEN((then_)
3088    (X_GEN_TAC `e:real` THEN DISCH_TAC) o MP_TAC) THEN
3089   ONCE_REWRITE_TAC[RIGHT_AND_FORALL_THM] THEN
3090   DISCH_THEN(ASSUME_TAC o SPEC `e * abs(x0) * (inv k)`) THEN
3091   SUBGOAL_THEN `&0 < k` ASSUME_TAC THENL
3092    [FIRST_ASSUM(MP_TAC o CONJUNCT1) THEN
3093     DISCH_THEN(X_CHOOSE_THEN `N:A` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
3094     DISCH_THEN(MP_TAC o SPEC `N:A`) THEN ASM_REWRITE_TAC[] THEN
3095     DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN
3096     MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(inv(x(N:A)))` THEN
3097     ASM_REWRITE_TAC[ABS_POS]; ALL_TAC] THEN
3098   SUBGOAL_THEN `&0 < e * abs(x0) * inv k` ASSUME_TAC THENL
3099    [REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC) THEN
3100     ASM_REWRITE_TAC[GSYM ABS_NZ] THEN
3101     MATCH_MP_TAC REAL_INV_POS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
3102   FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN
3103   ASM_REWRITE_TAC[] THEN DISCH_THEN(DORDER_THEN MP_TAC) THEN
3104   DISCH_THEN(X_CHOOSE_THEN `N:A` (CONJUNCTS_THEN ASSUME_TAC)) THEN
3105   EXISTS_TAC `N:A` THEN ASM_REWRITE_TAC[] THEN
3106   X_GEN_TAC `n:A` THEN DISCH_THEN(ANTE_RES_THEN STRIP_ASSUME_TAC) THEN
3107   RULE_ASSUM_TAC BETA_RULE THEN POP_ASSUM_LIST(MAP_EVERY STRIP_ASSUME_TAC) THEN
3108   SUBGOAL_THEN `inv(x n) - inv x0 =
3109                 inv(x n) * inv x0 * (x0 - x(n:A))` SUBST1_TAC THENL
3110    [REWRITE_TAC[REAL_SUB_LDISTRIB] THEN
3111     REWRITE_TAC[MATCH_MP REAL_MUL_LINV (ASSUME `~(x0 = &0)`)] THEN
3112     REWRITE_TAC[REAL_MUL_RID] THEN REPEAT AP_TERM_TAC THEN
3113     ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN
3114     REWRITE_TAC[MATCH_MP REAL_MUL_RINV (ASSUME `~(x(n:A) = &0)`)] THEN
3115     REWRITE_TAC[REAL_MUL_RID]; ALL_TAC] THEN
3116   REWRITE_TAC[ABS_MUL] THEN ONCE_REWRITE_TAC[ABS_SUB] THEN
3117   SUBGOAL_THEN `e = e * (abs(inv x0) * abs(x0)) * (inv k * k)`
3118   SUBST1_TAC THENL
3119    [REWRITE_TAC[GSYM ABS_MUL] THEN
3120     REWRITE_TAC[MATCH_MP REAL_MUL_LINV (ASSUME `~(x0 = &0)`)] THEN
3121     REWRITE_TAC[MATCH_MP REAL_MUL_LINV
3122       (GSYM(MATCH_MP REAL_LT_IMP_NE (ASSUME `&0 < k`)))] THEN
3123     REWRITE_TAC[REAL_MUL_RID] THEN
3124     REWRITE_TAC[real_abs; REAL_LE; LE_LT; num_CONV `1`; LESS_SUC_REFL] THEN
3125     REWRITE_TAC[SYM(num_CONV `1`); REAL_MUL_RID]; ALL_TAC] THEN
3126   ONCE_REWRITE_TAC[AC REAL_MUL_AC
3127     `a * (b * c) * (d * e) = e * b * (a * c * d)`] THEN
3128   REWRITE_TAC[GSYM ABS_MUL] THEN
3129   MATCH_MP_TAC ABS_LT_MUL2 THEN ASM_REWRITE_TAC[] THEN
3130   REWRITE_TAC[ABS_MUL] THEN SUBGOAL_THEN `&0 < abs(inv x0)`
3131     (fun th -> ASM_REWRITE_TAC[MATCH_MP REAL_LT_LMUL_EQ th]) THEN
3132   REWRITE_TAC[GSYM ABS_NZ] THEN
3133   MATCH_MP_TAC REAL_INV_NZ THEN ASM_REWRITE_TAC[]);;
3134
3135 let NET_DIV = prove(
3136   `!g:A->A->bool x x0 y y0.
3137        dorder g
3138        ==> (x --> x0)(mtop(mr1),g) /\
3139            (y --> y0)(mtop(mr1),g) /\ ~(y0 = &0)
3140            ==> ((\n. x(n) / y(n)) --> (x0 / y0))(mtop(mr1),g)`,
3141   REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN
3142   REWRITE_TAC[real_div] THEN
3143   CONV_TAC(EXACT_CONV[X_BETA_CONV `n:A` `inv(y(n:A))`]) THEN
3144   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP NET_MUL) THEN
3145   ASM_REWRITE_TAC[] THEN
3146   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP NET_INV) THEN
3147   ASM_REWRITE_TAC[]);;
3148
3149 let NET_ABS = prove(
3150   `!x x0. (x --> x0)(mtop(mr1),g) ==>
3151                ((\n:A. abs(x n)) --> abs(x0))(mtop(mr1),g)`,
3152   REPEAT GEN_TAC THEN REWRITE_TAC[MTOP_TENDS] THEN
3153   DISCH_TAC THEN X_GEN_TAC `e:real` THEN
3154   DISCH_THEN(fun th -> POP_ASSUM(MP_TAC o C MATCH_MP th)) THEN
3155   DISCH_THEN(X_CHOOSE_THEN `N:A` STRIP_ASSUME_TAC) THEN
3156   EXISTS_TAC `N:A` THEN ASM_REWRITE_TAC[] THEN
3157   X_GEN_TAC `n:A` THEN DISCH_TAC THEN BETA_TAC THEN
3158   MATCH_MP_TAC REAL_LET_TRANS THEN
3159   EXISTS_TAC `mdist(mr1)(x(n:A),x0)` THEN CONJ_TAC THENL
3160    [REWRITE_TAC[MR1_DEF; ABS_SUB_ABS];
3161     FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC]);;
3162
3163 let NET_SUM = prove
3164  (`!g. dorder g /\
3165        ((\x. &0) --> &0)(mtop(mr1),g)
3166        ==> !m n. (!r. m <= r /\ r < m + n ==> (f r --> l r)(mtop(mr1),g))
3167                  ==> ((\x. sum(m,n) (\r. f r x)) --> sum(m,n) l)
3168                      (mtop(mr1),g)`,
3169   GEN_TAC THEN STRIP_TAC THEN
3170   ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN INDUCT_TAC THEN
3171   ASM_SIMP_TAC[sum] THEN REPEAT STRIP_TAC THEN
3172   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP NET_ADD) THEN CONJ_TAC THENL
3173    [FIRST_ASSUM MATCH_MP_TAC THEN
3174     X_GEN_TAC `r:num` THEN REPEAT STRIP_TAC THEN
3175     FIRST_ASSUM MATCH_MP_TAC THEN
3176     ASM_SIMP_TAC[ARITH_RULE `a < b + c ==> a < b + SUC c`];
3177     CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN FIRST_ASSUM MATCH_MP_TAC THEN
3178     ARITH_TAC]);;
3179
3180 (*----------------------------------------------------------------------------*)
3181 (* Comparison between limits                                                  *)
3182 (*----------------------------------------------------------------------------*)
3183
3184 let NET_LE = prove(
3185   `!g:A->A->bool x x0 y y0.
3186         dorder g
3187         ==> (x --> x0)(mtop(mr1),g) /\
3188             (y --> y0)(mtop(mr1),g) /\
3189             (?N. g N N /\ !n. g n N ==> x(n) <= y(n))
3190             ==> x0 <= y0`,
3191   REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN
3192   GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN
3193   PURE_ONCE_REWRITE_TAC[REAL_NOT_LE] THEN
3194   ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN
3195   FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN
3196   REWRITE_TAC[CONJ_ASSOC] THEN
3197   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
3198   REWRITE_TAC[MTOP_TENDS] THEN
3199   DISCH_THEN(MP_TAC o end_itlist CONJ o
3200     map (SPEC `(x0 - y0) / &2`) o CONJUNCTS) THEN
3201   ASM_REWRITE_TAC[REAL_LT_HALF1] THEN
3202   DISCH_THEN(DORDER_THEN MP_TAC) THEN
3203   FIRST_ASSUM(UNDISCH_TAC o check is_exists o concl) THEN
3204   DISCH_THEN(fun th1 -> DISCH_THEN (fun th2 -> MP_TAC(CONJ th1 th2))) THEN
3205   DISCH_THEN(DORDER_THEN MP_TAC) THEN
3206   DISCH_THEN(X_CHOOSE_THEN `N:A` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
3207   BETA_TAC THEN DISCH_THEN(MP_TAC o SPEC `N:A`) THEN ASM_REWRITE_TAC[] THEN
3208   REWRITE_TAC[MR1_DEF] THEN ONCE_REWRITE_TAC[ABS_SUB] THEN
3209   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
3210   REWRITE_TAC[REAL_NOT_LE] THEN MATCH_MP_TAC ABS_BETWEEN2 THEN
3211   MAP_EVERY EXISTS_TAC [`y0:real`; `x0:real`] THEN
3212   ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
3213   FIRST_ASSUM ACCEPT_TAC);;
3214
3215 (*============================================================================*)
3216 (* Theory of sequences and series of real numbers                             *)
3217 (*============================================================================*)
3218
3219 parse_as_infix ("tends_num_real",(12,"right"));;
3220
3221 parse_as_infix ("sums",(12,"right"));;
3222
3223 (*----------------------------------------------------------------------------*)
3224 (* Specialize net theorems to sequences:num->real                             *)
3225 (*----------------------------------------------------------------------------*)
3226
3227 let tends_num_real = new_definition(
3228   `x tends_num_real x0 <=> (x tends x0)(mtop(mr1), (>=) :num->num->bool)`);;
3229
3230 override_interface ("-->",`(tends_num_real)`);;
3231
3232 let SEQ = prove(
3233   `!x x0. (x --> x0) <=>
3234           !e. &0 < e ==> ?N. !n. n >= N ==> abs(x(n) - x0) < e`,
3235   REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real; SEQ_TENDS; MR1_DEF] THEN
3236   GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ABS_SUB] THEN
3237   REFL_TAC);;
3238
3239 let SEQ_CONST = prove(
3240   `!k. (\x. k) --> k`,
3241   REPEAT GEN_TAC THEN REWRITE_TAC[SEQ; REAL_SUB_REFL; ABS_0] THEN
3242   GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);;
3243
3244 let SEQ_ADD = prove(
3245   `!x x0 y y0. x --> x0 /\ y --> y0 ==> (\n. x(n) + y(n)) --> (x0 + y0)`,
3246   REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN
3247   MATCH_MP_TAC NET_ADD THEN
3248   MATCH_ACCEPT_TAC DORDER_NGE);;
3249
3250 let SEQ_MUL = prove(
3251   `!x x0 y y0. x --> x0 /\ y --> y0 ==> (\n. x(n) * y(n)) --> (x0 * y0)`,
3252   REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN
3253   MATCH_MP_TAC NET_MUL THEN
3254   MATCH_ACCEPT_TAC DORDER_NGE);;
3255
3256 let SEQ_NEG = prove(
3257   `!x x0. x --> x0 <=> (\n. --(x n)) --> --x0`,
3258   REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN
3259   MATCH_MP_TAC NET_NEG THEN
3260   MATCH_ACCEPT_TAC DORDER_NGE);;
3261
3262 let SEQ_INV = prove(
3263   `!x x0. x --> x0 /\ ~(x0 = &0) ==> (\n. inv(x n)) --> inv x0`,
3264   REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN
3265   MATCH_MP_TAC NET_INV THEN
3266   MATCH_ACCEPT_TAC DORDER_NGE);;
3267
3268 let SEQ_SUB = prove(
3269   `!x x0 y y0. x --> x0 /\ y --> y0 ==> (\n. x(n) - y(n)) --> (x0 - y0)`,
3270   REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN
3271   MATCH_MP_TAC NET_SUB THEN
3272   MATCH_ACCEPT_TAC DORDER_NGE);;
3273
3274 let SEQ_DIV = prove(
3275   `!x x0 y y0. x --> x0 /\ y --> y0 /\ ~(y0 = &0) ==>
3276                   (\n. x(n) / y(n)) --> (x0 / y0)`,
3277   REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN
3278   MATCH_MP_TAC NET_DIV THEN
3279   MATCH_ACCEPT_TAC DORDER_NGE);;
3280
3281 let SEQ_UNIQ = prove(
3282   `!x x1 x2. x --> x1 /\ x --> x2 ==> (x1 = x2)`,
3283   REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN
3284   MATCH_MP_TAC MTOP_TENDS_UNIQ THEN
3285   MATCH_ACCEPT_TAC DORDER_NGE);;
3286
3287 let SEQ_NULL = prove(
3288   `!s l. s --> l <=> (\n. s(n) - l) --> &0`,
3289   REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN
3290   MATCH_ACCEPT_TAC NET_NULL);;
3291
3292 let SEQ_SUM = prove
3293  (`!f l m n.
3294       (!r. m <= r /\ r < m + n ==> f r --> l r)
3295       ==> (\k. sum(m,n) (\r. f r k)) --> sum(m,n) l`,
3296   REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN
3297   MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM] NET_SUM) THEN
3298   REWRITE_TAC[SEQ_CONST; DORDER_NGE; GSYM tends_num_real]);;
3299
3300 let SEQ_TRANSFORM = prove
3301  (`!s t l N. (!n. N <= n ==> (s n = t n)) /\ s --> l ==> t --> l`,
3302   REWRITE_TAC[SEQ; GE] THEN
3303   MESON_TAC[ARITH_RULE `M + N <= n:num ==> M <= n /\ N <= n`]);;
3304
3305 (*----------------------------------------------------------------------------*)
3306 (* Define convergence and Cauchy-ness                                         *)
3307 (*----------------------------------------------------------------------------*)
3308
3309 let convergent = new_definition(
3310   `convergent f <=> ?l. f --> l`);;
3311
3312 let cauchy = new_definition(
3313   `cauchy f <=> !e. &0 < e ==>
3314         ?N:num. !m n. m >= N /\ n >= N ==> abs(f(m) - f(n)) < e`);;
3315
3316 let lim = new_definition(
3317   `lim f = @l. f --> l`);;
3318
3319 let SEQ_LIM = prove(
3320   `!f. convergent f <=> (f --> lim f)`,
3321   GEN_TAC THEN REWRITE_TAC[convergent] THEN EQ_TAC THENL
3322    [DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[lim];
3323     DISCH_TAC THEN EXISTS_TAC `lim f` THEN POP_ASSUM ACCEPT_TAC]);;
3324
3325 (*----------------------------------------------------------------------------*)
3326 (* Define a subsequence                                                       *)
3327 (*----------------------------------------------------------------------------*)
3328
3329 let subseq = new_definition(
3330   `subseq (f:num->num) <=> !m n. m < n ==> (f m) < (f n)`);;
3331
3332 let SUBSEQ_SUC = prove(
3333   `!f. subseq f <=> !n. f(n) < f(SUC n)`,
3334   GEN_TAC THEN REWRITE_TAC[subseq] THEN EQ_TAC THEN DISCH_TAC THENL
3335    [X_GEN_TAC `n:num` THEN POP_ASSUM MATCH_MP_TAC THEN
3336     REWRITE_TAC[LESS_SUC_REFL];
3337     REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LESS_ADD_1) THEN
3338     REWRITE_TAC[GSYM ADD1] THEN
3339     DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC) THEN
3340     SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THENL
3341      [ALL_TAC;
3342       MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `f(m + (SUC p)):num`] THEN
3343     ASM_REWRITE_TAC[ADD_CLAUSES]]);;
3344
3345 (*----------------------------------------------------------------------------*)
3346 (* Define monotonicity                                                        *)
3347 (*----------------------------------------------------------------------------*)
3348
3349 let mono = new_definition(
3350   `mono (f:num->real) <=>
3351             (!m n. m <= n ==> f(m) <= f(n)) \/
3352             (!m n. m <= n ==> f(m) >= f(n))`);;
3353
3354 let MONO_SUC = prove(
3355   `!f. mono f <=> (!n. f(SUC n) >= f(n)) \/ (!n. f(SUC n) <= f(n))`,
3356   GEN_TAC THEN REWRITE_TAC[mono; real_ge] THEN
3357   MATCH_MP_TAC(TAUT `(a <=> c) /\ (b <=> d) ==> (a \/ b <=> c \/ d)`) THEN
3358   CONJ_TAC THEN (EQ_TAC THENL
3359     [DISCH_THEN(MP_TAC o GEN `n:num` o SPECL [`n:num`; `SUC n`]) THEN
3360      REWRITE_TAC[LESS_EQ_SUC_REFL];
3361      DISCH_TAC THEN REPEAT GEN_TAC THEN
3362      DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC o MATCH_MP LESS_EQUAL_ADD) THEN
3363      SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN
3364      ASM_REWRITE_TAC[ADD_CLAUSES; REAL_LE_REFL] THEN
3365      MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f(m + p:num):real` THEN
3366      ASM_REWRITE_TAC[]]));;
3367
3368 (*----------------------------------------------------------------------------*)
3369 (* Simpler characterization of bounded sequence                               *)
3370 (*----------------------------------------------------------------------------*)
3371
3372 let MAX_LEMMA = prove(
3373   `!s N. ?k. !n:num. n < N ==> abs(s n) < k`,
3374   GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[NOT_LESS_0] THEN
3375   POP_ASSUM(X_CHOOSE_TAC `k:real`) THEN
3376   DISJ_CASES_TAC (SPECL [`k:real`; `abs(s(N:num))`] REAL_LET_TOTAL) THENL
3377    [EXISTS_TAC `abs(s(N:num)) + &1`; EXISTS_TAC `k:real`] THEN
3378   X_GEN_TAC `n:num` THEN REWRITE_TAC[CONJUNCT2 LT] THEN
3379   DISCH_THEN(DISJ_CASES_THEN2 SUBST1_TAC MP_TAC) THEN
3380   TRY(MATCH_MP_TAC REAL_LT_ADD1) THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN
3381   DISCH_THEN(ANTE_RES_THEN ASSUME_TAC) THEN
3382   MATCH_MP_TAC REAL_LT_ADD1 THEN
3383   MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `k:real` THEN
3384   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
3385   ASM_REWRITE_TAC[]);;
3386
3387 let SEQ_BOUNDED = prove(
3388   `!s. bounded(mr1, (>=)) s <=> ?k. !n:num. abs(s n) < k`,
3389   GEN_TAC THEN REWRITE_TAC[MR1_BOUNDED] THEN
3390   REWRITE_TAC[GE; LE_REFL] THEN EQ_TAC THENL
3391    [DISCH_THEN(X_CHOOSE_THEN `k:real` (X_CHOOSE_TAC `N:num`)) THEN
3392     MP_TAC(SPECL [`s:num->real`; `N:num`] MAX_LEMMA) THEN
3393     DISCH_THEN(X_CHOOSE_TAC `l:real`) THEN
3394     DISJ_CASES_TAC (SPECL [`k:real`; `l:real`] REAL_LE_TOTAL) THENL
3395      [EXISTS_TAC `l:real`; EXISTS_TAC `k:real`] THEN
3396     X_GEN_TAC `n:num` THEN MP_TAC(SPECL [`n:num`; `N:num`] LTE_CASES) THEN
3397     DISCH_THEN(DISJ_CASES_THEN(ANTE_RES_THEN ASSUME_TAC)) THEN
3398     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN
3399     FIRST_ASSUM(fun th -> EXISTS_TAC(rand(concl th)) THEN
3400       ASM_REWRITE_TAC[] THEN NO_TAC);
3401     DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN
3402     MAP_EVERY EXISTS_TAC [`k:real`; `0`] THEN
3403     GEN_TAC THEN ASM_REWRITE_TAC[]]);;
3404
3405 let SEQ_BOUNDED_2 = prove(
3406   `!f k K. (!n:num. k <= f(n) /\ f(n) <= K) ==> bounded(mr1, (>=)) f`,
3407   REPEAT STRIP_TAC THEN REWRITE_TAC[SEQ_BOUNDED] THEN
3408   EXISTS_TAC `(abs(k) + abs(K)) + &1` THEN GEN_TAC THEN
3409   MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(k) + abs(K)` THEN
3410   REWRITE_TAC[REAL_LT_ADDR; REAL_LT_01] THEN
3411   GEN_REWRITE_TAC LAND_CONV [real_abs] THEN COND_CASES_TAC THENL
3412    [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(K)` THEN
3413     REWRITE_TAC[REAL_LE_ADDL; ABS_POS] THEN
3414     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `K:real` THEN
3415     ASM_REWRITE_TAC[ABS_LE];
3416     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(k)` THEN
3417     REWRITE_TAC[REAL_LE_ADDR; ABS_POS] THEN
3418     REWRITE_TAC[real_abs] THEN
3419     COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_NEG] THEN
3420     SUBGOAL_THEN `&0 <= f(n:num)` MP_TAC THENL
3421      [MATCH_MP_TAC REAL_LE_TRANS THEN
3422       EXISTS_TAC `k:real` THEN ASM_REWRITE_TAC[];
3423       ASM_REWRITE_TAC[]]]);;
3424
3425 (*----------------------------------------------------------------------------*)
3426 (* Show that every Cauchy sequence is bounded                                 *)
3427 (*----------------------------------------------------------------------------*)
3428
3429 let SEQ_CBOUNDED = prove(
3430   `!f. cauchy f ==> bounded(mr1, (>=)) f`,
3431   GEN_TAC THEN REWRITE_TAC[bounded; cauchy] THEN
3432   DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN
3433   DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN
3434   MAP_EVERY EXISTS_TAC [`&1`; `(f:num->real) N`; `N:num`] THEN
3435   REWRITE_TAC[GE; LE_REFL] THEN
3436   POP_ASSUM(MP_TAC o SPEC `N:num`) THEN
3437   REWRITE_TAC[GE; LE_REFL; MR1_DEF]);;
3438
3439 (*----------------------------------------------------------------------------*)
3440 (* Show that a bounded and monotonic sequence converges                       *)
3441 (*----------------------------------------------------------------------------*)
3442
3443 let SEQ_ICONV = prove(
3444   `!f. bounded(mr1, (>=)) f /\ (!m n. m >= n ==> f(m) >= f(n))
3445            ==> convergent f`,
3446   GEN_TAC THEN DISCH_TAC THEN
3447   MP_TAC (SPEC `\x:real. ?n:num. x = f(n)` REAL_SUP) THEN BETA_TAC THEN
3448   W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL
3449    [CONJ_TAC THENL
3450      [MAP_EVERY EXISTS_TAC [`f(0):real`; `0`] THEN REFL_TAC;
3451       POP_ASSUM(MP_TAC o REWRITE_RULE[SEQ_BOUNDED] o CONJUNCT1) THEN
3452       DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN EXISTS_TAC `k:real` THEN
3453       GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN
3454       MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(f(n:num))` THEN
3455       ASM_REWRITE_TAC[ABS_LE]]; ALL_TAC] THEN
3456   DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN DISCH_TAC THEN
3457   REWRITE_TAC[convergent] THEN EXISTS_TAC `sup(\x. ?n:num. x = f(n))` THEN
3458   REWRITE_TAC[SEQ] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
3459   FIRST_ASSUM(MP_TAC o check(is_forall o concl)) THEN
3460   DISCH_THEN(MP_TAC o SPEC `sup(\x. ?n:num. x = f(n)) - e`) THEN
3461   REWRITE_TAC[REAL_LT_SUB_RADD; REAL_LT_ADDR] THEN
3462   ASM_REWRITE_TAC[] THEN
3463   DISCH_THEN(X_CHOOSE_THEN `x:real` MP_TAC) THEN
3464   ONCE_REWRITE_TAC[CONJ_SYM] THEN
3465   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_THEN `n:num` SUBST1_TAC)) THEN
3466   ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[GSYM REAL_LT_SUB_RADD] THEN
3467   DISCH_TAC THEN SUBGOAL_THEN `!n. f(n) <= sup(\x. ?n:num. x = f(n))`
3468   ASSUME_TAC THENL
3469    [FIRST_ASSUM(MP_TAC o SPEC `sup(\x. ?n:num. x = f(n))`) THEN
3470     REWRITE_TAC[REAL_LT_REFL] THEN
3471     CONV_TAC(ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN
3472     REWRITE_TAC[TAUT `~(a /\ b) <=> a ==> ~b`] THEN
3473     REWRITE_TAC[REAL_NOT_LT] THEN
3474     CONV_TAC(ONCE_DEPTH_CONV LEFT_IMP_EXISTS_CONV) THEN
3475     DISCH_THEN(MP_TAC o GEN `n:num` o SPECL [`(f:num->real) n`; `n:num`]) THEN
3476     REWRITE_TAC[]; ALL_TAC] THEN
3477   EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN
3478   FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN
3479   DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN
3480   DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN
3481   RULE_ASSUM_TAC(REWRITE_RULE[REAL_LT_SUB_RADD]) THEN
3482   RULE_ASSUM_TAC(ONCE_REWRITE_RULE[REAL_ADD_SYM]) THEN
3483   RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_LT_SUB_RADD]) THEN
3484   REWRITE_TAC[real_ge] THEN DISCH_TAC THEN
3485   SUBGOAL_THEN `(sup(\x. ?m:num. x = f(m)) - e) < f(m)` ASSUME_TAC THENL
3486    [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `(f:num->real) n` THEN
3487     ASM_REWRITE_TAC[]; ALL_TAC] THEN
3488   REWRITE_TAC[real_abs] THEN COND_CASES_TAC THEN
3489   ASM_REWRITE_TAC[REAL_NEG_SUB] THENL
3490    [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&0` THEN
3491     ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_sub] THEN
3492     (SUBST1_TAC o REWRITE_RULE[REAL_ADD_RINV] o C SPECL REAL_LE_RADD)
3493       [`(f:num->real) m`; `(sup(\x. ?n:num. x = f(n)))`;
3494        `--(sup(\x. ?n:num. x = f(n)))`] THEN
3495     ASM_REWRITE_TAC[];
3496     REWRITE_TAC[REAL_LT_SUB_RADD] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
3497     REWRITE_TAC[GSYM REAL_LT_SUB_RADD] THEN ASM_REWRITE_TAC[]]);;
3498
3499 let SEQ_NEG_CONV = prove(
3500   `!f. convergent f <=> convergent (\n. --(f n))`,
3501   GEN_TAC THEN REWRITE_TAC[convergent] THEN EQ_TAC THEN
3502   DISCH_THEN(X_CHOOSE_TAC `l:real`) THEN
3503   EXISTS_TAC `--l` THEN POP_ASSUM MP_TAC THEN
3504   SUBST1_TAC(SYM(SPEC `l:real` REAL_NEGNEG)) THEN
3505   REWRITE_TAC[GSYM SEQ_NEG] THEN REWRITE_TAC[REAL_NEGNEG]);;
3506
3507 let SEQ_NEG_BOUNDED = prove(
3508   `!f. bounded(mr1, (>=))(\n:num. --(f n)) <=> bounded(mr1, (>=)) f`,
3509   GEN_TAC THEN REWRITE_TAC[SEQ_BOUNDED] THEN BETA_TAC THEN
3510   REWRITE_TAC[ABS_NEG]);;
3511
3512 let SEQ_BCONV = prove(
3513   `!f. bounded(mr1, (>=)) f /\ mono f ==> convergent f`,
3514   GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3515   REWRITE_TAC[mono] THEN DISCH_THEN DISJ_CASES_TAC THENL
3516    [MATCH_MP_TAC SEQ_ICONV THEN ASM_REWRITE_TAC[GE; real_ge];
3517     ONCE_REWRITE_TAC[SEQ_NEG_CONV] THEN MATCH_MP_TAC SEQ_ICONV THEN
3518     ASM_REWRITE_TAC[SEQ_NEG_BOUNDED] THEN BETA_TAC THEN
3519     REWRITE_TAC[GE; real_ge; REAL_LE_NEG] THEN
3520     ONCE_REWRITE_TAC[GSYM real_ge] THEN ASM_REWRITE_TAC[]]);;
3521
3522 (*----------------------------------------------------------------------------*)
3523 (* Show that every sequence contains a monotonic subsequence                  *)
3524 (*----------------------------------------------------------------------------*)
3525
3526 let SEQ_MONOSUB = prove(
3527   `!s:num->real. ?f. subseq f /\ mono(\n.s(f n))`,
3528   GEN_TAC THEN
3529   ASM_CASES_TAC `!n:num. ?p. p > n /\ !m. m >= p ==> s(m) <= s(p)` THENL
3530    [(X_CHOOSE_THEN `f:num->num` MP_TAC o EXISTENCE o C ISPECL num_Axiom)
3531      [`@p. p > 0 /\ (!m. m >= p ==> (s m) <= (s p))`;
3532       `\x. \n:num. @p:num. p > x /\
3533                        (!m. m >= p ==> (s m) <= (s p))`] THEN
3534     BETA_TAC THEN RULE_ASSUM_TAC(GEN `n:num` o SELECT_RULE o SPEC `n:num`) THEN
3535     POP_ASSUM(fun th -> DISCH_THEN(ASSUME_TAC o GSYM) THEN
3536     MP_TAC(SPEC `0` th) THEN
3537     MP_TAC(GEN `n:num` (SPEC `(f:num->num) n` th))) THEN
3538     ASM_REWRITE_TAC[] THEN POP_ASSUM(K ALL_TAC) THEN REPEAT STRIP_TAC THEN
3539     EXISTS_TAC `f:num->num` THEN ASM_REWRITE_TAC[SUBSEQ_SUC; GSYM GT] THEN
3540     SUBGOAL_THEN `!p q. p:num >= (f q) ==> s(p) <= s(f(q:num))` MP_TAC THENL
3541      [REPEAT GEN_TAC THEN STRUCT_CASES_TAC(SPEC `q:num` num_CASES) THEN
3542       ASM_REWRITE_TAC[]; ALL_TAC] THEN
3543     DISCH_THEN(MP_TAC o GEN `q:num` o SPECL [`f(SUC q):num`; `q:num`]) THEN
3544     SUBGOAL_THEN `!q. f(SUC q):num >= f(q)` (fun th -> REWRITE_TAC[th]) THENL
3545      [GEN_TAC THEN REWRITE_TAC[GE] THEN
3546       MATCH_MP_TAC LT_IMP_LE
3547       THEN ASM_REWRITE_TAC[GSYM GT]; ALL_TAC] THEN
3548     DISCH_TAC THEN REWRITE_TAC[MONO_SUC] THEN DISJ2_TAC THEN
3549     BETA_TAC THEN ASM_REWRITE_TAC[];
3550     POP_ASSUM(X_CHOOSE_TAC `N:num` o CONV_RULE NOT_FORALL_CONV) THEN
3551     POP_ASSUM(MP_TAC o CONV_RULE NOT_EXISTS_CONV) THEN
3552     REWRITE_TAC[TAUT `~(a /\ b) <=> a ==> ~b`] THEN
3553     CONV_TAC(ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN
3554     REWRITE_TAC[NOT_IMP; REAL_NOT_LE] THEN DISCH_TAC THEN
3555     SUBGOAL_THEN `!p. p >= SUC N ==> (?m. m > p /\ s(p) < s(m))`
3556     MP_TAC THENL
3557      [GEN_TAC THEN REWRITE_TAC[GE; LE_SUC_LT] THEN
3558       REWRITE_TAC[GSYM GT] THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN
3559       REWRITE_TAC[GE; LE_LT; RIGHT_AND_OVER_OR; GT] THEN
3560       DISCH_THEN(X_CHOOSE_THEN `m:num` DISJ_CASES_TAC) THENL
3561        [EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[];
3562         FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN
3563         DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
3564         ASM_REWRITE_TAC[REAL_LT_REFL]]; ALL_TAC] THEN
3565     POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN
3566     (X_CHOOSE_THEN `f:num->num` MP_TAC o EXISTENCE o C ISPECL num_Axiom)
3567      [`@m. m > (SUC N) /\ s(SUC N) < s(m)`;
3568       `\x. \n:num. @m:num. m > x /\ s(x) < s(m)`] THEN
3569     BETA_TAC THEN DISCH_THEN ASSUME_TAC THEN SUBGOAL_THEN
3570       `!n. f(n) >= (SUC N) /\
3571            f(SUC n) > f(n) /\ s(f n) < s(f(SUC n):num)` MP_TAC THENL
3572      [INDUCT_TAC THENL
3573        [SUBGOAL_THEN `f(0) >= (SUC N)` MP_TAC THENL
3574          [FIRST_ASSUM(MP_TAC o SPEC `SUC N`) THEN
3575           REWRITE_TAC[GE; LE_REFL] THEN
3576           DISCH_THEN(MP_TAC o SELECT_RULE) THEN ASM_REWRITE_TAC[] THEN
3577           DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN
3578           MATCH_MP_TAC LT_IMP_LE THEN
3579           ASM_REWRITE_TAC[GSYM GT]; ALL_TAC] THEN
3580         DISCH_THEN(fun th -> ASSUME_TAC th THEN REWRITE_TAC[th]) THEN
3581         FIRST_ASSUM(fun th -> REWRITE_TAC[CONJUNCT2 th]) THEN
3582         CONV_TAC SELECT_CONV THEN FIRST_ASSUM MATCH_MP_TAC THEN
3583         FIRST_ASSUM ACCEPT_TAC;
3584         FIRST_ASSUM(UNDISCH_TAC o
3585           check((=)3 o length o conjuncts) o concl) THEN
3586         DISCH_THEN STRIP_ASSUME_TAC THEN CONJ_TAC THENL
3587          [REWRITE_TAC[GE] THEN MATCH_MP_TAC LE_TRANS THEN
3588           EXISTS_TAC `(f:num->num) n` THEN REWRITE_TAC[GSYM GE] THEN
3589           CONJ_TAC THEN TRY(FIRST_ASSUM ACCEPT_TAC) THEN
3590           REWRITE_TAC[GE] THEN MATCH_MP_TAC LT_IMP_LE THEN
3591           REWRITE_TAC[GSYM GT] THEN FIRST_ASSUM ACCEPT_TAC;
3592           FIRST_ASSUM(SUBST1_TAC o SPEC `SUC n` o CONJUNCT2) THEN
3593           CONV_TAC SELECT_CONV THEN FIRST_ASSUM MATCH_MP_TAC THEN
3594           REWRITE_TAC[GE] THEN MATCH_MP_TAC LE_TRANS THEN
3595           EXISTS_TAC `(f:num->num) n` THEN
3596           REWRITE_TAC[GSYM GE] THEN CONJ_TAC THEN
3597           TRY(FIRST_ASSUM ACCEPT_TAC) THEN
3598           REWRITE_TAC[GE] THEN MATCH_MP_TAC LT_IMP_LE THEN
3599           REWRITE_TAC[GSYM GT] THEN
3600           FIRST_ASSUM ACCEPT_TAC]]; ALL_TAC] THEN
3601     POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_TAC THEN
3602     EXISTS_TAC `f:num->num` THEN REWRITE_TAC[SUBSEQ_SUC; MONO_SUC] THEN
3603     ASM_REWRITE_TAC[GSYM GT] THEN DISJ1_TAC THEN BETA_TAC THEN
3604     GEN_TAC THEN REWRITE_TAC[real_ge] THEN
3605     MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]);;
3606
3607 (*----------------------------------------------------------------------------*)
3608 (* Show that a subsequence of a bounded sequence is bounded                   *)
3609 (*----------------------------------------------------------------------------*)
3610
3611 let SEQ_SBOUNDED = prove(
3612   `!s (f:num->num). bounded(mr1, (>=)) s ==> bounded(mr1, (>=)) (\n. s(f n))`,
3613   REPEAT GEN_TAC THEN REWRITE_TAC[SEQ_BOUNDED] THEN
3614   DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN EXISTS_TAC `k:real` THEN
3615   GEN_TAC THEN BETA_TAC THEN ASM_REWRITE_TAC[]);;
3616
3617 (*----------------------------------------------------------------------------*)
3618 (* Show we can take subsequential terms arbitrarily far up a sequence         *)
3619 (*----------------------------------------------------------------------------*)
3620
3621 let SEQ_SUBLE = prove(
3622   `!f n. subseq f ==> n <= f(n)`,
3623   GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
3624   DISCH_TAC THEN INDUCT_TAC THENL
3625    [REWRITE_TAC[GSYM NOT_LT; NOT_LESS_0];
3626     MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `SUC(f(n:num))` THEN
3627     ASM_REWRITE_TAC[LE_SUC] THEN
3628     REWRITE_TAC[LE_SUC_LT] THEN
3629     UNDISCH_TAC `subseq f` THEN REWRITE_TAC[SUBSEQ_SUC] THEN
3630     DISCH_THEN MATCH_ACCEPT_TAC]);;
3631
3632 let SEQ_DIRECT = prove(
3633   `!f. subseq f ==> !N1 N2. ?n. n >= N1 /\ f(n) >= N2`,
3634   GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN
3635   DISJ_CASES_TAC (SPECL [`N1:num`; `N2:num`] LE_CASES) THENL
3636    [EXISTS_TAC `N2:num` THEN ASM_REWRITE_TAC[GE] THEN
3637     MATCH_MP_TAC SEQ_SUBLE THEN
3638     FIRST_ASSUM ACCEPT_TAC;
3639     EXISTS_TAC `N1:num` THEN REWRITE_TAC[GE; LE_REFL] THEN
3640     REWRITE_TAC[GE] THEN MATCH_MP_TAC LE_TRANS THEN
3641     EXISTS_TAC `N1:num` THEN ASM_REWRITE_TAC[] THEN
3642     MATCH_MP_TAC SEQ_SUBLE THEN
3643     FIRST_ASSUM ACCEPT_TAC]);;
3644
3645 (*----------------------------------------------------------------------------*)
3646 (* Now show that every Cauchy sequence converges                              *)
3647 (*----------------------------------------------------------------------------*)
3648
3649 let SEQ_CAUCHY = prove(
3650   `!f. cauchy f <=> convergent f`,
3651   GEN_TAC THEN EQ_TAC THENL
3652    [DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP SEQ_CBOUNDED) THEN
3653     MP_TAC(SPEC `f:num->real` SEQ_MONOSUB) THEN
3654     DISCH_THEN(X_CHOOSE_THEN `g:num->num` STRIP_ASSUME_TAC) THEN
3655     SUBGOAL_THEN `bounded(mr1, (>=) :num->num->bool)(\n. f(g(n):num))`
3656     ASSUME_TAC THENL
3657      [MATCH_MP_TAC SEQ_SBOUNDED THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
3658     SUBGOAL_THEN `convergent (\n. f(g(n):num))` MP_TAC THENL
3659      [MATCH_MP_TAC SEQ_BCONV THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
3660     REWRITE_TAC[convergent] THEN DISCH_THEN(X_CHOOSE_TAC `l:real`) THEN
3661     EXISTS_TAC `l:real` THEN REWRITE_TAC[SEQ] THEN
3662     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
3663     UNDISCH_TAC `(\n. f(g(n):num)) --> l` THEN REWRITE_TAC[SEQ] THEN
3664     DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN
3665     BETA_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN
3666     UNDISCH_TAC `cauchy f` THEN REWRITE_TAC[cauchy] THEN
3667     DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN
3668     DISCH_THEN(X_CHOOSE_THEN `N2:num` ASSUME_TAC) THEN
3669     FIRST_ASSUM(MP_TAC o MATCH_MP SEQ_DIRECT) THEN
3670     DISCH_THEN(MP_TAC o SPECL [`N1:num`; `N2:num`]) THEN
3671     DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN
3672     EXISTS_TAC `N2:num` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN
3673     UNDISCH_TAC `!n:num. n >= N1 ==> abs(f(g n:num) - l) < (e / &2)` THEN
3674     DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN
3675     DISCH_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN
3676     DISCH_THEN(MP_TAC o SPECL [`g(n:num):num`; `m:num`]) THEN
3677     ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
3678     MATCH_MP_TAC REAL_LET_TRANS THEN
3679     SUBGOAL_THEN `f(m:num) - l = (f(m) - f(g(n:num))) + (f(g n) - l)`
3680     SUBST1_TAC THENL [REWRITE_TAC[REAL_SUB_TRIANGLE]; ALL_TAC] THEN
3681     EXISTS_TAC `abs(f(m:num) - f(g(n:num))) + abs(f(g n) - l)` THEN
3682     REWRITE_TAC[ABS_TRIANGLE] THEN
3683     SUBST1_TAC(SYM(SPEC `e:real` REAL_HALF_DOUBLE)) THEN
3684     MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_REWRITE_TAC[] THEN
3685     ONCE_REWRITE_TAC[ABS_SUB] THEN ASM_REWRITE_TAC[];
3686
3687     REWRITE_TAC[convergent] THEN
3688     DISCH_THEN(X_CHOOSE_THEN `l:real` MP_TAC) THEN
3689     REWRITE_TAC[SEQ; cauchy] THEN DISCH_TAC THEN
3690     X_GEN_TAC `e:real` THEN DISCH_TAC THEN
3691     FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN
3692     DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN
3693     ASM_REWRITE_TAC[REAL_LT_HALF1] THEN
3694     DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN
3695     EXISTS_TAC `N:num` THEN REPEAT GEN_TAC THEN
3696     DISCH_THEN(CONJUNCTS_THEN (ANTE_RES_THEN ASSUME_TAC)) THEN
3697     MATCH_MP_TAC REAL_LET_TRANS THEN
3698     SUBGOAL_THEN `f(m:num) - f(n) = (f(m) - l) + (l - f(n))`
3699     SUBST1_TAC THENL [REWRITE_TAC[REAL_SUB_TRIANGLE]; ALL_TAC] THEN
3700     EXISTS_TAC `abs(f(m:num) - l) + abs(l - f(n))` THEN
3701     REWRITE_TAC[ABS_TRIANGLE] THEN
3702     SUBST1_TAC(SYM(SPEC `e:real` REAL_HALF_DOUBLE)) THEN
3703     MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_REWRITE_TAC[] THEN
3704     ONCE_REWRITE_TAC[ABS_SUB] THEN ASM_REWRITE_TAC[]]);;
3705
3706 (*----------------------------------------------------------------------------*)
3707 (* The limit comparison property for sequences                                *)
3708 (*----------------------------------------------------------------------------*)
3709
3710 let SEQ_LE = prove(
3711   `!f g l m. f --> l /\ g --> m /\ (?N. !n. n >= N ==> f(n) <= g(n))
3712         ==> l <= m`,
3713   REPEAT GEN_TAC THEN
3714   MP_TAC(ISPEC `(>=) :num->num->bool` NET_LE) THEN
3715   REWRITE_TAC[DORDER_NGE; tends_num_real; GE; LE_REFL] THEN
3716   DISCH_THEN MATCH_ACCEPT_TAC);;
3717
3718 (* ------------------------------------------------------------------------- *)
3719 (* When a sequence tends to zero.                                            *)
3720 (* ------------------------------------------------------------------------- *)
3721
3722 let SEQ_LE_0 = prove
3723  (`!f g. f --> &0 /\ (?N. !n. n >= N ==> abs(g n) <= abs(f n))
3724          ==> g --> &0`,
3725   REWRITE_TAC[SEQ; REAL_SUB_RZERO; GE] THEN
3726   MESON_TAC[LE_CASES; LE_TRANS; REAL_LET_TRANS]);;
3727
3728 (*----------------------------------------------------------------------------*)
3729 (* We can displace a convergent series by 1                                   *)
3730 (*----------------------------------------------------------------------------*)
3731
3732 let SEQ_SUC = prove(
3733   `!f l. f --> l <=> (\n. f(SUC n)) --> l`,
3734   REPEAT GEN_TAC THEN REWRITE_TAC[SEQ; GE] THEN EQ_TAC THEN
3735   DISCH_THEN(fun th -> X_GEN_TAC `e:real` THEN
3736     DISCH_THEN(MP_TAC o MATCH_MP th)) THEN BETA_TAC THEN
3737   DISCH_THEN(X_CHOOSE_TAC `N:num`) THENL
3738    [EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
3739     FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC LE_TRANS THEN
3740     EXISTS_TAC `SUC N` THEN ASM_REWRITE_TAC[LE_SUC; LESS_EQ_SUC_REFL];
3741     EXISTS_TAC `SUC N` THEN X_GEN_TAC `n:num` THEN
3742     STRUCT_CASES_TAC (SPEC `n:num` num_CASES) THENL
3743      [REWRITE_TAC[GSYM NOT_LT; LT_0];
3744       REWRITE_TAC[LE_SUC] THEN DISCH_TAC THEN
3745       FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]]);;
3746
3747 (*----------------------------------------------------------------------------*)
3748 (* Prove a sequence tends to zero iff its abs does                            *)
3749 (*----------------------------------------------------------------------------*)
3750
3751 let SEQ_ABS = prove(
3752   `!f. (\n. abs(f n)) --> &0 <=> f --> &0`,
3753   GEN_TAC THEN REWRITE_TAC[SEQ] THEN
3754   BETA_TAC THEN REWRITE_TAC[REAL_SUB_RZERO; ABS_ABS]);;
3755
3756 (*----------------------------------------------------------------------------*)
3757 (* Half this is true for a general limit                                      *)
3758 (*----------------------------------------------------------------------------*)
3759
3760 let SEQ_ABS_IMP = prove(
3761   `!f l. f --> l ==> (\n. abs(f n)) --> abs(l)`,
3762   REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN
3763   MATCH_ACCEPT_TAC NET_ABS);;
3764
3765 (*----------------------------------------------------------------------------*)
3766 (* Prove that an unbounded sequence's inverse tends to 0                      *)
3767 (*----------------------------------------------------------------------------*)
3768
3769 let SEQ_INV0 = prove(
3770   `!f. (!y. ?N. !n. n >= N ==> f(n) > y)
3771         ==> (\n. inv(f n)) --> &0`,
3772   GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[SEQ; REAL_SUB_RZERO] THEN
3773   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
3774   FIRST_ASSUM(X_CHOOSE_TAC `N:num` o SPEC `inv e`) THEN
3775   EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN
3776   DISCH_THEN(fun th -> ASSUME_TAC th THEN ANTE_RES_THEN MP_TAC th) THEN
3777   REWRITE_TAC[real_gt] THEN BETA_TAC THEN
3778   IMP_RES_THEN ASSUME_TAC REAL_INV_POS THEN
3779   SUBGOAL_THEN `&0 < f(n:num)` ASSUME_TAC THENL
3780    [MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `inv e` THEN
3781     ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM real_gt] THEN
3782     FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
3783   SUBGOAL_THEN `&0 < inv(f(n:num))` ASSUME_TAC THENL
3784    [MATCH_MP_TAC REAL_INV_POS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
3785   SUBGOAL_THEN `~(f(n:num) = &0)` ASSUME_TAC THENL
3786    [CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN
3787     ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_TAC THEN
3788   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP ABS_INV th]) THEN
3789   SUBGOAL_THEN `e = inv(inv e)` SUBST1_TAC THENL
3790    [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INVINV THEN
3791     CONV_TAC(RAND_CONV SYM_CONV) THEN
3792     MATCH_MP_TAC REAL_LT_IMP_NE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
3793   MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[] THEN
3794   MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `(f:num->real) n` THEN
3795   ASM_REWRITE_TAC[ABS_LE]);;
3796
3797 (*----------------------------------------------------------------------------*)
3798 (* Important limit of c^n for |c| < 1                                         *)
3799 (*----------------------------------------------------------------------------*)
3800
3801 let SEQ_POWER_ABS = prove(
3802   `!c. abs(c) < &1 ==> (\n. abs(c) pow n) --> &0`,
3803   GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPEC `c:real` ABS_POS) THEN
3804   REWRITE_TAC[REAL_LE_LT] THEN DISCH_THEN DISJ_CASES_TAC THENL
3805    [SUBGOAL_THEN `!n. abs(c) pow n = inv(inv(abs(c) pow n))`
3806       (fun th -> ONCE_REWRITE_TAC[th]) THENL
3807      [GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INVINV THEN
3808       MATCH_MP_TAC POW_NZ THEN
3809       ASM_REWRITE_TAC[ABS_NZ; ABS_ABS]; ALL_TAC] THEN
3810     CONV_TAC(EXACT_CONV[X_BETA_CONV `n:num` `inv(abs(c) pow n)`]) THEN
3811     MATCH_MP_TAC SEQ_INV0 THEN BETA_TAC THEN X_GEN_TAC `y:real` THEN
3812     SUBGOAL_THEN `~(abs(c) = &0)`
3813          (fun th -> REWRITE_TAC[MATCH_MP POW_INV th]) THENL
3814      [CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN
3815       ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[real_gt] THEN
3816     SUBGOAL_THEN `&0 < inv(abs c) - &1` ASSUME_TAC THENL
3817      [REWRITE_TAC[REAL_LT_SUB_LADD] THEN REWRITE_TAC[REAL_ADD_LID] THEN
3818       ONCE_REWRITE_TAC[GSYM REAL_INV1] THEN MATCH_MP_TAC REAL_LT_INV2 THEN
3819       ASM_REWRITE_TAC[]; ALL_TAC] THEN
3820     MP_TAC(SPEC `inv(abs c) - &1` REAL_ARCH) THEN ASM_REWRITE_TAC[] THEN
3821     DISCH_THEN(X_CHOOSE_TAC `N:num` o SPEC `y:real`) THEN
3822     EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN
3823     DISCH_TAC THEN SUBGOAL_THEN `y < (&n * (inv(abs c) - &1))`
3824     ASSUME_TAC THENL
3825      [MATCH_MP_TAC REAL_LTE_TRANS THEN
3826       EXISTS_TAC `&N * (inv(abs c) - &1)` THEN ASM_REWRITE_TAC[] THEN
3827       FIRST_ASSUM(fun th ->
3828         GEN_REWRITE_TAC I [MATCH_MP REAL_LE_RMUL_EQ th]) THEN
3829       ASM_REWRITE_TAC[REAL_LE]; ALL_TAC] THEN
3830     MATCH_MP_TAC REAL_LT_TRANS THEN
3831     EXISTS_TAC `&n * (inv(abs c) - &1)` THEN ASM_REWRITE_TAC[] THEN
3832     MATCH_MP_TAC REAL_LTE_TRANS THEN
3833     EXISTS_TAC `&1 + (&n * (inv(abs c) - &1))` THEN
3834     REWRITE_TAC[REAL_LT_ADDL; REAL_LT_01] THEN
3835     MATCH_MP_TAC REAL_LE_TRANS THEN
3836     EXISTS_TAC `(&1 + (inv(abs c) - &1)) pow n` THEN CONJ_TAC THENL
3837      [MATCH_MP_TAC POW_PLUS1 THEN ASM_REWRITE_TAC[];
3838       ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[REAL_SUB_ADD] THEN
3839       REWRITE_TAC[REAL_LE_REFL]];
3840     FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[SEQ] THEN
3841     GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `1` THEN
3842     X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN BETA_TAC THEN
3843     STRUCT_CASES_TAC(SPEC `n:num` num_CASES) THENL
3844      [REWRITE_TAC[GSYM NOT_LT; num_CONV `1`; LT_0];
3845       REWRITE_TAC[POW_0; REAL_SUB_RZERO; ABS_0] THEN
3846       REWRITE_TAC[ASSUME `&0 < e`]]]);;
3847
3848 (*----------------------------------------------------------------------------*)
3849 (* Similar version without the abs                                            *)
3850 (*----------------------------------------------------------------------------*)
3851
3852 let SEQ_POWER = prove(
3853   `!c. abs(c) < &1 ==> (\n. c pow n) --> &0`,
3854   GEN_TAC THEN DISCH_TAC THEN
3855   ONCE_REWRITE_TAC[GSYM SEQ_ABS] THEN BETA_TAC THEN
3856   REWRITE_TAC[GSYM POW_ABS] THEN
3857   POP_ASSUM(ACCEPT_TAC o MATCH_MP SEQ_POWER_ABS));;
3858
3859 (* ------------------------------------------------------------------------- *)
3860 (* Convergence to 0 of harmonic sequence (not series of course).             *)
3861 (* ------------------------------------------------------------------------- *)
3862
3863 let SEQ_HARMONIC = prove
3864  (`!a. (\n. a / &n) --> &0`,
3865   GEN_TAC THEN REWRITE_TAC[SEQ] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
3866   FIRST_ASSUM(MP_TAC o SPEC `abs a` o MATCH_MP REAL_ARCH) THEN
3867   DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N + 1` THEN
3868   X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN
3869   REWRITE_TAC[REAL_SUB_RZERO; REAL_ABS_DIV; REAL_ABS_NUM] THEN
3870   SUBGOAL_THEN `&0 < &n` (fun th -> SIMP_TAC[REAL_LT_LDIV_EQ; th]) THENL
3871    [REWRITE_TAC[REAL_OF_NUM_LT] THEN UNDISCH_TAC `N + 1 <= n` THEN ARITH_TAC;
3872     MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&N * e`] THEN
3873   ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
3874   MATCH_MP_TAC REAL_LE_RMUL THEN
3875   ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_OF_NUM_LE] THEN
3876   UNDISCH_TAC `N + 1 <= n` THEN ARITH_TAC);;
3877
3878 (* ------------------------------------------------------------------------- *)
3879 (* Other basic lemmas about sequences.                                       *)
3880 (* ------------------------------------------------------------------------- *)
3881
3882 let SEQ_SUBSEQ = prove
3883  (`!f l. f --> l ==> !a b. ~(a = 0) ==> (\n. f(a * n + b)) --> l`,
3884   REWRITE_TAC[RIGHT_IMP_FORALL_THM; SEQ; GE] THEN REPEAT GEN_TAC THEN
3885   SUBGOAL_THEN `!a b n. ~(a = 0) ==> n <= a * n + b`
3886    (fun th -> MESON_TAC[th; LE_TRANS]) THEN
3887   REPEAT STRIP_TAC THEN MATCH_MP_TAC(ARITH_RULE
3888    `1 * n <= a * n ==> n <= a * n + b`) THEN
3889   REWRITE_TAC[LE_MULT_RCANCEL] THEN POP_ASSUM MP_TAC THEN ARITH_TAC);;
3890
3891 let SEQ_POW = prove
3892  (`!f l. (f --> l) ==> !n. (\i. f(i) pow n) --> l pow n`,
3893   REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN
3894   REWRITE_TAC[real_pow; SEQ_CONST] THEN MATCH_MP_TAC SEQ_MUL THEN
3895   ASM_REWRITE_TAC[]);;
3896
3897 (*----------------------------------------------------------------------------*)
3898 (* Useful lemmas about nested intervals and proof by bisection                *)
3899 (*----------------------------------------------------------------------------*)
3900
3901 let NEST_LEMMA = prove(
3902   `!f g. (!n. f(SUC n) >= f(n)) /\
3903          (!n. g(SUC n) <= g(n)) /\
3904          (!n. f(n) <= g(n)) ==>
3905                 ?l m. l <= m /\ ((!n. f(n) <= l) /\ f --> l) /\
3906                                 ((!n. m <= g(n)) /\ g --> m)`,
3907   REPEAT STRIP_TAC THEN MP_TAC(SPEC `f:num->real` MONO_SUC) THEN
3908   ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
3909   MP_TAC(SPEC `g:num->real` MONO_SUC) THEN ASM_REWRITE_TAC[] THEN
3910   DISCH_TAC THEN SUBGOAL_THEN `bounded((mr1), (>=) :num->num->bool) f`
3911   ASSUME_TAC THENL
3912    [MATCH_MP_TAC SEQ_BOUNDED_2 THEN
3913     MAP_EVERY EXISTS_TAC [`(f:num->real) 0`; `(g:num->real) 0`] THEN
3914     INDUCT_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN CONJ_TAC THENL
3915      [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(f:num->real) n` THEN
3916       RULE_ASSUM_TAC(REWRITE_RULE[real_ge]) THEN ASM_REWRITE_TAC[];
3917       MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `g(SUC n):real` THEN
3918       ASM_REWRITE_TAC[] THEN SPEC_TAC(`SUC n`,`m:num`) THEN
3919       INDUCT_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN
3920       MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `g(m:num):real` THEN
3921       ASM_REWRITE_TAC[]]; ALL_TAC] THEN
3922   SUBGOAL_THEN `bounded((mr1), (>=) :num->num->bool) g` ASSUME_TAC THENL
3923    [MATCH_MP_TAC SEQ_BOUNDED_2 THEN
3924     MAP_EVERY EXISTS_TAC [`(f:num->real) 0`; `(g:num->real) 0`] THEN
3925     INDUCT_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN CONJ_TAC THENL
3926      [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(f:num->real) (SUC n)` THEN
3927       ASM_REWRITE_TAC[] THEN SPEC_TAC(`SUC n`,`m:num`) THEN
3928       INDUCT_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN
3929       MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(f:num->real) m` THEN
3930       RULE_ASSUM_TAC(REWRITE_RULE[real_ge]) THEN ASM_REWRITE_TAC[];
3931       MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(g:num->real) n` THEN
3932       ASM_REWRITE_TAC[]]; ALL_TAC] THEN
3933   MP_TAC(SPEC `f:num->real` SEQ_BCONV) THEN ASM_REWRITE_TAC[SEQ_LIM] THEN
3934   DISCH_TAC THEN MP_TAC(SPEC `g:num->real` SEQ_BCONV) THEN
3935   ASM_REWRITE_TAC[SEQ_LIM] THEN DISCH_TAC THEN
3936   MAP_EVERY EXISTS_TAC [`lim f`; `lim g`] THEN ASM_REWRITE_TAC[] THEN
3937   REPEAT CONJ_TAC THENL
3938    [MATCH_MP_TAC SEQ_LE THEN
3939     MAP_EVERY EXISTS_TAC [`f:num->real`; `g:num->real`] THEN ASM_REWRITE_TAC[];
3940     X_GEN_TAC `m:num` THEN GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN
3941     PURE_REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN
3942     UNDISCH_TAC `f --> lim f` THEN REWRITE_TAC[SEQ] THEN
3943     DISCH_THEN(MP_TAC o SPEC `f(m) - lim f`) THEN
3944     ASM_REWRITE_TAC[REAL_SUB_LT] THEN
3945     DISCH_THEN(X_CHOOSE_THEN `p:num` MP_TAC) THEN
3946     DISCH_THEN(MP_TAC o SPEC `p + m:num`) THEN
3947     REWRITE_TAC[GE; LE_ADD] THEN REWRITE_TAC[real_abs] THEN
3948     SUBGOAL_THEN `!p. lim f <= f(p + m:num)` ASSUME_TAC THENL
3949      [INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THENL
3950        [MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM ACCEPT_TAC;
3951         MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f(p + m:num):real` THEN
3952         RULE_ASSUM_TAC(REWRITE_RULE[real_ge]) THEN ASM_REWRITE_TAC[]];
3953       ASM_REWRITE_TAC[REAL_SUB_LE] THEN
3954       REWRITE_TAC[REAL_NOT_LT; real_sub; REAL_LE_RADD] THEN
3955       SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN
3956       REWRITE_TAC[REAL_LE_REFL; ADD_CLAUSES] THEN
3957       MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f(p + m:num):real` THEN
3958       RULE_ASSUM_TAC(REWRITE_RULE[real_ge]) THEN ASM_REWRITE_TAC[]];
3959     X_GEN_TAC `m:num` THEN GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN
3960     PURE_REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN
3961     UNDISCH_TAC `g --> lim g` THEN REWRITE_TAC[SEQ] THEN
3962     DISCH_THEN(MP_TAC o SPEC `lim g - g(m)`) THEN
3963     ASM_REWRITE_TAC[REAL_SUB_LT] THEN
3964     DISCH_THEN(X_CHOOSE_THEN `p:num` MP_TAC) THEN
3965     DISCH_THEN(MP_TAC o SPEC `p + m:num`) THEN
3966     REWRITE_TAC[GE; LE_ADD] THEN REWRITE_TAC[real_abs] THEN
3967     SUBGOAL_THEN `!p. g(p + m:num) < lim g` ASSUME_TAC THENL
3968      [INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN
3969       MATCH_MP_TAC REAL_LET_TRANS THEN
3970       EXISTS_TAC `g(p + m:num):real` THEN ASM_REWRITE_TAC[];
3971       REWRITE_TAC[REAL_SUB_LE] THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LT] THEN
3972       REWRITE_TAC[REAL_NOT_LT; REAL_NEG_SUB] THEN
3973       REWRITE_TAC[real_sub; REAL_LE_LADD; REAL_LE_NEG] THEN
3974       SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN
3975       REWRITE_TAC[REAL_LE_REFL; ADD_CLAUSES] THEN
3976       MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `g(p + m:num):real` THEN
3977       ASM_REWRITE_TAC[]]]);;
3978
3979 let NEST_LEMMA_UNIQ = prove(
3980   `!f g. (!n. f(SUC n) >= f(n)) /\
3981          (!n. g(SUC n) <= g(n)) /\
3982          (!n. f(n) <= g(n)) /\
3983          (\n. f(n) - g(n)) --> &0 ==>
3984                 ?l. ((!n. f(n) <= l) /\ f --> l) /\
3985                     ((!n. l <= g(n)) /\ g --> l)`,
3986   REPEAT GEN_TAC THEN
3987   DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC th) THEN
3988   REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN
3989   REWRITE_TAC[GSYM CONJ_ASSOC] THEN
3990   DISCH_THEN(MP_TAC o MATCH_MP NEST_LEMMA) THEN
3991   DISCH_THEN(X_CHOOSE_THEN `l:real` MP_TAC) THEN
3992   DISCH_THEN(X_CHOOSE_THEN `m:real` STRIP_ASSUME_TAC) THEN
3993   EXISTS_TAC `l:real` THEN ASM_REWRITE_TAC[] THEN
3994   SUBGOAL_THEN `l:real = m` (fun th -> ASM_REWRITE_TAC[th]) THEN
3995   MP_TAC(SPECL [`f:num->real`; `l:real`; `g:num->real`; `m:real`] SEQ_SUB) THEN
3996   ASM_REWRITE_TAC[] THEN
3997   DISCH_THEN(MP_TAC o CONJ(ASSUME `(\n. f(n) - g(n)) --> &0`)) THEN
3998   DISCH_THEN(MP_TAC o MATCH_MP SEQ_UNIQ) THEN
3999   CONV_TAC(LAND_CONV SYM_CONV) THEN
4000   REWRITE_TAC[REAL_SUB_0]);;
4001
4002 let BOLZANO_LEMMA = prove(
4003   `!P. (!a b c. a <= b /\ b <= c /\ P(a,b) /\ P(b,c) ==> P(a,c)) /\
4004        (!x. ?d. &0 < d /\ !a b. a <= x /\ x <= b /\ (b - a) < d ==> P(a,b))
4005       ==> !a b. a <= b ==> P(a,b)`,
4006   REPEAT STRIP_TAC THEN
4007   GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN DISCH_TAC THEN
4008   (X_CHOOSE_THEN `f:num->real#real` STRIP_ASSUME_TAC o
4009    EXISTENCE o BETA_RULE o C ISPECL num_Axiom)
4010     [`(a:real,(b:real))`;
4011      `\fn (n:num). if P(FST fn,(FST fn + SND fn)/ &2) then
4012                         ((FST fn + SND fn)/ &2,SND fn) else
4013                         (FST fn,(FST fn + SND fn)/ &2)`] THEN
4014   MP_TAC(SPECL
4015     [`\n:num. FST(f(n) :real#real)`; `\n:num. SND(f(n) :real#real)`]
4016     NEST_LEMMA_UNIQ) THEN BETA_TAC THEN
4017   SUBGOAL_THEN `!n:num. FST(f n) <= SND(f n)` ASSUME_TAC THENL
4018    [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN
4019     COND_CASES_TAC THEN REWRITE_TAC[] THENL
4020      [MATCH_MP_TAC REAL_MIDDLE2; MATCH_MP_TAC REAL_MIDDLE1] THEN
4021     FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN REWRITE_TAC[real_ge] THEN
4022   SUBGOAL_THEN `!n. FST(f n :real#real) <= FST(f(SUC n))`
4023   ASSUME_TAC THENL
4024    [REWRITE_TAC[real_ge] THEN INDUCT_TAC THEN
4025     FIRST_ASSUM
4026      (fun th -> GEN_REWRITE_TAC (funpow 2 RAND_CONV) [th]) THEN
4027     COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN
4028     MATCH_MP_TAC REAL_MIDDLE1 THEN FIRST_ASSUM MATCH_ACCEPT_TAC; ALL_TAC] THEN
4029   SUBGOAL_THEN `!n. ~P(FST((f:num->real#real) n),SND(f n))` ASSUME_TAC THENL
4030    [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN
4031     COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
4032     DISCH_TAC THEN UNDISCH_TAC `~P(FST((f:num->real#real) n),SND(f n))` THEN
4033     PURE_REWRITE_TAC[IMP_CLAUSES; NOT_CLAUSES] THEN
4034     FIRST_ASSUM MATCH_MP_TAC THEN
4035     EXISTS_TAC `(FST(f(n:num)) + SND(f(n))) / &2` THEN
4036     ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
4037      [MATCH_MP_TAC REAL_MIDDLE1; MATCH_MP_TAC REAL_MIDDLE2] THEN
4038     FIRST_ASSUM MATCH_ACCEPT_TAC; ALL_TAC] THEN
4039   SUBGOAL_THEN `!n. SND(f(SUC n) :real#real) <= SND(f n)` ASSUME_TAC THENL
4040    [BETA_TAC THEN INDUCT_TAC THEN
4041     FIRST_ASSUM(fun th -> GEN_REWRITE_TAC
4042       (LAND_CONV o RAND_CONV) [th]) THEN
4043     COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN
4044     MATCH_MP_TAC REAL_MIDDLE2 THEN FIRST_ASSUM MATCH_ACCEPT_TAC; ALL_TAC] THEN
4045   SUBGOAL_THEN `!n. SND(f n) - FST(f n) = (b - a) / (&2 pow n)`
4046   ASSUME_TAC THENL
4047    [INDUCT_TAC THENL
4048      [ASM_REWRITE_TAC[pow; real_div; REAL_INV1; REAL_MUL_RID]; ALL_TAC] THEN
4049     ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN
4050     MATCH_MP_TAC REAL_EQ_LMUL_IMP THEN EXISTS_TAC `&2` THEN
4051     REWRITE_TAC[REAL_SUB_LDISTRIB] THEN
4052     (SUBGOAL_THEN `~(&2 = &0)` (fun th -> REWRITE_TAC[th] THEN
4053      REWRITE_TAC[MATCH_MP REAL_DIV_LMUL th]) THENL
4054       [REWRITE_TAC[REAL_INJ; num_CONV `2`; NOT_SUC]; ALL_TAC]) THEN
4055     REWRITE_TAC[GSYM REAL_DOUBLE] THEN
4056     GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_ADD_SYM] THEN
4057     (SUBGOAL_THEN `!x y z. (x + y) - (x + z) = y - z`
4058      (fun th -> REWRITE_TAC[th])
4059      THENL
4060       [REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; REAL_NEG_ADD] THEN
4061        GEN_REWRITE_TAC RAND_CONV [GSYM REAL_ADD_RID] THEN
4062        SUBST1_TAC(SYM(SPEC `x:real` REAL_ADD_LINV)) THEN
4063        REWRITE_TAC[REAL_ADD_AC]; ALL_TAC]) THEN
4064     ASM_REWRITE_TAC[REAL_DOUBLE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
4065     REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN
4066     AP_TERM_TAC THEN REWRITE_TAC[pow] THEN
4067     (SUBGOAL_THEN `~(&2 = &0) /\ ~(&2 pow n = &0)`
4068        (fun th -> REWRITE_TAC[MATCH_MP REAL_INV_MUL_WEAK th]) THENL
4069       [CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC POW_NZ] THEN
4070        REWRITE_TAC[REAL_INJ] THEN
4071        REWRITE_TAC[num_CONV `2`; NOT_SUC];
4072        ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN
4073        GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV)
4074          [GSYM REAL_MUL_LID] THEN
4075        AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN
4076        MATCH_MP_TAC REAL_MUL_RINV THEN REWRITE_TAC[REAL_INJ] THEN
4077        REWRITE_TAC[num_CONV `2`; NOT_SUC]]);
4078     ALL_TAC] THEN
4079   FIRST_ASSUM(UNDISCH_TAC o check (can (find_term is_cond)) o concl) THEN
4080   DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[] THEN
4081   W(C SUBGOAL_THEN
4082     (fun t -> REWRITE_TAC[t]) o fst o dest_imp o rand o snd) THENL
4083    [ONCE_REWRITE_TAC[SEQ_NEG] THEN BETA_TAC THEN
4084     ASM_REWRITE_TAC[REAL_NEG_SUB; REAL_NEG_0] THEN
4085     REWRITE_TAC[real_div] THEN SUBGOAL_THEN `~(&2 = &0)` ASSUME_TAC THENL
4086      [REWRITE_TAC[REAL_INJ; num_CONV `2`; NOT_SUC]; ALL_TAC] THEN
4087     (MP_TAC o C SPECL SEQ_MUL)
4088       [`\n:num. b - a`; `b - a`; `\n. (inv (&2 pow n))`; `&0`] THEN
4089     REWRITE_TAC[SEQ_CONST; REAL_MUL_RZERO] THEN BETA_TAC THEN
4090     DISCH_THEN MATCH_MP_TAC THEN
4091     FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP POW_INV th]) THEN
4092     ONCE_REWRITE_TAC[GSYM SEQ_ABS] THEN BETA_TAC THEN
4093     REWRITE_TAC[GSYM POW_ABS] THEN MATCH_MP_TAC SEQ_POWER_ABS THEN
4094     FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP ABS_INV th]) THEN
4095     REWRITE_TAC[ABS_N] THEN SUBGOAL_THEN `&0 < &2`
4096     (fun th -> ONCE_REWRITE_TAC [GSYM (MATCH_MP REAL_LT_RMUL_EQ th)]) THENL
4097      [REWRITE_TAC[REAL_LT; num_CONV `2`; LT_0]; ALL_TAC] THEN
4098     FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN
4099     REWRITE_TAC[REAL_MUL_LID] THEN REWRITE_TAC[REAL_LT] THEN
4100     REWRITE_TAC[num_CONV `2`; LESS_SUC_REFL];
4101     DISCH_THEN(X_CHOOSE_THEN `l:real` STRIP_ASSUME_TAC) THEN
4102     FIRST_ASSUM(X_CHOOSE_THEN `d:real` MP_TAC o SPEC `l:real`) THEN
4103     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
4104     UNDISCH_TAC `(\n:num. SND(f n :real#real)) --> l` THEN
4105     UNDISCH_TAC `(\n:num. FST(f n :real#real)) --> l` THEN
4106     REWRITE_TAC[SEQ] THEN DISCH_THEN(MP_TAC o SPEC `d / &2`) THEN
4107     ASM_REWRITE_TAC[REAL_LT_HALF1] THEN
4108     DISCH_THEN(X_CHOOSE_THEN `N1:num` (ASSUME_TAC o BETA_RULE)) THEN
4109     DISCH_THEN(MP_TAC o SPEC `d / &2`) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN
4110     DISCH_THEN(X_CHOOSE_THEN `N2:num` (ASSUME_TAC o BETA_RULE)) THEN
4111     DISCH_THEN(MP_TAC o
4112       SPECL [`FST((f:num->real#real) (N1 + N2))`;
4113              `SND((f:num->real#real) (N1 + N2))`]) THEN
4114     UNDISCH_TAC `!n. (SND(f n)) - (FST(f n)) = (b - a) / ((& 2) pow n)` THEN
4115     DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[] THEN
4116     MATCH_MP_TAC REAL_LET_TRANS THEN
4117     EXISTS_TAC `abs(FST(f(N1 + N2:num)) - l) +
4118                 abs(SND(f(N1 + N2:num)) - l)` THEN
4119     GEN_REWRITE_TAC (funpow 2 RAND_CONV) [GSYM REAL_HALF_DOUBLE] THEN
4120     CONJ_TAC THENL
4121      [GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [ABS_SUB] THEN
4122       ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN
4123       REWRITE_TAC[real_sub; GSYM REAL_ADD_ASSOC] THEN
4124       REWRITE_TAC[AC REAL_ADD_AC `a + b + c + d = (d + a) + (c + b)`] THEN
4125       REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID; REAL_LE_REFL];
4126       MATCH_MP_TAC REAL_LT_ADD2 THEN
4127       CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
4128       REWRITE_TAC[GE; LE_ADD] THEN
4129       ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[LE_ADD]]]);;
4130
4131 (* ------------------------------------------------------------------------- *)
4132 (* This one is better for higher-order matching.                             *)
4133 (* ------------------------------------------------------------------------- *)
4134
4135 let BOLZANO_LEMMA_ALT = prove
4136  (`!P. (!a b c. a <= b /\ b <= c /\ P a b /\ P b c ==> P a c) /\
4137        (!x. ?d. &0 < d /\ (!a b. a <= x /\ x <= b /\ b - a < d ==> P a b))
4138        ==> !a b. a <= b ==> P a b`,
4139   GEN_TAC THEN MP_TAC(SPEC `\(x:real,y:real). P x y :bool` BOLZANO_LEMMA) THEN
4140   REWRITE_TAC[] THEN
4141   CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[]);;
4142
4143 (*----------------------------------------------------------------------------*)
4144 (* Define infinite sums                                                       *)
4145 (*----------------------------------------------------------------------------*)
4146
4147 let sums = new_definition
4148   `f sums s <=> (\n. sum(0,n) f) --> s`;;
4149
4150 let summable = new_definition(
4151   `summable f <=> ?s. f sums s`);;
4152
4153 let suminf = new_definition(
4154   `suminf f = @s. f sums s`);;
4155
4156 (*----------------------------------------------------------------------------*)
4157 (* If summable then it sums to the sum (!)                                    *)
4158 (*----------------------------------------------------------------------------*)
4159
4160 let SUM_SUMMABLE = prove(
4161   `!f l. f sums l ==> summable f`,
4162   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[summable] THEN
4163   EXISTS_TAC `l:real` THEN POP_ASSUM ACCEPT_TAC);;
4164
4165 let SUMMABLE_SUM = prove(
4166   `!f. summable f ==> f sums (suminf f)`,
4167   GEN_TAC THEN REWRITE_TAC[summable; suminf] THEN
4168   DISCH_THEN(CHOOSE_THEN MP_TAC) THEN
4169   CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN
4170   MATCH_ACCEPT_TAC SELECT_AX);;
4171
4172 (*----------------------------------------------------------------------------*)
4173 (* And the sum is unique                                                      *)
4174 (*----------------------------------------------------------------------------*)
4175
4176 let SUM_UNIQ = prove(
4177   `!f x. f sums x ==> (x = suminf f)`,
4178   REPEAT GEN_TAC THEN DISCH_TAC THEN
4179   SUBGOAL_THEN `summable f` MP_TAC THENL
4180    [REWRITE_TAC[summable] THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[];
4181     DISCH_THEN(ASSUME_TAC o MATCH_MP SUMMABLE_SUM) THEN
4182     MATCH_MP_TAC SEQ_UNIQ THEN
4183     EXISTS_TAC `\n. sum(0,n) f` THEN ASM_REWRITE_TAC[GSYM sums]]);;
4184
4185 let SER_UNIQ = prove
4186  (`!f x y. f sums x /\ f sums y ==> (x = y)`,
4187   MESON_TAC[SUM_UNIQ]);;
4188
4189 (*----------------------------------------------------------------------------*)
4190 (* Series which is zero beyond a certain point                                *)
4191 (*----------------------------------------------------------------------------*)
4192
4193 let SER_0 = prove(
4194   `!f n. (!m. n <= m ==> (f(m) = &0)) ==>
4195         f sums (sum(0,n) f)`,
4196   REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[sums; SEQ] THEN
4197   X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `n:num` THEN
4198   X_GEN_TAC `m:num` THEN REWRITE_TAC[GE] THEN
4199   DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC o MATCH_MP LESS_EQUAL_ADD) THEN
4200   W(C SUBGOAL_THEN SUBST1_TAC o C (curry mk_eq) `&0` o rand o rator o snd) THEN
4201   ASM_REWRITE_TAC[] THEN REWRITE_TAC[ABS_ZERO; REAL_SUB_0] THEN
4202   BETA_TAC THEN REWRITE_TAC[GSYM SUM_TWO; REAL_ADD_RID_UNIQ] THEN
4203   FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP(REWRITE_RULE[GE] SUM_ZERO)) THEN
4204   MATCH_ACCEPT_TAC LE_REFL);;
4205
4206 (*----------------------------------------------------------------------------*)
4207 (* summable series of positive terms has limit >(=) any partial sum           *)
4208 (*----------------------------------------------------------------------------*)
4209
4210 let SER_POS_LE = prove(
4211   `!f n. summable f /\ (!m. n <= m ==> &0 <= f(m))
4212         ==> sum(0,n) f <= suminf f`,
4213   REPEAT GEN_TAC THEN STRIP_TAC THEN
4214   FIRST_ASSUM(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN REWRITE_TAC[sums] THEN
4215   MP_TAC(SPEC `sum(0,n) f` SEQ_CONST) THEN
4216   GEN_REWRITE_TAC I [IMP_IMP] THEN
4217   MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`]
4218     SEQ_LE) THEN BETA_TAC THEN
4219   EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[GE] THEN
4220   DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC o MATCH_MP LESS_EQUAL_ADD) THEN
4221   REWRITE_TAC[GSYM SUM_TWO; REAL_LE_ADDR] THEN
4222   MATCH_MP_TAC SUM_POS_GEN THEN FIRST_ASSUM MATCH_ACCEPT_TAC);;
4223
4224 let SER_POS_LT = prove(
4225   `!f n. summable f /\ (!m. n <= m ==> &0 < f(m))
4226         ==> sum(0,n) f < suminf f`,
4227   REPEAT GEN_TAC THEN STRIP_TAC THEN
4228   MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `sum(0,n + 1) f` THEN
4229   CONJ_TAC THENL
4230    [REWRITE_TAC[GSYM SUM_TWO; REAL_LT_ADDR] THEN
4231     REWRITE_TAC[num_CONV `1`; sum; REAL_ADD_LID; ADD_CLAUSES] THEN
4232     FIRST_ASSUM MATCH_MP_TAC THEN MATCH_ACCEPT_TAC LE_REFL;
4233     MATCH_MP_TAC SER_POS_LE THEN ASM_REWRITE_TAC[] THEN
4234     GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
4235     FIRST_ASSUM MATCH_MP_TAC THEN
4236     MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `SUC n` THEN
4237     REWRITE_TAC[LESS_EQ_SUC_REFL] THEN ASM_REWRITE_TAC[ADD1]]);;
4238
4239 (*----------------------------------------------------------------------------*)
4240 (* Theorems about grouping and offsetting, *not* permuting, terms             *)
4241 (*----------------------------------------------------------------------------*)
4242
4243 let SER_GROUP = prove(
4244   `!f k. summable f /\ 0 < k ==>
4245           (\n. sum(n * k,k) f) sums (suminf f)`,
4246   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
4247   DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN
4248   REWRITE_TAC[sums; SEQ] THEN BETA_TAC THEN
4249   DISCH_THEN(fun t -> X_GEN_TAC `e:real` THEN
4250     DISCH_THEN(MP_TAC o MATCH_MP t)) THEN
4251   REWRITE_TAC[GE] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN
4252   REWRITE_TAC[SUM_GROUP] THEN EXISTS_TAC `N:num` THEN
4253   X_GEN_TAC `n:num` THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
4254   MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `n:num` THEN
4255   ASM_REWRITE_TAC[] THEN UNDISCH_TAC `0 < k` THEN
4256   STRUCT_CASES_TAC(SPEC `k:num` num_CASES) THEN
4257   REWRITE_TAC[MULT_CLAUSES; LE_ADD; CONJUNCT1 LE] THEN
4258   REWRITE_TAC[LT_REFL]);;
4259
4260 let SER_PAIR = prove(
4261   `!f. summable f ==> (\n. sum(2 * n,2) f) sums (suminf f)`,
4262   GEN_TAC THEN DISCH_THEN(MP_TAC o C CONJ (SPEC `1:num` LT_0)) THEN
4263   REWRITE_TAC[SYM(num_CONV `2`)] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN
4264   MATCH_ACCEPT_TAC SER_GROUP);;
4265
4266 let SER_OFFSET = prove(
4267   `!f. summable f ==> !k. (\n. f(n + k)) sums (suminf f - sum(0,k) f)`,
4268   GEN_TAC THEN
4269   DISCH_THEN((then_) GEN_TAC o MP_TAC o MATCH_MP SUMMABLE_SUM) THEN
4270   REWRITE_TAC[sums; SEQ] THEN
4271   DISCH_THEN(fun th -> GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP th)) THEN
4272   BETA_TAC THEN REWRITE_TAC[GE] THEN
4273   DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN
4274   EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
4275   REWRITE_TAC[SUM_OFFSET] THEN
4276   REWRITE_TAC[real_sub; REAL_NEG_ADD; REAL_NEGNEG] THEN
4277   ONCE_REWRITE_TAC[AC REAL_ADD_AC
4278     `(a + b) + (c + d) = (b + d) + (a + c)`] THEN
4279   REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID] THEN REWRITE_TAC[GSYM real_sub] THEN
4280   FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC LE_TRANS THEN
4281   EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[LE_ADD]);;
4282
4283 let SER_OFFSET_REV = prove
4284  (`!f k. summable(\n. f(n + k)) ==>
4285          f sums (sum(0,k) f) + suminf (\n. f(n + k))`,
4286   REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN
4287   REWRITE_TAC[sums; SEQ] THEN REWRITE_TAC[SUM_OFFSET] THEN
4288   MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN
4289   MATCH_MP_TAC(TAUT `(a ==> b ==> c) ==> (a ==> b) ==> (a ==> c)`) THEN
4290   DISCH_TAC THEN REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[ADD_SYM] SUM_DIFF)] THEN
4291   DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN
4292   EXISTS_TAC `N + k:num` THEN
4293   X_GEN_TAC `n:num` THEN REWRITE_TAC[GE; LE_EXISTS] THEN
4294   DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN
4295   ONCE_REWRITE_TAC[ARITH_RULE `(N + k) + d = k + N + d:num`] THEN
4296   REWRITE_TAC[REAL_ARITH `a - (b + c) = a - b - c`] THEN
4297   REWRITE_TAC[GSYM SUM_DIFF] THEN
4298   FIRST_ASSUM MATCH_MP_TAC THEN ARITH_TAC);;
4299
4300 (*----------------------------------------------------------------------------*)
4301 (* Similar version for pairing up terms                                       *)
4302 (*----------------------------------------------------------------------------*)
4303
4304 let SER_POS_LT_PAIR = prove(
4305   `!f n. summable f /\
4306          (!d. &0 < (f(n + (2 * d))) +
4307                f(n + ((2 * d) + 1)))
4308         ==> sum(0,n) f < suminf f`,
4309   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
4310   DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN
4311   REWRITE_TAC[sums; SEQ] THEN BETA_TAC THEN
4312   CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN
4313   DISCH_THEN(MP_TAC o SPEC `f(n) + f(n + 1)`) THEN
4314   FIRST_ASSUM(MP_TAC o SPEC `0`) THEN
4315   REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN
4316   DISCH_TAC THEN ASM_REWRITE_TAC[] THEN
4317   DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN
4318   SUBGOAL_THEN `sum(0,n + 2) f <= sum(0,(2 * (SUC N)) + n) f`
4319   ASSUME_TAC THENL
4320    [SPEC_TAC(`N:num`,`N:num`) THEN INDUCT_TAC THENL
4321      [REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN
4322       GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN
4323       MATCH_ACCEPT_TAC REAL_LE_REFL;
4324       ABBREV_TAC `M = SUC N` THEN
4325       REWRITE_TAC[MULT_CLAUSES] THEN
4326       REWRITE_TAC[num_CONV `2`; ADD_CLAUSES] THEN
4327       REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[ADD_SYM] ADD1)] THEN
4328       REWRITE_TAC[SYM(num_CONV `2`)] THEN REWRITE_TAC[ADD_CLAUSES] THEN
4329       GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [ADD1] THEN
4330       REWRITE_TAC[GSYM ADD_ASSOC] THEN
4331       REWRITE_TAC[GSYM ADD1; SYM(num_CONV `2`)] THEN
4332       MATCH_MP_TAC REAL_LE_TRANS THEN
4333       EXISTS_TAC `sum(0,(2 * M) + n) f` THEN
4334       ASM_REWRITE_TAC[] THEN REWRITE_TAC[sum] THEN
4335       REWRITE_TAC[GSYM REAL_ADD_ASSOC; REAL_LE_ADDR] THEN
4336       REWRITE_TAC[ADD_CLAUSES] THEN REWRITE_TAC[ADD1] THEN
4337       REWRITE_TAC[GSYM ADD_ASSOC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
4338       REWRITE_TAC[GSYM ADD_ASSOC] THEN
4339       ONCE_REWRITE_TAC[SPEC `1` ADD_SYM] THEN
4340       MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]];
4341     DISCH_THEN(MP_TAC o SPEC `(2 * (SUC N)) + n`) THEN
4342     W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o
4343       funpow 2(fst o dest_imp) o snd) THENL
4344      [REWRITE_TAC[num_CONV `2`; MULT_CLAUSES] THEN
4345       ONCE_REWRITE_TAC[AC ADD_AC
4346        `(a + (b + c)) + d:num = b + (a + (c + d))`] THEN
4347       REWRITE_TAC[GE; LE_ADD]; ALL_TAC] THEN
4348     SUBGOAL_THEN `(suminf f + (f(n) + f(n + 1))) <=
4349                               sum(0,(2 * (SUC N)) + n) f`
4350     ASSUME_TAC THENL
4351      [MATCH_MP_TAC REAL_LE_TRANS THEN
4352       EXISTS_TAC `sum(0,n + 2) f` THEN ASM_REWRITE_TAC[] THEN
4353       MATCH_MP_TAC REAL_LE_TRANS THEN
4354       EXISTS_TAC `sum(0,n) f + (f(n) + f(n + 1))` THEN
4355       ASM_REWRITE_TAC[REAL_LE_RADD] THEN
4356       MATCH_MP_TAC REAL_EQ_IMP_LE THEN
4357       CONV_TAC(REDEPTH_CONV num_CONV) THEN
4358       REWRITE_TAC[ADD_CLAUSES; sum; REAL_ADD_ASSOC]; ALL_TAC] THEN
4359     SUBGOAL_THEN `suminf f <= sum(0,(2 * (SUC N)) + n) f`
4360     ASSUME_TAC THENL
4361      [MATCH_MP_TAC REAL_LE_TRANS THEN
4362       EXISTS_TAC `suminf f + (f(n) + f(n + 1))` THEN
4363       ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_LE_ADDR] THEN
4364       MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN
4365     ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN
4366     REWRITE_TAC[REAL_LT_SUB_RADD] THEN
4367     GEN_REWRITE_TAC (funpow 2 RAND_CONV) [REAL_ADD_SYM] THEN
4368     ASM_REWRITE_TAC[REAL_NOT_LT]]);;
4369
4370 (*----------------------------------------------------------------------------*)
4371 (* Prove a few composition formulas for series                                *)
4372 (*----------------------------------------------------------------------------*)
4373
4374 let SER_ADD = prove(
4375   `!x x0 y y0. x sums x0 /\ y sums y0 ==> (\n. x(n) + y(n)) sums (x0 + y0)`,
4376   REPEAT GEN_TAC THEN REWRITE_TAC[sums; SUM_ADD] THEN
4377   CONV_TAC((RAND_CONV o EXACT_CONV)[X_BETA_CONV `n:num` `sum(0,n) x`]) THEN
4378   CONV_TAC((RAND_CONV o EXACT_CONV)[X_BETA_CONV `n:num` `sum(0,n) y`]) THEN
4379   MATCH_ACCEPT_TAC SEQ_ADD);;
4380
4381 let SER_CMUL = prove(
4382   `!x x0 c. x sums x0 ==> (\n. c * x(n)) sums (c * x0)`,
4383   REPEAT GEN_TAC THEN REWRITE_TAC[sums; SUM_CMUL] THEN DISCH_TAC THEN
4384   SUBGOAL_THEN `(\n. (\n. c) n * (\n. sum(0,n) x) n) --> c * x0` MP_TAC THENL
4385    [MATCH_MP_TAC SEQ_MUL THEN ASM_REWRITE_TAC[SEQ_CONST];
4386     REWRITE_TAC[BETA_THM]]);;
4387
4388 let SER_NEG = prove(
4389   `!x x0. x sums x0 ==> (\n. --(x n)) sums --x0`,
4390   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_NEG_MINUS1] THEN
4391   MATCH_ACCEPT_TAC SER_CMUL);;
4392
4393 let SER_SUB = prove(
4394   `!x x0 y y0. x sums x0 /\ y sums y0 ==> (\n. x(n) - y(n)) sums (x0 - y0)`,
4395   REPEAT GEN_TAC THEN DISCH_THEN(fun th -> MP_TAC (MATCH_MP SER_ADD
4396       (CONJ (CONJUNCT1 th) (MATCH_MP SER_NEG (CONJUNCT2 th))))) THEN
4397   BETA_TAC THEN REWRITE_TAC[real_sub]);;
4398
4399 let SER_CDIV = prove(
4400   `!x x0 c. x sums x0 ==> (\n. x(n) / c) sums (x0 / c)`,
4401   REPEAT GEN_TAC THEN REWRITE_TAC[real_div] THEN
4402   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
4403   MATCH_ACCEPT_TAC SER_CMUL);;
4404
4405 (*----------------------------------------------------------------------------*)
4406 (* Prove Cauchy-type criterion for convergence of series                      *)
4407 (*----------------------------------------------------------------------------*)
4408
4409 let SER_CAUCHY = prove(
4410   `!f. summable f <=>
4411           !e. &0 < e ==> ?N. !m n. m >= N ==> abs(sum(m,n) f) < e`,
4412   GEN_TAC THEN REWRITE_TAC[summable; sums] THEN
4413   REWRITE_TAC[GSYM convergent] THEN
4414   REWRITE_TAC[GSYM SEQ_CAUCHY] THEN REWRITE_TAC[cauchy] THEN
4415   AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[GE] THEN BETA_TAC THEN
4416   REWRITE_TAC[TAUT `((a ==> b) <=> (a ==> c)) <=> a ==> (b <=> c)`] THEN
4417   DISCH_TAC THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN
4418   EXISTS_TAC `N:num` THEN REPEAT GEN_TAC THEN DISCH_TAC THENL
4419    [ONCE_REWRITE_TAC[SUM_DIFF] THEN
4420     FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
4421     MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `m:num` THEN
4422     ASM_REWRITE_TAC[LE_ADD];
4423     DISJ_CASES_THEN MP_TAC (SPECL [`m:num`; `n:num`] LE_CASES) THEN
4424     DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC o
4425       MATCH_MP LESS_EQUAL_ADD) THENL
4426      [ONCE_REWRITE_TAC[ABS_SUB]; ALL_TAC] THEN
4427     REWRITE_TAC[GSYM SUM_DIFF] THEN FIRST_ASSUM MATCH_MP_TAC THEN
4428     ASM_REWRITE_TAC[]]);;
4429
4430 (*----------------------------------------------------------------------------*)
4431 (* Show that if a series converges, the terms tend to 0                       *)
4432 (*----------------------------------------------------------------------------*)
4433
4434 let SER_ZERO = prove(
4435   `!f. summable f ==> f --> &0`,
4436   GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[SEQ] THEN
4437   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
4438   UNDISCH_TAC `summable f` THEN REWRITE_TAC[SER_CAUCHY] THEN
4439   DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP th)) THEN
4440   DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN
4441   DISCH_THEN((then_) (EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN
4442   DISCH_TAC) o MP_TAC) THEN DISCH_THEN(MP_TAC o SPECL [`n:num`; `SUC 0`]) THEN
4443   ASM_REWRITE_TAC[sum; REAL_SUB_RZERO; REAL_ADD_LID; ADD_CLAUSES]);;
4444
4445 (*----------------------------------------------------------------------------*)
4446 (* Now prove the comparison test                                              *)
4447 (*----------------------------------------------------------------------------*)
4448
4449 let SER_COMPAR = prove(
4450   `!f g. (?N. !n. n >= N ==> abs(f(n)) <= g(n)) /\ summable g ==>
4451             summable f`,
4452   REPEAT GEN_TAC THEN REWRITE_TAC[SER_CAUCHY; GE] THEN
4453   DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `N1:num`) MP_TAC) THEN
4454   REWRITE_TAC[SER_CAUCHY; GE] THEN DISCH_TAC THEN
4455   X_GEN_TAC `e:real` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN
4456   DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `N1 + N2:num` THEN
4457   REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN
4458   EXISTS_TAC `sum(m,n)(\k. abs(f k))` THEN REWRITE_TAC[ABS_SUM] THEN
4459   MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum(m,n) g` THEN CONJ_TAC THENL
4460    [MATCH_MP_TAC SUM_LE THEN BETA_TAC THEN
4461     X_GEN_TAC `p:num` THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
4462     MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `m:num` THEN
4463     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LE_TRANS THEN
4464     EXISTS_TAC `N1 + N2:num` THEN ASM_REWRITE_TAC[LE_ADD]; ALL_TAC] THEN
4465   MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(sum(m,n) g)` THEN
4466   REWRITE_TAC[ABS_LE] THEN FIRST_ASSUM MATCH_MP_TAC THEN
4467   MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `N1 + N2:num` THEN
4468   ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
4469   REWRITE_TAC[LE_ADD]);;
4470
4471 (*----------------------------------------------------------------------------*)
4472 (* And a similar version for absolute convergence                             *)
4473 (*----------------------------------------------------------------------------*)
4474
4475 let SER_COMPARA = prove(
4476   `!f g. (?N. !n. n >= N ==> abs(f(n)) <= g(n)) /\ summable g ==>
4477             summable (\k. abs(f k))`,
4478   REPEAT GEN_TAC THEN SUBGOAL_THEN `!n. abs(f(n)) = abs((\k:num. abs(f k)) n)`
4479   (fun th -> GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [th])
4480   THENL
4481    [GEN_TAC THEN BETA_TAC THEN REWRITE_TAC[ABS_ABS];
4482     MATCH_ACCEPT_TAC SER_COMPAR]);;
4483
4484 (*----------------------------------------------------------------------------*)
4485 (* Limit comparison property for series                                       *)
4486 (*----------------------------------------------------------------------------*)
4487
4488 let SER_LE = prove(
4489   `!f g. (!n. f(n) <= g(n)) /\ summable f /\ summable g
4490         ==> suminf f <= suminf g`,
4491   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
4492   DISCH_THEN(CONJUNCTS_THEN (fun th -> ASSUME_TAC th THEN ASSUME_TAC
4493     (REWRITE_RULE[sums] (MATCH_MP SUMMABLE_SUM th)))) THEN
4494   MATCH_MP_TAC SEQ_LE THEN REWRITE_TAC[CONJ_ASSOC] THEN
4495   MAP_EVERY EXISTS_TAC [`\n. sum(0,n) f`; `\n. sum(0,n) g`] THEN CONJ_TAC THENL
4496    [REWRITE_TAC[GSYM sums] THEN CONJ_TAC THEN
4497     MATCH_MP_TAC SUMMABLE_SUM THEN FIRST_ASSUM ACCEPT_TAC;
4498     EXISTS_TAC `0` THEN REWRITE_TAC[GE; LE_0] THEN
4499     GEN_TAC THEN BETA_TAC THEN MATCH_MP_TAC SUM_LE THEN
4500     GEN_TAC THEN ASM_REWRITE_TAC[LE_0]]);;
4501
4502 let SER_LE2 = prove(
4503   `!f g. (!n. abs(f n) <= g(n)) /\ summable g ==>
4504                 summable f /\ suminf f <= suminf g`,
4505   REPEAT GEN_TAC THEN STRIP_TAC THEN
4506   SUBGOAL_THEN `summable f` ASSUME_TAC THENL
4507    [MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `g:num->real` THEN
4508     ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]] THEN
4509   MATCH_MP_TAC SER_LE THEN ASM_REWRITE_TAC[] THEN
4510   X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN
4511   EXISTS_TAC `abs(f(n:num))` THEN ASM_REWRITE_TAC[ABS_LE]);;
4512
4513 (*----------------------------------------------------------------------------*)
4514 (* Show that absolute convergence implies normal convergence                  *)
4515 (*----------------------------------------------------------------------------*)
4516
4517 let SER_ACONV = prove(
4518   `!f. summable (\n. abs(f n)) ==> summable f`,
4519   GEN_TAC THEN REWRITE_TAC[SER_CAUCHY] THEN REWRITE_TAC[SUM_ABS] THEN
4520   DISCH_THEN((then_) (X_GEN_TAC `e:real` THEN DISCH_TAC) o MP_TAC) THEN
4521   DISCH_THEN(IMP_RES_THEN (X_CHOOSE_TAC `N:num`)) THEN
4522   EXISTS_TAC `N:num` THEN REPEAT GEN_TAC THEN
4523   DISCH_THEN(ANTE_RES_THEN ASSUME_TAC) THEN MATCH_MP_TAC REAL_LET_TRANS THEN
4524   EXISTS_TAC `sum(m,n)(\m. abs(f m))` THEN ASM_REWRITE_TAC[ABS_SUM]);;
4525
4526 (*----------------------------------------------------------------------------*)
4527 (* Absolute value of series                                                   *)
4528 (*----------------------------------------------------------------------------*)
4529
4530 let SER_ABS = prove(
4531   `!f. summable(\n. abs(f n)) ==> abs(suminf f) <= suminf(\n. abs(f n))`,
4532   GEN_TAC THEN DISCH_TAC THEN
4533   FIRST_ASSUM(MP_TAC o MATCH_MP SUMMABLE_SUM o MATCH_MP SER_ACONV) THEN
4534   POP_ASSUM(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN
4535   REWRITE_TAC[sums] THEN DISCH_TAC THEN
4536   DISCH_THEN(ASSUME_TAC o BETA_RULE o MATCH_MP SEQ_ABS_IMP) THEN
4537   MATCH_MP_TAC SEQ_LE THEN MAP_EVERY EXISTS_TAC
4538    [`\n. abs(sum(0,n)f)`; `\n. sum(0,n)(\n. abs(f n))`] THEN
4539   ASM_REWRITE_TAC[] THEN EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN
4540   DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN MATCH_ACCEPT_TAC SUM_ABS_LE);;
4541
4542 (*----------------------------------------------------------------------------*)
4543 (* Prove sum of geometric progression (useful for comparison)                 *)
4544 (*----------------------------------------------------------------------------*)
4545
4546 let GP_FINITE = prove(
4547   `!x. ~(x = &1) ==>
4548         !n. (sum(0,n) (\n. x pow n) = ((x pow n) - &1) / (x - &1))`,
4549   GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THENL
4550    [REWRITE_TAC[sum; pow; REAL_SUB_REFL; REAL_DIV_LZERO];
4551     REWRITE_TAC[sum; pow] THEN BETA_TAC THEN
4552     ASM_REWRITE_TAC[ADD_CLAUSES] THEN
4553     SUBGOAL_THEN `~(x - &1 = &0)` ASSUME_TAC THEN
4554     ASM_REWRITE_TAC[REAL_SUB_0] THEN
4555     MP_TAC(GENL [`p:real`; `q:real`]
4556      (SPECL [`p:real`; `q:real`; `x - &1`] REAL_EQ_RMUL)) THEN
4557     ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN
4558     REWRITE_TAC[REAL_RDISTRIB] THEN SUBGOAL_THEN
4559       `!p. (p / (x - &1)) * (x - &1) = p` (fun th -> REWRITE_TAC[th]) THENL
4560       [GEN_TAC THEN MATCH_MP_TAC REAL_DIV_RMUL THEN ASM_REWRITE_TAC[]; ALL_TAC]
4561     THEN REWRITE_TAC[REAL_SUB_LDISTRIB] THEN REWRITE_TAC[real_sub] THEN
4562     ONCE_REWRITE_TAC[AC REAL_ADD_AC
4563       `(a + b) + (c + d) = (c + b) + (d + a)`] THEN
4564     REWRITE_TAC[REAL_MUL_RID; REAL_ADD_LINV; REAL_ADD_RID] THEN
4565     AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_ACCEPT_TAC REAL_MUL_SYM]);;
4566
4567 let GP = prove(
4568   `!x. abs(x) < &1 ==> (\n. x pow n) sums inv(&1 - x)`,
4569   GEN_TAC THEN ASM_CASES_TAC `x = &1` THEN
4570   ASM_REWRITE_TAC[ABS_1; REAL_LT_REFL] THEN DISCH_TAC THEN
4571   REWRITE_TAC[sums] THEN
4572   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP GP_FINITE th]) THEN
4573   REWRITE_TAC[REAL_INV_1OVER] THEN REWRITE_TAC[real_div] THEN
4574   GEN_REWRITE_TAC (LAND_CONV o ABS_CONV) [GSYM REAL_NEG_MUL2] THEN
4575   SUBGOAL_THEN `~(x - &1 = &0)`
4576     (fun t -> REWRITE_TAC[MATCH_MP REAL_NEG_INV t]) THENL
4577     [ASM_REWRITE_TAC[REAL_SUB_0]; ALL_TAC] THEN
4578   REWRITE_TAC[REAL_NEG_SUB; GSYM real_div] THEN
4579   SUBGOAL_THEN `(\n. (\n. &1 - x pow n) n / (\n. &1 - x) n) --> &1 / (&1 - x)`
4580   MP_TAC THENL [ALL_TAC; REWRITE_TAC[BETA_THM]] THEN
4581   MATCH_MP_TAC SEQ_DIV THEN BETA_TAC THEN REWRITE_TAC[SEQ_CONST] THEN
4582   REWRITE_TAC[REAL_SUB_0] THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN
4583   ASM_REWRITE_TAC[] THEN
4584   GEN_REWRITE_TAC RAND_CONV [GSYM REAL_SUB_RZERO] THEN
4585   SUBGOAL_THEN `(\n. (\n. &1) n - (\n. x pow n) n) --> &1 - &0`
4586   MP_TAC THENL [ALL_TAC; REWRITE_TAC[BETA_THM]] THEN
4587   MATCH_MP_TAC SEQ_SUB THEN BETA_TAC THEN REWRITE_TAC[SEQ_CONST] THEN
4588   MATCH_MP_TAC SEQ_POWER THEN FIRST_ASSUM ACCEPT_TAC);;
4589
4590 (*----------------------------------------------------------------------------*)
4591 (* Now prove the ratio test                                                   *)
4592 (*----------------------------------------------------------------------------*)
4593
4594 let ABS_NEG_LEMMA = prove(
4595   `!c x y. c <= &0 ==> abs(x) <= c * abs(y) ==> (x = &0)`,
4596   REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_NEG_GE0] THEN DISCH_TAC THEN
4597   MP_TAC(SPECL [`--c`; `abs(y)`] REAL_LE_MUL) THEN
4598   ASM_REWRITE_TAC[] THEN
4599   REWRITE_TAC[ABS_POS; GSYM REAL_NEG_LMUL; REAL_NEG_GE0] THEN
4600   DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o C CONJ th)) THEN
4601   DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_TRANS) THEN CONV_TAC CONTRAPOS_CONV THEN
4602   REWRITE_TAC[ABS_NZ; REAL_NOT_LE]);;
4603
4604 let SER_RATIO = prove(
4605   `!f c N. c < &1 /\
4606            (!n. n >= N ==> abs(f(SUC n)) <= c * abs(f(n))) ==>
4607        summable f`,
4608   REPEAT GEN_TAC THEN DISCH_THEN STRIP_ASSUME_TAC THEN
4609   DISJ_CASES_TAC (SPECL [`c:real`; `&0`] REAL_LET_TOTAL) THENL
4610    [REWRITE_TAC[SER_CAUCHY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
4611     SUBGOAL_THEN `!n. n >= N ==> (f(SUC n) = &0)` ASSUME_TAC THENL
4612      [GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN
4613       MATCH_MP_TAC ABS_NEG_LEMMA THEN FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN
4614     SUBGOAL_THEN `!n. n >= (SUC N) ==> (f(n) = &0)` ASSUME_TAC THENL
4615      [GEN_TAC THEN STRUCT_CASES_TAC(SPEC `n:num` num_CASES) THENL
4616        [REWRITE_TAC[GE] THEN DISCH_THEN(MP_TAC o MATCH_MP OR_LESS) THEN
4617         REWRITE_TAC[NOT_LESS_0];
4618         REWRITE_TAC[GE; LE_SUC] THEN
4619         ASM_REWRITE_TAC[GSYM GE]]; ALL_TAC] THEN
4620     EXISTS_TAC `SUC N` THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP SUM_ZERO) THEN
4621     REPEAT GEN_TAC THEN
4622     DISCH_THEN(ANTE_RES_THEN (fun th -> REWRITE_TAC[th])) THEN
4623     ASM_REWRITE_TAC[ABS_0];
4624
4625     MATCH_MP_TAC SER_COMPAR THEN
4626     EXISTS_TAC `\n. (abs(f N) / c pow N) * (c pow n)` THEN CONJ_TAC THENL
4627      [EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN
4628       REWRITE_TAC[GE] THEN
4629       DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC o MATCH_MP LESS_EQUAL_ADD)
4630       THEN BETA_TAC THEN REWRITE_TAC[POW_ADD] THEN REWRITE_TAC[real_div] THEN
4631       ONCE_REWRITE_TAC[AC REAL_MUL_AC
4632         `(a * b) * (c * d) = (a * d) * (b * c)`] THEN
4633       SUBGOAL_THEN `~(c pow N = &0)`
4634         (fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th; REAL_MUL_RID]) THENL
4635        [MATCH_MP_TAC POW_NZ THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
4636         MATCH_MP_TAC REAL_LT_IMP_NE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
4637       SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN
4638       REWRITE_TAC[pow; ADD_CLAUSES; REAL_MUL_RID; REAL_LE_REFL] THEN
4639       MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `c * abs(f(N + d:num))` THEN
4640       CONJ_TAC THENL
4641        [FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GE; LE_ADD];
4642         ONCE_REWRITE_TAC[AC REAL_MUL_AC
4643           `a * (b * c) = b * (a * c)`] THEN
4644         FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP REAL_LE_LMUL_LOCAL th])];
4645
4646       REWRITE_TAC[summable] THEN
4647       EXISTS_TAC `(abs(f(N:num)) / (c pow N)) * inv(&1 - c)` THEN
4648       MATCH_MP_TAC SER_CMUL THEN MATCH_MP_TAC GP THEN
4649       ASSUME_TAC(MATCH_MP REAL_LT_IMP_LE (ASSUME `&0 < c`)) THEN
4650       ASM_REWRITE_TAC[real_abs]]]);;
4651
4652 (* ------------------------------------------------------------------------- *)
4653 (* The error in truncating a convergent series is bounded by partial sums.   *)
4654 (* ------------------------------------------------------------------------- *)
4655
4656 let SEQ_TRUNCATION = prove
4657  (`!f l n b.
4658         f sums l /\ (!m. abs(sum(n,m) f) <= b)
4659         ==> abs(l - sum(0,n) f) <= b`,
4660   REPEAT STRIP_TAC THEN
4661   FIRST_ASSUM(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN
4662   DISCH_THEN(MP_TAC o SPEC `n:num` o MATCH_MP SER_OFFSET) THEN
4663   REWRITE_TAC[sums] THEN
4664   FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP SUM_UNIQ) THEN
4665   DISCH_THEN(ASSUME_TAC o MATCH_MP SEQ_ABS_IMP) THEN
4666   MATCH_MP_TAC SEQ_LE THEN
4667   REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN
4668   FIRST_ASSUM(fun th -> EXISTS_TAC (lhand(concl th)) THEN
4669                         CONJ_TAC THENL [ACCEPT_TAC th; ALL_TAC]) THEN
4670   EXISTS_TAC `\r:num. b:real` THEN REWRITE_TAC[SEQ_CONST] THEN
4671   ASM_REWRITE_TAC[GSYM SUM_REINDEX; ADD_CLAUSES]);;
4672
4673 (*============================================================================*)
4674 (* Theory of limits, continuity and differentiation of real->real functions   *)
4675 (*============================================================================*)
4676
4677 parse_as_infix ("tends_real_real",(12,"right"));;
4678
4679 parse_as_infix ("diffl",(12,"right"));;
4680 parse_as_infix ("contl",(12,"right"));;
4681 parse_as_infix ("differentiable",(12,"right"));;
4682
4683 (*----------------------------------------------------------------------------*)
4684 (* Specialize nets theorems to the pointwise limit of real->real functions    *)
4685 (*----------------------------------------------------------------------------*)
4686
4687 let tends_real_real = new_definition
4688   `(f tends_real_real l)(x0) <=>
4689         (f tends l)(mtop(mr1),tendsto(mr1,x0))`;;
4690
4691 override_interface ("-->",`(tends_real_real)`);;
4692
4693 let LIM = prove(
4694   `!f y0 x0. (f --> y0)(x0) <=>
4695         !e. &0 < e ==>
4696             ?d. &0 < d /\ !x. &0 < abs(x - x0) /\ abs(x - x0) < d ==>
4697                 abs(f(x) - y0) < e`,
4698   REPEAT GEN_TAC THEN
4699   REWRITE_TAC[tends_real_real; MATCH_MP LIM_TENDS2 (SPEC `x0:real` MR1_LIMPT)]
4700   THEN REWRITE_TAC[MR1_DEF] THEN
4701   GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ABS_SUB] THEN
4702   REFL_TAC);;
4703
4704 let LIM_CONST = prove(
4705   `!k x. ((\x. k) --> k)(x)`,
4706   REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real; MTOP_TENDS] THEN
4707   GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[METRIC_SAME] THEN
4708   REWRITE_TAC[tendsto; REAL_LE_REFL] THEN
4709   MP_TAC(REWRITE_RULE[MTOP_LIMPT] (SPEC `x:real` MR1_LIMPT)) THEN
4710   DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
4711   DISCH_THEN(X_CHOOSE_THEN `z:real` (ASSUME_TAC o CONJUNCT1)) THEN
4712   EXISTS_TAC `z:real` THEN REWRITE_TAC[MR1_DEF; GSYM ABS_NZ] THEN
4713   REWRITE_TAC[REAL_SUB_0] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
4714   ASM_REWRITE_TAC[]);;
4715
4716 let LIM_ADD = prove(
4717   `!f g l m. (f --> l)(x) /\ (g --> m)(x) ==>
4718       ((\x. f(x) + g(x)) --> (l + m))(x)`,
4719   REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN
4720   MATCH_MP_TAC NET_ADD THEN MATCH_ACCEPT_TAC DORDER_TENDSTO);;
4721
4722 let LIM_MUL = prove(
4723   `!f g l m. (f --> l)(x) /\ (g --> m)(x) ==>
4724       ((\x. f(x) * g(x)) --> (l * m))(x)`,
4725   REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN
4726   MATCH_MP_TAC NET_MUL THEN MATCH_ACCEPT_TAC DORDER_TENDSTO);;
4727
4728 let LIM_NEG = prove(
4729   `!f l. (f --> l)(x) <=> ((\x. --(f(x))) --> --l)(x)`,
4730   REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN
4731   MATCH_MP_TAC NET_NEG THEN MATCH_ACCEPT_TAC DORDER_TENDSTO);;
4732
4733 let LIM_INV = prove(
4734   `!f l. (f --> l)(x) /\ ~(l = &0) ==>
4735         ((\x. inv(f(x))) --> inv l)(x)`,
4736   REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN
4737   MATCH_MP_TAC NET_INV THEN MATCH_ACCEPT_TAC DORDER_TENDSTO);;
4738
4739 let LIM_SUB = prove(
4740   `!f g l m. (f --> l)(x) /\ (g --> m)(x) ==>
4741       ((\x. f(x) - g(x)) --> (l - m))(x)`,
4742   REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN
4743   MATCH_MP_TAC NET_SUB THEN MATCH_ACCEPT_TAC DORDER_TENDSTO);;
4744
4745 let LIM_DIV = prove(
4746   `!f g l m. (f --> l)(x) /\ (g --> m)(x) /\ ~(m = &0) ==>
4747       ((\x. f(x) / g(x)) --> (l / m))(x)`,
4748   REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN
4749   MATCH_MP_TAC NET_DIV THEN MATCH_ACCEPT_TAC DORDER_TENDSTO);;
4750
4751 let LIM_NULL = prove(
4752   `!f l x. (f --> l)(x) <=> ((\x. f(x) - l) --> &0)(x)`,
4753   REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN
4754   MATCH_ACCEPT_TAC NET_NULL);;
4755
4756 let LIM_SUM = prove
4757  (`!f l m n x.
4758       (!r. m <= r /\ r < m + n ==> (f r --> l r)(x))
4759       ==> ((\x. sum(m,n) (\r. f r x)) --> sum(m,n) l)(x)`,
4760   REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN
4761   MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM] NET_SUM) THEN
4762   REWRITE_TAC[LIM_CONST; DORDER_TENDSTO; GSYM tends_real_real]);;
4763
4764 (*----------------------------------------------------------------------------*)
4765 (* One extra theorem is handy                                                 *)
4766 (*----------------------------------------------------------------------------*)
4767
4768 let LIM_X = prove(
4769   `!x0. ((\x. x) --> x0)(x0)`,
4770   GEN_TAC THEN REWRITE_TAC[LIM] THEN X_GEN_TAC `e:real` THEN
4771   DISCH_TAC THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN
4772   BETA_TAC THEN GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);;
4773
4774 (*----------------------------------------------------------------------------*)
4775 (* Uniqueness of limit                                                        *)
4776 (*----------------------------------------------------------------------------*)
4777
4778 let LIM_UNIQ = prove(
4779   `!f l m x. (f --> l)(x) /\ (f --> m)(x) ==> (l = m)`,
4780   REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN
4781   MATCH_MP_TAC MTOP_TENDS_UNIQ THEN
4782   MATCH_ACCEPT_TAC DORDER_TENDSTO);;
4783
4784 (*----------------------------------------------------------------------------*)
4785 (* Show that limits are equal when functions are equal except at limit point  *)
4786 (*----------------------------------------------------------------------------*)
4787
4788 let LIM_EQUAL = prove(
4789   `!f g l x0. (!x. ~(x = x0) ==> (f x = g x)) ==>
4790         ((f --> l)(x0) <=> (g --> l)(x0))`,
4791   REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN DISCH_TAC THEN
4792   AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN
4793   AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN
4794   AP_TERM_TAC THEN ABS_TAC THEN
4795   ONCE_REWRITE_TAC[TAUT `(a ==> b <=> a ==> c) <=> a ==> (b <=> c)`] THEN
4796   DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN
4797   AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
4798   AP_THM_TAC THEN AP_TERM_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
4799   ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN
4800   ASM_REWRITE_TAC[ABS_NZ]);;
4801
4802 (*----------------------------------------------------------------------------*)
4803 (* A more general theorem about rearranging the body of a limit               *)
4804 (*----------------------------------------------------------------------------*)
4805
4806 let LIM_TRANSFORM = prove(
4807   `!f g x0 l. ((\x. f(x) - g(x)) --> &0)(x0) /\ (g --> l)(x0)
4808         ==> (f --> l)(x0)`,
4809   REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN
4810   DISCH_THEN((then_) (X_GEN_TAC `e:real` THEN DISCH_TAC) o MP_TAC) THEN
4811   DISCH_THEN(CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`)) THEN
4812   ASM_REWRITE_TAC[REAL_LT_HALF1] THEN BETA_TAC THEN
4813   REWRITE_TAC[REAL_SUB_RZERO] THEN
4814   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
4815   DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN
4816   MP_TAC(SPECL [`c:real`; `d:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN
4817   DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN
4818   EXISTS_TAC `b:real` THEN ASM_REWRITE_TAC[] THEN
4819   X_GEN_TAC `x:real` THEN DISCH_THEN STRIP_ASSUME_TAC THEN
4820   MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `(e / &2) + (e / &2)` THEN
4821   GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_HALF_DOUBLE] THEN
4822   REWRITE_TAC[REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
4823   EXISTS_TAC `abs(f(x:real) - g(x)) + abs(g(x) - l)` THEN
4824   SUBST1_TAC(SYM(SPECL
4825     [`(f:real->real) x`; `(g:real->real) x`; `l:real`] REAL_SUB_TRIANGLE)) THEN
4826   REWRITE_TAC[ABS_TRIANGLE] THEN MATCH_MP_TAC REAL_LT_ADD2 THEN
4827   CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
4828   MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `b:real` THEN
4829   ASM_REWRITE_TAC[]);;
4830
4831 (*----------------------------------------------------------------------------*)
4832 (* Define differentiation and continuity                                      *)
4833 (*----------------------------------------------------------------------------*)
4834
4835 let diffl = new_definition
4836   `(f diffl l)(x) <=> ((\h. (f(x+h) - f(x)) / h) --> l)(&0)`;;
4837
4838 let contl = new_definition
4839   `f contl x <=> ((\h. f(x + h)) --> f(x))(&0)`;;
4840
4841 let differentiable = new_definition
4842   `f differentiable x <=> ?l. (f diffl l)(x)`;;
4843
4844 (*----------------------------------------------------------------------------*)
4845 (* Derivative is unique                                                       *)
4846 (*----------------------------------------------------------------------------*)
4847
4848 let DIFF_UNIQ = prove(
4849   `!f l m x. (f diffl l)(x) /\ (f diffl m)(x) ==> (l = m)`,
4850   REPEAT GEN_TAC THEN REWRITE_TAC[diffl] THEN
4851   MATCH_ACCEPT_TAC LIM_UNIQ);;
4852
4853 (*----------------------------------------------------------------------------*)
4854 (* Differentiability implies continuity                                       *)
4855 (*----------------------------------------------------------------------------*)
4856
4857 let DIFF_CONT = prove(
4858   `!f l x. (f diffl l)(x) ==> f contl x`,
4859   REPEAT GEN_TAC THEN REWRITE_TAC[diffl; contl] THEN DISCH_TAC THEN
4860   REWRITE_TAC[tends_real_real] THEN ONCE_REWRITE_TAC[NET_NULL] THEN
4861   REWRITE_TAC[GSYM tends_real_real] THEN BETA_TAC THEN
4862   SUBGOAL_THEN `((\h. f(x + h) - f(x)) --> &0)(&0) <=>
4863                 ((\h. ((f(x + h) - f(x)) / h) * h) --> &0)(&0)` SUBST1_TAC
4864   THENL
4865    [MATCH_MP_TAC LIM_EQUAL THEN
4866     X_GEN_TAC `z:real` THEN BETA_TAC THEN
4867     DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP REAL_DIV_RMUL th]); ALL_TAC] THEN
4868   GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV o ABS_CONV o RAND_CONV)
4869     [SYM(BETA_CONV `(\h:real. h) h`)] THEN
4870   CONV_TAC(EXACT_CONV[X_BETA_CONV `h:real` `(f(x + h) - f(x)) / h`]) THEN
4871   SUBST1_TAC(SYM(SPEC `l:real` REAL_MUL_RZERO)) THEN
4872   MATCH_MP_TAC LIM_MUL THEN BETA_TAC THEN REWRITE_TAC[REAL_MUL_RZERO] THEN
4873   ASM_REWRITE_TAC[] THEN REWRITE_TAC[LIM] THEN BETA_TAC THEN
4874   REWRITE_TAC[REAL_SUB_RZERO] THEN
4875   X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e:real` THEN
4876   ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);;
4877
4878 (*----------------------------------------------------------------------------*)
4879 (* Alternative definition of continuity                                       *)
4880 (*----------------------------------------------------------------------------*)
4881
4882 let CONTL_LIM = prove(
4883   `!f x. f contl x <=> (f --> f(x))(x)`,
4884   REPEAT GEN_TAC THEN REWRITE_TAC[contl; LIM] THEN
4885   AP_TERM_TAC THEN ABS_TAC THEN
4886   ONCE_REWRITE_TAC[TAUT `(a ==> b <=> a ==> c) <=> a ==> (b <=> c)`] THEN
4887   DISCH_TAC THEN BETA_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN
4888   EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
4889   EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `k:real` THENL
4890    [DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[REAL_SUB_ADD2];
4891     DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
4892     ASM_REWRITE_TAC[REAL_ADD_SUB]]);;
4893
4894 (*----------------------------------------------------------------------------*)
4895 (* Simple combining theorems for continuity                                   *)
4896 (*----------------------------------------------------------------------------*)
4897
4898 let CONT_X = prove
4899  (`!x. (\x. x) contl x`,
4900   REWRITE_TAC[CONTL_LIM; LIM_X]);;
4901
4902 let CONT_CONST = prove(
4903   `!x. (\x. k) contl x`,
4904   REPEAT GEN_TAC THEN REWRITE_TAC[CONTL_LIM] THEN
4905   MATCH_ACCEPT_TAC LIM_CONST);;
4906
4907 let CONT_ADD = prove(
4908   `!x. f contl x /\ g contl x ==> (\x. f(x) + g(x)) contl x`,
4909   GEN_TAC THEN REWRITE_TAC[CONTL_LIM] THEN BETA_TAC THEN
4910   MATCH_ACCEPT_TAC LIM_ADD);;
4911
4912 let CONT_MUL = prove(
4913   `!x. f contl x /\ g contl x ==> (\x. f(x) * g(x)) contl x`,
4914   GEN_TAC THEN REWRITE_TAC[CONTL_LIM] THEN BETA_TAC THEN
4915   MATCH_ACCEPT_TAC LIM_MUL);;
4916
4917 let CONT_NEG = prove(
4918   `!x. f contl x ==> (\x. --(f(x))) contl x`,
4919   GEN_TAC THEN REWRITE_TAC[CONTL_LIM] THEN BETA_TAC THEN
4920   REWRITE_TAC[GSYM LIM_NEG]);;
4921
4922 let CONT_INV = prove(
4923   `!x. f contl x /\ ~(f x = &0) ==> (\x. inv(f(x))) contl x`,
4924   GEN_TAC THEN REWRITE_TAC[CONTL_LIM] THEN BETA_TAC THEN
4925   MATCH_ACCEPT_TAC LIM_INV);;
4926
4927 let CONT_SUB = prove(
4928   `!x. f contl x /\ g contl x ==> (\x. f(x) - g(x)) contl x`,
4929   GEN_TAC THEN REWRITE_TAC[CONTL_LIM] THEN BETA_TAC THEN
4930   MATCH_ACCEPT_TAC LIM_SUB);;
4931
4932 let CONT_DIV = prove(
4933   `!x. f contl x /\ g contl x /\ ~(g x = &0) ==>
4934         (\x. f(x) / g(x)) contl x`,
4935   GEN_TAC THEN REWRITE_TAC[CONTL_LIM] THEN BETA_TAC THEN
4936   MATCH_ACCEPT_TAC LIM_DIV);;
4937
4938 let CONT_ABS = prove
4939  (`!f x. f contl x ==> (\x. abs(f x)) contl x`,
4940   REWRITE_TAC[CONTL_LIM; LIM] THEN
4941   MESON_TAC[REAL_ARITH `abs(a - b) < e ==> abs(abs a - abs b) < e`]);;
4942
4943 (* ------------------------------------------------------------------------- *)
4944 (* Composition of continuous functions is continuous.                        *)
4945 (* ------------------------------------------------------------------------- *)
4946
4947 let CONT_COMPOSE = prove(
4948   `!f g x. f contl x /\ g contl (f x) ==> (\x. g(f x)) contl x`,
4949   REPEAT GEN_TAC THEN REWRITE_TAC[contl; LIM; REAL_SUB_RZERO] THEN
4950   BETA_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
4951   FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN
4952   DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN
4953   DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP th)) THEN
4954   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
4955   DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN
4956   DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN
4957   EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[] THEN
4958   X_GEN_TAC `h:real` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN
4959   ASM_CASES_TAC `&0 < abs(f(x + h) - f(x))` THENL
4960    [UNDISCH_TAC `&0 < abs(f(x + h) - f(x))` THEN
4961     DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o CONJ th)) THEN
4962     DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[REAL_SUB_ADD2];
4963     UNDISCH_TAC `~(&0 < abs(f(x + h) - f(x)))` THEN
4964     REWRITE_TAC[GSYM ABS_NZ; REAL_SUB_0] THEN DISCH_THEN SUBST1_TAC THEN
4965     ASM_REWRITE_TAC[REAL_SUB_REFL; ABS_0]]);;
4966
4967 (*----------------------------------------------------------------------------*)
4968 (* Intermediate Value Theorem (we prove contrapositive by bisection)          *)
4969 (*----------------------------------------------------------------------------*)
4970
4971 let IVT = prove(
4972   `!f a b y. a <= b /\
4973              (f(a) <= y /\ y <= f(b)) /\
4974              (!x. a <= x /\ x <= b ==> f contl x)
4975         ==> (?x. a <= x /\ x <= b /\ (f(x) = y))`,
4976   REPEAT GEN_TAC THEN
4977   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC
4978    (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN
4979   CONV_TAC CONTRAPOS_CONV THEN
4980   DISCH_THEN(ASSUME_TAC o CONV_RULE NOT_EXISTS_CONV) THEN
4981   (MP_TAC o C SPEC BOLZANO_LEMMA)
4982     `\(u,v). a <= u /\ u <= v /\ v <= b ==> ~(f(u) <= y /\ y <= f(v))` THEN
4983   CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN
4984   W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o
4985   funpow 2 (fst o dest_imp) o snd) THENL
4986    [ALL_TAC;
4987     DISCH_THEN(MP_TAC o SPECL [`a:real`; `b:real`]) THEN
4988     ASM_REWRITE_TAC[REAL_LE_REFL]] THEN
4989   CONJ_TAC THENL
4990    [MAP_EVERY X_GEN_TAC [`u:real`; `v:real`; `w:real`] THEN
4991     CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[DE_MORGAN_THM; NOT_IMP] THEN
4992     STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
4993     MAP_EVERY ASM_CASES_TAC [`u <= v`; `v <= w`] THEN ASM_REWRITE_TAC[] THEN
4994     DISJ_CASES_TAC(SPECL [`y:real`; `(f:real->real) v`] REAL_LE_TOTAL) THEN
4995     ASM_REWRITE_TAC[] THENL [DISJ1_TAC; DISJ2_TAC] THEN
4996     MATCH_MP_TAC REAL_LE_TRANS THENL
4997      [EXISTS_TAC `w:real`; EXISTS_TAC `u:real`] THEN ASM_REWRITE_TAC[];
4998     ALL_TAC] THEN
4999   X_GEN_TAC `x:real` THEN ASM_CASES_TAC `a <= x /\ x <= b` THENL
5000    [ALL_TAC;
5001     EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN
5002     MAP_EVERY X_GEN_TAC [`u:real`; `v:real`] THEN
5003     REPEAT STRIP_TAC THEN UNDISCH_TAC `~(a <= x /\ x <= b)` THEN
5004     REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL
5005      [EXISTS_TAC `u:real`; EXISTS_TAC `v:real`] THEN
5006     ASM_REWRITE_TAC[]] THEN
5007   UNDISCH_TAC `!x. ~(a <= x /\ x <= b /\ (f(x) = (y:real)))` THEN
5008   DISCH_THEN(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN
5009   UNDISCH_TAC `!x. a <= x /\ x <= b ==> f contl x` THEN
5010   DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP th)) THEN
5011   REWRITE_TAC[contl; LIM] THEN
5012   DISCH_THEN(MP_TAC o SPEC `abs(y - f(x:real))`) THEN
5013   GEN_REWRITE_TAC (funpow 2 LAND_CONV) [GSYM ABS_NZ] THEN
5014   REWRITE_TAC[REAL_SUB_0; REAL_SUB_RZERO] THEN BETA_TAC THEN
5015   ASSUM_LIST(fun thl -> REWRITE_TAC(map GSYM thl)) THEN
5016   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
5017   EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN
5018   MAP_EVERY X_GEN_TAC [`u:real`; `v:real`] THEN
5019   REPEAT STRIP_TAC THEN
5020   MP_TAC(SPECL [`(f:real->real) x`; `y:real`] REAL_LT_TOTAL) THEN
5021   ASM_REWRITE_TAC[] THEN DISCH_THEN DISJ_CASES_TAC THEN
5022   FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THENL
5023    [DISCH_THEN(MP_TAC o SPEC `v - x`) THEN REWRITE_TAC[NOT_IMP] THEN
5024     REPEAT CONJ_TAC THENL
5025      [ASM_REWRITE_TAC[real_abs; REAL_SUB_LE; REAL_SUB_LT] THEN
5026       ASM_REWRITE_TAC[REAL_LT_LE] THEN DISCH_THEN SUBST_ALL_TAC THEN
5027       UNDISCH_TAC `f(v:real) < y` THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LE];
5028       ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN
5029       MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `v - u` THEN
5030       ASM_REWRITE_TAC[real_sub; REAL_LE_LADD; REAL_LE_NEG; REAL_LE_RADD];
5031       ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[REAL_SUB_ADD] THEN
5032       REWRITE_TAC[REAL_NOT_LT; real_abs; REAL_SUB_LE] THEN
5033       SUBGOAL_THEN `f(x:real) <= y` ASSUME_TAC THENL
5034        [MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN
5035       SUBGOAL_THEN `f(x:real) <= f(v)` ASSUME_TAC THENL
5036        [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `y:real`; ALL_TAC] THEN
5037       ASM_REWRITE_TAC[real_sub; REAL_LE_RADD]];
5038     DISCH_THEN(MP_TAC o SPEC `u - x`) THEN REWRITE_TAC[NOT_IMP] THEN
5039     REPEAT CONJ_TAC THENL
5040      [ONCE_REWRITE_TAC[ABS_SUB] THEN
5041       ASM_REWRITE_TAC[real_abs; REAL_SUB_LE; REAL_SUB_LT] THEN
5042       ASM_REWRITE_TAC[REAL_LT_LE] THEN DISCH_THEN SUBST_ALL_TAC THEN
5043       UNDISCH_TAC `y < f(x:real)` THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LE];
5044       ONCE_REWRITE_TAC[ABS_SUB] THEN ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN
5045       MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `v - u` THEN
5046       ASM_REWRITE_TAC[real_sub; REAL_LE_LADD; REAL_LE_NEG; REAL_LE_RADD];
5047       ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[REAL_SUB_ADD] THEN
5048       REWRITE_TAC[REAL_NOT_LT; real_abs; REAL_SUB_LE] THEN
5049       SUBGOAL_THEN `f(u:real) < f(x)` ASSUME_TAC THENL
5050        [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `y:real` THEN
5051         ASM_REWRITE_TAC[]; ALL_TAC] THEN
5052       ASM_REWRITE_TAC[GSYM REAL_NOT_LT] THEN
5053       ASM_REWRITE_TAC[REAL_NOT_LT; REAL_LE_NEG; real_sub; REAL_LE_RADD]]]);;
5054
5055 (*----------------------------------------------------------------------------*)
5056 (* Intermediate value theorem where value at the left end is bigger           *)
5057 (*----------------------------------------------------------------------------*)
5058
5059 let IVT2 = prove(
5060   `!f a b y. (a <= b) /\ (f(b) <= y /\ y <= f(a)) /\
5061              (!x. a <= x /\ x <= b ==> f contl x) ==>
5062         ?x. a <= x /\ x <= b /\ (f(x) = y)`,
5063   REPEAT GEN_TAC THEN STRIP_TAC THEN
5064   MP_TAC(SPECL [`\x:real. --(f x)`; `a:real`; `b:real`; `--y`] IVT) THEN
5065   BETA_TAC THEN ASM_REWRITE_TAC[REAL_LE_NEG; REAL_NEG_EQ; REAL_NEGNEG] THEN
5066   DISCH_THEN MATCH_MP_TAC THEN GEN_TAC THEN DISCH_TAC THEN
5067   MATCH_MP_TAC CONT_NEG THEN FIRST_ASSUM MATCH_MP_TAC THEN
5068   ASM_REWRITE_TAC[]);;
5069
5070 (*----------------------------------------------------------------------------*)
5071 (* Prove the simple combining theorems for differentiation                    *)
5072 (*----------------------------------------------------------------------------*)
5073
5074 let DIFF_CONST = prove(
5075   `!k x. ((\x. k) diffl &0)(x)`,
5076   REPEAT GEN_TAC THEN REWRITE_TAC[diffl] THEN
5077   REWRITE_TAC[REAL_SUB_REFL; real_div; REAL_MUL_LZERO] THEN
5078   MATCH_ACCEPT_TAC LIM_CONST);;
5079
5080 let DIFF_ADD = prove(
5081   `!f g l m x. (f diffl l)(x) /\ (g diffl m)(x) ==>
5082                    ((\x. f(x) + g(x)) diffl (l + m))(x)`,
5083   REPEAT GEN_TAC THEN REWRITE_TAC[diffl] THEN
5084   DISCH_TAC THEN BETA_TAC THEN
5085   REWRITE_TAC[REAL_ADD2_SUB2] THEN
5086   REWRITE_TAC[real_div; REAL_RDISTRIB] THEN
5087   REWRITE_TAC[GSYM real_div] THEN
5088   CONV_TAC(EXACT_CONV[X_BETA_CONV `h:real` `(f(x + h) - f(x)) / h`]) THEN
5089   CONV_TAC(EXACT_CONV[X_BETA_CONV `h:real` `(g(x + h) - g(x)) / h`]) THEN
5090   MATCH_MP_TAC LIM_ADD THEN ASM_REWRITE_TAC[]);;
5091
5092 let DIFF_MUL = prove(
5093   `!f g l m x. (f diffl l)(x) /\ (g diffl m)(x) ==>
5094                   ((\x. f(x) * g(x)) diffl ((l * g(x)) + (m * f(x))))(x)`,
5095   REPEAT GEN_TAC THEN REWRITE_TAC[diffl] THEN
5096   DISCH_TAC THEN BETA_TAC THEN SUBGOAL_THEN
5097     `!a b c d. (a * b) - (c * d) = ((a * b) - (a * d)) + ((a * d) - (c * d))`
5098   (fun th -> ONCE_REWRITE_TAC[GEN_ALL th]) THENL
5099    [REWRITE_TAC[real_sub] THEN
5100     ONCE_REWRITE_TAC[AC REAL_ADD_AC
5101       `(a + b) + (c + d) = (b + c) + (a + d)`] THEN
5102     REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]; ALL_TAC] THEN
5103   REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN SUBGOAL_THEN
5104     `!a b c d e. ((a * b) + (c * d)) / e = ((b / e) * a) + ((c / e) * d)`
5105     (fun th -> ONCE_REWRITE_TAC[th]) THENL
5106    [REPEAT GEN_TAC THEN REWRITE_TAC[real_div] THEN
5107     REWRITE_TAC[REAL_RDISTRIB] THEN BINOP_TAC THEN
5108     REWRITE_TAC[REAL_MUL_AC]; ALL_TAC] THEN
5109   GEN_REWRITE_TAC LAND_CONV [REAL_ADD_SYM] THEN
5110   CONV_TAC(EXACT_CONV(map (X_BETA_CONV `h:real`)
5111     [`((g(x + h) - g(x)) / h) * f(x + h)`;
5112      `((f(x + h) - f(x)) / h) * g(x)`])) THEN
5113   MATCH_MP_TAC LIM_ADD THEN
5114   CONV_TAC(EXACT_CONV(map (X_BETA_CONV `h:real`)
5115     [`(g(x + h) - g(x)) / h`; `f(x + h):real`;
5116      `(f(x + h) - f(x)) / h`; `g(x:real):real`])) THEN
5117   CONJ_TAC THEN MATCH_MP_TAC LIM_MUL THEN
5118   BETA_TAC THEN ASM_REWRITE_TAC[LIM_CONST] THEN
5119   REWRITE_TAC[GSYM contl] THEN
5120   MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `l:real` THEN
5121   ASM_REWRITE_TAC[diffl]);;
5122
5123 let DIFF_CMUL = prove(
5124   `!f c l x. (f diffl l)(x) ==> ((\x. c * f(x)) diffl (c * l))(x)`,
5125   REPEAT GEN_TAC THEN
5126   DISCH_THEN(MP_TAC o CONJ (SPECL [`c:real`; `x:real`] DIFF_CONST)) THEN
5127   DISCH_THEN(MP_TAC o MATCH_MP DIFF_MUL) THEN BETA_TAC THEN
5128   REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID] THEN
5129   MATCH_MP_TAC(TAUT(`(a <=> b) ==> a ==> b`)) THEN AP_THM_TAC THEN
5130   GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [REAL_MUL_SYM] THEN
5131   REWRITE_TAC[]);;
5132
5133 let DIFF_NEG = prove(
5134   `!f l x. (f diffl l)(x) ==> ((\x. --(f x)) diffl --l)(x)`,
5135   REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_NEG_MINUS1] THEN
5136   MATCH_ACCEPT_TAC DIFF_CMUL);;
5137
5138 let DIFF_SUB = prove(
5139   `!f g l m x. (f diffl l)(x) /\ (g diffl m)(x) ==>
5140                    ((\x. f(x) - g(x)) diffl (l - m))(x)`,
5141   REPEAT GEN_TAC THEN
5142   DISCH_THEN(MP_TAC o MATCH_MP DIFF_ADD o (uncurry CONJ) o
5143               (I F_F MATCH_MP DIFF_NEG) o CONJ_PAIR) THEN
5144   BETA_TAC THEN REWRITE_TAC[real_sub]);;
5145
5146 (* ------------------------------------------------------------------------- *)
5147 (* Carathe'odory definition makes the chain rule proof much easier.          *)
5148 (* ------------------------------------------------------------------------- *)
5149
5150 let DIFF_CARAT = prove(
5151   `!f l x. (f diffl l)(x) <=>
5152       ?g. (!z. f(z) - f(x) = g(z) * (z - x)) /\ g contl x /\ (g(x) = l)`,
5153   REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL
5154    [EXISTS_TAC `\z. if z = x then l else (f(z) - f(x)) / (z - x)` THEN
5155     BETA_TAC THEN REWRITE_TAC[] THEN CONJ_TAC THENL
5156      [X_GEN_TAC `z:real` THEN COND_CASES_TAC THEN
5157       ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO] THEN
5158       CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN
5159       ASM_REWRITE_TAC[REAL_SUB_0];
5160       POP_ASSUM MP_TAC THEN MATCH_MP_TAC EQ_IMP THEN
5161       REWRITE_TAC[diffl; contl] THEN BETA_TAC THEN REWRITE_TAC[] THEN
5162       MATCH_MP_TAC LIM_EQUAL THEN GEN_TAC THEN DISCH_TAC THEN BETA_TAC THEN
5163       ASM_REWRITE_TAC[REAL_ADD_RID_UNIQ; REAL_ADD_SUB]];
5164     POP_ASSUM(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN
5165     FIRST_ASSUM(UNDISCH_TAC o check is_eq o concl) THEN
5166     DISCH_THEN(SUBST1_TAC o SYM) THEN UNDISCH_TAC `g contl x` THEN
5167     ASM_REWRITE_TAC[contl; diffl; REAL_ADD_SUB] THEN
5168     MATCH_MP_TAC EQ_IMP THEN
5169     MATCH_MP_TAC LIM_EQUAL THEN GEN_TAC THEN DISCH_TAC THEN BETA_TAC THEN
5170     REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN
5171     FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_RINV th]) THEN
5172     REWRITE_TAC[REAL_MUL_RID]]);;
5173
5174 (*----------------------------------------------------------------------------*)
5175 (* Now the chain rule                                                         *)
5176 (*----------------------------------------------------------------------------*)
5177
5178 let DIFF_CHAIN = prove(
5179   `!f g l m x.
5180      (f diffl l)(g x) /\ (g diffl m)(x) ==> ((\x. f(g x)) diffl (l * m))(x)`,
5181   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN
5182   DISCH_THEN(fun th -> MP_TAC th THEN ASSUME_TAC(MATCH_MP DIFF_CONT th)) THEN
5183   REWRITE_TAC[DIFF_CARAT] THEN
5184   DISCH_THEN(X_CHOOSE_THEN `g':real->real` STRIP_ASSUME_TAC) THEN
5185   DISCH_THEN(X_CHOOSE_THEN `f':real->real` STRIP_ASSUME_TAC) THEN
5186   EXISTS_TAC
5187    `\z. if z = x then l * m else (f(g(z):real) - f(g(x))) / (z - x)` THEN
5188   BETA_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
5189    [GEN_TAC THEN COND_CASES_TAC THEN
5190     ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO] THEN
5191     CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN
5192     ASM_REWRITE_TAC[REAL_SUB_0];
5193     MP_TAC(CONJ (ASSUME `g contl x`) (ASSUME `f' contl (g(x:real))`)) THEN
5194     DISCH_THEN(MP_TAC o MATCH_MP CONT_COMPOSE) THEN
5195     DISCH_THEN(MP_TAC o C CONJ (ASSUME `g' contl x`)) THEN
5196     DISCH_THEN(MP_TAC o MATCH_MP CONT_MUL) THEN BETA_TAC THEN
5197     ASM_REWRITE_TAC[contl] THEN BETA_TAC THEN ASM_REWRITE_TAC[] THEN
5198     MATCH_MP_TAC EQ_IMP THEN
5199     MATCH_MP_TAC LIM_EQUAL THEN X_GEN_TAC `z:real` THEN
5200     DISCH_TAC THEN BETA_TAC THEN ASM_REWRITE_TAC[REAL_ADD_RID_UNIQ] THEN
5201     REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_ADD_SUB] THEN
5202     FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_RINV th]) THEN
5203     REWRITE_TAC[REAL_MUL_RID]]);;
5204
5205 (*----------------------------------------------------------------------------*)
5206 (* Differentiation of natural number powers                                   *)
5207 (*----------------------------------------------------------------------------*)
5208
5209 let DIFF_X = prove(
5210   `!x. ((\x. x) diffl &1)(x)`,
5211   GEN_TAC THEN REWRITE_TAC[diffl] THEN BETA_TAC THEN
5212   REWRITE_TAC[REAL_ADD_SUB] THEN REWRITE_TAC[LIM; REAL_SUB_RZERO] THEN
5213   BETA_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5214   EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN
5215   GEN_TAC THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN
5216   REWRITE_TAC[GSYM ABS_NZ] THEN
5217   DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP REAL_DIV_REFL th]) THEN
5218   ASM_REWRITE_TAC[REAL_SUB_REFL; ABS_0]);;
5219
5220 let DIFF_POW = prove(
5221   `!n x. ((\x. x pow n) diffl (&n * (x pow (n - 1))))(x)`,
5222   INDUCT_TAC THEN REWRITE_TAC[pow; DIFF_CONST; REAL_MUL_LZERO] THEN
5223   X_GEN_TAC `x:real` THEN
5224   POP_ASSUM(MP_TAC o CONJ(SPEC `x:real` DIFF_X) o SPEC `x:real`) THEN
5225   DISCH_THEN(MP_TAC o MATCH_MP DIFF_MUL) THEN BETA_TAC THEN
5226   MATCH_MP_TAC EQ_IMP THEN
5227   AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_LID] THEN
5228   REWRITE_TAC[REAL; REAL_RDISTRIB; REAL_MUL_LID] THEN
5229   GEN_REWRITE_TAC RAND_CONV [REAL_ADD_SYM] THEN BINOP_TAC THENL
5230    [REWRITE_TAC[ADD1; ADD_SUB];
5231     STRUCT_CASES_TAC (SPEC `n:num` num_CASES) THEN
5232     REWRITE_TAC[REAL_MUL_LZERO] THEN
5233     REWRITE_TAC[ADD1; ADD_SUB; POW_ADD] THEN
5234     REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN
5235     REWRITE_TAC[num_CONV `1`; pow] THEN
5236     REWRITE_TAC[SYM(num_CONV `1`); REAL_MUL_RID]]);;
5237
5238 (*----------------------------------------------------------------------------*)
5239 (* Now power of -1 (then differentiation of inverses follows from chain rule) *)
5240 (*----------------------------------------------------------------------------*)
5241
5242 let DIFF_XM1 = prove(
5243   `!x. ~(x = &0) ==> ((\x. inv(x)) diffl (--(inv(x) pow 2)))(x)`,
5244   GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[diffl] THEN BETA_TAC THEN
5245   MATCH_MP_TAC LIM_TRANSFORM THEN
5246   EXISTS_TAC `\h. --(inv(x + h) * inv(x))` THEN
5247   BETA_TAC THEN CONJ_TAC THENL
5248    [REWRITE_TAC[LIM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
5249     EXISTS_TAC `abs(x)` THEN
5250     EVERY_ASSUM(fun th -> REWRITE_TAC[REWRITE_RULE[ABS_NZ] th]) THEN
5251     X_GEN_TAC `h:real` THEN REWRITE_TAC[REAL_SUB_RZERO] THEN
5252     DISCH_THEN STRIP_ASSUME_TAC THEN BETA_TAC THEN
5253     W(C SUBGOAL_THEN SUBST1_TAC o C (curry mk_eq) `&0` o
5254       rand o rator o snd) THEN ASM_REWRITE_TAC[] THEN
5255     REWRITE_TAC[ABS_ZERO; REAL_SUB_0] THEN
5256     SUBGOAL_THEN `~(x + h = &0)` ASSUME_TAC THENL
5257      [REWRITE_TAC[REAL_LNEG_UNIQ] THEN DISCH_THEN SUBST_ALL_TAC THEN
5258       UNDISCH_TAC `abs(h) < abs(--h)` THEN
5259       REWRITE_TAC[ABS_NEG; REAL_LT_REFL]; ALL_TAC] THEN
5260     W(fun (asl,w) -> MP_TAC
5261         (SPECL [`x * (x + h)`; lhs w; rhs w] REAL_EQ_LMUL)) THEN
5262     ASM_REWRITE_TAC[REAL_ENTIRE] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN
5263     REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN
5264     REWRITE_TAC[real_div; REAL_SUB_LDISTRIB; REAL_SUB_RDISTRIB] THEN
5265     ONCE_REWRITE_TAC[AC REAL_MUL_AC
5266       `(a * b) * (c * d) = (c * b) * (d * a)`] THEN
5267     REWRITE_TAC(map (MATCH_MP REAL_MUL_LINV o ASSUME)
5268      [`~(x = &0)`; `~(x + h = &0)`]) THEN REWRITE_TAC[REAL_MUL_LID] THEN
5269     ONCE_REWRITE_TAC[AC REAL_MUL_AC
5270       `(a * b) * (c * d) = (a * d) * (c * b)`] THEN
5271     REWRITE_TAC[MATCH_MP REAL_MUL_LINV (ASSUME `~(x = &0)`)] THEN
5272     REWRITE_TAC[REAL_MUL_LID; GSYM REAL_SUB_LDISTRIB] THEN
5273     REWRITE_TAC[REWRITE_RULE[REAL_NEG_SUB]
5274       (AP_TERM `(--)` (SPEC_ALL REAL_ADD_SUB))] THEN
5275     REWRITE_TAC[GSYM REAL_NEG_RMUL] THEN AP_TERM_TAC THEN
5276     MATCH_MP_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[ABS_NZ];
5277
5278     REWRITE_TAC[POW_2] THEN
5279     CONV_TAC(EXACT_CONV[X_BETA_CONV `h:real` `inv(x + h) * inv(x)`]) THEN
5280     REWRITE_TAC[GSYM LIM_NEG] THEN
5281     CONV_TAC(EXACT_CONV(map (X_BETA_CONV `h:real`) [`inv(x + h)`; `inv(x)`]))
5282     THEN MATCH_MP_TAC LIM_MUL THEN BETA_TAC THEN
5283     REWRITE_TAC[LIM_CONST] THEN
5284     CONV_TAC(EXACT_CONV[X_BETA_CONV `h:real` `x + h`]) THEN
5285     MATCH_MP_TAC LIM_INV THEN ASM_REWRITE_TAC[] THEN
5286     GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_RID] THEN
5287     CONV_TAC(EXACT_CONV(map (X_BETA_CONV `h:real`) [`x:real`; `h:real`])) THEN
5288     MATCH_MP_TAC LIM_ADD THEN BETA_TAC THEN REWRITE_TAC[LIM_CONST] THEN
5289     MATCH_ACCEPT_TAC LIM_X]);;
5290
5291 (*----------------------------------------------------------------------------*)
5292 (* Now differentiation of inverse and quotient                                *)
5293 (*----------------------------------------------------------------------------*)
5294
5295 let DIFF_INV = prove(
5296   `!f l x. (f diffl l)(x) /\ ~(f(x) = &0) ==>
5297         ((\x. inv(f x)) diffl --(l / (f(x) pow 2)))(x)`,
5298   REPEAT GEN_TAC THEN REWRITE_TAC[real_div; REAL_NEG_RMUL] THEN
5299   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN DISCH_TAC THEN
5300   MATCH_MP_TAC DIFF_CHAIN THEN ASM_REWRITE_TAC[] THEN
5301   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP POW_INV (CONJUNCT2 th)]) THEN
5302   MATCH_MP_TAC(CONV_RULE(ONCE_DEPTH_CONV ETA_CONV) DIFF_XM1) THEN
5303   ASM_REWRITE_TAC[]);;
5304
5305 let DIFF_DIV = prove(
5306   `!f g l m. (f diffl l)(x) /\ (g diffl m)(x) /\ ~(g(x) = &0) ==>
5307     ((\x. f(x) / g(x)) diffl (((l * g(x)) - (m * f(x))) / (g(x) pow 2)))(x)`,
5308   REPEAT GEN_TAC THEN DISCH_THEN STRIP_ASSUME_TAC THEN
5309   REWRITE_TAC[real_div] THEN
5310   MP_TAC(SPECL [`g:real->real`; `m:real`; `x:real`] DIFF_INV) THEN
5311   ASM_REWRITE_TAC[] THEN
5312   DISCH_THEN(MP_TAC o CONJ(ASSUME `(f diffl l)(x)`)) THEN
5313   DISCH_THEN(MP_TAC o MATCH_MP DIFF_MUL) THEN BETA_TAC THEN
5314   W(C SUBGOAL_THEN SUBST1_TAC o mk_eq o
5315       ((rand o rator) F_F (rand o rator)) o dest_imp o snd) THEN
5316   REWRITE_TAC[] THEN REWRITE_TAC[real_sub] THEN
5317   REWRITE_TAC[REAL_LDISTRIB; REAL_RDISTRIB] THEN BINOP_TAC THENL
5318    [REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN
5319     REWRITE_TAC[POW_2] THEN
5320     FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_INV_MUL_WEAK (W CONJ th)]) THEN
5321     REWRITE_TAC[REAL_MUL_ASSOC] THEN
5322     FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_RINV th]) THEN
5323     REWRITE_TAC[REAL_MUL_LID];
5324     REWRITE_TAC[real_div; GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN
5325     AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_AC]]);;
5326
5327 (*----------------------------------------------------------------------------*)
5328 (* Differentiation of finite sum                                              *)
5329 (*----------------------------------------------------------------------------*)
5330
5331 let DIFF_SUM = prove(
5332   `!f f' m n x. (!r. m <= r /\ r < (m + n)
5333                  ==> ((\x. f r x) diffl (f' r x))(x))
5334      ==> ((\x. sum(m,n)(\n. f n x)) diffl (sum(m,n) (\r. f' r x)))(x)`,
5335   REPEAT GEN_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN
5336   INDUCT_TAC THEN REWRITE_TAC[sum; DIFF_CONST] THEN DISCH_TAC THEN
5337   CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN MATCH_MP_TAC DIFF_ADD THEN
5338   BETA_TAC THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THENL
5339    [GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
5340     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LT_TRANS THEN
5341     EXISTS_TAC `m + n:num` THEN ASM_REWRITE_TAC[ADD_CLAUSES; LESS_SUC_REFL];
5342     REWRITE_TAC[LE_ADD; ADD_CLAUSES; LESS_SUC_REFL]]);;
5343
5344 (*----------------------------------------------------------------------------*)
5345 (* By bisection, function continuous on closed interval is bounded above      *)
5346 (*----------------------------------------------------------------------------*)
5347
5348 let CONT_BOUNDED = prove(
5349   `!f a b. (a <= b /\ !x. a <= x /\ x <= b ==> f contl x)
5350         ==> ?M. !x. a <= x /\ x <= b ==> f(x) <= M`,
5351   REPEAT STRIP_TAC THEN
5352   (MP_TAC o C SPEC BOLZANO_LEMMA)
5353     `\(u,v). a <= u /\ u <= v /\ v <= b ==>
5354                ?M. !x. u <= x /\ x <= v ==> f x <= M` THEN
5355   CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN
5356   W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o
5357   funpow 2(fst o dest_imp) o snd) THENL
5358    [ALL_TAC;
5359     DISCH_THEN(MP_TAC o SPECL [`a:real`; `b:real`]) THEN
5360     ASM_REWRITE_TAC[REAL_LE_REFL]] THEN
5361   CONJ_TAC THENL
5362    [MAP_EVERY X_GEN_TAC [`u:real`; `v:real`; `w:real`] THEN
5363     DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN
5364     DISCH_TAC THEN
5365     REPEAT(FIRST_ASSUM(UNDISCH_TAC o check is_imp o concl)) THEN
5366     ASM_REWRITE_TAC[] THEN
5367     SUBGOAL_THEN `v <= b` ASSUME_TAC THENL
5368      [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `w:real` THEN
5369       ASM_REWRITE_TAC[]; ALL_TAC] THEN
5370     SUBGOAL_THEN `a <= v` ASSUME_TAC THENL
5371      [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `u:real` THEN
5372       ASM_REWRITE_TAC[]; ALL_TAC] THEN
5373     ASM_REWRITE_TAC[] THEN
5374     DISCH_THEN(X_CHOOSE_TAC `M1:real`) THEN
5375     DISCH_THEN(X_CHOOSE_TAC `M2:real`) THEN
5376     DISJ_CASES_TAC(SPECL [`M1:real`; `M2:real`] REAL_LE_TOTAL) THENL
5377      [EXISTS_TAC `M2:real` THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN
5378       DISJ_CASES_TAC(SPECL [`x:real`; `v:real`] REAL_LE_TOTAL) THENL
5379        [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `M1:real` THEN
5380         ASM_REWRITE_TAC[]; ALL_TAC] THEN
5381       FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[];
5382       EXISTS_TAC `M1:real` THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN
5383       DISJ_CASES_TAC(SPECL [`x:real`; `v:real`] REAL_LE_TOTAL) THENL
5384        [ALL_TAC; MATCH_MP_TAC REAL_LE_TRANS THEN
5385         EXISTS_TAC `M2:real` THEN ASM_REWRITE_TAC[]] THEN
5386       FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]];
5387     ALL_TAC] THEN
5388   X_GEN_TAC `x:real` THEN ASM_CASES_TAC `a <= x /\ x <= b` THENL
5389    [ALL_TAC;
5390     EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN
5391     MAP_EVERY X_GEN_TAC [`u:real`; `v:real`] THEN
5392     REPEAT STRIP_TAC THEN UNDISCH_TAC `~(a <= x /\ x <= b)` THEN
5393     CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN
5394     REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL
5395      [EXISTS_TAC `u:real`; EXISTS_TAC `v:real`] THEN
5396     ASM_REWRITE_TAC[]] THEN
5397   UNDISCH_TAC `!x. a <= x /\ x <= b ==> f contl x` THEN
5398   DISCH_THEN(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[] THEN
5399   REWRITE_TAC[contl; LIM] THEN
5400   DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN
5401   ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN BETA_TAC THEN
5402   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
5403   EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN
5404   MAP_EVERY X_GEN_TAC [`u:real`; `v:real`] THEN REPEAT STRIP_TAC THEN
5405   EXISTS_TAC `abs(f(x:real)) + &1` THEN
5406   X_GEN_TAC `z:real` THEN STRIP_TAC THEN
5407   FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN
5408   DISCH_THEN(MP_TAC o SPEC `z - x`) THEN
5409   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_ADD_SYM] THEN
5410   REWRITE_TAC[REAL_SUB_ADD] THEN DISCH_TAC THEN
5411   MP_TAC(SPECL [`f(z:real) - f(x)`; `(f:real->real) x`] ABS_TRIANGLE) THEN
5412   REWRITE_TAC[REAL_SUB_ADD] THEN
5413   DISCH_THEN(ASSUME_TAC o ONCE_REWRITE_RULE[REAL_ADD_SYM]) THEN
5414   MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(f(z:real))` THEN
5415   REWRITE_TAC[ABS_LE] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
5416   EXISTS_TAC `abs(f(x:real)) + (abs(f(z) - f(x)))` THEN
5417   ASM_REWRITE_TAC[REAL_LE_LADD] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
5418   ASM_CASES_TAC `z:real = x` THENL
5419    [ASM_REWRITE_TAC[REAL_SUB_REFL; ABS_0; REAL_LT_01];
5420     FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GSYM ABS_NZ] THEN
5421     ASM_REWRITE_TAC[REAL_SUB_0; real_abs; REAL_SUB_LE] THEN
5422     REWRITE_TAC[REAL_NEG_SUB] THEN COND_CASES_TAC THEN
5423     MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `v - u` THEN
5424     ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THENL
5425      [EXISTS_TAC `v - x`; EXISTS_TAC `v - z`] THEN
5426     ASM_REWRITE_TAC[real_sub; REAL_LE_RADD; REAL_LE_LADD; REAL_LE_NEG]]);;
5427
5428 let CONT_BOUNDED_ABS = prove
5429  (`!f a b. (!x. a <= x /\ x <= b ==> f contl x)
5430            ==> ?M. !x. a <= x /\ x <= b ==> abs(f(x)) <= M`,
5431   REPEAT STRIP_TAC THEN
5432   ASM_CASES_TAC `a <= b` THENL
5433    [ALL_TAC;
5434     ASM_SIMP_TAC[REAL_ARITH `~(a <= b) ==> ~(a <= x /\ x <= b)`]] THEN
5435   MP_TAC(SPECL [`f:real->real`; `a:real`; `b:real`] CONT_BOUNDED) THEN
5436   MP_TAC(SPECL [`\x:real. --(f x)`; `a:real`; `b:real`] CONT_BOUNDED) THEN
5437   ASM_SIMP_TAC[CONT_NEG] THEN
5438   DISCH_THEN(X_CHOOSE_TAC `M1:real`) THEN
5439   DISCH_THEN(X_CHOOSE_TAC `M2:real`) THEN
5440   EXISTS_TAC `abs(M1) + abs(M2)` THEN
5441   ASM_SIMP_TAC[REAL_ARITH
5442    `x <= m1 /\ --x <= m2 ==> abs(x) <= abs(m2) + abs(m1)`]);;
5443
5444 (*----------------------------------------------------------------------------*)
5445 (* Refine the above to existence of least upper bound                         *)
5446 (*----------------------------------------------------------------------------*)
5447
5448 let CONT_HASSUP = prove(
5449   `!f a b. (a <= b /\ !x. a <= x /\ x <= b ==> f contl x)
5450         ==> ?M. (!x. a <= x /\ x <= b ==> f(x) <= M) /\
5451                 (!N. N < M ==> ?x. a <= x /\ x <= b /\ N < f(x))`,
5452   let tm = `\y:real. ?x. a <= x /\ x <= b /\ (y = f(x))` in
5453   REPEAT GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPEC tm REAL_SUP_LE) THEN
5454   BETA_TAC THEN
5455   W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd)
5456   THENL
5457    [CONJ_TAC THENL
5458      [MAP_EVERY EXISTS_TAC [`(f:real->real) a`; `a:real`] THEN
5459       ASM_REWRITE_TAC[REAL_LE_REFL; REAL_LE_LT];
5460       POP_ASSUM(X_CHOOSE_TAC `M:real` o MATCH_MP CONT_BOUNDED) THEN
5461       EXISTS_TAC `M:real` THEN X_GEN_TAC `y:real` THEN
5462       DISCH_THEN(X_CHOOSE_THEN `x:real` MP_TAC) THEN
5463       REWRITE_TAC[CONJ_ASSOC] THEN
5464       DISCH_THEN(CONJUNCTS_THEN2 MP_TAC SUBST1_TAC) THEN
5465       POP_ASSUM MATCH_ACCEPT_TAC];
5466     DISCH_TAC THEN EXISTS_TAC (mk_comb(`sup`,tm)) THEN CONJ_TAC THENL
5467      [X_GEN_TAC `x:real` THEN DISCH_TAC THEN
5468       FIRST_ASSUM(MP_TAC o SPEC (mk_comb(`sup`,tm))) THEN
5469       REWRITE_TAC[REAL_LT_REFL] THEN
5470       CONV_TAC(ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN
5471       DISCH_THEN(MP_TAC o SPEC `(f:real->real) x`) THEN
5472       REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LT] THEN
5473       CONV_TAC(ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN
5474       DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN REWRITE_TAC[] THEN
5475       DISCH_THEN(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[];
5476       GEN_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `N:real`) THEN
5477       DISCH_THEN(X_CHOOSE_THEN `y:real` MP_TAC) THEN
5478       DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
5479       DISCH_THEN(X_CHOOSE_THEN `x:real` MP_TAC) THEN
5480       REWRITE_TAC[CONJ_ASSOC] THEN
5481       DISCH_THEN(CONJUNCTS_THEN2 MP_TAC SUBST_ALL_TAC) THEN
5482       DISCH_TAC THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]]]);;
5483
5484 (*----------------------------------------------------------------------------*)
5485 (* Now show that it attains its upper bound                                   *)
5486 (*----------------------------------------------------------------------------*)
5487
5488 let CONT_ATTAINS = prove(
5489   `!f a b. (a <= b /\ !x. a <= x /\ x <= b ==> f contl x)
5490         ==> ?M. (!x. a <= x /\ x <= b ==> f(x) <= M) /\
5491                 (?x. a <= x /\ x <= b /\ (f(x) = M))`,
5492   REPEAT GEN_TAC THEN DISCH_TAC THEN
5493   FIRST_ASSUM(X_CHOOSE_THEN `M:real` STRIP_ASSUME_TAC o MATCH_MP CONT_HASSUP)
5494   THEN EXISTS_TAC `M:real` THEN ASM_REWRITE_TAC[] THEN
5495   GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN
5496   CONV_TAC(RAND_CONV NOT_EXISTS_CONV) THEN
5497   REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN
5498   DISCH_TAC THEN
5499   SUBGOAL_THEN `!x. a <= x /\ x <= b ==> f(x) < M` MP_TAC THENL
5500    [GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN
5501     CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
5502     FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN
5503   PURE_ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN
5504   SUBGOAL_THEN `!x. a <= x /\ x <= b ==> (\x. inv(M - f(x))) contl x`
5505   ASSUME_TAC THENL
5506    [GEN_TAC THEN DISCH_TAC THEN
5507     CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN
5508     MATCH_MP_TAC CONT_INV THEN BETA_TAC THEN
5509     REWRITE_TAC[REAL_SUB_0] THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN
5510     CONJ_TAC THENL
5511      [ALL_TAC;
5512       MATCH_MP_TAC REAL_LT_IMP_NE THEN
5513       ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
5514       FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]] THEN
5515     CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN
5516     MATCH_MP_TAC CONT_SUB THEN BETA_TAC THEN
5517     REWRITE_TAC[CONT_CONST] THEN
5518     CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN
5519     FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2) THEN
5520     ASM_REWRITE_TAC[]; ALL_TAC] THEN
5521   SUBGOAL_THEN `?k. !x. a <= x /\ x <= b ==> (\x. inv(M - (f x))) x <= k`
5522   MP_TAC THENL
5523    [MATCH_MP_TAC CONT_BOUNDED THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
5524   BETA_TAC THEN DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN
5525   SUBGOAL_THEN `!x. a <= x /\ x <= b ==> &0 < inv(M - f(x))` ASSUME_TAC THENL
5526    [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_INV_POS THEN
5527     FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
5528   SUBGOAL_THEN `!x. a <= x /\ x <= b ==> (\x. inv(M - (f x))) x < (k + &1)`
5529   ASSUME_TAC THENL
5530    [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN
5531     EXISTS_TAC `k:real` THEN REWRITE_TAC[REAL_LT_ADDR; REAL_LT_01] THEN
5532     BETA_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
5533     ASM_REWRITE_TAC[]; ALL_TAC] THEN
5534   SUBGOAL_THEN `!x. a <= x /\ x <= b ==>
5535          inv(k + &1) < inv((\x. inv(M - (f x))) x)` MP_TAC THENL
5536    [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LT_INV2 THEN
5537     CONJ_TAC THENL
5538      [BETA_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[];
5539       FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN
5540   BETA_TAC THEN DISCH_TAC THEN
5541   SUBGOAL_THEN `!x. a <= x /\ x <= b ==> inv(k + &1) < (M - (f x))`
5542   MP_TAC THENL
5543    [GEN_TAC THEN DISCH_TAC THEN
5544     SUBGOAL_THEN `~(M - f(x:real) = &0)`
5545       (SUBST1_TAC o SYM o MATCH_MP REAL_INVINV) THENL
5546      [CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN
5547       FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[];
5548       FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN
5549   REWRITE_TAC[REAL_LT_SUB_LADD] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
5550   ONCE_REWRITE_TAC[GSYM REAL_LT_SUB_LADD] THEN DISCH_TAC THEN
5551   UNDISCH_TAC `!N. N < M ==> (?x. a <= x /\ x <= b /\ N < (f x))` THEN
5552   DISCH_THEN(MP_TAC o SPEC `M - inv(k + &1)`) THEN
5553   REWRITE_TAC[REAL_LT_SUB_RADD; REAL_LT_ADDR] THEN
5554   REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL
5555    [MATCH_MP_TAC REAL_INV_POS THEN MATCH_MP_TAC REAL_LT_TRANS THEN
5556     EXISTS_TAC `k:real` THEN REWRITE_TAC[REAL_LT_ADDR; REAL_LT_01] THEN
5557     MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(M - f(a:real))` THEN
5558     CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
5559     ASM_REWRITE_TAC[REAL_LE_REFL];
5560     DISCH_THEN(X_CHOOSE_THEN `x:real` MP_TAC) THEN REWRITE_TAC[CONJ_ASSOC] THEN
5561     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
5562     REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN
5563     ONCE_REWRITE_TAC[GSYM REAL_LT_SUB_LADD] THEN
5564     FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);;
5565
5566 (*----------------------------------------------------------------------------*)
5567 (* Same theorem for lower bound                                               *)
5568 (*----------------------------------------------------------------------------*)
5569
5570 let CONT_ATTAINS2 = prove(
5571   `!f a b. (a <= b /\ !x. a <= x /\ x <= b ==> f contl x)
5572         ==> ?M. (!x. a <= x /\ x <= b ==> M <= f(x)) /\
5573                 (?x. a <= x /\ x <= b /\ (f(x) = M))`,
5574   REPEAT GEN_TAC THEN DISCH_THEN STRIP_ASSUME_TAC THEN
5575   SUBGOAL_THEN `!x. a <= x /\ x <= b ==> (\x. --(f x)) contl x` MP_TAC THENL
5576    [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CONT_NEG THEN
5577     FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
5578   DISCH_THEN(MP_TAC o CONJ (ASSUME `a <= b`)) THEN
5579   DISCH_THEN(X_CHOOSE_THEN `M:real` MP_TAC o MATCH_MP CONT_ATTAINS) THEN
5580   BETA_TAC THEN DISCH_TAC THEN EXISTS_TAC `--M` THEN CONJ_TAC THENL
5581    [GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_LE_NEG] THEN
5582     ASM_REWRITE_TAC[REAL_NEGNEG];
5583     ASM_REWRITE_TAC[GSYM REAL_NEG_EQ]]);;
5584
5585 (* ------------------------------------------------------------------------- *)
5586 (* Another version.                                                          *)
5587 (* ------------------------------------------------------------------------- *)
5588
5589 let CONT_ATTAINS_ALL = prove(
5590   `!f a b. (a <= b /\ !x. a <= x /\ x <= b ==>  f contl x)
5591         ==> ?L M. (!x. a <= x /\ x <= b ==> L <= f(x) /\ f(x) <= M) /\
5592                   !y. L <= y /\ y <= M ==> ?x. a <= x /\ x <= b /\ (f(x) = y)`,
5593   REPEAT GEN_TAC THEN DISCH_TAC THEN
5594   FIRST_ASSUM(X_CHOOSE_THEN `L:real` MP_TAC o MATCH_MP CONT_ATTAINS2) THEN
5595   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
5596   DISCH_THEN(X_CHOOSE_THEN `x1:real` STRIP_ASSUME_TAC) THEN
5597   FIRST_ASSUM(X_CHOOSE_THEN `M:real` MP_TAC o MATCH_MP CONT_ATTAINS) THEN
5598   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
5599     DISCH_THEN(X_CHOOSE_THEN `x2:real` STRIP_ASSUME_TAC) THEN
5600    MAP_EVERY EXISTS_TAC [`L:real`; `M:real`] THEN CONJ_TAC THENL
5601    [REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[];
5602     ALL_TAC] THEN
5603   DISJ_CASES_TAC(SPECL [`x1:real`; `x2:real`] REAL_LE_TOTAL) THEN
5604   REPEAT STRIP_TAC THENL
5605    [MP_TAC(SPECL [`f:real->real`; `x1:real`; `x2:real`; `y:real`] IVT) THEN
5606     ASM_REWRITE_TAC[] THEN W(C SUBGOAL_THEN
5607     (fun t -> REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd) THENL
5608      [REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2);
5609       DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN
5610
5611       ASM_REWRITE_TAC[] THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]] THEN
5612     (CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL
5613       [EXISTS_TAC `x1:real`; EXISTS_TAC `x2:real`] THEN
5614      ASM_REWRITE_TAC[]);
5615     MP_TAC(SPECL [`f:real->real`; `x2:real`; `x1:real`; `y:real`] IVT2) THEN
5616     ASM_REWRITE_TAC[] THEN W(C SUBGOAL_THEN
5617     (fun t -> REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd) THENL
5618      [REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2);
5619       DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN
5620      ASM_REWRITE_TAC[] THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]] THEN
5621     (CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL
5622       [EXISTS_TAC `x2:real`; EXISTS_TAC `x1:real`] THEN
5623      ASM_REWRITE_TAC[])]);;
5624
5625 (*----------------------------------------------------------------------------*)
5626 (* If f'(x) > 0 then x is locally strictly increasing at the right            *)
5627 (*----------------------------------------------------------------------------*)
5628
5629 let DIFF_LINC = prove(
5630   `!f x l. (f diffl l)(x) /\ &0 < l ==>
5631       ?d. &0 < d /\ !h. &0 < h /\ h < d ==> f(x) < f(x + h)`,
5632   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
5633   REWRITE_TAC[diffl; LIM; REAL_SUB_RZERO] THEN
5634   DISCH_THEN(MP_TAC o SPEC `l:real`) THEN ASM_REWRITE_TAC[] THEN BETA_TAC THEN
5635   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
5636   EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN
5637   DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
5638   FIRST_ASSUM(MP_TAC o MATCH_MP REAL_INV_POS o CONJUNCT1) THEN
5639   DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM(MATCH_MP REAL_LT_RMUL_EQ th)]) THEN
5640   REWRITE_TAC[REAL_MUL_LZERO] THEN REWRITE_TAC[GSYM real_div] THEN
5641   MATCH_MP_TAC ABS_SIGN THEN EXISTS_TAC `l:real` THEN
5642   FIRST_ASSUM MATCH_MP_TAC THEN
5643   FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE o CONJUNCT1) THEN
5644   ASM_REWRITE_TAC[real_abs]);;
5645
5646 (*----------------------------------------------------------------------------*)
5647 (* If f'(x) < 0 then x is locally strictly increasing at the left             *)
5648 (*----------------------------------------------------------------------------*)
5649
5650 let DIFF_LDEC = prove(
5651   `!f x l. (f diffl l)(x) /\ l < &0 ==>
5652       ?d. &0 < d /\ !h. &0 < h /\ h < d ==> f(x) < f(x - h)`,
5653   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
5654   REWRITE_TAC[diffl; LIM; REAL_SUB_RZERO] THEN
5655   DISCH_THEN(MP_TAC o SPEC `--l`) THEN
5656   ONCE_REWRITE_TAC[GSYM REAL_NEG_LT0] THEN ASM_REWRITE_TAC[REAL_NEGNEG] THEN
5657   REWRITE_TAC[REAL_NEG_LT0] THEN BETA_TAC THEN
5658   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
5659   EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN
5660   DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN
5661   FIRST_ASSUM(MP_TAC o MATCH_MP REAL_INV_POS o CONJUNCT1) THEN
5662   DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM(MATCH_MP REAL_LT_RMUL_EQ th)]) THEN
5663   REWRITE_TAC[REAL_MUL_LZERO] THEN
5664   REWRITE_TAC[GSYM REAL_NEG_LT0; REAL_NEG_RMUL] THEN
5665   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_NEG_INV
5666    (GSYM (MATCH_MP REAL_LT_IMP_NE (CONJUNCT1 th)))]) THEN
5667   MATCH_MP_TAC ABS_SIGN2 THEN EXISTS_TAC `l:real` THEN
5668   REWRITE_TAC[GSYM real_div] THEN
5669   GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o funpow 3 LAND_CONV o RAND_CONV)
5670     [real_sub] THEN
5671   FIRST_ASSUM MATCH_MP_TAC THEN
5672   FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE o CONJUNCT1) THEN
5673   REWRITE_TAC[real_abs; GSYM REAL_NEG_LE0; REAL_NEGNEG] THEN
5674   ASM_REWRITE_TAC[GSYM REAL_NOT_LT]);;
5675
5676 (*----------------------------------------------------------------------------*)
5677 (* If f is differentiable at a local maximum x, f'(x) = 0                     *)
5678 (*----------------------------------------------------------------------------*)
5679
5680 let DIFF_LMAX = prove(
5681   `!f x l. (f diffl l)(x) /\
5682            (?d. &0 < d /\ (!y. abs(x - y) < d ==> f(y) <= f(x))) ==> (l = &0)`,
5683   REPEAT GEN_TAC THEN DISCH_THEN
5684    (CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC)) THEN
5685   REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC
5686    (SPECL [`l:real`; `&0`] REAL_LT_TOTAL) THEN
5687   ASM_REWRITE_TAC[] THENL
5688    [DISCH_THEN(MP_TAC o C CONJ(ASSUME `l < &0`)) THEN
5689     DISCH_THEN(MP_TAC o MATCH_MP DIFF_LDEC) THEN
5690     DISCH_THEN(X_CHOOSE_THEN `e:real` MP_TAC) THEN
5691     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
5692     MP_TAC(SPECL [`k:real`; `e:real`] REAL_DOWN2) THEN
5693     ASM_REWRITE_TAC[] THEN
5694     DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
5695     DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN
5696     DISCH_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN
5697     DISCH_THEN(MP_TAC o SPEC `x - d`) THEN REWRITE_TAC[REAL_SUB_SUB2] THEN
5698     SUBGOAL_THEN `&0 <= d` ASSUME_TAC THENL
5699      [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
5700     ASM_REWRITE_TAC[real_abs] THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LT];
5701     DISCH_THEN(MP_TAC o C CONJ(ASSUME `&0 < l`)) THEN
5702     DISCH_THEN(MP_TAC o MATCH_MP DIFF_LINC) THEN
5703     DISCH_THEN(X_CHOOSE_THEN `e:real` MP_TAC) THEN
5704     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
5705     MP_TAC(SPECL [`k:real`; `e:real`] REAL_DOWN2) THEN
5706     ASM_REWRITE_TAC[] THEN
5707     DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
5708     DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN
5709     DISCH_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN
5710     DISCH_THEN(MP_TAC o SPEC `x + d`) THEN REWRITE_TAC[REAL_ADD_SUB2] THEN
5711     SUBGOAL_THEN `&0 <= d` ASSUME_TAC THENL
5712      [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
5713     REWRITE_TAC[ABS_NEG] THEN
5714     ASM_REWRITE_TAC[real_abs] THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LT]]);;
5715
5716 (*----------------------------------------------------------------------------*)
5717 (* Similar theorem for a local minimum                                        *)
5718 (*----------------------------------------------------------------------------*)
5719
5720 let DIFF_LMIN = prove(
5721   `!f x l. (f diffl l)(x) /\
5722            (?d. &0 < d /\ (!y. abs(x - y) < d ==> f(x) <= f(y))) ==> (l = &0)`,
5723   REPEAT GEN_TAC THEN DISCH_TAC THEN
5724   MP_TAC(SPECL [`\x:real. --(f x)`; `x:real`; `--l`] DIFF_LMAX) THEN
5725   BETA_TAC THEN REWRITE_TAC[REAL_LE_NEG; REAL_NEG_EQ0] THEN
5726   DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
5727   MATCH_MP_TAC DIFF_NEG THEN ASM_REWRITE_TAC[]);;
5728
5729 (*----------------------------------------------------------------------------*)
5730 (* In particular if a function is locally flat                                *)
5731 (*----------------------------------------------------------------------------*)
5732
5733 let DIFF_LCONST = prove(
5734   `!f x l. (f diffl l)(x) /\
5735          (?d. &0 < d /\ (!y. abs(x - y) < d ==> (f(y) = f(x)))) ==> (l = &0)`,
5736   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
5737   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
5738   MATCH_MP_TAC DIFF_LMAX THEN
5739   MAP_EVERY EXISTS_TAC [`f:real->real`; `x:real`] THEN ASM_REWRITE_TAC[] THEN
5740   EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN
5741   DISCH_THEN(fun th -> FIRST_ASSUM(SUBST1_TAC o C MATCH_MP th)) THEN
5742   MATCH_ACCEPT_TAC REAL_LE_REFL);;
5743
5744 (*----------------------------------------------------------------------------*)
5745 (* Lemma about introducing open ball in open interval                         *)
5746 (*----------------------------------------------------------------------------*)
5747
5748 let INTERVAL_LEMMA_LT = prove(
5749   `!a b x. a < x /\ x < b ==>
5750         ?d. &0 < d /\ !y. abs(x - y) < d ==> a < y /\ y < b`,
5751   REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM ABS_BETWEEN] THEN
5752   DISJ_CASES_TAC(SPECL [`x - a`; `b - x`] REAL_LE_TOTAL) THENL
5753    [EXISTS_TAC `x - a`; EXISTS_TAC `b - x`] THEN
5754   ASM_REWRITE_TAC[REAL_SUB_LT] THEN GEN_TAC THEN
5755   REWRITE_TAC[REAL_LT_SUB_LADD; REAL_LT_SUB_RADD] THEN
5756   REWRITE_TAC[real_sub; REAL_ADD_ASSOC] THEN
5757   REWRITE_TAC[GSYM real_sub; REAL_LT_SUB_LADD; REAL_LT_SUB_RADD] THEN
5758   FREEZE_THEN(fun th -> ONCE_REWRITE_TAC[th]) (SPEC `x:real` REAL_ADD_SYM) THEN
5759   REWRITE_TAC[REAL_LT_RADD] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
5760   (MATCH_MP_TAC o GEN_ALL o fst o EQ_IMP_RULE o SPEC_ALL) REAL_LT_RADD THENL
5761    [EXISTS_TAC `a:real` THEN MATCH_MP_TAC REAL_LTE_TRANS THEN
5762     EXISTS_TAC `x + x` THEN ASM_REWRITE_TAC[] THEN
5763     UNDISCH_TAC `(x - a) <= (b - x)`;
5764      EXISTS_TAC `b:real` THEN MATCH_MP_TAC REAL_LET_TRANS THEN
5765     EXISTS_TAC `x + x` THEN ASM_REWRITE_TAC[] THEN
5766     UNDISCH_TAC `(b - x) <= (x - a)`] THEN
5767   REWRITE_TAC[REAL_LE_SUB_LADD; GSYM REAL_LE_SUB_RADD] THEN
5768   MATCH_MP_TAC EQ_IMP THEN
5769   AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[real_sub] THEN
5770   REWRITE_TAC[REAL_ADD_AC]);;
5771
5772 let INTERVAL_LEMMA = prove(
5773   `!a b x. a < x /\ x < b ==>
5774         ?d. &0 < d /\ !y. abs(x - y) < d ==> a <= y /\ y <= b`,
5775   REPEAT GEN_TAC THEN
5776   DISCH_THEN(X_CHOOSE_TAC `d:real` o MATCH_MP INTERVAL_LEMMA_LT) THEN
5777   EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN
5778   DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th o CONJUNCT2)) THEN
5779   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]);;
5780
5781 (*----------------------------------------------------------------------------*)
5782 (* Now Rolle's theorem                                                        *)
5783 (*----------------------------------------------------------------------------*)
5784
5785 let ROLLE = prove(
5786   `!f a b. a < b /\
5787            (f(a) = f(b)) /\
5788            (!x. a <= x /\ x <= b ==> f contl x) /\
5789            (!x. a < x /\ x < b ==> f differentiable x)
5790         ==> ?z. a < z /\ z < b /\ (f diffl &0)(z)`,
5791   REPEAT GEN_TAC THEN DISCH_THEN STRIP_ASSUME_TAC THEN
5792   FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE) THEN
5793   MP_TAC(SPECL [`f:real->real`; `a:real`; `b:real`] CONT_ATTAINS) THEN
5794   ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `M:real` MP_TAC) THEN
5795   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `x1:real`)) THEN
5796   MP_TAC(SPECL [`f:real->real`; `a:real`; `b:real`] CONT_ATTAINS2) THEN
5797   ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `m:real` MP_TAC) THEN
5798   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `x2:real`)) THEN
5799   ASM_CASES_TAC `a < x1 /\ x1 < b` THENL
5800    [FIRST_ASSUM(X_CHOOSE_THEN `d:real` MP_TAC o MATCH_MP INTERVAL_LEMMA) THEN
5801     DISCH_THEN STRIP_ASSUME_TAC THEN EXISTS_TAC `x1:real` THEN
5802     ASM_REWRITE_TAC[] THEN SUBGOAL_THEN
5803      `?l. (f diffl l)(x1) /\
5804           ?d. &0 < d /\ (!y. abs(x1 - y) < d ==> f(y) <= f(x1))` MP_TAC THENL
5805      [CONV_TAC EXISTS_AND_CONV THEN CONJ_TAC THENL
5806        [REWRITE_TAC[GSYM differentiable] THEN FIRST_ASSUM MATCH_MP_TAC THEN
5807         ASM_REWRITE_TAC[];
5808         EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real` THEN
5809         DISCH_TAC THEN REPEAT(FIRST_ASSUM MATCH_MP_TAC) THEN
5810         ASM_REWRITE_TAC[]]; ALL_TAC] THEN
5811     DISCH_THEN(X_CHOOSE_THEN `l:real` MP_TAC) THEN
5812     DISCH_THEN(fun th -> ASSUME_TAC th THEN
5813                          SUBST_ALL_TAC(MATCH_MP DIFF_LMAX th))
5814     THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
5815   ASM_CASES_TAC `a < x2 /\ x2 < b` THENL
5816    [FIRST_ASSUM(X_CHOOSE_THEN `d:real` MP_TAC o MATCH_MP INTERVAL_LEMMA) THEN
5817     DISCH_THEN STRIP_ASSUME_TAC THEN EXISTS_TAC `x2:real` THEN
5818     ASM_REWRITE_TAC[] THEN SUBGOAL_THEN
5819      `?l. (f diffl l)(x2) /\
5820           ?d. &0 < d /\ (!y. abs(x2 - y) < d ==> f(x2) <= f(y))` MP_TAC THENL
5821      [CONV_TAC EXISTS_AND_CONV THEN CONJ_TAC THENL
5822        [REWRITE_TAC[GSYM differentiable] THEN FIRST_ASSUM MATCH_MP_TAC THEN
5823         ASM_REWRITE_TAC[];
5824         EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real` THEN
5825         DISCH_TAC THEN REPEAT(FIRST_ASSUM MATCH_MP_TAC) THEN
5826         ASM_REWRITE_TAC[]]; ALL_TAC] THEN
5827     DISCH_THEN(X_CHOOSE_THEN `l:real` MP_TAC) THEN
5828     DISCH_THEN(fun th -> ASSUME_TAC th THEN
5829                          SUBST_ALL_TAC(MATCH_MP DIFF_LMIN th)) THEN
5830   ASM_REWRITE_TAC[]; ALL_TAC] THEN
5831   SUBGOAL_THEN `!x. a <= x /\ x <= b ==> (f(x):real = f(b))` MP_TAC THENL
5832    [REPEAT(FIRST_ASSUM(UNDISCH_TAC o check is_neg o concl)) THEN
5833     ASM_REWRITE_TAC[REAL_LT_LE] THEN REWRITE_TAC[DE_MORGAN_THM] THEN
5834     REPEAT (DISCH_THEN(DISJ_CASES_THEN2 (MP_TAC o SYM) MP_TAC) THEN
5835             DISCH_THEN(SUBST_ALL_TAC o AP_TERM `f:real->real`)) THEN
5836     UNDISCH_TAC `(f:real->real) a = f b` THEN
5837     DISCH_THEN(fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th) THEN
5838     GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN
5839     (CONJ_TAC THENL
5840       [SUBGOAL_THEN `(f:real->real) b = M` SUBST1_TAC THENL
5841         [FIRST_ASSUM(ACCEPT_TAC o el 2 o CONJUNCTS);
5842          FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]];
5843        SUBGOAL_THEN `(f:real->real) b = m` SUBST1_TAC THENL
5844         [FIRST_ASSUM(ACCEPT_TAC o el 2 o CONJUNCTS);
5845          FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]]);
5846     X_CHOOSE_TAC `x:real` (MATCH_MP REAL_MEAN (ASSUME `a < b`)) THEN
5847     DISCH_TAC THEN EXISTS_TAC `x:real` THEN
5848     REWRITE_TAC[ASSUME `a < x /\ x < b`] THEN
5849     FIRST_ASSUM(MP_TAC o MATCH_MP INTERVAL_LEMMA) THEN
5850     DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
5851     SUBGOAL_THEN `?l. (f diffl l)(x) /\
5852         (?d. &0 < d /\ (!y. abs(x - y) < d ==> (f(y) = f(x))))` MP_TAC THENL
5853      [CONV_TAC(ONCE_DEPTH_CONV EXISTS_AND_CONV) THEN CONJ_TAC THENL
5854        [REWRITE_TAC[GSYM differentiable] THEN FIRST_ASSUM MATCH_MP_TAC THEN
5855         ASM_REWRITE_TAC[];
5856         EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN
5857         DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
5858         DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
5859         DISCH_THEN SUBST1_TAC THEN CONV_TAC SYM_CONV THEN
5860         FIRST_ASSUM MATCH_MP_TAC THEN CONJ_TAC THEN
5861         MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]];
5862       DISCH_THEN(X_CHOOSE_THEN `l:real` (fun th ->
5863        ASSUME_TAC th THEN SUBST_ALL_TAC(MATCH_MP DIFF_LCONST th))) THEN
5864       ASM_REWRITE_TAC[]]]);;
5865
5866 (*----------------------------------------------------------------------------*)
5867 (* Mean value theorem                                                         *)
5868 (*----------------------------------------------------------------------------*)
5869
5870 let MVT_LEMMA = prove(
5871   `!(f:real->real) a b.
5872         (\x. f(x) - (((f(b) - f(a)) / (b - a)) * x))(a) =
5873         (\x. f(x) - (((f(b) - f(a)) / (b - a)) * x))(b)`,
5874   REPEAT GEN_TAC THEN BETA_TAC THEN
5875   ASM_CASES_TAC `b:real = a` THEN ASM_REWRITE_TAC[] THEN
5876   ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
5877   RULE_ASSUM_TAC(ONCE_REWRITE_RULE[GSYM REAL_SUB_0]) THEN
5878   MP_TAC(GENL [`x:real`; `y:real`]
5879    (SPECL [`x:real`; `y:real`; `b - a`] REAL_EQ_RMUL)) THEN
5880   ASM_REWRITE_TAC[] THEN
5881   DISCH_THEN(fun th -> GEN_REWRITE_TAC I [GSYM th]) THEN
5882   REWRITE_TAC[REAL_SUB_RDISTRIB; GSYM REAL_MUL_ASSOC] THEN
5883   FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_DIV_RMUL th]) THEN
5884   GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [REAL_MUL_SYM] THEN
5885   GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_MUL_SYM] THEN
5886   REWRITE_TAC[real_sub; REAL_LDISTRIB; REAL_RDISTRIB] THEN
5887   REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL;
5888               REAL_NEG_ADD; REAL_NEGNEG] THEN
5889   REWRITE_TAC[GSYM REAL_ADD_ASSOC] THEN
5890   REWRITE_TAC[AC REAL_ADD_AC
5891     `w + x + y + z = (y + w) + (x + z)`; REAL_ADD_LINV; REAL_ADD_LID] THEN
5892   REWRITE_TAC[REAL_ADD_RID]);;
5893
5894 let MVT = prove(
5895   `!f a b. a < b /\
5896            (!x. a <= x /\ x <= b ==> f contl x) /\
5897            (!x. a < x /\ x < b ==> f differentiable x)
5898         ==> ?l z. a < z /\ z < b /\ (f diffl l)(z) /\
5899             (f(b) - f(a) = (b - a) * l)`,
5900   REPEAT GEN_TAC THEN STRIP_TAC THEN
5901   MP_TAC(SPECL [`\x. f(x) - (((f(b) - f(a)) / (b - a)) * x)`;
5902                 `a:real`; `b:real`] ROLLE) THEN
5903   W(C SUBGOAL_THEN (fun t ->REWRITE_TAC[t]) o
5904   funpow 2 (fst o dest_imp) o snd) THENL
5905    [ASM_REWRITE_TAC[MVT_LEMMA] THEN BETA_TAC THEN
5906     CONJ_TAC THEN X_GEN_TAC `x:real` THENL
5907      [DISCH_TAC THEN CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN
5908       MATCH_MP_TAC CONT_SUB THEN CONJ_TAC THENL
5909        [CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN
5910         FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[];
5911         CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN MATCH_MP_TAC CONT_MUL THEN
5912         REWRITE_TAC[CONT_CONST] THEN MATCH_MP_TAC DIFF_CONT THEN
5913         EXISTS_TAC `&1` THEN MATCH_ACCEPT_TAC DIFF_X];
5914       DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
5915       REWRITE_TAC[differentiable] THEN DISCH_THEN(X_CHOOSE_TAC `l:real`) THEN
5916       EXISTS_TAC `l - ((f(b) - f(a)) / (b - a))` THEN
5917       CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN MATCH_MP_TAC DIFF_SUB THEN
5918       CONJ_TAC THENL
5919        [CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN FIRST_ASSUM ACCEPT_TAC;
5920         CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN REWRITE_TAC[] THEN
5921         GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN
5922         MATCH_MP_TAC DIFF_CMUL THEN MATCH_ACCEPT_TAC DIFF_X]];
5923     ALL_TAC] THEN
5924   REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(X_CHOOSE_THEN `z:real` MP_TAC) THEN
5925   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
5926   DISCH_THEN((then_) (MAP_EVERY EXISTS_TAC
5927    [`((f(b) - f(a)) / (b - a))`; `z:real`]) o MP_TAC) THEN
5928   ASM_REWRITE_TAC[] THEN DISCH_THEN((then_) CONJ_TAC o MP_TAC) THENL
5929    [ALL_TAC; DISCH_THEN(K ALL_TAC) THEN CONV_TAC SYM_CONV THEN
5930     MATCH_MP_TAC REAL_DIV_LMUL THEN REWRITE_TAC[REAL_SUB_0] THEN
5931     DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `a < a` THEN
5932     REWRITE_TAC[REAL_LT_REFL]] THEN
5933   SUBGOAL_THEN `((\x. ((f(b) - f(a)) / (b - a)) * x ) diffl
5934                       ((f(b) - f(a)) / (b - a)))(z)`
5935   (fun th -> DISCH_THEN(MP_TAC o C CONJ th)) THENL
5936    [CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN REWRITE_TAC[] THEN
5937     GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN
5938     MATCH_MP_TAC DIFF_CMUL THEN REWRITE_TAC[DIFF_X]; ALL_TAC] THEN
5939   DISCH_THEN(MP_TAC o MATCH_MP DIFF_ADD) THEN BETA_TAC THEN
5940   REWRITE_TAC[REAL_SUB_ADD] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN
5941   REWRITE_TAC[REAL_ADD_LID]);;
5942
5943 (* ------------------------------------------------------------------------- *)
5944 (* Simple version with pure differentiability assumption.                    *)
5945 (* ------------------------------------------------------------------------- *)
5946
5947 let MVT_ALT = prove
5948  (`!f f' a b.
5949         a < b /\ (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x))
5950         ==> ?z. a < z /\ z < b /\ (f b - f a = (b - a) * f'(z))`,
5951   REPEAT STRIP_TAC THEN SUBGOAL_THEN
5952    `?l z. a < z /\ z < b /\ (f diffl l) z /\ (f b - f a = (b - a) * l)`
5953   MP_TAC THENL
5954    [MATCH_MP_TAC MVT THEN REWRITE_TAC[differentiable] THEN
5955     ASM_MESON_TAC[DIFF_CONT; REAL_LT_IMP_LE];
5956     ASM_MESON_TAC[DIFF_UNIQ; REAL_LT_IMP_LE]]);;
5957
5958 (*----------------------------------------------------------------------------*)
5959 (* Theorem that function is constant if its derivative is 0 over an interval. *)
5960 (*                                                                            *)
5961 (* We could have proved this directly by bisection; consider instantiating    *)
5962 (* BOLZANO_LEMMA with                                                         *)
5963 (*                                                                            *)
5964 (*     \(x,y). f(y) - f(x) <= C * (y - x)                                     *)
5965 (*                                                                            *)
5966 (* However the Rolle and Mean Value theorems are useful to have anyway        *)
5967 (*----------------------------------------------------------------------------*)
5968
5969 let DIFF_ISCONST_END = prove(
5970   `!f a b. a < b /\
5971            (!x. a <= x /\ x <= b ==> f contl x) /\
5972            (!x. a < x /\ x < b ==> (f diffl &0)(x))
5973         ==> (f b = f a)`,
5974   REPEAT GEN_TAC THEN STRIP_TAC THEN
5975   MP_TAC(SPECL [`f:real->real`; `a:real`; `b:real`] MVT) THEN
5976   ASM_REWRITE_TAC[] THEN
5977   W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL
5978    [GEN_TAC THEN REWRITE_TAC[differentiable] THEN
5979     DISCH_THEN((then_) (EXISTS_TAC `&0`) o MP_TAC) THEN
5980     ASM_REWRITE_TAC[];
5981     DISCH_THEN(fun th -> REWRITE_TAC[th])] THEN
5982   DISCH_THEN(X_CHOOSE_THEN `l:real` (X_CHOOSE_THEN `x:real` MP_TAC)) THEN
5983   ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> (a /\ b) /\ (c /\ d)`] THEN
5984   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN
5985   DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
5986   DISCH_THEN(MP_TAC o CONJ (ASSUME `(f diffl l)(x)`)) THEN
5987   DISCH_THEN(SUBST_ALL_TAC o MATCH_MP DIFF_UNIQ) THEN
5988   RULE_ASSUM_TAC(REWRITE_RULE[REAL_MUL_RZERO; REAL_SUB_0]) THEN
5989   FIRST_ASSUM ACCEPT_TAC);;
5990
5991 let DIFF_ISCONST = prove(
5992   `!f a b. a < b /\
5993            (!x. a <= x /\ x <= b ==> f contl x) /\
5994            (!x. a < x /\ x < b ==> (f diffl &0)(x))
5995         ==> !x. a <= x /\ x <= b ==> (f x = f a)`,
5996   REPEAT GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN STRIP_TAC THEN
5997   MP_TAC(SPECL [`f:real->real`; `a:real`; `x:real`] DIFF_ISCONST_END) THEN
5998   DISJ_CASES_THEN MP_TAC (REWRITE_RULE[REAL_LE_LT] (ASSUME `a <= x`)) THENL
5999    [DISCH_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN
6000     CONJ_TAC THEN X_GEN_TAC `z:real` THEN STRIP_TAC THEN
6001     FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THENL
6002      [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real`;
6003       MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `x:real`] THEN
6004     ASM_REWRITE_TAC[];
6005     DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[]]);;
6006
6007 let DIFF_ISCONST_END_SIMPLE = prove
6008  (`!f a b. a < b /\
6009            (!x. a <= x /\ x <= b ==> (f diffl &0)(x))
6010         ==> (f b = f a)`,
6011   REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFF_ISCONST_END THEN
6012   ASM_MESON_TAC[DIFF_CONT; REAL_LT_IMP_LE]);;
6013
6014 let DIFF_ISCONST_ALL = prove(
6015   `!f x y. (!x. (f diffl &0)(x)) ==> (f(x) = f(y))`,
6016   REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN
6017   GEN_TAC THEN DISCH_TAC THEN
6018   SUBGOAL_THEN `!x. f contl x` ASSUME_TAC THENL
6019    [GEN_TAC THEN MATCH_MP_TAC DIFF_CONT THEN
6020     EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
6021   REPEAT GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN MP_TAC
6022    (SPECL [`x:real`; `y:real`] REAL_LT_TOTAL) THENL
6023    [DISCH_THEN SUBST1_TAC THEN REFL_TAC;
6024     CONV_TAC(RAND_CONV SYM_CONV);
6025     ALL_TAC] THEN
6026   DISCH_TAC THEN MATCH_MP_TAC DIFF_ISCONST_END THEN
6027   ASM_REWRITE_TAC[]);;
6028
6029 (* ------------------------------------------------------------------------ *)
6030 (* Boring lemma about distances                                             *)
6031 (* ------------------------------------------------------------------------ *)
6032
6033 let INTERVAL_ABS = REAL_ARITH
6034   `!x z d. (x - d) <= z /\ z <= (x + d) <=> abs(z - x) <= d`;;
6035
6036 (* ------------------------------------------------------------------------ *)
6037 (* Dull lemma that an continuous injection on an interval must have a strict*)
6038 (* maximum at an end point, not in the middle.                              *)
6039 (* ------------------------------------------------------------------------ *)
6040
6041 let CONT_INJ_LEMMA = prove(
6042   `!f g x d. &0 < d /\
6043             (!z. abs(z - x) <= d ==> (g(f(z)) = z)) /\
6044             (!z. abs(z - x) <= d ==> f contl z) ==>
6045      ~(!z. abs(z - x) <= d ==> f(z) <= f(x))`,
6046   REPEAT GEN_TAC THEN STRIP_TAC THEN
6047   IMP_RES_THEN ASSUME_TAC REAL_LT_IMP_LE THEN
6048   DISCH_THEN(fun th -> MAP_EVERY (MP_TAC o C SPEC th) [`x - d`; `x + d`]) THEN
6049   REWRITE_TAC[REAL_ADD_SUB; REAL_SUB_SUB; ABS_NEG] THEN
6050   ASM_REWRITE_TAC[real_abs; REAL_LE_REFL] THEN
6051   DISCH_TAC THEN DISCH_TAC THEN DISJ_CASES_TAC
6052     (SPECL [`f(x - d):real`; `f(x + d):real`] REAL_LE_TOTAL) THENL
6053    [MP_TAC(SPECL [`f:real->real`; `x - d`; `x:real`; `f(x + d):real`] IVT) THEN
6054     ASM_REWRITE_TAC[REAL_LE_SUB_RADD; REAL_LE_ADDR] THEN
6055     W(C SUBGOAL_THEN MP_TAC o fst o dest_imp o dest_neg o snd) THENL
6056      [X_GEN_TAC `z:real` THEN STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
6057       ONCE_REWRITE_TAC[GSYM ABS_NEG] THEN
6058       REWRITE_TAC[real_abs; REAL_SUB_LE] THEN
6059       ASM_REWRITE_TAC[REAL_NEG_SUB; REAL_SUB_LE; REAL_LE_SUB_RADD] THEN
6060       ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_REWRITE_TAC[];
6061       DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN
6062       DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN
6063       FIRST_ASSUM(MP_TAC o AP_TERM `g:real->real`) THEN
6064       SUBGOAL_THEN `g((f:real->real) z) = z` SUBST1_TAC THENL
6065        [FIRST_ASSUM MATCH_MP_TAC THEN
6066         ONCE_REWRITE_TAC[GSYM ABS_NEG] THEN
6067         REWRITE_TAC[real_abs; REAL_SUB_LE] THEN
6068         ASM_REWRITE_TAC[REAL_NEG_SUB; REAL_SUB_LE; REAL_LE_SUB_RADD] THEN
6069         ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
6070       SUBGOAL_THEN `g(f(x + d):real) = x + d` SUBST1_TAC THENL
6071        [FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[REAL_ADD_SUB] THEN
6072         ASM_REWRITE_TAC[real_abs; REAL_LE_REFL]; ALL_TAC] THEN
6073       REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN
6074       MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x:real` THEN
6075       ASM_REWRITE_TAC[REAL_LT_ADDR]];
6076     MP_TAC(SPECL [`f:real->real`; `x:real`; `x + d`; `f(x - d):real`] IVT2) THEN
6077     ASM_REWRITE_TAC[REAL_LE_SUB_RADD; REAL_LE_ADDR] THEN
6078     W(C SUBGOAL_THEN MP_TAC o fst o dest_imp o dest_neg o snd) THENL
6079      [X_GEN_TAC `z:real` THEN STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
6080       ASM_REWRITE_TAC[real_abs; REAL_SUB_LE; REAL_LE_SUB_RADD] THEN
6081       ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_REWRITE_TAC[];
6082       DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN
6083       DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN
6084       FIRST_ASSUM(MP_TAC o AP_TERM `g:real->real`) THEN
6085       SUBGOAL_THEN `g((f:real->real) z) = z` SUBST1_TAC THENL
6086        [FIRST_ASSUM MATCH_MP_TAC THEN
6087         ASM_REWRITE_TAC[real_abs; REAL_SUB_LE; REAL_LE_SUB_RADD] THEN
6088         ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
6089       SUBGOAL_THEN `g(f(x - d):real) = x - d` SUBST1_TAC THENL
6090        [FIRST_ASSUM MATCH_MP_TAC THEN
6091         REWRITE_TAC[REAL_SUB_SUB; ABS_NEG] THEN
6092         ASM_REWRITE_TAC[real_abs; REAL_LE_REFL]; ALL_TAC] THEN
6093       REWRITE_TAC[] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN
6094       MATCH_MP_TAC REAL_LT_IMP_NE THEN
6095       MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `x:real` THEN
6096       ASM_REWRITE_TAC[REAL_LT_SUB_RADD; REAL_LT_ADDR]]]);;
6097
6098 (* ------------------------------------------------------------------------ *)
6099 (* Similar version for lower bound                                          *)
6100 (* ------------------------------------------------------------------------ *)
6101
6102 let CONT_INJ_LEMMA2 = prove(
6103   `!f g x d. &0 < d /\
6104             (!z. abs(z - x) <= d ==> (g(f(z)) = z)) /\
6105             (!z. abs(z - x) <= d ==> f contl z) ==>
6106      ~(!z. abs(z - x) <= d ==> f(x) <= f(z))`,
6107   REPEAT GEN_TAC THEN STRIP_TAC THEN
6108   MP_TAC(SPECL [`\x:real. --(f x)`; `\y. (g(--y):real)`; `x:real`; `d:real`]
6109     CONT_INJ_LEMMA) THEN
6110   BETA_TAC THEN ASM_REWRITE_TAC[REAL_NEGNEG; REAL_LE_NEG] THEN
6111   DISCH_THEN MATCH_MP_TAC THEN
6112   GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CONT_NEG THEN
6113   FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC);;
6114
6115 (* ------------------------------------------------------------------------ *)
6116 (* Show there's an interval surrounding f(x) in f[[x - d, x + d]]           *)
6117 (* ------------------------------------------------------------------------ *)
6118
6119 let CONT_INJ_RANGE = prove(
6120   `!f g x d.  &0 < d /\
6121             (!z. abs(z - x) <= d ==> (g(f(z)) = z)) /\
6122             (!z. abs(z - x) <= d ==> f contl z) ==>
6123         ?e. &0 < e /\
6124             (!y. abs(y - f(x)) <= e ==> ?z. abs(z - x) <= d /\ (f z = y))`,
6125   REPEAT GEN_TAC THEN STRIP_TAC THEN
6126   IMP_RES_THEN ASSUME_TAC REAL_LT_IMP_LE THEN
6127   MP_TAC(SPECL [`f:real->real`; `x - d`; `x + d`] CONT_ATTAINS_ALL) THEN
6128   ASM_REWRITE_TAC[INTERVAL_ABS; REAL_LE_SUB_RADD] THEN
6129   ASM_REWRITE_TAC[GSYM REAL_ADD_ASSOC; REAL_LE_ADDR; REAL_LE_DOUBLE] THEN
6130   DISCH_THEN(X_CHOOSE_THEN `L:real` (X_CHOOSE_THEN `M:real` MP_TAC)) THEN
6131   STRIP_TAC THEN
6132   SUBGOAL_THEN `L <= f(x:real) /\ f(x) <= M` STRIP_ASSUME_TAC THENL
6133    [FIRST_ASSUM MATCH_MP_TAC THEN
6134     ASM_REWRITE_TAC[REAL_SUB_REFL; ABS_0]; ALL_TAC] THEN
6135   SUBGOAL_THEN `L < f(x:real) /\ f(x:real) < M` STRIP_ASSUME_TAC THENL
6136    [CONJ_TAC THEN ASM_REWRITE_TAC[REAL_LT_LE] THENL
6137      [DISCH_THEN SUBST_ALL_TAC THEN (MP_TAC o C SPECL CONT_INJ_LEMMA2)
6138         [`f:real->real`; `g:real->real`; `x:real`; `d:real`];
6139       DISCH_THEN(SUBST_ALL_TAC o SYM) THEN (MP_TAC o C SPECL CONT_INJ_LEMMA)
6140         [`f:real->real`; `g:real->real`; `x:real`; `d:real`]] THEN
6141     ASM_REWRITE_TAC[] THEN GEN_TAC THEN
6142     DISCH_THEN(fun t -> FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP th t] THEN
6143       NO_TAC));
6144     MP_TAC(SPECL [`f(x:real) - L`; `M - f(x:real)`] REAL_DOWN2) THEN
6145     ASM_REWRITE_TAC[REAL_SUB_LT] THEN
6146     DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6147     EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN
6148     GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM INTERVAL_ABS] THEN
6149     REWRITE_TAC[REAL_LE_SUB_RADD] THEN ONCE_REWRITE_TAC[GSYM CONJ_ASSOC] THEN
6150     FIRST_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `abs(y - f(x:real)) <= e` THEN
6151     REWRITE_TAC[GSYM INTERVAL_ABS] THEN STRIP_TAC THEN CONJ_TAC THENL
6152      [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f(x:real) - e` THEN
6153       ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_LE_SUB_LADD] THEN
6154       ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
6155       REWRITE_TAC[GSYM REAL_LE_SUB_LADD];
6156       MATCH_MP_TAC REAL_LE_TRANS THEN
6157       EXISTS_TAC `f(x:real) + (M - f(x))` THEN CONJ_TAC THENL
6158        [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f(x:real) + e` THEN
6159         ASM_REWRITE_TAC[REAL_LE_LADD];
6160         REWRITE_TAC[REAL_SUB_ADD2; REAL_LE_REFL]]] THEN
6161     MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]);;
6162
6163 (* ------------------------------------------------------------------------ *)
6164 (* Continuity of inverse function                                           *)
6165 (* ------------------------------------------------------------------------ *)
6166
6167 let CONT_INVERSE = prove(
6168   `!f g x d. &0 < d /\
6169              (!z. abs(z - x) <= d ==> (g(f(z)) = z)) /\
6170              (!z. abs(z - x) <= d ==> f contl z)
6171         ==> g contl (f x)`,
6172   REPEAT STRIP_TAC THEN REWRITE_TAC[contl; LIM] THEN
6173   X_GEN_TAC `a:real` THEN DISCH_TAC THEN
6174   MP_TAC(SPECL [`a:real`; `d:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN
6175   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6176   IMP_RES_THEN ASSUME_TAC REAL_LT_IMP_LE THEN
6177   SUBGOAL_THEN `!z. abs(z - x) <= e ==> (g(f z :real) = z)` ASSUME_TAC THENL
6178    [X_GEN_TAC `z:real` THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
6179     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[];
6180     ALL_TAC] THEN
6181   SUBGOAL_THEN `!z. abs(z - x) <= e ==> (f contl z)` ASSUME_TAC THENL
6182    [X_GEN_TAC `z:real` THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
6183     MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[];
6184     ALL_TAC] THEN
6185   UNDISCH_TAC `!z. abs(z - x) <= d ==> (g(f z :real) = z)` THEN
6186   UNDISCH_TAC `!z. abs(z - x) <= d ==> (f contl z)` THEN
6187   DISCH_THEN(K ALL_TAC) THEN DISCH_THEN(K ALL_TAC) THEN
6188   (MP_TAC o C SPECL CONT_INJ_RANGE)
6189     [`f:real->real`; `g:real->real`; `x:real`; `e:real`] THEN
6190   ASM_REWRITE_TAC[] THEN
6191   DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN
6192   EXISTS_TAC `k:real` THEN ASM_REWRITE_TAC[] THEN
6193   X_GEN_TAC `h:real` THEN BETA_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN
6194   DISCH_THEN(CONJUNCTS_THEN2 MP_TAC
6195     (ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE)) THEN
6196   REWRITE_TAC[GSYM ABS_NZ] THEN DISCH_TAC THEN
6197   FIRST_ASSUM(fun th -> MP_TAC(SPEC `f(x:real) + h` th) THEN
6198     REWRITE_TAC[REAL_ADD_SUB; ASSUME `abs(h) <= k`] THEN
6199     DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC)) THEN
6200   FIRST_ASSUM(UNDISCH_TAC o check is_eq o concl) THEN
6201   DISCH_THEN(SUBST1_TAC o SYM) THEN
6202   MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `e:real` THEN
6203   SUBGOAL_THEN `(g((f:real->real)(z)) = z) /\ (g(f(x)) = x)`
6204     (fun t -> ASM_REWRITE_TAC[t]) THEN CONJ_TAC THEN
6205   FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[REAL_SUB_REFL; ABS_0]);;
6206
6207 (* ------------------------------------------------------------------------ *)
6208 (* Differentiability of inverse function                                    *)
6209 (* ------------------------------------------------------------------------ *)
6210
6211 let DIFF_INVERSE = prove(
6212   `!f g l x d. &0 < d /\
6213                (!z. abs(z - x) <= d ==> (g(f(z)) = z)) /\
6214                (!z. abs(z - x) <= d ==> f contl z) /\
6215                (f diffl l)(x) /\
6216                ~(l = &0)
6217         ==> (g diffl (inv l))(f x)`,
6218   REPEAT STRIP_TAC THEN UNDISCH_TAC `(f diffl l)(x)` THEN
6219   DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP DIFF_CONT th) THEN MP_TAC th) THEN
6220   REWRITE_TAC[DIFF_CARAT] THEN
6221   DISCH_THEN(X_CHOOSE_THEN `h:real->real` STRIP_ASSUME_TAC) THEN
6222   EXISTS_TAC `\y. if y = f(x) then
6223     inv(h(g y)) else (g(y) - g(f(x:real))) / (y - f(x))` THEN BETA_TAC THEN
6224   ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL
6225    [X_GEN_TAC `z:real` THEN COND_CASES_TAC THEN
6226     ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO] THEN
6227     CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN
6228     ASM_REWRITE_TAC[REAL_SUB_0];
6229     ALL_TAC;
6230     FIRST_ASSUM(SUBST1_TAC o SYM) THEN REPEAT AP_TERM_TAC THEN
6231     FIRST_ASSUM MATCH_MP_TAC THEN
6232     REWRITE_TAC[REAL_SUB_REFL; ABS_0] THEN
6233     MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]] THEN
6234   REWRITE_TAC[CONTL_LIM] THEN BETA_TAC THEN REWRITE_TAC[] THEN
6235   SUBGOAL_THEN `g((f:real->real)(x)) = x` ASSUME_TAC THENL
6236    [FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[REAL_SUB_REFL; ABS_0] THEN
6237     MATCH_MP_TAC REAL_LT_IMP_LE; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN
6238   MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC `\y:real. inv(h(g(y):real))` THEN
6239   BETA_TAC THEN CONJ_TAC THENL
6240    [ALL_TAC;
6241     (SUBST1_TAC o SYM o ONCE_DEPTH_CONV BETA_CONV)
6242       `\y. inv((\y:real. h(g(y):real)) y)` THEN
6243     MATCH_MP_TAC LIM_INV THEN ASM_REWRITE_TAC[] THEN
6244     SUBGOAL_THEN `(\y:real. h(g(y):real)) contl (f(x:real))` MP_TAC THENL
6245      [MATCH_MP_TAC CONT_COMPOSE THEN ASM_REWRITE_TAC[] THEN
6246       MATCH_MP_TAC CONT_INVERSE THEN EXISTS_TAC `d:real`;
6247       REWRITE_TAC[CONTL_LIM] THEN BETA_TAC] THEN
6248     ASM_REWRITE_TAC[]] THEN
6249   SUBGOAL_THEN `?e. &0 < e /\
6250                     !y. &0 < abs(y - f(x:real)) /\
6251                         abs(y - f(x:real)) < e ==>
6252                             (f(g(y)) = y) /\ ~(h(g(y)) = &0)`
6253   STRIP_ASSUME_TAC THENL
6254    [ALL_TAC;
6255     REWRITE_TAC[LIM] THEN X_GEN_TAC `k:real` THEN DISCH_TAC THEN
6256     EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real` THEN
6257     DISCH_THEN(fun th -> FIRST_ASSUM(STRIP_ASSUME_TAC o C MATCH_MP th) THEN
6258       ASSUME_TAC(REWRITE_RULE[GSYM ABS_NZ; REAL_SUB_0] (CONJUNCT1 th))) THEN
6259     BETA_TAC THEN ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN
6260     SUBGOAL_THEN `y - f(x) = h(g(y)) * (g(y) - x)` SUBST1_TAC THENL
6261      [FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN
6262       REWRITE_TAC[ASSUME `f((g:real->real)(y)) = y`];
6263       UNDISCH_TAC `&0 < k` THEN
6264       MATCH_MP_TAC EQ_IMP THEN
6265       AP_THM_TAC THEN AP_TERM_TAC THEN
6266       CONV_TAC SYM_CONV THEN REWRITE_TAC[ABS_ZERO; REAL_SUB_0]] THEN
6267     SUBGOAL_THEN `~(g(y:real) - x = &0)` ASSUME_TAC THENL
6268      [REWRITE_TAC[REAL_SUB_0] THEN
6269       DISCH_THEN(MP_TAC o AP_TERM `f:real->real`) THEN
6270       ASM_REWRITE_TAC[]; REWRITE_TAC[real_div]] THEN
6271     SUBGOAL_THEN `inv((h(g(y))) * (g(y:real) - x)) =
6272       inv(h(g(y))) * inv(g(y) - x)` SUBST1_TAC THENL
6273      [MATCH_MP_TAC REAL_INV_MUL_WEAK THEN ASM_REWRITE_TAC[];
6274       REWRITE_TAC[REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
6275       REWRITE_TAC[REAL_MUL_ASSOC] THEN
6276       GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
6277       AP_THM_TAC THEN AP_TERM_TAC THEN
6278       MATCH_MP_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[]]] THEN
6279   SUBGOAL_THEN
6280     `?e. &0 < e /\
6281          !y. &0 < abs(y - f(x:real)) /\ abs(y - f(x)) < e ==> (f(g(y)) = y)`
6282   (X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THENL
6283    [MP_TAC(SPECL [`f:real->real`; `g:real->real`; `x:real`; `d:real`]
6284       CONT_INJ_RANGE) THEN ASM_REWRITE_TAC[] THEN
6285     DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6286     EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN
6287     X_GEN_TAC `y:real` THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN
6288     DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN
6289     DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
6290     DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN
6291     UNDISCH_TAC `(f:real->real)(z) = y` THEN
6292     DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN
6293     FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN
6294   SUBGOAL_THEN
6295     `?e. &0 < e /\
6296          !y. &0 < abs(y - f(x:real)) /\ abs(y - f(x)) < e
6297                     ==> ~((h:real->real)(g(y)) = &0)`
6298   (X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THENL
6299    [ALL_TAC;
6300     MP_TAC(SPECL [`b:real`; `c:real`] REAL_DOWN2) THEN
6301     ASM_REWRITE_TAC[] THEN
6302     DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6303     EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN
6304     X_GEN_TAC `y:real` THEN STRIP_TAC THEN CONJ_TAC THEN
6305     FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
6306     MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `e:real` THEN
6307     ASM_REWRITE_TAC[]] THEN
6308   SUBGOAL_THEN `(\y. h(g(y:real):real)) contl (f(x:real))` MP_TAC THENL
6309    [MATCH_MP_TAC CONT_COMPOSE THEN ASM_REWRITE_TAC[] THEN
6310     MATCH_MP_TAC CONT_INVERSE THEN EXISTS_TAC `d:real` THEN
6311     ASM_REWRITE_TAC[]; ALL_TAC] THEN
6312   REWRITE_TAC[CONTL_LIM; LIM] THEN DISCH_THEN(MP_TAC o SPEC `abs(l)`) THEN
6313   ASM_REWRITE_TAC[GSYM ABS_NZ] THEN BETA_TAC THEN ASM_REWRITE_TAC[] THEN
6314   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6315   EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[ABS_NZ] THEN X_GEN_TAC `y:real` THEN
6316   RULE_ASSUM_TAC(REWRITE_RULE[ABS_NZ]) THEN
6317   DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN
6318   REWRITE_TAC[GSYM ABS_NZ] THEN
6319   CONV_TAC CONTRAPOS_CONV THEN ASM_REWRITE_TAC[] THEN
6320   DISCH_THEN SUBST1_TAC THEN
6321   REWRITE_TAC[REAL_SUB_LZERO; ABS_NEG; REAL_LT_REFL]);;
6322
6323 let DIFF_INVERSE_LT = prove(
6324   `!f g l x d. &0 < d /\
6325                (!z. abs(z - x) < d ==> (g(f(z)) = z)) /\
6326                (!z. abs(z - x) < d ==> f contl z) /\
6327                (f diffl l)(x) /\
6328                ~(l = &0)
6329         ==> (g diffl (inv l))(f x)`,
6330   REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFF_INVERSE THEN
6331   EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN
6332   REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN
6333   MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `d / &2` THEN
6334   ASM_REWRITE_TAC[REAL_LT_HALF2]);;
6335
6336 (* ------------------------------------------------------------------------- *)
6337 (* Every derivative is Darboux continuous.                                   *)
6338 (* ------------------------------------------------------------------------- *)
6339
6340 let IVT_DERIVATIVE_0 = prove
6341  (`!f f' a b.
6342         a <= b /\
6343         (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x)) /\
6344         f'(a) > &0 /\ f'(b) < &0
6345         ==> ?z. a < z /\ z < b /\ (f'(z) = &0)`,
6346   REPEAT GEN_TAC THEN REWRITE_TAC[real_gt] THEN
6347   GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [REAL_LE_LT] THEN
6348   STRIP_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LT_ANTISYM]] THEN
6349   SUBGOAL_THEN `?w. (!x. a <= x /\ x <= b ==> f x <= w) /\
6350                     (?x. a <= x /\ x <= b /\ (f x = w))`
6351   MP_TAC THENL
6352    [MATCH_MP_TAC CONT_ATTAINS THEN
6353     ASM_MESON_TAC[REAL_LT_IMP_LE; DIFF_CONT]; ALL_TAC] THEN
6354   DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
6355   DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN
6356   EXISTS_TAC `z:real` THEN ASM_CASES_TAC `z:real = a` THENL
6357    [UNDISCH_THEN `z:real = a` SUBST_ALL_TAC  THEN
6358     MP_TAC(SPECL[`f:real->real`; `a:real`; `(f':real->real) a`] DIFF_LINC) THEN
6359     ASM_SIMP_TAC[REAL_LE_REFL; REAL_LT_IMP_LE] THEN
6360     DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
6361     MP_TAC(SPECL [`d:real`; `b - a`] REAL_DOWN2) THEN
6362     ASM_REWRITE_TAC[REAL_LT_SUB_LADD; REAL_ADD_LID] THEN
6363     DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6364     UNDISCH_TAC `!h. &0 < h /\ h < d ==> w < f (a + h)` THEN
6365     DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
6366     CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN
6367     REWRITE_TAC[REAL_NOT_LT] THEN FIRST_ASSUM MATCH_MP_TAC THEN
6368     ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
6369     ASM_SIMP_TAC[REAL_LE_ADDL; REAL_LT_IMP_LE]; ALL_TAC] THEN
6370   ASM_CASES_TAC `z:real = b` THENL
6371    [UNDISCH_THEN `z:real = b` SUBST_ALL_TAC  THEN
6372     MP_TAC(SPECL[`f:real->real`; `b:real`; `(f':real->real) b`] DIFF_LDEC) THEN
6373     ASM_SIMP_TAC[REAL_LE_REFL; REAL_LT_IMP_LE] THEN
6374     DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
6375     MP_TAC(SPECL [`d:real`; `b - a`] REAL_DOWN2) THEN
6376     ASM_REWRITE_TAC[REAL_LT_SUB_LADD; REAL_ADD_LID] THEN
6377     DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6378     UNDISCH_TAC `!h. &0 < h /\ h < d ==> w < f (b - h)` THEN
6379     DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
6380     CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN
6381     REWRITE_TAC[REAL_NOT_LT] THEN FIRST_ASSUM MATCH_MP_TAC THEN
6382     REWRITE_TAC[REAL_LE_SUB_LADD; REAL_LE_SUB_RADD] THEN
6383     ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN
6384     ASM_SIMP_TAC[REAL_LE_ADDL; REAL_LT_IMP_LE]; ALL_TAC] THEN
6385   SUBGOAL_THEN `a < z /\ z < b` STRIP_ASSUME_TAC THENL
6386    [ASM_REWRITE_TAC[REAL_LT_LE]; ALL_TAC] THEN
6387   ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIFF_LMAX THEN
6388   MP_TAC(SPECL [`z - a`; `b - z`] REAL_DOWN2) THEN
6389   ASM_REWRITE_TAC[REAL_LT_SUB_LADD; REAL_ADD_LID] THEN
6390   DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
6391   MAP_EVERY EXISTS_TAC [`f:real->real`; `z:real`] THEN
6392   ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN
6393   EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN
6394   DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN
6395   MAP_EVERY UNDISCH_TAC [`e + z < b`; `e + a < z`] THEN
6396   REAL_ARITH_TAC);;
6397
6398 let IVT_DERIVATIVE_POS = prove
6399  (`!f f' a b y.
6400         a <= b /\
6401         (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x)) /\
6402         f'(a) > y /\ f'(b) < y
6403         ==> ?z. a < z /\ z < b /\ (f'(z) = y)`,
6404   REWRITE_TAC[real_gt] THEN REPEAT STRIP_TAC THEN
6405   MP_TAC(SPECL [`\x. f(x) - y * x`; `\x:real. f'(x) - y`;
6406                 `a:real`; `b:real`] IVT_DERIVATIVE_0) THEN
6407   ASM_REWRITE_TAC[real_gt] THEN
6408   ASM_REWRITE_TAC[REAL_LT_SUB_LADD; REAL_LT_SUB_RADD] THEN
6409   ASM_REWRITE_TAC[REAL_EQ_SUB_RADD; REAL_ADD_LID] THEN
6410   GEN_REWRITE_TAC (funpow 2 LAND_CONV o BINDER_CONV o RAND_CONV o
6411                    LAND_CONV o RAND_CONV) [GSYM REAL_MUL_RID] THEN
6412   ASM_SIMP_TAC[DIFF_SUB; DIFF_X; DIFF_CMUL]);;
6413
6414 let IVT_DERIVATIVE_NEG = prove
6415  (`!f f' a b y.
6416         a <= b /\
6417         (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x)) /\
6418         f'(a) < y /\ f'(b) > y
6419         ==> ?z. a < z /\ z < b /\ (f'(z) = y)`,
6420   REWRITE_TAC[real_gt] THEN REPEAT STRIP_TAC THEN
6421   MP_TAC(SPECL [`\x:real. --(f x)`; `\x:real. --(f' x)`;
6422                 `a:real`; `b:real`; `--y`] IVT_DERIVATIVE_POS) THEN
6423   ASM_REWRITE_TAC[real_gt; REAL_LT_NEG2; REAL_EQ_NEG2] THEN
6424   ASM_SIMP_TAC[DIFF_NEG]);;
6425
6426 (* ------------------------------------------------------------------------- *)
6427 (* Uniformly convergent sequence of continuous functions is continuous.      *)
6428 (* (Continuity at a point; uniformity in some neighbourhood of that point.)  *)
6429 (* ------------------------------------------------------------------------- *)
6430
6431 let SEQ_CONT_UNIFORM = prove
6432  (`!s f x0. (!e. &0 < e
6433                  ==> ?N d. &0 < d /\
6434                            !x n. abs(x - x0) < d /\ n >= N
6435                                  ==> abs(s n x - f(x)) < e) /\
6436             (?N:num. !n. n >= N ==> (s n) contl x0)
6437             ==> f contl x0`,
6438   REPEAT GEN_TAC THEN
6439   DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `M:num`)) THEN
6440   REWRITE_TAC[CONTL_LIM; LIM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
6441   FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN
6442   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; LEFT_IMP_EXISTS_THM] THEN
6443   MAP_EVERY X_GEN_TAC [`N:num`; `d1:real`] THEN STRIP_TAC THEN
6444   FIRST_X_ASSUM(MP_TAC o SPEC `M + N:num`) THEN REWRITE_TAC[GE; LE_ADD] THEN
6445   REWRITE_TAC[CONTL_LIM; LIM] THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN
6446   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
6447   DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN
6448   MP_TAC(SPECL [`d1:real`; `d2:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN
6449   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN
6450   ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN
6451   MATCH_MP_TAC(REAL_ARITH
6452    `!fx sx fx0 sx0 e3.
6453         abs(sx - fx) < e3 /\ abs(sx0 - fx0) < e3 /\ abs(sx - sx0) < e3 /\
6454         (&3 * e3 = e)
6455         ==> abs(fx - fx0) < e`) THEN
6456   MAP_EVERY EXISTS_TAC
6457    [`(s:num->real->real) (M + N) x`;
6458     `(s:num->real->real) (M + N) x0`;
6459     `e / &3`] THEN
6460   ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH] THEN
6461   ASM_MESON_TAC[REAL_SUB_REFL; REAL_ABS_NUM; REAL_LT_TRANS;
6462                 ARITH_RULE `M + N >= N:num`]);;
6463
6464 (* ------------------------------------------------------------------------- *)
6465 (* Comparison test gives uniform convergence of sum in a neighbourhood.      *)
6466 (* ------------------------------------------------------------------------- *)
6467
6468 let SER_COMPARA_UNIFORM = prove
6469  (`!s x0 g.
6470         (?N d. &0 < d /\
6471                !n x. abs(x - x0) < d /\ n >= N
6472                      ==> abs(s x n) <= g n) /\ summable g
6473         ==> ?f d. &0 < d /\
6474                   !e. &0 < e
6475                       ==> ?N. !x n. abs(x - x0) < d /\ n >= N
6476                                     ==> abs(sum(0,n) (s x) - f(x)) < e`,
6477   REPEAT STRIP_TAC THEN
6478   SUBGOAL_THEN `!x. abs(x - x0) < d ==> ?y. (s x) sums y` MP_TAC THENL
6479    [ASM_MESON_TAC[summable; SER_COMPAR]; ALL_TAC] THEN
6480   GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV)
6481       [RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN
6482   MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real->real` THEN DISCH_TAC THEN
6483   EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN
6484   X_GEN_TAC `e:real` THEN DISCH_TAC THEN
6485   FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SER_CAUCHY]) THEN
6486   DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN
6487   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
6488   DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN
6489   EXISTS_TAC `M + N:num` THEN ASM_REWRITE_TAC[] THEN
6490   MAP_EVERY X_GEN_TAC [`x:real`; `n:num`] THEN STRIP_TAC THEN
6491   FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP (ARITH_RULE
6492    `n >= M + N ==> n >= M /\ n >= N:num`)) THEN
6493   FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[sums; SEQ] THEN
6494   DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN
6495   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
6496   DISCH_THEN(X_CHOOSE_THEN `m:num` (MP_TAC o SPEC `m + n:num`)) THEN
6497   REWRITE_TAC[GE; LE_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN
6498   ONCE_REWRITE_TAC[GSYM SUM_TWO] THEN
6499   MATCH_MP_TAC(REAL_ARITH
6500    `abs(snm) < e2 /\ (&2 * e2 = e)
6501     ==> abs((sn + snm) - fx) < e2 ==> abs(sn - fx) < e`) THEN
6502   SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH] THEN
6503   MATCH_MP_TAC REAL_LET_TRANS THEN
6504   EXISTS_TAC `sum(n,m) (\n. abs(s (x:real) n))` THEN
6505   REWRITE_TAC[SUM_ABS_LE] THEN
6506   MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum(n,m) g` THEN CONJ_TAC THENL
6507    [MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN
6508     REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN
6509     ASM_MESON_TAC[GE; LE_TRANS]; ALL_TAC] THEN
6510   MATCH_MP_TAC(REAL_ARITH `abs(x) < a ==> x < a`) THEN ASM_SIMP_TAC[]);;
6511
6512 (* ------------------------------------------------------------------------- *)
6513 (* A weaker variant matching the requirement for continuity of limit.        *)
6514 (* ------------------------------------------------------------------------- *)
6515
6516 let SER_COMPARA_UNIFORM_WEAK = prove
6517  (`!s x0 g.
6518         (?N d. &0 < d /\
6519                !n x. abs(x - x0) < d /\ n >= N
6520                      ==> abs(s x n) <= g n) /\ summable g
6521         ==> ?f. !e. &0 < e
6522                     ==> ?N d. &0 < d /\
6523                               !x n. abs(x - x0) < d /\ n >= N
6524                                     ==> abs(sum(0,n) (s x) - f(x)) < e`,
6525   REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SER_COMPARA_UNIFORM) THEN
6526   MESON_TAC[]);;
6527
6528 (* ------------------------------------------------------------------------- *)
6529 (* More convenient formulation of continuity.                                *)
6530 (* ------------------------------------------------------------------------- *)
6531
6532 let CONTL = prove
6533  (`!f x. f contl x <=>
6534          !e. &0 < e ==> ?d. &0 < d /\ !x'. abs(x' - x) < d
6535                             ==> abs(f(x') - f(x)) < e`,
6536   REPEAT GEN_TAC THEN REWRITE_TAC[CONTL_LIM; LIM] THEN
6537   REWRITE_TAC[REAL_ARITH `&0 < abs(x - y) <=> ~(x = y)`] THEN
6538   AP_TERM_TAC THEN ABS_TAC THEN
6539   MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> ((a ==> b) <=> (a ==> c))`) THEN
6540   DISCH_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
6541   AP_TERM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN
6542   ASM_MESON_TAC[REAL_ARITH `abs(x - x) = &0`]);;
6543
6544 (* ------------------------------------------------------------------------- *)
6545 (* Of course we also have this and similar results for sequences.            *)
6546 (* ------------------------------------------------------------------------- *)
6547
6548 let CONTL_SEQ = prove
6549  (`!f x l. f contl l /\ x tends_num_real l
6550
6551            ==> (\n. f(x n)) tends_num_real f(l)`,
6552   REWRITE_TAC[CONTL; SEQ] THEN MESON_TAC[]);;
6553
6554 (* ------------------------------------------------------------------------- *)
6555 (* Uniformity of continuity over closed interval.                            *)
6556 (* ------------------------------------------------------------------------- *)
6557
6558 let SUP_INTERVAL = prove
6559  (`!P a b.
6560         (?x. a <= x /\ x <= b /\ P x)
6561         ==> ?s. a <= s /\ s <= b /\
6562                 !y. y < s <=> (?x. a <= x /\ x <= b /\ P x /\ y < x)`,
6563   REPEAT STRIP_TAC THEN
6564   MP_TAC(SPEC `\x. a <= x /\ x <= b /\ P x` REAL_SUP) THEN ANTS_TAC THENL
6565    [ASM_REWRITE_TAC[] THEN
6566     ASM_MESON_TAC[ARITH_RULE `x <= b ==> x < b + &1`];
6567     ALL_TAC] THEN
6568   ABBREV_TAC `s = sup (\x. a <= x /\ x <= b /\ P x)` THEN
6569   REWRITE_TAC[] THEN DISCH_TAC THEN EXISTS_TAC `s:real` THEN
6570   ASM_REWRITE_TAC[] THEN
6571   ASM_MESON_TAC[REAL_LTE_TRANS; REAL_NOT_LE; REAL_LT_ANTISYM]);;
6572
6573 let CONT_UNIFORM = prove
6574  (`!f a b. a <= b /\ (!x. a <= x /\ x <= b ==> f contl x)
6575            ==> !e. &0 < e ==> ?d. &0 < d /\
6576                                   !x y. a <= x /\ x <= b /\
6577                                         a <= y /\ y <= b /\
6578                                         abs(x - y) < d
6579                                         ==> abs(f(x) - f(y)) < e`,
6580   REPEAT STRIP_TAC THEN
6581   MP_TAC(SPEC `\c. ?d. &0 < d /\
6582                        !x y. a <= x /\ x <= c /\
6583                              a <= y /\ y <= c /\
6584                              abs(x - y) < d
6585                              ==> abs(f(x) - f(y)) < e`
6586          SUP_INTERVAL) THEN
6587   DISCH_THEN(MP_TAC o SPECL [`a:real`; `b:real`]) THEN ANTS_TAC THENL
6588    [EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN
6589     REPEAT STRIP_TAC THEN EXISTS_TAC `&1` THEN
6590     REWRITE_TAC[REAL_OF_NUM_LT; ARITH] THEN
6591     ASM_MESON_TAC[REAL_LE_ANTISYM; REAL_ARITH `abs(x - x) = &0`];
6592     ALL_TAC] THEN
6593   REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `s:real` STRIP_ASSUME_TAC) THEN
6594   SUBGOAL_THEN `?t. s < t /\ ?d. &0 < d /\
6595                                  !x y. a <= x /\ x <= t /\ a <= y /\ y <= t /\
6596                                        abs(x - y) < d ==> abs(f(x) - f(y)) < e`
6597   MP_TAC THENL
6598    [UNDISCH_TAC `!x. a <= x /\ x <= b ==> f contl x` THEN
6599     DISCH_THEN(MP_TAC o SPEC `s:real`) THEN ASM_REWRITE_TAC[] THEN
6600     REWRITE_TAC[CONTL_LIM; LIM] THEN
6601     DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN
6602     ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
6603     DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN
6604     SUBGOAL_THEN `&0 < d1 / &2 /\ d1 / &2 < d1` STRIP_ASSUME_TAC THENL
6605      [ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; REAL_LT_LDIV_EQ;
6606                    REAL_ARITH `d < d * &2 <=> &0 < d`];
6607       ALL_TAC] THEN
6608     SUBGOAL_THEN `!x y. abs(x - s) < d1 /\ abs(y - s) < d1
6609                         ==> abs(f(x) - f(y)) < e`
6610     ASSUME_TAC THENL
6611      [REPEAT STRIP_TAC THEN
6612       MATCH_MP_TAC(REAL_ARITH
6613        `!a. abs(x - a) < e / &2 /\ abs(y - a) < e / &2 /\ (&2 * e / &2 = e)
6614             ==> abs(x - y) < e`) THEN
6615       EXISTS_TAC `(f:real->real) s` THEN
6616       SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH] THEN
6617       SUBGOAL_THEN `!x. abs(x - s) < d1 ==> abs(f x - f s) < e / &2`
6618        (fun th -> ASM_MESON_TAC[th]) THEN
6619       X_GEN_TAC `u:real` THEN
6620       REPEAT STRIP_TAC THEN ASM_CASES_TAC `u:real = s` THENL
6621        [ASM_SIMP_TAC[REAL_SUB_REFL; REAL_ABS_NUM; REAL_LT_DIV;
6622                      REAL_OF_NUM_LT; ARITH];
6623         ALL_TAC] THEN
6624       ASM_MESON_TAC[REAL_ARITH `&0 < abs(x - s) <=> ~(x = s)`];
6625       ALL_TAC] THEN
6626     SUBGOAL_THEN `s - d1 / &2 < s` MP_TAC THENL
6627      [ASM_REWRITE_TAC[REAL_ARITH `x - y < x <=> &0 < y`];
6628       ALL_TAC] THEN
6629     DISCH_THEN(fun th -> FIRST_ASSUM(fun th' ->
6630       MP_TAC(GEN_REWRITE_RULE I [th'] th))) THEN
6631     DISCH_THEN(X_CHOOSE_THEN `r:real` MP_TAC) THEN
6632     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
6633     DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
6634     DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
6635     DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN
6636     MP_TAC(SPECL [`d2:real`; `d1 / &2`] REAL_DOWN2) THEN
6637     ASM_REWRITE_TAC[] THEN
6638     DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
6639     EXISTS_TAC `s + d / &2` THEN
6640     ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH;
6641                  REAL_ARITH `s < s + d <=> &0 < d`] THEN
6642     EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN
6643     MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN STRIP_TAC THEN
6644     ASM_CASES_TAC `x <= r /\ y <= r` THENL
6645      [ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN
6646     MATCH_MP_TAC(ASSUME
6647      `!x y. abs(x - s) < d1 /\ abs(y - s) < d1 ==> abs(f x - f y) < e`) THEN
6648     MATCH_MP_TAC(REAL_ARITH
6649      `!r t d d12.
6650        ~(x <= r /\ y <= r) /\
6651       abs(x - y) < d /\
6652       s - d12 < r /\ t <= s + d /\
6653       x <= t /\ y <= t /\ &2 * d12 <= e /\
6654       &2 * d < e ==> abs(x - s) < e /\ abs(y - s) < e`) THEN
6655     MAP_EVERY EXISTS_TAC [`r:real`; `s + d / &2`; `d:real`; `d1 / &2`] THEN
6656     ASM_REWRITE_TAC[REAL_LE_LADD] THEN
6657     SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH] THEN
6658     ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
6659     SIMP_TAC[REAL_LE_LDIV_EQ; GSYM REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN
6660     ASM_SIMP_TAC[REAL_ARITH `&0 < d ==> d <= d * &2`; REAL_LE_REFL];
6661     ALL_TAC] THEN
6662   DISCH_THEN(X_CHOOSE_THEN `t:real` (CONJUNCTS_THEN ASSUME_TAC)) THEN
6663   SUBGOAL_THEN `b <= t` (fun th -> ASM_MESON_TAC[REAL_LE_TRANS; th]) THEN
6664   FIRST_X_ASSUM(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
6665   UNDISCH_THEN `!x. a <= x /\ x <= b ==> f contl x` (K ALL_TAC) THEN
6666   FIRST_X_ASSUM(MP_TAC o check(is_eq o concl) o SPEC `s:real`) THEN
6667   REWRITE_TAC[REAL_LT_REFL] THEN
6668   ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN
6669   DISCH_TAC THEN EXISTS_TAC `t:real` THEN
6670   ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]);;
6671
6672 (* ------------------------------------------------------------------------- *)
6673 (* Slightly stronger version exploiting 2-sided continuity at ends.          *)
6674 (* ------------------------------------------------------------------------- *)
6675
6676 let CONT_UNIFORM_STRONG = prove
6677  (`!f a b. (!x. a <= x /\ x <= b ==> f contl x)
6678            ==> !e. &0 < e
6679                    ==> ?d. &0 < d /\
6680                            !x y. (a <= x /\ x <= b \/ a <= y /\ y <= b) /\
6681                                  abs(x - y) < d
6682                                  ==> abs(f(x) - f(y)) < e`,
6683   REPEAT STRIP_TAC THEN
6684   ASM_CASES_TAC `a <= b` THENL
6685    [ALL_TAC; ASM_MESON_TAC[REAL_LE_TRANS; REAL_LT_01]] THEN
6686   FIRST_ASSUM(fun th ->
6687     MP_TAC(SPEC `a:real` th) THEN MP_TAC(SPEC `b:real` th)) THEN
6688   REWRITE_TAC[CONTL; REAL_LE_REFL] THEN
6689   ASM_REWRITE_TAC[] THEN
6690   DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN
6691   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
6692   DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN
6693   DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN
6694   ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
6695   DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN
6696   MP_TAC(SPECL [`d1:real`; `d2:real`] REAL_DOWN2) THEN
6697   ASM_REWRITE_TAC[] THEN
6698   DISCH_THEN(X_CHOOSE_THEN `d0:real` STRIP_ASSUME_TAC) THEN
6699   MP_TAC(SPECL [`f:real->real`; `a:real`; `b:real`] CONT_UNIFORM) THEN
6700   ASM_REWRITE_TAC[] THEN
6701   DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
6702   DISCH_THEN(X_CHOOSE_THEN `d3:real` STRIP_ASSUME_TAC) THEN
6703   MP_TAC(SPECL [`d0:real`; `d3:real`] REAL_DOWN2) THEN
6704   ASM_REWRITE_TAC[] THEN
6705   DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN
6706   EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN
6707   MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL
6708    [MESON_TAC[REAL_ABS_SUB]; ALL_TAC] THEN
6709   REPEAT STRIP_TAC THENL
6710    [ASM_CASES_TAC `y <= b` THENL
6711      [ASM_MESON_TAC[REAL_LT_TRANS; REAL_LE_TRANS]; ALL_TAC] THEN
6712     MATCH_MP_TAC(REAL_ARITH
6713      `!a. abs(x - a) < e / &2 /\ abs(y - a) < e / &2 /\ (&2 * e / &2 = e)
6714           ==> abs(x - y) < e`) THEN
6715     EXISTS_TAC `(f:real->real) b` THEN
6716     SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ] THEN
6717     ASM_MESON_TAC[REAL_LT_TRANS; REAL_ARITH
6718      `x <= b /\ ~(y <= b) /\ abs(x - y) < d /\ d < d1
6719       ==> abs(x - b) < d1 /\ abs(y - b) < d1`];
6720     ASM_CASES_TAC `a <= x` THENL
6721      [ASM_MESON_TAC[REAL_LT_TRANS; REAL_LE_TRANS]; ALL_TAC] THEN
6722     MATCH_MP_TAC(REAL_ARITH
6723      `!a. abs(x - a) < e / &2 /\ abs(y - a) < e / &2 /\ (&2 * e / &2 = e)
6724           ==> abs(x - y) < e`) THEN
6725     EXISTS_TAC `(f:real->real) a` THEN
6726     SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ] THEN
6727     ASM_MESON_TAC[REAL_LT_TRANS; REAL_ARITH
6728      `~(a <= x) /\ a <= y /\ abs(x - y) < d /\ d < d1
6729       ==> abs(x - a) < d1 /\ abs(y - a) < d1`]]);;
6730
6731 (* ------------------------------------------------------------------------- *)
6732 (* Get rid of special syntax status of '-->'.                                *)
6733 (* ------------------------------------------------------------------------- *)
6734
6735 remove_interface "-->";;